Mercurial > urweb

comparison src/explify.sml @ 213:0343557355fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Explifying type classes
author Adam Chlipala <adamc@hcoop.net>
date Sat, 16 Aug 2008 14:45:23 -0400
parents e86411f647c6
children 19e5791923d0
comparison
equal deleted inserted replaced
212:ba4d7c33a45f 213:0343557355fc
37 | L.KArrow (k1, k2) => (L'.KArrow (explifyKind k1, explifyKind k2), loc) 37 | L.KArrow (k1, k2) => (L'.KArrow (explifyKind k1, explifyKind k2), loc)
38 | L.KName => (L'.KName, loc) 38 | L.KName => (L'.KName, loc)
39 | L.KRecord k => (L'.KRecord (explifyKind k), loc) 39 | L.KRecord k => (L'.KRecord (explifyKind k), loc)
40 40
41 | L.KUnit => (L'.KUnit, loc) 41 | L.KUnit => (L'.KUnit, loc)
42 | L.KTuple _ => raise Fail "Explify KTuple" 42 | L.KTuple ks => (L'.KTuple (map explifyKind ks), loc)
43 43
44 | L.KError => raise Fail ("explifyKind: KError at " ^ EM.spanToString loc) 44 | L.KError => raise Fail ("explifyKind: KError at " ^ EM.spanToString loc)
45 | L.KUnif (_, _, ref (SOME k)) => explifyKind k 45 | L.KUnif (_, _, ref (SOME k)) => explifyKind k
46 | L.KUnif _ => raise Fail ("explifyKind: KUnif at " ^ EM.spanToString loc) 46 | L.KUnif _ => raise Fail ("explifyKind: KUnif at " ^ EM.spanToString loc)
47 47
66 | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc) 66 | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc)
67 | L.CFold (dom, ran) => (L'.CFold (explifyKind dom, explifyKind ran), loc) 67 | L.CFold (dom, ran) => (L'.CFold (explifyKind dom, explifyKind ran), loc)
68 68
69 | L.CUnit => (L'.CUnit, loc) 69 | L.CUnit => (L'.CUnit, loc)
70 70
71 | L.CTuple _ => raise Fail "Explify CTuple" 71 | L.CTuple cs => (L'.CTuple (map explifyCon cs), loc)
72 | L.CProj _ => raise Fail "Explify CProj" 72 | L.CProj (c, n) => (L'.CProj (explifyCon c, n), loc)
73 73
74 | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc) 74 | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc)
75 | L.CUnif (_, _, _, ref (SOME c)) => explifyCon c 75 | L.CUnif (_, _, _, ref (SOME c)) => explifyCon c
76 | L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc) 76 | L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc)
77 77
158 | L.DStr (x, n, sgn, str) => SOME (L'.DStr (x, n, explifySgn sgn, explifyStr str), loc) 158 | L.DStr (x, n, sgn, str) => SOME (L'.DStr (x, n, explifySgn sgn, explifyStr str), loc)
159 | L.DFfiStr (x, n, sgn) => SOME (L'.DFfiStr (x, n, explifySgn sgn), loc) 159 | L.DFfiStr (x, n, sgn) => SOME (L'.DFfiStr (x, n, explifySgn sgn), loc)
160 | L.DConstraint (c1, c2) => NONE 160 | L.DConstraint (c1, c2) => NONE
161 | L.DExport (en, sgn, str) => SOME (L'.DExport (en, explifySgn sgn, explifyStr str), loc) 161 | L.DExport (en, sgn, str) => SOME (L'.DExport (en, explifySgn sgn, explifyStr str), loc)
162 | L.DTable _ => raise Fail "Explify DTable" 162 | L.DTable _ => raise Fail "Explify DTable"
163 | L.DClass (x, n, c) => SOME (L'.DCon (x, n,
164 (L'.KArrow ((L'.KType, loc), (L'.KType, loc)), loc), explifyCon c), loc)
163 165
164 and explifyStr (str, loc) = 166 and explifyStr (str, loc) =
165 case str of 167 case str of
166 L.StrConst ds => (L'.StrConst (List.mapPartial explifyDecl ds), loc) 168 L.StrConst ds => (L'.StrConst (List.mapPartial explifyDecl ds), loc)
167 | L.StrVar n => (L'.StrVar n, loc) 169 | L.StrVar n => (L'.StrVar n, loc)