//
// Copyright (C) 1999, 2000 Refal+ Development Group
//
// Refal+ is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// Refal+ is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Refal+; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//
// $Source$
// $Revision$
// $Date$
// Author: Andrey Slepuhin <pooh@msu.ru>

// rfp_lex.rfi
$use "rfpc" ; // rfpc.rfi
$use "rfp_helper" ; // rfp_helper.rfi
$use "rfp_src" ; // rfp_src.rfi
$use "rfp_err" ; // rfp_err.rfi

$use StdIO;
$use Box ;
$use Dir ;
$use Dos ;
$use Arithm ;
$use Class ;
$use Access ;
$use Compare ;
$use Convert ;
$use Table ;
$use Apply ;
$use List ;
$use File ;

$box Source ;
$box Position ;
$box Source-Index ;
$box Saved-Sources ;
$box Src-Counter ;

$func? Get-Source-Line = e.line ;
$func Scan-Token e.line = (e.tokens) (e.new-line) ;
$func Scan-Tokens e.line = e.tokens ;
$func? Blank? s.char = ;
$func? Skip-Blank e.line = e.new-line ;
$func Next-Column = ;
$func Next-Row = ;
$func? Uppercase-Letter? s.letter = ;
$func Source-File-Name = e.name ;
$func Print-File-Name = ;
$func Token-Position = e.position;
$func? Scan-Number? e.line = (e.num) (e.new-line) ;
$func Scan-Number-Rest (e.start) (e.line) = (e.num) (e.new-line) ;
$func? Scan-Keyword? e.line = (e.token) (e.new-line) ;
$func Scan-Keyword-Rest (e.start) (e.line) = (e.keyword) (e.new-line) ;
$func? Scan-Variable? e.line = (e.token) (e.new-line) ;
$func? Scan-Identifier? e.line = (e.token) (e.new-line) ;
$func Scan-Identifier-Rest s.obj (e.start) (e.line) = (e.word) (e.new-line) ;
$func? Scan-Word? e.line = (e.token) (e.new-line) ;
$func? Scan-String? e.line = (e.token) (e.new-line) ;
$func Scan-String-Rest (e.start) (e.line) s.term = (e.string) (e.new-line) ;
$func? Skip-Comment e.line = e.new-line ;
$func? Find-Include? e.name s.case-insensitive? = e.source ;
$func? Try-Open e.filename = e.source ;
$func? Interface-Name? e.source = e.iname ;

$func Push-Source e.source s.type s.row s.column = ;
$func? Pop-Source? = ;

RFP-Lexer e.filename =
  <Store &Source>,
  <Store &Saved-Sources>,
  <Store &Position>,
  <Store &Source-Index>,
  <Store &Src-Counter 0>,
  <RFP-Clear-Table &RFP-Sources>,
  {
    e.filename : v, {
      <RFP-Src-Open-File e.filename>;
      <PrintLN! &StdErr 'Error: cannot open source file ' e.filename>,
        <Exit 1>;
    };
    <RFP-Src-Open-StdIN>;
  } :: e.source,
  {
    e.source : e (e '.rfi') (e) = <Push-Source e.source I 0 1>;
    <Push-Source e.source S 0 1>;
  },
  {
    <RFP-Src-Open-File <Interface-Name? e.source>> :: e.source,
      <Push-Source e.source I 0 1>, <Scan-Tokens>;;
  } :: e.ts,
  e.ts <Scan-Tokens>;

