Mercurial > urweb

comparison src/explify.sml @ 182:d11754ffe252

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Compiled pattern matching to C
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 12:43:20 -0400
parents 33d4a8eea484
children 8e9f97508f0d
comparison
equal deleted inserted replaced
181:31dfab1d4050 182:d11754ffe252
77 | L.PConProj x => L'.PConProj x 77 | L.PConProj x => L'.PConProj x
78 78
79 fun explifyPat (p, loc) = 79 fun explifyPat (p, loc) =
80 case p of 80 case p of
81 L.PWild => (L'.PWild, loc) 81 L.PWild => (L'.PWild, loc)
82 | L.PVar x => (L'.PVar x, loc) 82 | L.PVar (x, t) => (L'.PVar (x, explifyCon t), loc)
83 | L.PPrim p => (L'.PPrim p, loc) 83 | L.PPrim p => (L'.PPrim p, loc)
84 | L.PCon (pc, po) => (L'.PCon (explifyPatCon pc, Option.map explifyPat po), 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) 85 | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, explifyPat p, explifyCon t)) xps), loc)
86 86
87 fun explifyExp (e, loc) = 87 fun explifyExp (e, loc) =
88 case e of 88 case e of
89 L.EPrim p => (L'.EPrim p, loc) 89 L.EPrim p => (L'.EPrim p, loc)
90 | L.ERel n => (L'.ERel n, loc) 90 | L.ERel n => (L'.ERel n, loc)
100 {field = explifyCon field, rest = explifyCon rest}), loc) 100 {field = explifyCon field, rest = explifyCon rest}), loc)
101 | 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,
102 {field = explifyCon field, rest = explifyCon rest}), loc) 102 {field = explifyCon field, rest = explifyCon rest}), loc)
103 | L.EFold k => (L'.EFold (explifyKind k), loc) 103 | L.EFold k => (L'.EFold (explifyKind k), loc)
104 104
105 | L.ECase (e, pes, t) => (L'.ECase (explifyExp e, 105 | L.ECase (e, pes, {disc, result}) =>
106 map (fn (p, e) => (explifyPat p, explifyExp e)) pes, 106 (L'.ECase (explifyExp e,
107 explifyCon t), loc) 107 map (fn (p, e) => (explifyPat p, explifyExp e)) pes,
108 {disc = explifyCon disc, result = explifyCon result}), loc)
108 109
109 | L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc) 110 | L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc)
110 111
111 fun explifySgi (sgi, loc) = 112 fun explifySgi (sgi, loc) =
112 case sgi of 113 case sgi of