Changeset 3795


Ignore:
Timestamp:
May 31, 2008, 2:55:49 AM (12 years ago)
Author:
orlov
Message:
  • Little improvements.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • applications/trunk/LFC/parser/Lexer.rf

    r3789 r3795  
    77$func Error s.line s.column e.message = ;
    88Error s.line s.column e.message =
    9         <Put &Errors (<TokenPosition s.line s.column> e.message)>;
     9  <Put &Errors (<TokenPosition s.line s.column> e.message)>;
    1010
    1111$public $func Lexer stream e.filename = e.tokens;
    1212Lexer stream e.filename =
    13         <Store &InputStream stream>,
    14         <Store &FileName e.filename>,
    15         <Store &Errors /*empty*/>,
    16         <GetTokens 0 1>;
     13  <Store &InputStream stream>,
     14  <Store &FileName e.filename>,
     15  <Store &Errors /*empty*/>,
     16  <GetTokens 0 1>;
    1717
    1818$func GetTokens e.chars s.line s.column = e.tokens;
    1919GetTokens e.chars s.line s.column =
    20         {
    21                 e.chars : /*empty*/ = {
    22                         /*empty*/ (<GetSourceLine>) <Add s.line 1> 1;
    23                         (EOF <TokenPosition s.line s.column>) () s.line s.column;
    24                 };
    25                 {
    26                         <SkipBlanksAndComments e.chars s.line s.column>;
    27                         <ScanKeyword e.chars s.line s.column>;
    28                         <ScanString e.chars s.line s.column>;
    29                         <ScanIdentifier e.chars s.line s.column>;
    30                         <Error s.line s.column "Invalid character '" <L 0 e.chars> "'">,
    31                                 (<Middle 1 0 e.chars>) s.line <Add s.column 1>;
    32                 };
    33         } :: e.tokens (e.chars) s.line s.column,
    34         {
    35                 e.tokens : (EOF e) = e.tokens;
    36                 e.tokens <GetTokens e.chars s.line s.column>;
    37         };
     20  {
     21    e.chars : /*empty*/ = {
     22      /*empty*/ (<GetSourceLine>) <Add s.line 1> 1;
     23      (EOF <TokenPosition s.line s.column>) () s.line s.column;
     24    };
     25    {
     26      <SkipBlanksAndComments e.chars s.line s.column>;
     27      <ScanKeyword e.chars s.line s.column>;
     28      <ScanString e.chars s.line s.column>;
     29      <ScanIdentifier e.chars s.line s.column>;
     30      <Error s.line s.column "Invalid character '" <L 0 e.chars> "'">,
     31        (<Middle 1 0 e.chars>) s.line <Add s.column 1>;
     32    };
     33  } :: e.tokens (e.chars) s.line s.column,
     34  {
     35    e.tokens : (EOF e) = e.tokens;
     36    e.tokens <GetTokens e.chars s.line s.column>;
     37  };
    3838
    3939$func? SkipBlanksAndComments e.chars s.line s.column = (e.chars) s.line s.column;
    4040SkipBlanksAndComments e.chars s.line s.column =
    41         e.chars : \{
    42                 s.ch e.rest,
    43                         ' \t\r\n' : e s.ch e = (e.rest) s.line <Add s.column 1>;
    44                 '/*' e.rest =
    45                         $trap <SkipComment e.rest s.line <Add s.column 2>>
    46                         $with {
    47                                 "Unclosed comment" =
    48                                         <Error s.line s.column "Unclosed comment">,
    49                                         () s.line s.column;
    50                         };
    51         };
     41  e.chars : \{
     42    s.ch e.rest,
     43      ' \t\r\n' : e s.ch e = (e.rest) s.line <Add s.column 1>;
     44    '/*' e.rest =
     45      $trap <SkipComment e.rest s.line <Add s.column 2>>
     46      $with {
     47        "Unclosed comment" =
     48          <Error s.line s.column "Unclosed comment">,
     49          () s.line s.column;
     50      };
     51  };
    5252
    5353$func SkipComment e.chars s.line s.column = (e.chars) s.line s.column;
    5454SkipComment e.chars s.line s.column =
    55         e.chars : {
    56                 /*empty*/ = {
    57                         <SkipComment <GetSourceLine> <Add s.line 1> 1>;
    58                         $error "Unclosed comment";
    59                 };
    60                 '*/' e.rest = (e.rest) s.line <Add s.column 2>;
    61                 s.ch e.rest = <SkipComment e.rest s.line <Add s.column 1>>;
    62         };
     55  e.chars : {
     56    /*empty*/ = {
     57      <SkipComment <GetSourceLine> <Add s.line 1> 1>;
     58      $error "Unclosed comment";
     59    };
     60    '*/' e.rest = (e.rest) s.line <Add s.column 2>;
     61    s.ch e.rest = <SkipComment e.rest s.line <Add s.column 1>>;
     62  };
    6363
    6464$func? ScanKeyword e.chars s.line s.column = e.token (e.chars) s.line s.column;
    6565ScanKeyword e.chars s.line s.column =
    66         e.chars : \{
    67                 \{
    68                         ';'  e.rest = SC 1 e.rest;
    69                         ':'  e.rest = COLON 1 e.rest;
    70                         ','  e.rest = COMMA 1 e.rest;
    71                         '*'  e.rest = ASTERISK 1 e.rest;
    72                         '->' e.rest = TO 2 e.rest;
    73                         '='  e.rest = EQ 1 e.rest;
    74                         '('  e.rest = LPAR 1 e.rest;
    75                         ')'  e.rest = RPAR 1 e.rest;
    76                         '[]' e.rest = CONCAT 2 e.rest;
    77                         '~'  e.rest = STRING 1 e.rest;
    78                 };
    79                 \{
    80                         'dec'       e.rest = DEC 3 e.rest;
    81                         'var'       e.rest = VAR 3 e.rest;
    82                         'def'       e.rest = DEF 3 e.rest;   
    83                         'undefined' e.rest = UNDEFINED 9 e.rest;
    84                         'if'        e.rest = IF 2 e.rest;
    85                         'then'      e.rest = THEN 4 e.rest;
    86                         'else'      e.rest = ELSE 4 e.rest;   
    87                         'where'     e.rest = WHERE 5 e.rest;
    88                 } :: s.tk s.length e.rest,
    89                         e.rest : \{
    90                                 /*empty*/;
    91                                 s.ch e, # <IsAlphanumeric s.ch>;
    92                         } =
    93                         s.tk s.length e.rest;
    94         } :: s.tk s.length e.rest =
    95         (s.tk <TokenPosition s.line s.column>) (e.rest) s.line <Add s.column s.length>;
     66  e.chars : \{
     67    \{
     68      ';'  e.rest = SC 1 e.rest;
     69      ':'  e.rest = COLON 1 e.rest;
     70      ','  e.rest = COMMA 1 e.rest;
     71      '*'  e.rest = ASTERISK 1 e.rest;
     72      '->' e.rest = TO 2 e.rest;
     73      '='  e.rest = EQ 1 e.rest;
     74      '('  e.rest = LPAR 1 e.rest;
     75      ')'  e.rest = RPAR 1 e.rest;
     76      '[]' e.rest = CONCAT 2 e.rest;
     77      '~'  e.rest = STRING 1 e.rest;
     78    };
     79    \{
     80      'dec'       e.rest = DEC 3 e.rest;
     81      'var'       e.rest = VAR 3 e.rest;
     82      'def'       e.rest = DEF 3 e.rest;   
     83      'undefined' e.rest = UNDEFINED 9 e.rest;
     84      'if'        e.rest = IF 2 e.rest;
     85      'then'      e.rest = THEN 4 e.rest;
     86      'else'      e.rest = ELSE 4 e.rest;   
     87      'where'     e.rest = WHERE 5 e.rest;
     88    } :: s.tk s.length e.rest,
     89      e.rest : \{
     90        /*empty*/;
     91        s.ch e, # <IsAlphanumeric s.ch>;
     92      } =
     93      s.tk s.length e.rest;
     94  } :: s.tk s.length e.rest =
     95  (s.tk <TokenPosition s.line s.column>) (e.rest) s.line <Add s.column s.length>;
    9696
    9797$func? ScanString e.chars s.line s.column = e.token (e.chars) s.line s.column;
    9898ScanString e.chars s.line s.column =
    99         e.chars : '"' =
    100         <ScanStringRest e.chars s.line <Add s.column 1>> :: e.string (e.chars) s.new_line s.new_column,
    101         (STRING e.string <TokenPosition s.line s.column>) (e.chars) s.new_line s.new_column;
     99  e.chars : '"' e.rest =
     100  <ScanStringRest e.rest s.line <Add s.column 1>> :: e.string (e.chars) s.new_line s.new_column,
     101  {
     102    e.string : e.str Unclosed =
     103      <Error s.line s.column "Unclosed string">,
     104      e.str;
     105    e.string;
     106  } :: e.string,
     107  (STRING e.string <TokenPosition s.line s.column>) (e.chars) s.new_line s.new_column;
    102108
    103109$func ScanStringRest e.chars s.line s.column = e.string (e.chars) s.line s.column;
    104110ScanStringRest e.chars s.line s.column =
    105         {
    106                 e.chars : s.ch e.rest = {
    107                         s.ch : '"' = (e.rest) s.line <Add s.column 1>;
    108                         {
    109                                 s.ch : '\\' =
    110                                         e.rest : {
    111                                                 'n'  e.rest2 = '\n' 2 e.rest2;
    112                                                 'r'  e.rest2 = '\r' 2 e.rest2;
    113                                                 't'  e.rest2 = '\t' 2 e.rest2;
    114                                                 '"'  e.rest2 = '"'  2 e.rest2;
    115                                                 '~'  e.rest2 = '~'  2 e.rest2; // What is it for??? (See p. 6 of the Introduction to LFC)
    116                                                 '\\' e.rest2 = '\\' 2 e.rest2;
    117                                                 s1 s2 s3 e.rest2,
    118                                                         '01234567' : e s1 e,
    119                                                         '01234567' : e s2 e,
    120                                                         '01234567' : e s3 e =
    121                                                         <BytesToChars <ToInt s1 s2 s3>> 4 e.rest2;
    122                                                 e =
    123                                                         <Error s.line s.column "Invalid sequence after \\">,
    124                                                         '\\' 1 e.rest;
    125                                         };
    126                                 s.ch 1 e.rest;
    127                         } : s.char s.length e.other =
    128                                 s.char <ScanStringRest e.other s.line <Add s.column s.length>>;
    129                 };
    130                 /* Error here!!! */
    131         };
     111  {
     112    e.chars : s.ch e.rest = {
     113      s.ch : '"' = (e.rest) s.line <Add s.column 1>;
     114      {
     115        s.ch : '\\' =
     116          e.rest : {
     117            'n'  e.rest2 = '\n' 2 e.rest2;
     118            'r'  e.rest2 = '\r' 2 e.rest2;
     119            't'  e.rest2 = '\t' 2 e.rest2;
     120            '"'  e.rest2 = '"'  2 e.rest2;
     121            '~'  e.rest2 = '~'  2 e.rest2; // What is it for??? (See p. 6 of the Introduction to LFC)
     122            '\\' e.rest2 = '\\' 2 e.rest2;
     123            s1 s2 s3 e.rest2,
     124              '01234567' : e s1 e,
     125              '01234567' : e s2 e,
     126              '01234567' : e s3 e =
     127              <BytesToChars <ToInt s1 s2 s3>> 4 e.rest2;
     128            e =
     129              <Error s.line s.column "Invalid sequence after \\">,
     130              '\\' 1 e.rest;
     131          };
     132        s.ch 1 e.rest;
     133      } : s.char s.length e.other =
     134        s.char <ScanStringRest e.other s.line <Add s.column s.length>>;
     135    };
     136    Unclosed () s.line s.column;
     137  };
    132138
    133139$func? ScanIdentifier e.chars s.line s.column = e.token (e.chars) s.line s.column;
    134140ScanIdentifier e.chars s.line s.column =
    135         e.chars : s.ch e.rest,
    136         \{
    137                 <IsLetter s.ch>;
    138                 s.ch : '_';
    139         } =
    140         e.rest : e.head e.tail, \{
    141                 e.tail : /*empty*/ = e.head (e.tail);
    142                 e.tail : s.first e, # <IsAlphanumeric s.first> = e.head (e.tail);
    143         } :: e.head (e.tail) =
    144         (IDENTIFIER s.ch e.head <TokenPosition s.line s.column>) (e.tail) s.line <Add 1 <Add s.column <Length e.head>>>;
     141  e.chars : s.ch e.rest,
     142  \{
     143    <IsLetter s.ch>;
     144    s.ch : '_';
     145  } =
     146  e.rest : e.head e.tail, \{
     147    e.tail : /*empty*/ = e.head (e.tail);
     148    e.tail : s.first e, # <IsAlphanumeric s.first> = e.head (e.tail);
     149  } :: e.head (e.tail) =
     150  (IDENTIFIER s.ch e.head <TokenPosition s.line s.column>) (e.tail) s.line <Add 1 <Add s.column <Length e.head>>>;
    145151
    146152$func? GetSourceLine = e.chars;
    147153GetSourceLine =
    148         <Get &InputStream> : s.stream,
    149         # <IsEnd_of_Stream s.stream> = <Get_Line s.stream>;
     154  <Get &InputStream> : s.stream,
     155  # <IsEnd_of_Stream s.stream> = <Get_Line s.stream>;
    150156
    151157$func TokenPosition s.line s.column = t.token_position;
    … …  
    154160$func? IsAlphanumeric s.char = ;
    155161IsAlphanumeric s.char = \{
    156         <IsLetter s.char>;
    157         <IsDigit s.char>;
    158         s.char : '_';
     162  <IsLetter s.char>;
     163  <IsDigit s.char>;
     164  s.char : '_';
    159165};
    160166
    161167$func Main = e;
    162 Main = <WriteLn <Lexer <Expr_Open '1abcdef'>>>;
     168Main = <WriteLn <Lexer <Expr_Open '1a"b\\cdef'>>>,
     169  <WriteLn <Get &Errors>>;
Note: See TracChangeset for help on using the changeset viewer.