diff src/tag.sml @ 492:4a241d108a2c

Handle nullary transaction pages; avoid marking up headers array when reading cookies
author Adam Chlipala <adamc@hcoop.net>
date Tue, 11 Nov 2008 18:39:38 -0500
parents 9117a7bf229c
children 9864b64b1700
line wrap: on
line diff
--- a/src/tag.sml	Tue Nov 11 16:51:45 2008 -0500
+++ b/src/tag.sml	Tue Nov 11 18:39:38 2008 -0500
@@ -184,6 +184,8 @@
                     val newDs = map
                                     (fn (ek, f, cn) =>
                                         let
+                                            val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
+
                                             fun unravel (all as (t, _)) =
                                                 case t of
                                                     TFun (dom, ran) =>
@@ -197,15 +199,14 @@
                                             val (fnam, t, _, tag) = E.lookupENamed env f
                                             val (args, result) = unravel t
 
-                                            val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
-
                                             val (abs, t) =
                                                 case args of
                                                     [] =>
                                                     let
-                                                        val body = (EWrite (ENamed f, loc), loc)
+                                                        val app = (EApp ((ENamed f, loc), (ERecord [], loc)), loc)
+                                                        val body = (EWrite app, loc)
                                                     in
-                                                        ((EAbs ("x", unit, unit, body), loc),
+                                                        (body,
                                                          (TFun (unit, unit), loc))
                                                     end
                                                   | _ =>