diff src/monoize.sml @ 1042:a8a825861397

Explicitly abort in-flight RPCs onunload
author Adam Chlipala <adamc@hcoop.net>
date Tue, 24 Nov 2009 09:24:25 -0500
parents c1f49f6ba856
children d73cf02427df
line wrap: on
line diff
--- a/src/monoize.sml	Sun Nov 22 17:57:15 2009 -0500
+++ b/src/monoize.sml	Tue Nov 24 09:24:25 2009 -0500
@@ -2483,13 +2483,14 @@
                     else
                         attrs
 
-                fun findOnload (attrs, acc) =
+                fun findOnload (attrs, onload, onunload, acc) =
                     case attrs of
-                        [] => (NONE, acc)
-                      | ("Onload", e, _) :: rest => (SOME e, List.revAppend (acc, rest))
-                      | x :: rest => findOnload (rest, x :: acc)
+                        [] => (onload, onunload, acc)
+                      | ("Onload", e, _) :: rest => findOnload (rest, SOME e, onunload, acc)
+                      | ("Onunload", e, _) :: rest => findOnload (rest, onload, SOME e, acc)
+                      | x :: rest => findOnload (rest, onload, onunload, x :: acc)
                                      
-                val (onload, attrs) = findOnload (attrs, [])
+                val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, [])
 
                 val (class, fm) = monoExp (env, st, fm) class
 
@@ -2669,26 +2670,33 @@
                                          :: str ";"
                                          :: assgns)
                     end
+
+                fun execify e =
+                    case e of
+                        NONE => (L'.EPrim (Prim.String ""), loc)
+                      | SOME e =>
+                        let
+                            val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
+                        in
+                            (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
+                                         (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
+                                                      (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
+                        end
             in
                 case tag of
                     "body" => let
-                        val onload = case onload of
-                                         NONE => (L'.EPrim (Prim.String ""), loc)
-                                       | SOME e =>
-                                         let
-                                             val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
-                                         in
-                                             (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
-                                                          (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
-                                                                       (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
-                                         end
+                        val onload = execify onload
+                        val onunload = execify onunload
                     in
                         normal ("body",
-                                SOME (L'.EFfiApp ("Basis", "maybe_onload",
-                                                  [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings",
-                                                                             [(L'.ERecord [], loc)]), loc),
-                                                                onload), loc)]),
-                                      loc),
+                                SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload",
+                                                               [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings",
+                                                                                          [(L'.ERecord [], loc)]), loc),
+                                                                             onload), loc)]),
+                                                   loc),
+                                                  (L'.EFfiApp ("Basis", "maybe_onunload",
+                                                               [onunload]),
+                                                   loc)), loc),
                                 SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc))
                     end