source: to-imperative/trunk/compiler/src/org/refal/plus/compiler/rfp_src.rf @ 3595

$use Apply Arithm Box Class Convert Dir File Java List StdIO Table ;

$use "org.refal.plus.compiler.rfpc";
$use "org.refal.plus.compiler.rfp_helper";

//$use "org.refal.plus.wrappers.java.io.BufferedReader";
//$use "org.refal.plus.wrappers.java.io.InputStreamReader";
//$use "org.refal.plus.wrappers.java.lang.ClassLoader";
//$use "org.refal.plus.wrappers.org.refal.plus.comp.CompilerEnvironment";
//$use "org.refal.plus.wrappers.org.refal.plus.comp.FormatReader";

$func BRclose s = ;
$native BRclose = "void java.io.BufferedReader.close ()";

$func BRreadLine s = s;
$native BRreadLine = "java.lang.String java.io.BufferedReader.readLine ()";

$func BufferedReader s = s;
$native BufferedReader = "java.io.BufferedReader (java.io.Reader)";

$func InputStreamReader s = s;
$native InputStreamReader = "java.io.InputStreamReader (java.io.InputStream)";

$func GetSystemResourceAsStream s = s;
$native GetSystemResourceAsStream = "static java.io.InputStream java.lang.ClassLoader.getSystemResourceAsStream (java.lang.String)";

$func  Arg_GetImplementationReader t.fileId = (e.qname) (e.inter_reader) (e.implem_reader) ;
$func? Arg_GetInterfaceReader e.qname = e.reader ;
//$func  Env_GetImplementationReader t.fileId = (e.qname) (e.inter_reader) (e.implem_reader) ;
//$func? Env_GetInterfaceReader e.qname = e.reader ;

$box Env Package ;

Reader_GetLine s.srctype s.getline_func (e.name) (e.src) =
  <Apply s.getline_func e.src>;

Reader_Close s.srctype s.getline_func (e.name) (e.src) =
  s.srctype :
  {
    FILE = e.src : {
      s.channel, {
        <IsChannel s.channel> = <CloseChannel s.channel>;
        <BRclose s.channel>;
      };
      /*empty*/;
    };
    STDIN = ;
  };

GetImplementationReader t.fileId =
//  {
//    <Get &Env> : s = <Env_GetImplementationReader t.fileId>;
    = <Arg_GetImplementationReader t.fileId>;
//  };

GetInterfaceReader e.name =
//  {
//    <Get &Env> : s = <Env_GetInterfaceReader e.name>;
    = <Arg_GetInterfaceReader e.name>;
//  };


$func? Try_Open e.filename = e.source;
$func? Get_Line_From_File e.source = e.line ;
$func? Get_Line_From_Reader s.reader = e.line;
$func? ReadFormatsFromBox e = e.line;

RFP_Src_InitFromArgs e.files =
  {
    <Store &Package <Make_Name <Lookup &RFP_Options PACKAGE>>>;
    <Store &Package>;
  };

Arg_GetImplementationReader (e.file) =
  <Get &DirSeparator> : s.dir_separator,
  e.file : {
    $r e s.dir_separator e.name '.' e = e.name;
    $r e.name '.' e = e.name;
  } :: e.name,
  <Get &Package> <ToWord e.name> :: e.qname,
  e.file : $r e.head '.' e,
  {
    <Try_Open e.head '.rfi'>;
    /*empty*/;
  } :: e.inter_reader,
  {
    <Try_Open e.file>;
    /*empty*/;
  } :: e.implem_reader,
  //<WriteLn "Arg_GetImplementationReader: " (e.qname) (e.inter_reader) (e.implem_reader)>,
  (e.qname) (e.inter_reader) (e.implem_reader);

$box FormatsFromClass;

$func ReadFormatsFromClass s = s;
$native ReadFormatsFromClass = "static java.lang.String org.refal.plus.compiler.FormatReader.ReadFormatsFromClass (java.lang.String)";

$func ReadFormatsFromFile s = s;
$native ReadFormatsFromFile = "static java.lang.String org.refal.plus.compiler.FormatReader.ReadFormatsFromFile (java.lang.String)";

