summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/elisp/urweb-defs.el23
-rw-r--r--src/elisp/urweb-mode.el2
-rw-r--r--src/source.sml7
-rw-r--r--src/source_print.sml55
-rw-r--r--src/urweb.grm12
-rw-r--r--src/urweb.lex2
-rw-r--r--tests/let.ur6
-rw-r--r--tests/let.urp3
8 files changed, 82 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));
diff --git a/tests/let.ur b/tests/let.ur
new file mode 100644
index 00000000..45d52ded
--- /dev/null
+++ b/tests/let.ur
@@ -0,0 +1,6 @@
+fun main () : transaction page =
+ let
+ val x = 1
+ in
+ return <xml>{[x]}</xml>
+ end
diff --git a/tests/let.urp b/tests/let.urp
new file mode 100644
index 00000000..4bb17d32
--- /dev/null
+++ b/tests/let.urp
@@ -0,0 +1,3 @@
+debug
+
+let
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 23:51:59 +0000