Mercurial > urweb

comparison src/lacweb.lex @ 54:a6e185c7c428

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Lexer/parser hacks to share code between regular and signature file parsers
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Jun 2008 10:53:11 -0400
parents 0a5c312de09a
children fd8a81ecd598
comparison
equal deleted inserted replaced
53:4f641f8fddaa 54:a6e185c7c428
60 end 60 end
61 61
62 val str = ref ([] : char list) 62 val str = ref ([] : char list)
63 val strStart = ref 0 63 val strStart = ref 0
64 64
65 local
66 val initSig = ref false
67 val offset = ref 0
68 in
69
70 fun initialSig () = initSig := true
71
72 fun pos yypos = yypos - !offset
73
74 fun newline yypos =
75 if !initSig then
76 (initSig := false;
77 offset := yypos + 1)
78 else
79 ErrorMsg.newline (pos yypos)
80
81 end
82
83
65 %% 84 %%
66 %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS)); 85 %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS));
67 %full 86 %full
68 %s COMMENT STRING; 87 %s COMMENT STRING;
69 88
73 intconst = [0-9]+; 92 intconst = [0-9]+;
74 realconst = [0-9]+\.[0-9]*; 93 realconst = [0-9]+\.[0-9]*;
75 94
76 %% 95 %%
77 96
78 <INITIAL> \n => (ErrorMsg.newline yypos; 97 <INITIAL> \n => (newline yypos;
79 continue ()); 98 continue ());
80 <COMMENT> \n => (ErrorMsg.newline yypos; 99 <COMMENT> \n => (newline yypos;
81 continue ()); 100 continue ());
82 101
83 <INITIAL> {ws}+ => (lex ()); 102 <INITIAL> {ws}+ => (lex ());
84 103
85 <INITIAL> "(*" => (YYBEGIN COMMENT; 104 <INITIAL> "(*" => (YYBEGIN COMMENT;
86 enterComment yypos; 105 enterComment (pos yypos);
87 continue ()); 106 continue ());
88 <INITIAL> "*)" => (ErrorMsg.errorAt' (yypos, yypos) "Unbalanced comments"; 107 <INITIAL> "*)" => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
89 continue ()); 108 continue ());
90 109
91 <COMMENT> "(*" => (enterComment yypos; 110 <COMMENT> "(*" => (enterComment (pos yypos);
92 continue ()); 111 continue ());
93 <COMMENT> "*)" => (if exitComment () then YYBEGIN INITIAL else (); 112 <COMMENT> "*)" => (if exitComment () then YYBEGIN INITIAL else ();
94 continue ()); 113 continue ());
95 114
96 <INITIAL> "\"" => (YYBEGIN STRING; strStart := yypos; str := []; continue()); 115 <INITIAL> "\"" => (YYBEGIN STRING; strStart := pos yypos; str := []; continue());
97 <STRING> "\\\"" => (str := #"\"" :: !str; continue()); 116 <STRING> "\\\"" => (str := #"\"" :: !str; continue());
98 <STRING> "\"" => (YYBEGIN INITIAL; 117 <STRING> "\"" => (YYBEGIN INITIAL;
99 Tokens.STRING (String.implode (List.rev (!str)), !strStart, yypos + 1)); 118 Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1));
100 <STRING> "\n" => (ErrorMsg.newline yypos; 119 <STRING> "\n" => (newline yypos;
101 str := #"\n" :: !str; continue()); 120 str := #"\n" :: !str; continue());
102 <STRING> . => (str := String.sub (yytext, 0) :: !str; continue()); 121 <STRING> . => (str := String.sub (yytext, 0) :: !str; continue());
103 122
104 <INITIAL> "(" => (Tokens.LPAREN (yypos, yypos + size yytext)); 123 <INITIAL> "(" => (Tokens.LPAREN (pos yypos, pos yypos + size yytext));
105 <INITIAL> ")" => (Tokens.RPAREN (yypos, yypos + size yytext)); 124 <INITIAL> ")" => (Tokens.RPAREN (pos yypos, pos yypos + size yytext));
106 <INITIAL> "[" => (Tokens.LBRACK (yypos, yypos + size yytext)); 125 <INITIAL> "[" => (Tokens.LBRACK (pos yypos, pos yypos + size yytext));
107 <INITIAL> "]" => (Tokens.RBRACK (yypos, yypos + size yytext)); 126 <INITIAL> "]" => (Tokens.RBRACK (pos yypos, pos yypos + size yytext));
108 <INITIAL> "{" => (Tokens.LBRACE (yypos, yypos + size yytext)); 127 <INITIAL> "{" => (Tokens.LBRACE (pos yypos, pos yypos + size yytext));
109 <INITIAL> "}" => (Tokens.RBRACE (yypos, yypos + size yytext)); 128 <INITIAL> "}" => (Tokens.RBRACE (pos yypos, pos yypos + size yytext));
110 129
111 <INITIAL> "->" => (Tokens.ARROW (yypos, yypos + size yytext)); 130 <INITIAL> "->" => (Tokens.ARROW (pos yypos, pos yypos + size yytext));
112 <INITIAL> "=>" => (Tokens.DARROW (yypos, yypos + size yytext)); 131 <INITIAL> "=>" => (Tokens.DARROW (pos yypos, pos yypos + size yytext));
113 <INITIAL> "++" => (Tokens.PLUSPLUS (yypos, yypos + size yytext)); 132 <INITIAL> "++" => (Tokens.PLUSPLUS (pos yypos, pos yypos + size yytext));
114 133
115 <INITIAL> "=" => (Tokens.EQ (yypos, yypos + size yytext)); 134 <INITIAL> "=" => (Tokens.EQ (pos yypos, pos yypos + size yytext));
116 <INITIAL> "," => (Tokens.COMMA (yypos, yypos + size yytext)); 135 <INITIAL> "," => (Tokens.COMMA (pos yypos, pos yypos + size yytext));
117 <INITIAL> ":::" => (Tokens.TCOLON (yypos, yypos + size yytext)); 136 <INITIAL> ":::" => (Tokens.TCOLON (pos yypos, pos yypos + size yytext));
118 <INITIAL> "::" => (Tokens.DCOLON (yypos, yypos + size yytext)); 137 <INITIAL> "::" => (Tokens.DCOLON (pos yypos, pos yypos + size yytext));
119 <INITIAL> ":" => (Tokens.COLON (yypos, yypos + size yytext)); 138 <INITIAL> ":" => (Tokens.COLON (pos yypos, pos yypos + size yytext));
120 <INITIAL> "." => (Tokens.DOT (yypos, yypos + size yytext)); 139 <INITIAL> "." => (Tokens.DOT (pos yypos, pos yypos + size yytext));
121 <INITIAL> "$" => (Tokens.DOLLAR (yypos, yypos + size yytext)); 140 <INITIAL> "$" => (Tokens.DOLLAR (pos yypos, pos yypos + size yytext));
122 <INITIAL> "#" => (Tokens.HASH (yypos, yypos + size yytext)); 141 <INITIAL> "#" => (Tokens.HASH (pos yypos, pos yypos + size yytext));
123 <INITIAL> "__" => (Tokens.UNDERUNDER (yypos, yypos + size yytext)); 142 <INITIAL> "__" => (Tokens.UNDERUNDER (pos yypos, pos yypos + size yytext));
124 <INITIAL> "_" => (Tokens.UNDER (yypos, yypos + size yytext)); 143 <INITIAL> "_" => (Tokens.UNDER (pos yypos, pos yypos + size yytext));
125 144
126 <INITIAL> "con" => (Tokens.CON (yypos, yypos + size yytext)); 145 <INITIAL> "con" => (Tokens.CON (pos yypos, pos yypos + size yytext));
127 <INITIAL> "type" => (Tokens.LTYPE (yypos, yypos + size yytext)); 146 <INITIAL> "type" => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
128 <INITIAL> "val" => (Tokens.VAL (yypos, yypos + size yytext)); 147 <INITIAL> "val" => (Tokens.VAL (pos yypos, pos yypos + size yytext));
129 <INITIAL> "fn" => (Tokens.FN (yypos, yypos + size yytext)); 148 <INITIAL> "fn" => (Tokens.FN (pos yypos, pos yypos + size yytext));
130 149
131 <INITIAL> "structure" => (Tokens.STRUCTURE (yypos, yypos + size yytext)); 150 <INITIAL> "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext));
132 <INITIAL> "signature" => (Tokens.SIGNATURE (yypos, yypos + size yytext)); 151 <INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext));
133 <INITIAL> "struct" => (Tokens.STRUCT (yypos, yypos + size yytext)); 152 <INITIAL> "struct" => (Tokens.STRUCT (pos yypos, pos yypos + size yytext));
134 <INITIAL> "sig" => (Tokens.SIG (yypos, yypos + size yytext)); 153 <INITIAL> "sig" => (if yypos = 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext));
135 <INITIAL> "end" => (Tokens.END (yypos, yypos + size yytext)); 154 <INITIAL> "end" => (Tokens.END (pos yypos, pos yypos + size yytext));
136 <INITIAL> "functor" => (Tokens.FUNCTOR (yypos, yypos + size yytext)); 155 <INITIAL> "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext));
137 <INITIAL> "where" => (Tokens.WHERE (yypos, yypos + size yytext)); 156 <INITIAL> "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext));
138 <INITIAL> "extern" => (Tokens.EXTERN (yypos, yypos + size yytext)); 157 <INITIAL> "extern" => (Tokens.EXTERN (pos yypos, pos yypos + size yytext));
139 158
140 <INITIAL> "Type" => (Tokens.TYPE (yypos, yypos + size yytext)); 159 <INITIAL> "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext));
141 <INITIAL> "Name" => (Tokens.NAME (yypos, yypos + size yytext)); 160 <INITIAL> "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext));
142 161
143 <INITIAL> {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext)); 162 <INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
144 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext)); 163 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
145 164
146 <INITIAL> {intconst} => (case Int64.fromString yytext of 165 <INITIAL> {intconst} => (case Int64.fromString yytext of
147 SOME x => Tokens.INT (x, yypos, yypos + size yytext) 166 SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
148 | NONE => (ErrorMsg.errorAt' (yypos, yypos) 167 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
149 ("Expected int, received: " ^ yytext); 168 ("Expected int, received: " ^ yytext);
150 continue ())); 169 continue ()));
151 <INITIAL> {realconst} => (case Real64.fromString yytext of 170 <INITIAL> {realconst} => (case Real64.fromString yytext of
152 SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext) 171 SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
153 | NONE => (ErrorMsg.errorAt' (yypos, yypos) 172 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
154 ("Expected float, received: " ^ yytext); 173 ("Expected float, received: " ^ yytext);
155 continue ())); 174 continue ()));
156 175
157 <COMMENT> . => (continue()); 176 <COMMENT> . => (continue());
158 177
159 <INITIAL> . => (ErrorMsg.errorAt' (yypos, yypos) 178 <INITIAL> . => (ErrorMsg.errorAt' (pos yypos, pos yypos)
160 ("illegal character: \"" ^ yytext ^ "\""); 179 ("illegal character: \"" ^ yytext ^ "\"");
161 continue ()); 180 continue ());