Find-Includes e.filename =
  <Store &Source>,
  <Store &Saved-Sources>,
  <Store &Position>,
  <Store &Source-Index>,
  <Store &Src-Counter 0>,
  {
    <RFP-Src-Open-File e.filename>;
    <PrintLN! &StdErr 'Error: cannot open source file ' e.filename>,
      <Exit 1>;
  } :: e.source,
  <Push-Source e.source S 0 1>,
  (/*e.includes*/) (/*e.line*/) /*e.stop?*/ $iter <Scan-Token e.line> : {
    ((e (EOF))) e = (e.includes) () STOP;
    ((e (USE))) (e.ln) =
      () (e.ln) /*e.st?*/ $iter <Scan-Token e.ln> : {
        ((e (SEMICOLON))) (e.l) = (e.incs) (e.l) STOP;
        (((e.p) (s.WORD-or-QWORD e.s))) (e.l),
          s.WORD-or-QWORD : \{
            WORD;
            QWORD;
          } =	(e.incs (e.s)) (e.l);
        (((e.p) (EOF))) =
          <PrintLN! &StdErr 'Error: unexpected end of file during $use parsing'>,
          <Exit 2>, () ();
        (((e.p) (e.tag))) =
          <PrintLN! &StdErr 'Error: unexpected token 'e.tag' during $use parsing'>,
          <Exit 2>, () ();
      } :: (e.incs) (e.ln) e.st?,
      e.st? : STOP =
      (e.includes e.incs) (e.ln);
    e (e.ln) = (e.includes) (e.ln);
  } :: (e.includes) (e.line) e.stop?,
  e.stop? : STOP =
  e.includes;

Push-Source e.source s.type s.row s.col =
  <? &Src-Counter> : s.n,
  <"+" s.n 1> :: s.n,
  <Store &Src-Counter s.n>,
  <Store &Saved-Sources
    <? &Saved-Sources> (<? &Source> <? &Source-Index> <? &Position>)
  >,
  <Store &Source e.source>,
  <Bind &RFP-Sources (s.n) (<Source-File-Name>)>,
  <Store &Source-Index s.n s.type>,
  <Store &Position s.row s.col>;

Pop-Source? =
  <RFP-Src-Close <? &Source>>,
  <? &Saved-Sources> : e1,
  e1 : $r e.saved (e.source s.n s.type s.row s.col),
  <Store &Saved-Sources e.saved>,
  <Store &Source e.source>,
  <Store &Source-Index s.n s.type>,
  <Store &Position s.row s.col>;

Scan-Tokens e.line =
  <Scan-Token e.line> :: (e.t) (e.line),
  e.t : {
    ((e) (EOF)) =
      {
        <Pop-Source?>;
        e.t;
      };
    ((e) (USE)), # <In-Table? &RFP-Options NO-ELABORATE> = {
      () (e.line) T $iter {
        <Scan-Token e.line> :: (e.t) (e.line),
        e.t : {
          ((e) (SEMICOLON)) = (e.nts) (e.line) F;
          ((e.p) (s.WORD-or-QWORD e.s)),
            s.WORD-or-QWORD : \{
              WORD = CI;
              QWORD = NOT-CI;
            } :: s.ci? =
            {
              <Lookup &RFP-Module-Subst e.s>;
              e.s;
            } :: e.s,
            {
              <RFP-Debug?>, <PrintLN "Processing " e.s>;;
            },
            {
              <Find-Include? e.s s.ci?> :: e.include,
                <Push-Source e.include I 0 1>,
                e.nts <Scan-Tokens>;
              <RFP-Error (e.p) ("Unable to find include file \'" e.s ".rfi\'")>,
                e.nts;
            } :: e.nts,
            (e.nts) (e.line) T;
          ((e.p) (EOF)) =
            <RFP-Error (e.p) ("Unexpected end of file")>,
            (e.nts) (e.line) F;
          ((e.p) (e.tag)) =
            <RFP-Error (e.p) ("Unexpected token "e.tag)>,
            (e.nts) (e.line) T;
        };
      } :: (e.nts) (e.line) s1,
      s1 : F,
      e.nts <Scan-Tokens e.line>;
    };
    e = e.t <Scan-Tokens e.line>;
  };