Arg_GetInterfaceReader e.qname =
  <Store &FormatsFromClass>,
  <Get &DirSeparator> : s.dir_separator,
  \{
    <Intersperse (s.dir_separator) e.qname> :: e.fname,
      <Get &RFP_Include_Path> : e (e.dirname) e,
      <Try_Open e.dirname e.fname '.rfi'>;
    $trap \{
      <Intersperse ('/') e.qname> '.rfi' :: e.fname \?
        <GetSystemResourceAsStream <ToWord e.fname>> <Null> : {
          s.null s.null \! $fail;
          s.is   s.null = FILE &Get_Line_From_Reader (e.fname) (<BufferedReader <InputStreamReader s.is>>);
        };
      <Intersperse (s.dir_separator) e.qname> :: e.fname,
        <Get &RFP_Include_Path> : e (e.dirname) e \?
        <ReadFormatsFromFile <ToWord e.dirname e.fname '.class'>> <Null> : {
          s.null s.null \! $fail;
          s.str  s.null = <Store &FormatsFromClass <ToChars s.str>>,
            FILE &ReadFormatsFromBox (e.dirname e.fname '.class') ();
        };
      <Intersperse ('/') e.qname> :: e.fname \?
        <ReadFormatsFromClass <ToWord e.fname>> <Null> : {
          s.null s.null \! $fail;
          s.str  s.null = <Store &FormatsFromClass <ToChars s.str>>,
            FILE &ReadFormatsFromBox (e.fname '.class') ();
        };
    }
    $with \{
      e "Not available",
        e.qname : "refal" "plus" e.lib,
        <Intersperse (s.dir_separator) e.lib> :: e.lib,
        <Get &RFP_Boot_Path> : e (e.dirname) e,
        <Try_Open e.dirname e.lib '.rfi'>;
    };
  };

Try_Open e.filename =
  {
    <IsRFP_Debug>, <PrintLn "Trying to open \'" e.filename "\'">;;
  },
  {
    <IsCaseInsensitive> \?
      <Get &DirSeparator> : s.dir_separator,
      {
        e.filename : $r e.dirname s.dir_separator e.fname = (e.dirname) e.fname;
        ('.') e.filename;
      } :: (e.dirname) e.fname,
      <ToUpper <ToChars e.fname>> :: e.fname,
      <OpenDir e.dirname> :: s.dir,
      $iter,
      {
        <ReadDir s.dir>;
        \! $fail;
      } :: e.filename,
      <ToUpper e.filename> : e.fname,
      <Channel> :: s.chl,
      <OpenFile s.chl e.dirname s.dir_separator e.filename "r">,
      e.dirname s.dir_separator e.filename s.chl;
    = <Channel> :: s.chl,
      <OpenFile s.chl e.filename "r">,
      e.filename s.chl;
  } :: e.filename s.chl,
  {
    <IsRFP_Debug>, <PrintLn "\'" e.filename "\' successfully opened">;;
  },
  FILE &Get_Line_From_File (e.filename) (s.chl);

Get_Line_From_File s.channel =
  <ReadLineCh s.channel>;

ReadFormatsFromBox e,
  <Get &FormatsFromClass> : v.formats,
  <Store &FormatsFromClass>,
  v.formats;


// No more used
//RFP_Src_InitFromEnv s.env = 
//  <Store &Env s.env>;
//
//Env_GetImplementationReader t = 
//  <Get &Env> : s.env,
//  <GetModuleName s.env> :: s.name,
//  <Make_Name <ToChars s.name>> :: e.qname,
//  <GetInterfReader s.env s.name> :: s.reader,
//  {
//    <Null> : s.reader = /*empty*/;
//    FILE &Get_Line_From_Reader (s.name) (<BufferedReader s.reader>);
//  } :: e.inter_reader,
//  <GetImplemReader s.env> :: s.reader,
//  {
//    <Null> : s.reader = /*empty*/;
//    FILE &Get_Line_From_Reader (s.name) (<BufferedReader s.reader>);
//  } :: e.implem_reader,
//  (e.qname) (e.inter_reader) (e.implem_reader);
//
//Env_GetInterfaceReader e.qname =
//  <Get &Env> : s.env,
//  <ToWord <Intersperse ('/') e.qname>> :: s.fname,
//  <GetInterfReader s.env s.fname> :: s.reader,
//  {
//    <Null> : s.reader = $fail;
//    FILE &Get_Line_From_Reader (e.qname) (<BufferedReader s.reader>);
//  };

Get_Line_From_Reader s.reader =
  <BRreadLine s.reader> :: s.string,
  {
    <Null> : s.string = $fail;
    <ToChars s.string>;
  };


IsCaseInsensitive = <IsInTable &RFP_Options "CASE-INSENSITIVE">;

WordFirstSymbol = {
  <IsInTable &RFP_Options "IDENT-COMPATIBILITY"> = '?!';
  '_';
};

WordSymbol = {
  <IsInTable &RFP_Options "IDENT-COMPATIBILITY"> = '?!-';
  '_.';
};

VarSymbol = {
  <IsInTable &RFP_Options "IDENT-COMPATIBILITY"> = '?!-';
  '_';
};


InitPosition = 0 1;

NextRow s.row s.col =
  <Arithm.Add s.row 1> 1;

NextColumn s.row s.col =
  s.row <Arithm.Add s.col 1>;

PositionToChars s.row s.col = <ToChars s.row '-' s.col>;