From 6179a09d47c5af4db1ac41d00b8cb7ec36741c3e Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Tue, 15 Dec 2009 10:19:05 -0500 Subject: Convert to task syntax --- CHANGELOG | 2 +- lib/ur/basis.urs | 6 ++++++ src/cjr.sml | 4 +++- src/cjr_env.sml | 2 +- src/cjr_print.sml | 4 ++-- src/cjrize.sml | 10 +++++++--- src/core.sml | 2 +- src/core_env.sml | 2 +- src/core_print.sml | 8 ++++++-- src/core_util.sml | 14 ++++++++------ src/corify.sml | 6 +++--- src/elab.sml | 2 +- src/elab_env.sml | 2 +- src/elab_print.sml | 8 ++++++-- src/elab_util.sml | 14 ++++++++------ src/elaborate.sml | 18 +++++++++++------- src/elisp/urweb-defs.el | 6 +++--- src/elisp/urweb-mode.el | 4 ++-- src/expl.sml | 2 +- src/expl_env.sml | 2 +- src/expl_print.sml | 8 ++++++-- src/explify.sml | 2 +- src/mono.sml | 2 +- src/mono_env.sml | 2 +- src/mono_print.sml | 8 ++++++-- src/mono_shake.sml | 6 +++--- src/mono_util.sml | 14 ++++++++------ src/monoize.sml | 7 ++++--- src/prepare.sml | 4 ++-- src/reduce.sml | 7 ++++--- src/reduce_local.sml | 2 +- src/shake.sml | 6 +++--- src/source.sml | 2 +- src/source_print.sml | 8 ++++++-- src/unnest.sml | 2 +- src/urweb.grm | 4 ++-- src/urweb.lex | 2 +- tests/init.ur | 2 +- 38 files changed, 125 insertions(+), 81 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index e1e14aea..ec2eda90 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -6,7 +6,7 @@ Next - More syntactic sugar for SQL - Typing of SQL queries no longer exposes which tables were used in joins but had none of their fields projected -- Module-level initializers +- Tasks ======== 20091203 diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index f7e098d4..f550ce67 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -757,3 +757,9 @@ val onDisconnect : transaction unit -> transaction unit val onServerError : (string -> transaction unit) -> transaction unit val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind) + + +(** Tasks *) + +type task_kind +val initialize : task_kind diff --git a/src/cjr.sml b/src/cjr.sml index 9be54670..f5392d49 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -100,6 +100,8 @@ datatype exp' = withtype exp = exp' located +datatype task = Initialize + datatype decl' = DStruct of int * (string * typ) list | DDatatype of (datatype_kind * string * int * (string * int * typ option) list) list @@ -118,7 +120,7 @@ datatype decl' = | DCookie of string | DStyle of string - | DInitializer of exp + | DTask of task * exp withtype decl = decl' located diff --git a/src/cjr_env.sml b/src/cjr_env.sml index e4d978d5..ac83f263 100644 --- a/src/cjr_env.sml +++ b/src/cjr_env.sml @@ -171,6 +171,6 @@ fun declBinds env (d, loc) = | DJavaScript _ => env | DCookie _ => env | DStyle _ => env - | DInitializer _ => env + | DTask _ => env end diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 6a5116ce..2d547519 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2099,7 +2099,7 @@ fun p_decl env (dAll as (d, _) : decl) = space, string "*/"] - | DInitializer _ => box [] + | DTask _ => box [] datatype 'a search = Found of 'a @@ -2733,7 +2733,7 @@ fun p_file env (ds, ps) = string "}", newline] - val initializers = List.mapPartial (fn (DInitializer e, _) => SOME e | _ => NONE) ds + val initializers = List.mapPartial (fn (DTask (Initialize, e), _) => SOME e | _ => NONE) ds in box [string "#include ", newline, diff --git a/src/cjrize.sml b/src/cjrize.sml index 3936f6a5..0136bdf6 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -660,13 +660,17 @@ fun cifyDecl ((d, loc), sm) = | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm) | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm) | L.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm) - | L.DInitializer e => - (case #1 e of + | L.DTask (e1, e2) => + (case #1 e2 of L.EAbs (_, _, _, e) => let + val tk = case #1 e1 of + L.EFfi ("Basis", "initialize") => L'.Initialize + | _ => (ErrorMsg.errorAt loc "Task kind not fully determined"; + L'.Initialize) val (e, sm) = cifyExp (e, sm) in - (SOME (L'.DInitializer e, loc), NONE, sm) + (SOME (L'.DTask (tk, e), loc), NONE, sm) end | _ => (ErrorMsg.errorAt loc "Initializer has not been fully determined"; (NONE, NONE, sm))) diff --git a/src/core.sml b/src/core.sml index a60bfd3b..78a1eded 100644 --- a/src/core.sml +++ b/src/core.sml @@ -134,7 +134,7 @@ datatype decl' = | DDatabase of string | DCookie of string * int * con * string | DStyle of string * int * string - | DInitializer of exp + | DTask of exp * exp withtype decl = decl' located diff --git a/src/core_env.sml b/src/core_env.sml index 5e0af98c..4c50bdd7 100644 --- a/src/core_env.sml +++ b/src/core_env.sml @@ -348,7 +348,7 @@ fun declBinds env (d, loc) = in pushENamed env x n t NONE s end - | DInitializer _ => env + | DTask _ => env fun patBinds env (p, loc) = case p of diff --git a/src/core_print.sml b/src/core_print.sml index 7dd43d56..c1f93587 100644 --- a/src/core_print.sml +++ b/src/core_print.sml @@ -611,9 +611,13 @@ fun p_decl env (dAll as (d, _) : decl) = string "as", space, string s] - | DInitializer e => box [string "initializer", + | DTask (e1, e2) => box [string "task", space, - p_exp env e] + p_exp env e1, + space, + string "=", + space, + p_exp env e2] fun p_file env file = let diff --git a/src/core_util.sml b/src/core_util.sml index 7ead1157..599e1abc 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -971,10 +971,12 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = fn c' => (DCookie (x, n, c', s), loc)) | DStyle _ => S.return2 dAll - | DInitializer e => - S.map2 (mfe ctx e, - fn e' => - (DInitializer e', loc)) + | DTask (e1, e2) => + S.bind2 (mfe ctx e1, + fn e1' => + S.map2 (mfe ctx e2, + fn e2' => + (DTask (e1', e2'), loc))) and mfvi ctx (x, n, t, e, s) = S.bind2 (mfc ctx t, @@ -1129,7 +1131,7 @@ fun mapfoldB (all as {bind, ...}) = in bind (ctx, NamedE (x, n, t, NONE, s)) end - | DInitializer _ => ctx + | DTask _ => ctx in S.map2 (mff ctx' ds', fn ds' => @@ -1193,7 +1195,7 @@ val maxName = foldl (fn ((d, _) : decl, count) => | DDatabase _ => count | DCookie (_, n, _, _) => Int.max (n, count) | DStyle (_, n, _) => Int.max (n, count) - | DInitializer _ => count) 0 + | DTask _ => count) 0 end diff --git a/src/corify.sml b/src/corify.sml index cc0500af..9259b4f2 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -1064,8 +1064,8 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = ([(L'.DStyle (x, n, s), loc)], st) end - | L.DInitializer e => - ([(L'.DInitializer (corifyExp st e), loc)], st) + | L.DTask (e1, e2) => + ([(L'.DTask (corifyExp st e1, corifyExp st e2), loc)], st) and corifyStr mods ((str, _), st) = case str of @@ -1124,7 +1124,7 @@ fun maxName ds = foldl (fn ((d, _), n) => | L.DDatabase _ => n | L.DCookie (_, _, n', _) => Int.max (n, n') | L.DStyle (_, _, n') => Int.max (n, n') - | L.DInitializer _ => n) + | L.DTask _ => n) 0 ds and maxNameStr (str, _) = diff --git a/src/elab.sml b/src/elab.sml index 1cd7aefa..a0f9a4e8 100644 --- a/src/elab.sml +++ b/src/elab.sml @@ -170,7 +170,7 @@ datatype decl' = | DDatabase of string | DCookie of int * string * int * con | DStyle of int * string * int - | DInitializer of exp + | DTask of exp * exp and str' = StrConst of decl list diff --git a/src/elab_env.sml b/src/elab_env.sml index 763cf801..5092c6fb 100644 --- a/src/elab_env.sml +++ b/src/elab_env.sml @@ -1622,6 +1622,6 @@ fun declBinds env (d, loc) = in pushENamedAs env x n t end - | DInitializer _ => env + | DTask _ => env end diff --git a/src/elab_print.sml b/src/elab_print.sml index 906c836d..62b5262f 100644 --- a/src/elab_print.sml +++ b/src/elab_print.sml @@ -799,9 +799,13 @@ fun p_decl env (dAll as (d, _) : decl) = | DStyle (_, x, n) => box [string "style", space, p_named x n] - | DInitializer e => box [string "initializer", + | DTask (e1, e2) => box [string "task", space, - p_exp env e] + p_exp env e1, + space, + string "=", + space, + p_exp env e2] and p_str env (str, _) = case str of diff --git a/src/elab_util.sml b/src/elab_util.sml index 2a044e71..d0e140c5 100644 --- a/src/elab_util.sml +++ b/src/elab_util.sml @@ -854,7 +854,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f c), loc))) | DStyle (tn, x, n) => bind (ctx, NamedE (x, (CModProj (n, [], "css_class"), loc))) - | DInitializer _ => ctx, + | DTask _ => ctx, mfd ctx d)) ctx ds, fn ds' => (StrConst ds', loc)) | StrVar _ => S.return2 strAll @@ -979,10 +979,12 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f fn c' => (DCookie (tn, x, n, c'), loc)) | DStyle _ => S.return2 dAll - | DInitializer e => - S.map2 (mfe ctx e, - fn e' => - (DInitializer e', loc)) + | DTask (e1, e2) => + S.bind2 (mfe ctx e1, + fn e1' => + S.map2 (mfe ctx e2, + fn e2' => + (DTask (e1', e2'), loc))) and mfvi ctx (x, n, c, e) = S.bind2 (mfc ctx c, @@ -1125,7 +1127,7 @@ and maxNameDecl (d, _) = | DDatabase _ => 0 | DCookie (n1, _, n2, _) => Int.max (n1, n2) | DStyle (n1, _, n2) => Int.max (n1, n2) - | DInitializer _ => 0 + | DTask _ => 0 and maxNameStr (str, _) = case str of StrConst ds => maxName ds diff --git a/src/elaborate.sml b/src/elaborate.sml index d1b9648a..2a237c50 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -2548,7 +2548,7 @@ and sgiOfDecl (d, loc) = | L'.DDatabase _ => [] | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)] | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] - | L'.DInitializer _ => [] + | L'.DTask _ => [] and subSgn' counterparts env strLoc sgn1 (sgn2 as (_, loc2)) = ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), @@ -3669,14 +3669,18 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) = in ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs)) end - | L.DInitializer e => + | L.DTask (e1, e2) => let - val (e', t, gs') = elabExp (env, denv) e - val t' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), - (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc) + val (e1', t1, gs1) = elabExp (env, denv) e1 + val (e2', t2, gs2) = elabExp (env, denv) e2 + + val t1' = (L'.CModProj (!basis_r, [], "task_kind"), loc) + val t2' = (L'.CApp ((L'.CModProj (!basis_r, [], "transaction"), loc), + (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc)), loc) in - checkCon env e' t t'; - ([(L'.DInitializer e', loc)], (env, denv, gs' @ gs)) + checkCon env e1' t1 t1'; + checkCon env e2' t2 t2'; + ([(L'.DTask (e1', e2'), loc)], (env, denv, gs2 @ gs1 @ gs)) end (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) diff --git a/src/elisp/urweb-defs.el b/src/elisp/urweb-defs.el index bb0e257d..c697a274 100644 --- a/src/elisp/urweb-defs.el +++ b/src/elisp/urweb-defs.el @@ -108,7 +108,7 @@ notion of \"the end of an outline\".") "datatype" "type" "open" "include" urweb-module-head-syms "con" "map" "where" "extern" "constraint" "constraints" - "table" "sequence" "class" "cookie" "initializer") + "table" "sequence" "class" "cookie" "task") "Symbols starting an sexp.") ;; (defconst urweb-not-arg-start-re @@ -135,7 +135,7 @@ notion of \"the end of an outline\".") (("case" "datatype" "if" "then" "else" "let" "open" "sig" "struct" "type" "val" "con" "constraint" "table" "sequence" "class" "cookie" - "initializer"))))) + "task"))))) (defconst urweb-starters-indent-after (urweb-syms-re "let" "in" "struct" "sig") @@ -190,7 +190,7 @@ for all symbols and in all lines starting with the given symbol." '("datatype" "fun" "open" "type" "val" "and" "con" "constraint" "table" "sequence" "class" "cookie" - "initializer")) + "task")) "The starters of new expressions.") (defconst urweb-exptrail-syms diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el index ab274f22..107ea3bc 100644 --- a/src/elisp/urweb-mode.el +++ b/src/elisp/urweb-mode.el @@ -136,7 +136,7 @@ See doc for the variable `urweb-mode-info'." "datatype" "else" "end" "extern" "fn" "map" "fun" "functor" "if" "include" "of" "open" "let" "in" - "rec" "sequence" "sig" "signature" "cookie" "style" "initializer" + "rec" "sequence" "sig" "signature" "cookie" "style" "task" "struct" "structure" "table" "view" "then" "type" "val" "where" "with" @@ -226,7 +226,7 @@ See doc for the variable `urweb-mode-info'." ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)" (1 font-lock-keyword-face) (3 (amAttribute font-lock-type-def-face))) - ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|initializer\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]" + ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|task\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]" (1 font-lock-keyword-face) (3 (amAttribute font-lock-variable-name-face))) ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)" diff --git a/src/expl.sml b/src/expl.sml index eb79e2b0..17797626 100644 --- a/src/expl.sml +++ b/src/expl.sml @@ -147,7 +147,7 @@ datatype decl' = | DDatabase of string | DCookie of int * string * int * con | DStyle of int * string * int - | DInitializer of exp + | DTask of exp * exp and str' = StrConst of decl list diff --git a/src/expl_env.sml b/src/expl_env.sml index f16eeb8e..0bf7323f 100644 --- a/src/expl_env.sml +++ b/src/expl_env.sml @@ -343,7 +343,7 @@ fun declBinds env (d, loc) = in pushENamed env x n t end - | DInitializer _ => env + | DTask _ => env fun sgiBinds env (sgi, loc) = case sgi of diff --git a/src/expl_print.sml b/src/expl_print.sml index 624afa63..5284eecb 100644 --- a/src/expl_print.sml +++ b/src/expl_print.sml @@ -713,9 +713,13 @@ fun p_decl env (dAll as (d, _) : decl) = | DStyle (_, x, n) => box [string "style", space, p_named x n] - | DInitializer e => box [string "initializer", + | DTask (e1, e2) => box [string "task", space, - p_exp env e] + p_exp env e1, + space, + string "=", + space, + p_exp env e2] and p_str env (str, _) = case str of diff --git a/src/explify.sml b/src/explify.sml index d66b3530..aff91a34 100644 --- a/src/explify.sml +++ b/src/explify.sml @@ -195,7 +195,7 @@ fun explifyDecl (d, loc : EM.span) = | L.DDatabase s => SOME (L'.DDatabase s, loc) | L.DCookie (nt, x, n, c) => SOME (L'.DCookie (nt, x, n, explifyCon c), loc) | L.DStyle (nt, x, n) => SOME (L'.DStyle (nt, x, n), loc) - | L.DInitializer e => SOME (L'.DInitializer (explifyExp e), loc) + | L.DTask (e1, e2) => SOME (L'.DTask (explifyExp e1, explifyExp e2), loc) and explifyStr (str, loc) = case str of diff --git a/src/mono.sml b/src/mono.sml index 1962c6c5..e5e68bfa 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -139,7 +139,7 @@ datatype decl' = | DCookie of string | DStyle of string - | DInitializer of exp + | DTask of exp * exp withtype decl = decl' located diff --git a/src/mono_env.sml b/src/mono_env.sml index 6ffab153..c2e6cf02 100644 --- a/src/mono_env.sml +++ b/src/mono_env.sml @@ -129,7 +129,7 @@ fun declBinds env (d, loc) = | DJavaScript _ => env | DCookie _ => env | DStyle _ => env - | DInitializer _ => env + | DTask _ => env fun patBinds env (p, loc) = case p of diff --git a/src/mono_print.sml b/src/mono_print.sml index 13c45329..da34c220 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -491,9 +491,13 @@ fun p_decl env (dAll as (d, _) : decl) = | DStyle s => box [string "style", space, string s] - | DInitializer e => box [string "initializer", + | DTask (e1, e2) => box [string "task", space, - p_exp env e] + p_exp env e1, + space, + string "=", + space, + p_exp env e2] fun p_file env file = diff --git a/src/mono_shake.sml b/src/mono_shake.sml index fc46cf96..048cc190 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -57,7 +57,7 @@ fun shake file = (fn ((DExport (_, _, n, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) => (page_cs, IS.addList (page_es, [n1, n2])) - | ((DInitializer e, _), st) => usedVars st e + | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1 | (_, st) => st) (IS.empty, IS.empty) file val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => @@ -74,7 +74,7 @@ fun shake file = | ((DJavaScript _, _), acc) => acc | ((DCookie _, _), acc) => acc | ((DStyle _, _), acc) => acc - | ((DInitializer _, _), acc) => acc) + | ((DTask _, _), acc) => acc) (IM.empty, IM.empty) file fun typ (c, s) = @@ -141,7 +141,7 @@ fun shake file = | (DJavaScript _, _) => true | (DCookie _, _) => true | (DStyle _, _) => true - | (DInitializer _, _) => true) file + | (DTask _, _) => true) file end end diff --git a/src/mono_util.sml b/src/mono_util.sml index 184ce168..894e35d0 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -528,10 +528,12 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} = | DJavaScript _ => S.return2 dAll | DCookie _ => S.return2 dAll | DStyle _ => S.return2 dAll - | DInitializer e => - S.map2 (mfe ctx e, - fn e' => - (DInitializer e', loc)) + | DTask (e1, e2) => + S.bind2 (mfe ctx e1, + fn e1' => + S.map2 (mfe ctx e2, + fn e2' => + (DTask (e1', e2'), loc))) and mfvi ctx (x, n, t, e, s) = S.bind2 (mft t, @@ -618,7 +620,7 @@ fun mapfoldB (all as {bind, ...}) = | DJavaScript _ => ctx | DCookie _ => ctx | DStyle _ => ctx - | DInitializer _ => ctx + | DTask _ => ctx in S.map2 (mff ctx' ds', fn ds' => @@ -672,7 +674,7 @@ val maxName = foldl (fn ((d, _) : decl, count) => | DJavaScript _ => count | DCookie _ => count | DStyle _ => count - | DInitializer _ => count) 0 + | DTask _ => count) 0 end diff --git a/src/monoize.sml b/src/monoize.sml index 503fd6b3..f6a56c33 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3478,13 +3478,14 @@ fun monoDecl (env, fm) (all as (d, loc)) = [(L'.DStyle s, loc), (L'.DVal (x, n, t', e, s), loc)]) end - | L.DInitializer e => + | L.DTask (e1, e2) => let - val (e, fm) = monoExp (env, St.empty, fm) e + val (e1, fm) = monoExp (env, St.empty, fm) e1 + val (e2, fm) = monoExp (env, St.empty, fm) e2 in SOME (env, fm, - [(L'.DInitializer e, loc)]) + [(L'.DTask (e1, e2), loc)]) end end diff --git a/src/prepare.sml b/src/prepare.sml index 7cbd7d76..2d144c67 100644 --- a/src/prepare.sml +++ b/src/prepare.sml @@ -325,11 +325,11 @@ fun prepDecl (d as (_, loc), st) = | DJavaScript _ => (d, st) | DCookie _ => (d, st) | DStyle _ => (d, st) - | DInitializer e => + | DTask (tk, e) => let val (e, st) = prepExp (e, st) in - ((DInitializer e, loc), st) + ((DTask (tk, e), loc), st) end fun prepare (ds, ps) = diff --git a/src/reduce.sml b/src/reduce.sml index cedb79fa..95b26da8 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -804,11 +804,12 @@ fun reduce file = | DDatabase _ => (d, st) | DCookie (s, n, c, s') => ((DCookie (s, n, con namedC [] c, s'), loc), st) | DStyle (s, n, s') => ((DStyle (s, n, s'), loc), st) - | DInitializer e => + | DTask (e1, e2) => let - val e = exp (namedC, namedE) [] e + val e1 = exp (namedC, namedE) [] e1 + val e2 = exp (namedC, namedE) [] e2 in - ((DInitializer e, loc), + ((DTask (e1, e2), loc), (polyC, namedC, namedE)) diff --git a/src/reduce_local.sml b/src/reduce_local.sml index 82490118..b040a1ec 100644 --- a/src/reduce_local.sml +++ b/src/reduce_local.sml @@ -251,7 +251,7 @@ fun reduce file = | DDatabase _ => d | DCookie _ => d | DStyle _ => d - | DInitializer e => (DInitializer (exp [] e), loc) + | DTask (e1, e2) => (DTask (exp [] e1, exp [] e2), loc) in map doDecl file end diff --git a/src/shake.sml b/src/shake.sml index 787500ea..d1810bea 100644 --- a/src/shake.sml +++ b/src/shake.sml @@ -79,7 +79,7 @@ fun shake file = in (usedE, usedC) end - | ((DInitializer e, _), st) => usedVars st e + | ((DTask (e1, e2), _), st) => usedVars (usedVars st e1) e2 | (_, acc) => acc) (IS.empty, IS.empty) file val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef) @@ -106,7 +106,7 @@ fun shake file = (cdef, IM.insert (edef, n, ([], c, dummye))) | ((DStyle (_, n, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], dummyt, dummye))) - | ((DInitializer _, _), acc) => acc) + | ((DTask _, _), acc) => acc) (IM.empty, IM.empty) file fun kind (_, s) = s @@ -186,7 +186,7 @@ fun shake file = | (DDatabase _, _) => true | (DCookie _, _) => true | (DStyle _, _) => true - | (DInitializer _, _) => true) file + | (DTask _, _) => true) file end end diff --git a/src/source.sml b/src/source.sml index e52872f0..dc867026 100644 --- a/src/source.sml +++ b/src/source.sml @@ -167,7 +167,7 @@ datatype decl' = | DDatabase of string | DCookie of string * con | DStyle of string - | DInitializer of exp + | DTask of exp * exp and str' = StrConst of decl list diff --git a/src/source_print.sml b/src/source_print.sml index 31fc2500..e3b4fe94 100644 --- a/src/source_print.sml +++ b/src/source_print.sml @@ -662,9 +662,13 @@ fun p_decl ((d, _) : decl) = | DStyle x => box [string "style", space, string x] - | DInitializer e => box [string "initializer", + | DTask (e1, e2) => box [string "task", space, - p_exp e] + p_exp e1, + space, + string "=", + space, + p_exp e2] and p_str (str, _) = case str of diff --git a/src/unnest.sml b/src/unnest.sml index c4d9a8b5..e030bbc6 100644 --- a/src/unnest.sml +++ b/src/unnest.sml @@ -422,7 +422,7 @@ fun unnest file = | DDatabase _ => default () | DCookie _ => default () | DStyle _ => default () - | DInitializer _ => explore () + | DTask _ => explore () end and doStr (all as (str, loc), st) = diff --git a/src/urweb.grm b/src/urweb.grm index 8780d9f6..afe7be07 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -201,7 +201,7 @@ fun patType loc (p : pat) = | LET | IN | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL | SELECT1 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | VIEW - | COOKIE | STYLE | INITIALIZER + | COOKIE | STYLE | TASK | CASE | IF | THEN | ELSE | ANDALSO | ORELSE | XML_BEGIN of string | XML_END | XML_BEGIN_END of string @@ -479,7 +479,7 @@ decl : CON SYMBOL cargl2 kopt EQ cexp (let end) | COOKIE SYMBOL COLON cexp ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))]) | STYLE SYMBOL ([(DStyle SYMBOL, s (STYLEleft, SYMBOLright))]) - | INITIALIZER eexp ([(DInitializer eexp, s (INITIALIZERleft, eexpright))]) + | TASK eapps EQ eexp ([(DTask (eapps, eexp), s (TASKleft, eexpright))]) dtype : SYMBOL dargs EQ barOpt dcons (SYMBOL, dargs, dcons) diff --git a/src/urweb.lex b/src/urweb.lex index d04822f7..5fb767b1 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -402,7 +402,7 @@ notags = [^<{\n]+; "class" => (Tokens.CLASS (pos yypos, pos yypos + size yytext)); "cookie" => (Tokens.COOKIE (pos yypos, pos yypos + size yytext)); "style" => (Tokens.STYLE (pos yypos, pos yypos + size yytext)); - "initializer" => (Tokens.INITIALIZER (pos yypos, pos yypos + size yytext)); + "task" => (Tokens.TASK (pos yypos, pos yypos + size yytext)); "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext)); "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext)); diff --git a/tests/init.ur b/tests/init.ur index 0a44a9e4..aafbb55f 100644 --- a/tests/init.ur +++ b/tests/init.ur @@ -1,6 +1,6 @@ sequence seq table fred : {A : int, B : int} -initializer +task initialize = setval seq 1; dml (INSERT INTO fred (A, B) VALUES (0, 1)) -- cgit v1.2.3