Scan-Token e.line =
  e.line :
  {
    = {
        <Get-Source-Line> :: e.line,
          <Scan-Token e.line>;
        (((<Token-Position>) (EOF))) ();
    };
    s.char e.rest = <Token-Position> :: e.saved-position,
    {
      <Blank? s.char> =
        <Next-Column>,
        <Scan-Token e.rest>;
      s.char :
        \{
          '(' = LPAREN;
          ')' = RPAREN;
          '<' = LBRACKET;
          '>' = RBRACKET;
          '{' = LBRACE;
          '}' = RBRACE;
          '#' = NOT;
          '&' = REF;
          ',' = COMMA;
          ';' = SEMICOLON;
          '=' = EQUAL;
        } :: s.tk =
          <Next-Column>, (((e.saved-position) (s.tk))) (e.rest);
      s.char :
        \{
          ':' = <Next-Column>,
            {
              e.rest : ':' e.rest2 = <Next-Column>,
                (((e.saved-position) (DCOLON))) (e.rest2);
              (((e.saved-position) (COLON))) (e.rest);
            };
          '\\' = <Next-Column>,
            {
              e.rest : s.char2 e.rest2 = {
                s.char2 :
                  \{
                    '?' = STAKE;
                    '!' = CUT;
                    '{' = TLBRACE;
                  } :: s.tk =
                    <Next-Column>, (((e.saved-position) (s.tk))) (e.rest2);
                <RFP-Error (<Token-Position>)
                  ("Invalid character \'" s.char2 "\'")>,
                  <Next-Column>,
                  <Scan-Token e.rest2>;
              };
              <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
                <Scan-Token>;
            };
          '/' = <Next-Column>, e.rest :
            \{
              '/' e.rest2 = <Scan-Token>;
              '*' e.rest2 = <Next-Column>, <Scan-Token <Skip-Comment e.rest2>>;
              s.err e.rest2 = <RFP-Error (<Token-Position>)
                ("Invalid character \'" s.err "\'")>,
                <Next-Column>,
                <Scan-Token e.rest2>;
              = <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
                <Scan-Token>;
            };
          '*' = <Scan-Token>;
        };
      \{
        <Scan-Keyword? e.line>;
        <Scan-Identifier? e.line>;
        <Scan-Variable? e.line>;
        <Scan-Word? e.line>;
        <Scan-String? e.line>;
        <Scan-Number? e.line>;
      } :: (e.tk) (e.new-line),
        (((e.saved-position) (e.tk))) (e.new-line);
      <RFP-Error (<Token-Position>) ("Invalid character \'" s.char "\'")>,
        <Next-Column>,
        <Scan-Token e.rest>;
    };
  };

Get-Source-Line =
  <RFP-Src-Get-Line <? &Source>> :: e.line,
  <Next-Row>,
  e.line;

Blank? s.char =
  ' \n\t' : e s.char e;

Skip-Blank e.line =
  e.line :
  {
    = <Skip-Blank <Get-Source-Line>>;

    s.char e.rest =
    {
      <Blank? s.char> = <Next-Column>, <Skip-Blank e.rest>;
      e.line;
    };
  };

Scan-Keyword? '$' e.rest =
  <Next-Column>,
  <Scan-Keyword-Rest ('$') (e.rest)> :: (e.ident) (e.line),
  {
    <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Lower e.ident>;
    e.ident;
  } : \{
    '$box' = BOX;
    '$channel' = CHANNEL;
    '$const' = CONST;
    '$error' = ERROR;
    '$fail' = FAIL;
    '$func' = FUNC;
    '$func?' = FUNC?;
    '$tfunc' = 
      {
        <In-Table? &RFP-Options TPP> = TFUNC;
        <RFP-Error (<Token-Position>) ("Incorrect using of t-function \n")>,
          TFUNC;
      };
    '$extern' = EXTERN;
    '$iter' = ITER;
    '$l' = L;
    '$r' = R;
    '$string' = STRING;
    '$table' = TABLE;
    '$trace' = TRACE;
    '$traceall' = TRACEALL;
    '$trap' = TRAP;
    '$use' = USE;
    '$vector' = VECTOR;
    '$with' = WITH;
  } :: s.key,
  (s.key) (e.line);

