Mercurial > urweb
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