source: applications/trunk/LFC/parser/Lexer.rf @ 3796

Last change on this file since 3796 was 3796, checked in by orlov, 13 years ago
  • Property svn:eol-style set to native
File size: 5.5 KB
Line 
1$use Access Arithm Box Class Convert StdIO Stream;
2
3$box FileName InputStream;
4
5$box Errors;
6
7$func Error s.line s.column e.message = ;
8Error s.line s.column e.message =
9  <Put &Errors (<TokenPosition s.line s.column> e.message)>;
10
11$public $func Lexer stream e.filename = e.tokens;
12Lexer stream e.filename =
13  <Store &InputStream stream>,
14  <Store &FileName e.filename>,
15  <Store &Errors /*empty*/>,
16  <GetTokens 0 1>;
17
18$func GetTokens e.chars s.line s.column = e.tokens;
19GetTokens 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  };
38
39$func? SkipBlanksAndComments e.chars s.line s.column = (e.chars) s.line s.column;
40SkipBlanksAndComments 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  };
52
53$func SkipComment e.chars s.line s.column = (e.chars) s.line s.column;
54SkipComment 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  };
63
64$func? ScanKeyword e.chars s.line s.column = e.token (e.chars) s.line s.column;
65ScanKeyword 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>;
96
97$func? ScanString e.chars s.line s.column = e.token (e.chars) s.line s.column;
98ScanString e.chars s.line s.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;
108
109$func ScanStringRest e.chars s.line s.column = e.string (e.chars) s.line s.column;
110ScanStringRest e.chars s.line s.column =
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  };
138
139$func? ScanIdentifier e.chars s.line s.column = e.token (e.chars) s.line s.column;
140ScanIdentifier e.chars s.line s.column =
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>>>;
151
152$func? GetSourceLine = e.chars;
153GetSourceLine =
154  <Get &InputStream> : s.stream,
155  # <IsEnd_of_Stream s.stream> =
156  <Get_Line s.stream> : {
157    e.line '\r\n' = e.line;
158    e.line '\n'   = e.line;
159    e.line '\r'   = e.line;
160    e.line        = e.line;
161  };
162
163$func TokenPosition s.line s.column = t.token_position;
164TokenPosition s.line s.column = (<Get &FileName> s.line s.column);
165
166$func? IsAlphanumeric s.char = ;
167IsAlphanumeric s.char = \{
168  <IsLetter s.char>;
169  <IsDigit s.char>;
170  s.char : '_';
171};
172
173$func Main = e;
174Main = <WriteLn <Lexer <Expr_Open '1a"b\\cd\n ef'>>>,
175  <WriteLn <Get &Errors>>;
Note: See TracBrowser for help on using the repository browser.