Scan-Keyword-Rest (e.start) (e.line) =
  (e.start) (e.line) T $iter {
    e.l : s.first e.rest,
      \{
        <Letter? s.first>;
        s.first : \{
          '?';
          '!';
        };
      },
      <Next-Column>,
      (e.w s.first) (e.rest) T;
    (e.w) (e.l) F;
  } :: (e.w) (e.l) s.cond,
  s.cond : F,
  (e.w) (e.l) ;

Scan-Variable? e.line =
  e.line : s.first e.rest,
  s.first : \{
    's', SVAR;
    'e', EVAR;
    'v', VVAR;
    't', TVAR;
  } :: s.type,
  <Next-Column>,
  {
    e.rest : '.' e.rest2 = <Next-Column>,
      <Scan-Identifier-Rest Var () (e.rest2)>;
    <Scan-Identifier-Rest Var () (e.rest)>;
  } :: (e.name) (e.new-line),
  {
    e.name : = <? &Position> : s.r s.c,
      (s.type '!!tmp-' <To-Chars <Source-File-Name> '-' s.r '-' s.c>)
      (e.new-line);
    (s.type e.name) (e.new-line);
  };

Scan-Number? e.line =
  e.line : s.first e.rest,
  \{
    \{
      <Digit? s.first>;
      s.first : \{
        '+';
        '-';
      };
    },
    <Next-Column>,
    <Scan-Number-Rest (s.first) (e.rest)> :: (e.num) (e.rest),
    (NUMBER <To-Int e.num>)(e.rest);
  };

Scan-Number-Rest (e.start) (e.line) = {
  e.line : '\\' = <Scan-Number-Rest (e.start) (<Get-Source-Line>)>;
  (e.start) (e.line) T $iter {
    e.l : s.first e.rest,
      <Digit? s.first>,
      <Next-Column>,
      (e.w s.first) (e.rest) T;
    (e.w) (e.l) F;
  } :: (e.w) (e.l) s.cond,
  s.cond : F,
  (e.w) (e.l) ;
};

Scan-Identifier? e.line =
  e.line : s.first e.rest,
  \{
    \{
      <Uppercase-Letter? s.first>;
      s.first : \{
        '?';
        '!';
      };
    },
    <Next-Column>,
    <Scan-Identifier-Rest Fun (s.first) (e.rest)> :: (e.word) (e.rest),
    (WORD e.word) (e.rest);
  };

Scan-Identifier-Rest s.obj (e.start) (e.line) =
  s.obj : {
    Var = '?!-' ;
    Fun = '?!-.';
  } :: e.extra,
  (e.start) (e.line) T $iter {
    e.l : s.first e.rest,
      \{
        <Letter? s.first>;
        <Digit? s.first>;
        e.extra : e s.first e;
      },
      <Next-Column>,
      (e.w s.first) (e.rest) T;
    (e.w) (e.l) F;
  } :: (e.w) (e.l) s.cond,
  s.cond : F =
  {
//    <In-Table? &RFP-Options CASE-INSENSITIVE> = (<To-Upper e.w>) (e.l);
    (e.w) (e.l);
  };

Scan-Word? e.line =
  e.line : '\"' e.rest,
  \{
    <Next-Column>,
    <Scan-String-Rest () (e.rest) '\"'> :: (e.word) (e.rest),
    (QWORD e.word) (e.rest);
  };

Scan-String? e.line =
  e.line : '\'' e.rest,
  \{
    <Next-Column>,
    <Scan-String-Rest () (e.rest) '\''> :: (e.str) (e.rest),
    (SYMBOLS e.str) (e.rest);
  };

