diff src/cloconv.sml @ 101:717b6f8d8505

First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents f0f59e918cac
children 5f04adf47f48
line wrap: on
line diff
--- a/src/cloconv.sml	Thu Jul 10 10:11:35 2008 -0400
+++ b/src/cloconv.sml	Thu Jul 10 11:13:49 2008 -0400
@@ -78,6 +78,7 @@
 
     val exp : t -> string * int * L'.typ * L'.exp -> t
     val func : t -> string * L'.typ * L'.typ * L'.exp -> t * int
+    val page : t -> (string * L'.typ) list * L'.exp -> t
     val decls : t -> L'.decl list
 
     val enter : t -> t
@@ -95,6 +96,8 @@
 fun func (fc, ds, vm) (x, dom, ran, e as (_, loc)) =
     ((fc+1, (L'.DFun (fc, x, dom, ran, e), loc) :: ds, vm), fc)
 
+fun page (fc, ds, vm) (xts, e as (_, loc)) = (fc, (L'.DPage (xts, e), loc) :: ds, vm)
+
 fun decls (_, ds, _) = rev ds
 
 fun enter (fc, ds, vm) = (fc, ds, IS.map (fn n => n + 1) vm)
@@ -197,7 +200,13 @@
         in
             Ds.exp D (x, n, t, e)
         end
-      | L.DPage _ => raise Fail "Cloconv DPage"
+      | L.DPage (xts, e) =>
+        let
+            val xts = map (fn (x, t) => (x, ccTyp t)) xts
+            val (e, D) = ccExp E.empty (e, D)
+        in
+            Ds.page D (xts, e)
+        end
 
 fun cloconv ds =
     let