Mercurial > urweb

comparison src/explify.sml @ 176:33d4a8eea484

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Case through explify
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Jul 2008 16:28:55 -0400
parents c7a6e6dbc318
children d11754ffe252
comparison
equal deleted inserted replaced
175:b2d752455182 176:33d4a8eea484
69 69
70 | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc) 70 | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc)
71 | L.CUnif (_, _, _, ref (SOME c)) => explifyCon c 71 | L.CUnif (_, _, _, ref (SOME c)) => explifyCon c
72 | L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc) 72 | L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc)
73 73
74 fun explifyPatCon pc =
75 case pc of
76 L.PConVar n => L'.PConVar n
77 | L.PConProj x => L'.PConProj x
78
79 fun explifyPat (p, loc) =
80 case p of
81 L.PWild => (L'.PWild, loc)
82 | L.PVar x => (L'.PVar x, loc)
83 | L.PPrim p => (L'.PPrim p, loc)
84 | L.PCon (pc, po) => (L'.PCon (explifyPatCon pc, Option.map explifyPat po), loc)
85 | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, explifyPat p)) xps), loc)
86
74 fun explifyExp (e, loc) = 87 fun explifyExp (e, loc) =
75 case e of 88 case e of
76 L.EPrim p => (L'.EPrim p, loc) 89 L.EPrim p => (L'.EPrim p, loc)
77 | L.ERel n => (L'.ERel n, loc) 90 | L.ERel n => (L'.ERel n, loc)
78 | L.ENamed n => (L'.ENamed n, loc) 91 | L.ENamed n => (L'.ENamed n, loc)
87 {field = explifyCon field, rest = explifyCon rest}), loc) 100 {field = explifyCon field, rest = explifyCon rest}), loc)
88 | L.ECut (e1, c, {field, rest}) => (L'.ECut (explifyExp e1, explifyCon c, 101 | L.ECut (e1, c, {field, rest}) => (L'.ECut (explifyExp e1, explifyCon c,
89 {field = explifyCon field, rest = explifyCon rest}), loc) 102 {field = explifyCon field, rest = explifyCon rest}), loc)
90 | L.EFold k => (L'.EFold (explifyKind k), loc) 103 | L.EFold k => (L'.EFold (explifyKind k), loc)
91 104
92 | L.ECase _ => raise Fail "Explify ECase" 105 | L.ECase (e, pes, t) => (L'.ECase (explifyExp e,
106 map (fn (p, e) => (explifyPat p, explifyExp e)) pes,
107 explifyCon t), loc)
93 108
94 | L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc) 109 | L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc)
95 110
96 fun explifySgi (sgi, loc) = 111 fun explifySgi (sgi, loc) =
97 case sgi of 112 case sgi of