Changeset 3795
- Timestamp:
- May 31, 2008, 2:55:49 AM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
applications/trunk/LFC/parser/Lexer.rf
r3789 r3795 7 7 $func Error s.line s.column e.message = ; 8 8 Error s.line s.column e.message = 9 9 <Put &Errors (<TokenPosition s.line s.column> e.message)>; 10 10 11 11 $public $func Lexer stream e.filename = e.tokens; 12 12 Lexer stream e.filename = 13 14 15 16 13 <Store &InputStream stream>, 14 <Store &FileName e.filename>, 15 <Store &Errors /*empty*/>, 16 <GetTokens 0 1>; 17 17 18 18 $func GetTokens e.chars s.line s.column = e.tokens; 19 19 GetTokens e.chars s.line s.column = 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 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 }; 38 38 39 39 $func? SkipBlanksAndComments e.chars s.line s.column = (e.chars) s.line s.column; 40 40 SkipBlanksAndComments e.chars s.line s.column = 41 42 43 44 45 46 47 48 49 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 }; 52 52 53 53 $func SkipComment e.chars s.line s.column = (e.chars) s.line s.column; 54 54 SkipComment e.chars s.line s.column = 55 56 57 58 59 60 61 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 }; 63 63 64 64 $func? ScanKeyword e.chars s.line s.column = e.token (e.chars) s.line s.column; 65 65 ScanKeyword e.chars s.line s.column = 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 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 96 97 97 $func? ScanString e.chars s.line s.column = e.token (e.chars) s.line s.column; 98 98 ScanString 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; 102 108 103 109 $func ScanStringRest e.chars s.line s.column = e.string (e.chars) s.line s.column; 104 110 ScanStringRest e.chars s.line s.column = 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 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 }; 132 138 133 139 $func? ScanIdentifier e.chars s.line s.column = e.token (e.chars) s.line s.column; 134 140 ScanIdentifier e.chars s.line s.column = 135 136 137 138 139 140 141 142 143 144 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>>>; 145 151 146 152 $func? GetSourceLine = e.chars; 147 153 GetSourceLine = 148 149 154 <Get &InputStream> : s.stream, 155 # <IsEnd_of_Stream s.stream> = <Get_Line s.stream>; 150 156 151 157 $func TokenPosition s.line s.column = t.token_position; … … 154 160 $func? IsAlphanumeric s.char = ; 155 161 IsAlphanumeric s.char = \{ 156 157 158 162 <IsLetter s.char>; 163 <IsDigit s.char>; 164 s.char : '_'; 159 165 }; 160 166 161 167 $func Main = e; 162 Main = <WriteLn <Lexer <Expr_Open '1abcdef'>>>; 168 Main = <WriteLn <Lexer <Expr_Open '1a"b\\cdef'>>>, 169 <WriteLn <Get &Errors>>;
Note: See TracChangeset
for help on using the changeset viewer.