Mercurial > urweb

comparison src/lacweb.lex @ 1:4202f6eda946

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial parsing and pretty-printing
author Adam Chlipala <adamc@hcoop.net>
date Sat, 26 Jan 2008 12:35:32 -0500
parents
children 2ce5bf227d01
comparison
equal deleted inserted replaced
0:502c6d622477 1:4202f6eda946
1 (* Copyright (c) 2008, Adam Chlipala
2 * All rights reserved.
3 *
4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met:
6 *
7 * - Redistributions of source code must retain the above copyright notice,
8 * this list of conditions and the following disclaimer.
9 * - Redistributions in binary form must reproduce the above copyright notice,
10 * this list of conditions and the following disclaimer in the documentation
11 * and/or other materials provided with the distribution.
12 * - The names of contributors may not be used to endorse or promote products
13 * derived from this software without specific prior written permission.
14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25 * POSSIBILITY OF SUCH DAMAGE.
26 *)
27
28 (* Lexing info for Laconic/Web programs *)
29
30 type pos = int
31 type svalue = Tokens.svalue
32 type ('a,'b) token = ('a,'b) Tokens.token
33 type lexresult = (svalue,pos) Tokens.token
34
35 local
36 val commentLevel = ref 0
37 val commentPos = ref 0
38 in
39 fun enterComment pos =
40 (if !commentLevel = 0 then
41 commentPos := pos
42 else
43 ();
44 commentLevel := !commentLevel + 1)
45
46 fun exitComment () =
47 (ignore (commentLevel := !commentLevel - 1);
48 !commentLevel = 0)
49
50 fun eof () =
51 let
52 val pos = ErrorMsg.lastLineStart ()
53 in
54 if !commentLevel > 0 then
55 ErrorMsg.errorAt' (!commentPos, !commentPos) "Unterminated comment"
56 else
57 ();
58 Tokens.EOF (pos, pos)
59 end
60 end
61
62 %%
63 %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS));
64 %full
65 %s COMMENT;
66
67 id = [a-z_][A-Za-z0-9_]*;
68 cid = [A-Z][A-Za-z0-9_]*;
69 ws = [\ \t\012];
70
71 %%
72
73 <INITIAL> \n => (ErrorMsg.newline yypos;
74 continue ());
75 <COMMENT> \n => (ErrorMsg.newline yypos;
76 continue ());
77
78 <INITIAL> {ws}+ => (lex ());
79
80 <INITIAL> "(*" => (YYBEGIN COMMENT;
81 enterComment yypos;
82 continue ());
83 <INITIAL> "*)" => (ErrorMsg.errorAt' (yypos, yypos) "Unbalanced comments";
84 continue ());
85
86 <COMMENT> "(*" => (enterComment yypos;
87 continue ());
88 <COMMENT> "*)" => (if exitComment () then YYBEGIN INITIAL else ();
89 continue ());
90
91 <INITIAL> "(" => (Tokens.LPAREN (yypos, yypos + size yytext));
92 <INITIAL> ")" => (Tokens.RPAREN (yypos, yypos + size yytext));
93 <INITIAL> "[" => (Tokens.LBRACK (yypos, yypos + size yytext));
94 <INITIAL> "]" => (Tokens.RBRACK (yypos, yypos + size yytext));
95 <INITIAL> "{" => (Tokens.LBRACE (yypos, yypos + size yytext));
96 <INITIAL> "}" => (Tokens.RBRACE (yypos, yypos + size yytext));
97
98 <INITIAL> "->" => (Tokens.ARROW (yypos, yypos + size yytext));
99 <INITIAL> "=>" => (Tokens.DARROW (yypos, yypos + size yytext));
100 <INITIAL> "++" => (Tokens.PLUSPLUS (yypos, yypos + size yytext));
101
102 <INITIAL> "=" => (Tokens.EQ (yypos, yypos + size yytext));
103 <INITIAL> "," => (Tokens.COMMA (yypos, yypos + size yytext));
104 <INITIAL> ":::" => (Tokens.TCOLON (yypos, yypos + size yytext));
105 <INITIAL> "::" => (Tokens.DCOLON (yypos, yypos + size yytext));
106 <INITIAL> ":" => (Tokens.COLON (yypos, yypos + size yytext));
107 <INITIAL> "." => (Tokens.DOT (yypos, yypos + size yytext));
108 <INITIAL> "$" => (Tokens.DOLLAR (yypos, yypos + size yytext));
109 <INITIAL> "#" => (Tokens.HASH (yypos, yypos + size yytext));
110
111 <INITIAL> "con" => (Tokens.CON (yypos, yypos + size yytext));
112 <INITIAL> "fn" => (Tokens.FN (yypos, yypos + size yytext));
113
114 <INITIAL> "Type" => (Tokens.TYPE (yypos, yypos + size yytext));
115 <INITIAL> "Name" => (Tokens.NAME (yypos, yypos + size yytext));
116
117 <INITIAL> {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
118 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
119
120 <COMMENT> . => (continue());
121
122 <INITIAL> . => (ErrorMsg.errorAt' (yypos, yypos)
123 ("illegal character: \"" ^ yytext ^ "\"");
124 continue ());