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

Last change on this file since 3789 was 3789, checked in by orlov, 13 years ago
  • Lexer for LFC.
  • Property svn:eol-style set to native
File size: 4.9 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 : '"' =
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;
102
103$func ScanStringRest e.chars s.line s.column = e.string (e.chars) s.line s.column;
104ScanStringRest 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        };
132
133$func? ScanIdentifier e.chars s.line s.column = e.token (e.chars) s.line s.column;
134ScanIdentifier 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>>>;
145
146$func? GetSourceLine = e.chars;
147GetSourceLine =
148        <Get &InputStream> : s.stream,
149        # <IsEnd_of_Stream s.stream> = <Get_Line s.stream>;
150
151$func TokenPosition s.line s.column = t.token_position;
152TokenPosition s.line s.column = (<Get &FileName> s.line s.column);
153
154$func? IsAlphanumeric s.char = ;
155IsAlphanumeric s.char = \{
156        <IsLetter s.char>;
157        <IsDigit s.char>;
158        s.char : '_';
159};
160
161$func Main = e;
162Main = <WriteLn <Lexer <Expr_Open '1abcdef'>>>;
Note: See TracBrowser for help on using the repository browser.