Mercurial > urweb
changeset 446:86c063fedc4d
Parsing 'let'
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 01 Nov 2008 10:47:10 -0400 |
| parents | dfc8c991abd0 |
| children | b77863cd0be2 |
| files | src/elisp/urweb-defs.el src/elisp/urweb-mode.el src/source.sml src/source_print.sml src/urweb.grm src/urweb.lex tests/let.ur tests/let.urp |
| diffstat | 8 files changed, 82 insertions(+), 28 deletions(-) [+] |
line wrap: on
line diff
--- a/src/elisp/urweb-defs.el Fri Oct 31 09:30:22 2008 -0400 +++ b/src/elisp/urweb-defs.el Sat Nov 01 10:47:10 2008 -0400 @@ -91,7 +91,7 @@ (defconst urweb-begin-syms - '("struct" "sig") + '("let" "struct" "sig") "Symbols matching the `end' symbol.") (defconst urweb-begin-syms-re @@ -103,12 +103,12 @@ ;; "Symbols matching (loosely) the `end' symbol.") (defconst urweb-sexp-head-symbols-re - (urweb-syms-re "struct" "sig" "with" - "if" "then" "else" "case" "of" "fn" "fun" "val" "and" - "datatype" "type" "open" "include" - urweb-module-head-syms - "con" "fold" "where" "extern" "constraint" "constraints" - "table" "sequence" "class") + (urweb-syms-re "let" "struct" "sig" "in" "with" + "if" "then" "else" "case" "of" "fn" "fun" "val" "and" + "datatype" "type" "open" "include" + urweb-module-head-syms + "con" "fold" "where" "extern" "constraint" "constraints" + "table" "sequence" "class") "Symbols starting an sexp.") ;; (defconst urweb-not-arg-start-re @@ -133,11 +133,11 @@ ("if" "else" 0) (,urweb-=-starter-syms nil) (("case" "datatype" "if" "then" "else" - "open" "sig" "struct" "type" "val" + "let" "open" "sig" "struct" "type" "val" "con" "constraint" "table" "sequence" "class"))))) (defconst urweb-starters-indent-after - (urweb-syms-re "struct" "sig") + (urweb-syms-re "let" "in" "struct" "sig") "Indent after these.") (defconst urweb-delegate @@ -164,11 +164,12 @@ (defconst urweb-open-paren (urweb-preproc-alist - `((,(list* urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>"))) + `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\<end\\>"))) "Symbols that should behave somewhat like opening parens.") (defconst urweb-close-paren - `(("end" ,urweb-begin-syms-re) + `(("in" "\\<let\\>") + ("end" ,urweb-begin-syms-re) ("then" "\\<if\\>") ("else" "\\<if\\>" (urweb-bolp)) ("of" "\\<case\\>")
--- a/src/elisp/urweb-mode.el Fri Oct 31 09:30:22 2008 -0400 +++ b/src/elisp/urweb-mode.el Sat Nov 01 10:47:10 2008 -0400 @@ -135,7 +135,7 @@ (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints" "datatype" "else" "end" "extern" "fn" "fold" "fun" "functor" "if" "include" - "of" "open" + "of" "open" "let" "in" "rec" "sequence" "sig" "signature" "struct" "structure" "table" "then" "type" "val" "where" "with"
--- a/src/source.sml Fri Oct 31 09:30:22 2008 -0400 +++ b/src/source.sml Sat Nov 01 10:47:10 2008 -0400 @@ -131,7 +131,14 @@ | ECase of exp * (pat * exp) list + | ELet of edecl list * exp + +and edecl' = + EDVal of string * con option * exp + | EDValRec of (string * con option * exp) list + withtype exp = exp' located +and edecl = edecl' located datatype decl' = DCon of string * kind option * con
--- a/src/source_print.sml Fri Oct 31 09:30:22 2008 -0400 +++ b/src/source_print.sml Sat Nov 01 10:47:10 2008 -0400 @@ -285,8 +285,47 @@ | EWild => string "_" + | ELet (ds, e) => box [string "let", + newline, + box [p_list_sep newline p_edecl ds], + newline, + string "in", + newline, + box [p_exp e], + newline, + string "end"] + and p_exp e = p_exp' false e +and p_edecl (d, _) = + case d of + EDVal vi => box [string "val", + space, + p_vali vi] + | EDValRec vis => box [string "val", + space, + string "rec", + space, + p_list_sep (box [newline, string "and", space]) p_vali vis] + +and p_vali (x, co, e) = + case co of + NONE => box [string x, + space, + string "=", + space, + p_exp e] + | SOME t => box [string x, + space, + string ":", + space, + p_con t, + space, + string "=", + space, + p_exp e] + + fun p_datatype (x, xs, cons) = box [string "datatype", space, @@ -424,22 +463,6 @@ | SgnProj (m, ms, x) => p_list_sep (string ".") string (m :: ms @ [x]) -fun p_vali (x, co, e) = - case co of - NONE => box [string x, - space, - string "=", - space, - p_exp e] - | SOME t => box [string x, - space, - string ":", - space, - p_con t, - space, - string "=", - space, - p_exp e] fun p_decl ((d, _) : decl) = case d of
--- a/src/urweb.grm Fri Oct 31 09:30:22 2008 -0400 +++ b/src/urweb.grm Sat Nov 01 10:47:10 2008 -0400 @@ -198,6 +198,7 @@ | TYPE | NAME | ARROW | LARROW | DARROW | STAR | SEMI | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE + | LET | IN | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | CASE | IF | THEN | ELSE @@ -272,6 +273,8 @@ | tag of string * exp | tagHead of string * exp | bind of string * con option * exp + | edecl of edecl + | edecls of edecl list | earg of exp * con -> exp * con | eargp of exp * con -> exp * con @@ -919,6 +922,15 @@ | UNDER (EWild, s (UNDERleft, UNDERright)) + | LET edecls IN eexp END (ELet (edecls, eexp), s (LETleft, ENDright)) + +edecls : ([]) + | edecl edecls (edecl :: edecls) + +edecl : VAL vali ((EDVal vali, s (VALleft, valiright))) + | VAL REC valis ((EDValRec valis, s (VALleft, valisright))) + | FUN valis ((EDValRec valis, s (FUNleft, valisright))) + enterDml : (inDml := true) leaveDml : (inDml := false)
--- a/src/urweb.lex Fri Oct 31 09:30:22 2008 -0400 +++ b/src/urweb.lex Sat Nov 01 10:47:10 2008 -0400 @@ -299,6 +299,8 @@ <INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext)); <INITIAL> "struct" => (Tokens.STRUCT (pos yypos, pos yypos + size yytext)); <INITIAL> "sig" => (if yypos = 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext)); +<INITIAL> "let" => (Tokens.LET (pos yypos, pos yypos + size yytext)); +<INITIAL> "in" => (Tokens.IN (pos yypos, pos yypos + size yytext)); <INITIAL> "end" => (Tokens.END (pos yypos, pos yypos + size yytext)); <INITIAL> "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext)); <INITIAL> "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext));