Mercurial > urweb

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