Scan-String-Rest (e.start) (e.line) s.term =
  (e.start) (e.line) T $iter {
    e.l : s.first e.rest,
      <Next-Column>,
      s.first : {
        s.term = (e.s) (e.rest) F;
        '\\' = {
          e.rest : s.first2 e.rest2,
            <Next-Column>,
            s.first2 : \{
              't' = (e.s '\t') (e.rest2) T;
              'n' = (e.s '\n') (e.rest2) T;
              'r' = (e.s '\r') (e.rest2) T;
              '\\' = (e.s '\\') (e.rest2) T;
              '\'' = (e.s '\'') (e.rest2) T;
              '\"' = (e.s '\"') (e.rest2) T;
              s = <RFP-Warning (<Token-Position>)
                ("Unknown control sequence \'\\" s.first2 "\'")>,
                (e.s s.first2) (e.rest2) T;
            };
          (e.s) (<Get-Source-Line>) T;
          <RFP-Error (<Token-Position>) (Error "Unterminated string detected")>,
            (e.s) () F;
        };
        s = (e.s s.first) (e.rest) T;
      };
    (e.s '\n') (<Get-Source-Line>) T;
    <RFP-Error (<Token-Position>) ("Unterminated string detected")>,
      (e.s) () F;
  } :: (e.s) (e.l) s.cond,
  s.cond : F,
  (e.s) (e.l) ;

Skip-Comment e.line = {
  e.line : e1 '*/' e.rest = <Map &Apply (<Replicate <Length e1 '*/'> &Next-Column>)> : e, e.rest;
  <Skip-Comment <Get-Source-Line>>;
  <RFP-Error (<Token-Position>) ("Unexpected end of file")>;
};

Next-Column =
  <Store &Position <RFP-Next-Column <? &Position>>>;

Next-Row =
  <Store &Position <RFP-Next-Row <? &Position>>>;

Uppercase-Letter? s.letter =
  <Letter? s.letter>,
  <"=" (<To-Upper s.letter>) (s.letter)>;

Source-File-Name =
  <? &Source> : s.srctype s.getline-func (e.name) (e.src),
  e.name;

Print-File-Name = <Print <Source-File-Name>>;

Token-Position =
  <? &Source-Index> <? &Position> ;

Find-Include? e.name s.ci? =
  <? &Dir-Separator> : s.dir-separator,
  <To-Upper e.name> :: e.NAME,
  {
    e.name : s.dir-separator e = ();
    e.name : '.' e = (<RFP-Dir-Name <Source-File-Name>>);
    (<RFP-Dir-Name <Source-File-Name>>) <? &RFP-Include-Path>;
  } :: e.path,
  e.path : e (e.dirname) e \?
  e.dirname : {
    e s.dir-separator = e.dirname;
    v = e.dirname s.dir-separator;
    e = '.' s.dir-separator;
  } :: e.dirn,
//  {
//    e.name $iter { e.name : e1 '.' e2 = e1 s.dir-separator e2; } :: e.name,
//    # \{ e.name : e1 '.' e2; }, e.name;
//  } :: e.name,
  \{
    <In-Table? &RFP-Options CASE-INSENSITIVE> \!
      {
        $trap <Open-Dir e.dirn> $with {
          e = $fail;
        };
      } : s.dir,
      $iter \{
        <Read-Dir s.dir> :: e.filename, {
          e.filename : e.basename '.rfi',
            \{
              e.basename : e.name;
              s.ci? : CI, <To-Upper e.basename> : e.NAME;
            } =
            (<Try-Open e.dirn e.basename '.rfi'>);;
        };
      } :: e.res,
      e.res : (e.source) =
      e.source;
    <Try-Open e.dirn e.name '.rfi'>;
  } :: e.source,
  e.source;

Try-Open e.filename =
  {
    <RFP-Debug?>, <PrintLN "Trying to open \'" e.filename "\'">;;
  },
  <RFP-Src-Open-File e.filename> :: e.source,
  {
    <RFP-Debug?>, <PrintLN "\'" e.filename "\' successfully opened">;;
  },
  e.source;

Interface-Name? FILE s (e.name) (e) =
  e.name : \{
    e.base '.rf' = e.base '.rfi';
  };