Mercurial > urweb
comparison src/cloconv.sml @ 52:198172560b73
FFI through cloconv
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 22 Jun 2008 10:17:34 -0400 |
parents | 92361a008a10 |
children | d3cc191cb25f |
comparison
equal
deleted
inserted
replaced
51:92361a008a10 | 52:198172560b73 |
---|---|
67 fun ccTyp (t, loc) = | 67 fun ccTyp (t, loc) = |
68 case t of | 68 case t of |
69 L.TFun (t1, t2) => (L'.TFun (ccTyp t1, ccTyp t2), loc) | 69 L.TFun (t1, t2) => (L'.TFun (ccTyp t1, ccTyp t2), loc) |
70 | L.TRecord xts => (L'.TRecord (map (fn (x, t) => (x, ccTyp t)) xts), loc) | 70 | L.TRecord xts => (L'.TRecord (map (fn (x, t) => (x, ccTyp t)) xts), loc) |
71 | L.TNamed n => (L'.TNamed n, loc) | 71 | L.TNamed n => (L'.TNamed n, loc) |
72 | L.TFfi _ => raise Fail "Cloconv TFfi" | 72 | L.TFfi mx => (L'.TFfi mx, loc) |
73 | 73 |
74 structure Ds :> sig | 74 structure Ds :> sig |
75 type t | 75 type t |
76 | 76 |
77 val empty : t | 77 val empty : t |
109 fun ccExp env ((e, loc), D) = | 109 fun ccExp env ((e, loc), D) = |
110 case e of | 110 case e of |
111 L.EPrim p => ((L'.EPrim p, loc), D) | 111 L.EPrim p => ((L'.EPrim p, loc), D) |
112 | L.ERel n => ((L'.ERel n, loc), Ds.used (D, n)) | 112 | L.ERel n => ((L'.ERel n, loc), Ds.used (D, n)) |
113 | L.ENamed n => ((L'.ENamed n, loc), D) | 113 | L.ENamed n => ((L'.ENamed n, loc), D) |
114 | L.EFfi _ => raise Fail "Cloconv EFfi" | 114 | L.EFfi mx => ((L'.EFfi mx, loc), D) |
115 | L.EFfiApp _ => raise Fail "Cloconv EFfiApp" | 115 | L.EFfiApp (m, x, es) => |
116 let | |
117 val (es, D) = ListUtil.foldlMap (ccExp env) D es | |
118 in | |
119 ((L'.EFfiApp (m, x, es), loc), D) | |
120 end | |
116 | L.EApp (e1, e2) => | 121 | L.EApp (e1, e2) => |
117 let | 122 let |
118 val (e1, D) = ccExp env (e1, D) | 123 val (e1, D) = ccExp env (e1, D) |
119 val (e2, D) = ccExp env (e2, D) | 124 val (e2, D) = ccExp env (e2, D) |
120 in | 125 in |