Parsing 'let'

6 files changed, 73 insertions, 28 deletions

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 "\\<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\\>")
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]+;
 <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));