// $Id$

$use Access Apply Box Class Compare Convert List StdIO Table ;
$use "rfp_src" ;

$box Errors Position Source ;

$func Add_Error_wPos (e.pos) e.msg = ;
$func Add_Error e.msg = ;
$func Add_Warning e.msg = ;
$func? Get_Source_Line = e.line ;
$func Scan_Token e.line = e.tokens (e.line) ;
$func? IsScan_Keyword (e.pos) e.line = (e.token) (e.line) ;
$func? IsScan_Number (e.pos) e.line = (e.num) (e.line) ;
$func? IsScan_Variable e.line = (e.token) (e.line) ;
$func? IsScan_Word e.line = (e.token) (e.line) ;
$func? IsScan_QWord e.line = (e.token) (e.line) ;
$func? IsScan_Chars e.line = (e.token) (e.line) ;
$func Scan_Symbols (e.symbols) (e.line) = (e.string) (e.line) ;
$func Scan_Chars_Rest (e.start) (e.line) s.term = (e.string) (e.line) ;
$func Skip_Comment e.line = (e.tk) (e.line) ;
$func Skip_Line_Comment e.line = (e.tk) (e.line) ;
$func? NoDelimiter e.line = ;
$func Next_Column = ;
$func Next_Row = ;
$func Token_Position = e.pos;

RFP_Lexer e.source =
  <Store &Source e.source>,
  <Store &Position <RFP_Src_InitPosition>>,
  <Store &Errors>,
  () $iter e.tokens <Scan_Token e.line> :: e.tokens (e.line),
  e.tokens : e ((e) (EOF)) =
  (e.tokens) (<Get &Errors>);

Add_Error_wPos (e.pos) e.msg = <Put &Errors (ERROR ((e.pos) (0 0)) (e.msg))>;

Add_Error e.msg = <Put &Errors (ERROR ((<Token_Position>) (0 0)) (e.msg))>;

Add_Warning e.msg = <Put &Errors (WARNING ((<Token_Position>) (0 0)) (e.msg))>;

Get_Source_Line =
  <RFP_Src_Get_Line <Get &Source>> :: e.line,
  <Next_Row>,
  e.line;

Scan_Token e.line =
  <Token_Position> :: e.saved_position,
  e.line : {
    /*empty*/ = {
      /*empty*/ (<Get_Source_Line>);
      (EOF) ();
    };
    s.char1 s.char2 e.rest, \{
      s.char1 s.char2 : \{
        \{
          '::'  = DCOLON;
          '\\?' = STAKE;
          '\\!' = CUT;
          '\\{' = '}':e, TLBRACE;
        } :: s.tk = <Next_Column> <Next_Column>,
          (s.tk) (e.rest);
        '/*' = <Next_Column> <Next_Column>,
          <Skip_Comment e.rest>;
        '//' = <Next_Column> <Next_Column>,
          <Skip_Line_Comment e.rest>;
      };
      s.char1 : \{ '\\'; '/'; } =
        <Next_Column> <Add_Error "Invalid character '"s.char2"' after '"s.char1"'"> <Next_Column>,
        /*empty*/ (e.rest);
    };
    s.char e.rest, \{
      s.char : \{
        \{
          '(' = LPAREN;
          ')' = RPAREN;
          '<' = LBRACKET;
          '>' = RBRACKET;
          '{' = LBRACE;
          '}' = RBRACE;
          '#' = NOT;
          '&' = REF;
          ',' = COMMA;
          ';' = SEMICOLON;
          '=' = EQUAL;
          ':' = COLON;
        } :: s.tk = <Next_Column>,
          (s.tk) (e.rest);
        '*' = <Next_Column>,
          <Skip_Line_Comment e.rest>;
        \{ '\\'; '/'; } =
          <Next_Column> <Add_Error "Unexpected end of line after'"s.char"'">,
          /*empty*/ (/*empty*/);
      };
      ' \n\r\t' : e s.char e = <Next_Column>,
        /*empty*/ (e.rest);
      <IsScan_Keyword (e.saved_position) e.line>;
      <IsScan_Word e.line>;
      <IsScan_Variable e.line>;
      <IsScan_QWord e.line>;
      <IsScan_Chars e.line>;
      <IsScan_Number (e.saved_position) e.line>;
      = <Add_Error "Invalid character '"s.char"'"> <Next_Column>,
        /*empty*/ (e.rest);
    };
  } : {
    /*empty*/ (e.rest) = /*empty*/ (e.rest);
    (e.tk) (e.rest) = (((e.saved_position) (<Token_Position>)) (e.tk)) (e.rest);
  };

