Propagated a source change into a dynamic document element

1 files changed, 98 insertions, 86 deletions

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index c96f97cf..0117623f 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -56,6 +56,7 @@ fun impure (e, _) =
       | EFfiApp ("Basis", "set_cookie", _) => true
       | EFfiApp ("Basis", "new_client_source", _) => true
       | EFfiApp ("Basis", "set_client_source", _) => true
+      | EFfiApp ("Basis", "alert", _) => true
       | EFfiApp _ => false
       | EApp ((EFfi _, _), _) => false
       | EApp _ => true
@@ -253,92 +254,103 @@ fun reduce file =
             IM.empty file
 
         fun summarize d (e, _) =
-            case e of
-                EPrim _ => []
-              | ERel n => if n = d then [UseRel] else []
-              | ENamed _ => []
-              | ECon (_, _, NONE) => []
-              | ECon (_, _, SOME e) => summarize d e
-              | ENone _ => []
-              | ESome (_, e) => summarize d e
-              | EFfi _ => []
-              | EFfiApp ("Basis", "set_cookie", _) => [Unsure]
-              | EFfiApp ("Basis", "new_client_source", _) => [Unsure]
-              | EFfiApp ("Basis", "set_client_source", _) => [Unsure]
-              | EFfiApp (_, _, es) => List.concat (map (summarize d) es)
-              | EApp ((EFfi _, _), e) => summarize d e
-              | EApp _ =>
-                let
-                    fun unravel (e, ls) =
-                        case e of
-                            ENamed n =>
-                            let
-                                val ls = rev ls
-                            in
-                                case IM.find (absCounts, n) of
-                                    NONE => [Unsure]
-                                  | SOME len =>
-                                    if length ls < len then
-                                        ls
-                                    else
-                                        [Unsure]
-                            end
-                          | ERel n => List.revAppend (ls,
-                                                      if n = d then
-                                                          [UseRel, Unsure]
-                                                      else
-                                                          [Unsure])
-                          | EApp (f, x) =>
-                            unravel (#1 f, summarize d x @ ls)
-                          | _ => [Unsure]
-                in
-                    unravel (e, [])
-                end
-
-              | EAbs _ => []
-
-              | EUnop (_, e) => summarize d e
-              | EBinop (_, e1, e2) => summarize d e1 @ summarize d e2
-
-              | ERecord xets => List.concat (map (summarize d o #2) xets)
-              | EField (e, _) => summarize d e
-
-              | ECase (e, pes, _) =>
-                let
-                    val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes
-                in
-                    case lss of
-                        [] => raise Fail "Empty pattern match"
-                      | ls :: lss =>
-                        if List.all (fn ls' => ls' = ls) lss then
-                            summarize d e @ ls
-                        else
-                            [Unsure]
-                end
-              | EStrcat (e1, e2) => summarize d e1 @ summarize d e2
-
-              | EError (e, _) => summarize d e @ [Unsure]
-
-              | EWrite e => summarize d e @ [WritePage]
-                            
-              | ESeq (e1, e2) => summarize d e1 @ summarize d e2
-              | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2
-
-              | EClosure (_, es) => List.concat (map (summarize d) es)
-
-              | EQuery {query, body, initial, ...} =>
-                List.concat [summarize d query,
-                             summarize (d + 2) body,
-                             summarize d initial,
-                             [ReadDb]]
-
-              | EDml e => summarize d e @ [WriteDb]
-              | ENextval e => summarize d e @ [WriteDb]
-              | EUnurlify (e, _) => summarize d e
-              | EJavaScript (_, e, _) => summarize d e
-              | ESignalReturn e => summarize d e
-              | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
-              | ESignalSource e => summarize d e
+            let
+                val s =
+                    case e of
+                        EPrim _ => []
+                      | ERel n => if n = d then [UseRel] else []
+                      | ENamed _ => []
+                      | ECon (_, _, NONE) => []
+                      | ECon (_, _, SOME e) => summarize d e
+                      | ENone _ => []
+                      | ESome (_, e) => summarize d e
+                      | EFfi _ => []
+                      | EFfiApp ("Basis", "set_cookie", es) => List.concat (map (summarize d) es) @ [Unsure]
+                      | EFfiApp ("Basis", "new_client_source", es) => List.concat (map (summarize d) es) @ [Unsure]
+                      | EFfiApp ("Basis", "set_client_source", es) => List.concat (map (summarize d) es) @ [Unsure]
+                      | EFfiApp ("Basis", "alert", es) => List.concat (map (summarize d) es) @ [Unsure]
+                      | EFfiApp (_, _, es) => List.concat (map (summarize d) es)
+                      | EApp ((EFfi _, _), e) => summarize d e
+                      | EApp _ =>
+                        let
+                            fun unravel (e, ls) =
+                                case e of
+                                    ENamed n =>
+                                    let
+                                        val ls = rev ls
+                                    in
+                                        case IM.find (absCounts, n) of
+                                            NONE => [Unsure]
+                                          | SOME len =>
+                                            if length ls < len then
+                                                ls
+                                            else
+                                                [Unsure]
+                                    end
+                                  | ERel n => List.revAppend (ls,
+                                                              if n = d then
+                                                                  [UseRel, Unsure]
+                                                              else
+                                                                  [Unsure])
+                                  | EApp (f, x) =>
+                                    unravel (#1 f, summarize d x @ ls)
+                                  | _ => [Unsure]
+                        in
+                            unravel (e, [])
+                        end
+
+                      | EAbs (_, _, _, e) => List.filter (fn UseRel => true
+                                                           | _ => false) (summarize (d + 1) e)
+
+                      | EUnop (_, e) => summarize d e
+                      | EBinop (_, e1, e2) => summarize d e1 @ summarize d e2
+
+                      | ERecord xets => List.concat (map (summarize d o #2) xets)
+                      | EField (e, _) => summarize d e
+
+                      | ECase (e, pes, _) =>
+                        let
+                            val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes
+                        in
+                            case lss of
+                                [] => raise Fail "Empty pattern match"
+                              | ls :: lss =>
+                                if List.all (fn ls' => ls' = ls) lss then
+                                    summarize d e @ ls
+                                else
+                                    [Unsure]
+                        end
+                      | EStrcat (e1, e2) => summarize d e1 @ summarize d e2
+
+                      | EError (e, _) => summarize d e @ [Unsure]
+
+                      | EWrite e => summarize d e @ [WritePage]
+                                    
+                      | ESeq (e1, e2) => summarize d e1 @ summarize d e2
+                      | ELet (_, _, e1, e2) => summarize d e1 @ summarize (d + 1) e2
+
+                      | EClosure (_, es) => List.concat (map (summarize d) es)
+
+                      | EQuery {query, body, initial, ...} =>
+                        List.concat [summarize d query,
+                                     summarize (d + 2) body,
+                                     summarize d initial,
+                                     [ReadDb]]
+
+                      | EDml e => summarize d e @ [WriteDb]
+                      | ENextval e => summarize d e @ [WriteDb]
+                      | EUnurlify (e, _) => summarize d e
+                      | EJavaScript (_, e, _) => summarize d e
+                      | ESignalReturn e => summarize d e
+                      | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
+                      | ESignalSource e => summarize d e
+            in
+                (*Print.prefaces "Summarize"
+                               [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
+                                ("d", Print.PD.string (Int.toString d)),
+                                ("s", p_events s)];*)
+                s
+            end
 
         fun exp env e =
             let