From 89f97891a33b5c0a8971d3508059a139a8815091 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 1 Nov 2008 10:47:10 -0400 Subject: Parsing 'let' --- src/elisp/urweb-defs.el | 23 +++++++++++---------- src/elisp/urweb-mode.el | 2 +- src/source.sml | 7 +++++++ src/source_print.sml | 55 +++++++++++++++++++++++++++++++++++-------------- src/urweb.grm | 12 +++++++++++ src/urweb.lex | 2 ++ 6 files changed, 73 insertions(+), 28 deletions(-) (limited to 'src') diff --git a/src/elisp/urweb-defs.el b/src/elisp/urweb-defs.el index 8b4ebe2e..fe4da2e4 100644 --- a/src/elisp/urweb-defs.el +++ b/src/elisp/urweb-defs.el @@ -91,7 +91,7 @@ notion of \"the end of an outline\".") (defconst urweb-begin-syms - '("struct" "sig") + '("let" "struct" "sig") "Symbols matching the `end' symbol.") (defconst urweb-begin-syms-re @@ -103,12 +103,12 @@ notion of \"the end of an outline\".") ;; "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 @@ notion of \"the end of an outline\".") ("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 @@ for all symbols and in all lines starting with the given symbol." (defconst urweb-open-paren (urweb-preproc-alist - `((,(list* urweb-begin-syms) ,urweb-begin-syms-re "\\"))) + `((,(list* "in" urweb-begin-syms) ,urweb-begin-syms-re "\\"))) "Symbols that should behave somewhat like opening parens.") (defconst urweb-close-paren - `(("end" ,urweb-begin-syms-re) + `(("in" "\\") + ("end" ,urweb-begin-syms-re) ("then" "\\") ("else" "\\" (urweb-bolp)) ("of" "\\") diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el index 8c016e3d..1a578cf9 100644 --- a/src/elisp/urweb-mode.el +++ b/src/elisp/urweb-mode.el @@ -135,7 +135,7 @@ See doc for the variable `urweb-mode-info'." (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" diff --git a/src/source.sml b/src/source.sml index 386b1a83..7e204390 100644 --- a/src/source.sml +++ b/src/source.sml @@ -131,7 +131,14 @@ datatype exp' = | 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 diff --git a/src/source_print.sml b/src/source_print.sml index a25be2d4..9e6608df 100644 --- a/src/source_print.sml +++ b/src/source_print.sml @@ -285,8 +285,47 @@ fun p_exp' par (e, _) = | 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 @@ and p_sgn (sgn, _) = | 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 diff --git a/src/urweb.grm b/src/urweb.grm index 143b6935..1555dc37 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -198,6 +198,7 @@ fun tagIn bt = | 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 @@ fun tagIn bt = | 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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) | 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) diff --git a/src/urweb.lex b/src/urweb.lex index cc0f5b7c..d5393e7d 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -299,6 +299,8 @@ notags = [^<{\n]+; "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext)); "struct" => (Tokens.STRUCT (pos yypos, pos yypos + size yytext)); "sig" => (if yypos = 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext)); + "let" => (Tokens.LET (pos yypos, pos yypos + size yytext)); + "in" => (Tokens.IN (pos yypos, pos yypos + size yytext)); "end" => (Tokens.END (pos yypos, pos yypos + size yytext)); "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext)); "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext)); -- cgit v1.2.3