IsScan_Keyword (e.saved_position) '$' e.rest =
  <Next_Column>,
  <Scan_Symbols ('A?') (e.rest)> :: (e.last) (e.rest),
  {
    <RFP_Src_IsCaseInsensitive> = <ToLower e.last>;
    e.last;
  } : {
    'box' = BOX;
    'channel' = CHANNEL;
    'const' = CONST;
    'error' = ERROR;
    'fail' = FAIL;
    'func' = FUNC;
    'func?' = "FUNC?";
    'tfunc' = TFUNC;
    'extern' = EXTERN;
    'iter' = ITER;
    'l' = L;
    'r' = R;
    'module' = MODULE;
    'string' = STRING;
    'table' = TABLE;
    'trace' = TRACE;
    'traceall' = TRACEALL;
    'trap' = TRAP;
    'use' = USE;
    'import' = IMPORT;
    'vector' = VECTOR;
    'with' = WITH;
    e = <Add_Error_wPos (e.saved_position) "Invalid keyword '$"e.last"'">, ERROR;
  } :: s.key,
  {
    <NoDelimiter e.rest>, <Add_Error "Keyword must be followed by a delimiter">;;
  },
  (s.key) (e.rest);

IsScan_Number (e.saved_position) s.first e.rest,
  \{
    <IsDigit s.first>;
    '+-' : e s.first e;
  } =
  <Next_Column>,
  <Scan_Symbols ('0') (e.rest)> :: (e.last) (e.rest),
  {
    <ToInt s.first e.last>;
    <Add_Error_wPos (e.saved_position) "Invalid number '"s.first e.last"'">, 0;
  } :: s.num,
  {
    <NoDelimiter e.rest>, <Add_Error "Number must be followed by a delimiter">;;
  },
  (NUMBER s.num) (e.rest);

IsScan_Variable s.first e.rest,
  s.first : \{
    's' = SVAR;
    'e' = EVAR;
    'v' = VVAR;
    't' = TVAR;
  } :: s.type =
  <Next_Column>,
  {
    e.rest : '.' e.new_rest = <Next_Column>, e.new_rest;
    e.rest;
  } :: e.rest,	
  <Scan_Symbols ('A0' <RFP_Src_VarSymbol>) (e.rest)> :: (e.name) (e.rest),
  {
    e.name : /*empty*/ = '$tmp-' <RFP_Src_PositionToChars <Token_Position>>;
    e.name;
  } :: e.name,
  {
    <RFP_Src_IsCaseInsensitive> = <ToLower e.name>;
    e.name;
  } :: e.name,
  {
    <NoDelimiter e.rest>, <Add_Error "Variable must be followed by a delimiter">;;
  },
  (s.type e.name) (e.rest);

IsScan_Word s.first e.rest,
  \{
    <IsLetter s.first>, <Eq (<ToUpper s.first>) (s.first)>;
    <RFP_Src_WordFirstSymbol> : e s.first e;
  } =
  <Next_Column>,
  <Scan_Symbols ('A0' <RFP_Src_WordSymbol>) (e.rest)> :: (e.last) (e.rest),
  {
    <NoDelimiter e.rest>, <Add_Error "Word must be followed by a delimiter">;;
  },
  (WORD s.first e.last) (e.rest);

IsScan_QWord '\"' e.rest =
  <Next_Column>,
  <Scan_Chars_Rest () (e.rest) '\"'> :: (e.word) (e.rest),
  (QWORD e.word) (e.rest);

IsScan_Chars '\'' e.rest =
  <Next_Column>,
  <Scan_Chars_Rest () (e.rest) '\''> :: (e.chars) (e.rest),
  (SYMBOLS e.chars) (e.rest);

Scan_Symbols (e.symbols) (e.line) =
  () (e.line) T $iter {
    e.line : s.first e.rest,
      \{
        e.symbols : e '0' e, <IsDigit s.first>;
        e.symbols : e 'A' e, <IsLetter s.first>;
        e.symbols : e s.first e;
      },
      <Next_Column>,
      (e.string s.first) (e.rest) T;
    (e.string) (e.line) F;
  } :: (e.string) (e.line) s.cond,
  s.cond : F =
  (e.string) (e.line);

Scan_Chars_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 = <Add_Warning "Unknown control sequence '\\"s.first2"'">,
                (e.s s.first2) (e.rest2) T;
            };
          (e.s) (<Get_Source_Line>) T;
          <Add_Error "Unterminated string detected">,
            (e.s) () F;
        };
        s = (e.s s.first) (e.rest) T;
      };
    <Add_Error "Unterminated string detected">,
      (e.s) () F;
  } :: (e.s) (e.l) s.cond,
  s.cond : F,
  (e.s) (e.l) ;

Skip_Comment e.line =
  (/*empty*/) (e.line) F $iter {
    e.line : e.com '*/' e.rest =
      <Map &Apply (<Replicate <Length e.com '*/'> &Next_Column>)> : e,
      (e.comment (e.com)) (e.rest) T;
    (e.comment (e.line)) (<Get_Source_Line>) F;
  } :: (e.comment) (e.line) s.tag,
  s.tag : T =
  (COMMENT e.comment) (e.line);

Skip_Line_Comment e.line =
  <Map &Apply (<Replicate <Length e.line> &Next_Column>)> : e,
  (COMMENT e.line) ();

NoDelimiter s.first e.rest, \{
  <IsDigit s.first>;
  <IsLetter s.first>;
  '+-?!_.' : e s.first e;
};

Next_Column =
  <Store &Position <RFP_Src_NextColumn <Get &Position>>>;

Next_Row =
  <Store &Position <RFP_Src_NextRow <Get &Position>>>;

Token_Position =
  <Get &Position>;