Mercurial > urweb

comparison src/cloconv.sml @ 101:717b6f8d8505

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents f0f59e918cac
children 5f04adf47f48
comparison
equal deleted inserted replaced
100:f0f59e918cac 101:717b6f8d8505
76 76
77 val empty : t 77 val empty : t
78 78
79 val exp : t -> string * int * L'.typ * L'.exp -> t 79 val exp : t -> string * int * L'.typ * L'.exp -> t
80 val func : t -> string * L'.typ * L'.typ * L'.exp -> t * int 80 val func : t -> string * L'.typ * L'.typ * L'.exp -> t * int
81 val page : t -> (string * L'.typ) list * L'.exp -> t
81 val decls : t -> L'.decl list 82 val decls : t -> L'.decl list
82 83
83 val enter : t -> t 84 val enter : t -> t
84 val used : t * int -> t 85 val used : t * int -> t
85 val leave : t -> t 86 val leave : t -> t
92 93
93 fun exp (fc, ds, vm) (v as (_, _, _, (_, loc))) = (fc, (L'.DVal v, loc) :: ds, vm) 94 fun exp (fc, ds, vm) (v as (_, _, _, (_, loc))) = (fc, (L'.DVal v, loc) :: ds, vm)
94 95
95 fun func (fc, ds, vm) (x, dom, ran, e as (_, loc)) = 96 fun func (fc, ds, vm) (x, dom, ran, e as (_, loc)) =
96 ((fc+1, (L'.DFun (fc, x, dom, ran, e), loc) :: ds, vm), fc) 97 ((fc+1, (L'.DFun (fc, x, dom, ran, e), loc) :: ds, vm), fc)
98
99 fun page (fc, ds, vm) (xts, e as (_, loc)) = (fc, (L'.DPage (xts, e), loc) :: ds, vm)
97 100
98 fun decls (_, ds, _) = rev ds 101 fun decls (_, ds, _) = rev ds
99 102
100 fun enter (fc, ds, vm) = (fc, ds, IS.map (fn n => n + 1) vm) 103 fun enter (fc, ds, vm) = (fc, ds, IS.map (fn n => n + 1) vm)
101 fun used ((fc, ds, vm), n) = (fc, ds, IS.add (vm, n)) 104 fun used ((fc, ds, vm), n) = (fc, ds, IS.add (vm, n))
195 val t = ccTyp t 198 val t = ccTyp t
196 val (e, D) = ccExp E.empty (e, D) 199 val (e, D) = ccExp E.empty (e, D)
197 in 200 in
198 Ds.exp D (x, n, t, e) 201 Ds.exp D (x, n, t, e)
199 end 202 end
200 | L.DPage _ => raise Fail "Cloconv DPage" 203 | L.DPage (xts, e) =>
204 let
205 val xts = map (fn (x, t) => (x, ccTyp t)) xts
206 val (e, D) = ccExp E.empty (e, D)
207 in
208 Ds.page D (xts, e)
209 end
201 210
202 fun cloconv ds = 211 fun cloconv ds =
203 let 212 let
204 val D = foldl ccDecl Ds.empty ds 213 val D = foldl ccDecl Ds.empty ds
205 in 214 in