Mercurial > urweb
comparison src/tag.sml @ 1062:3bc726a822fb
Shake bug fix; pattern reduction in ReduceLocal
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 08 Dec 2009 11:45:19 -0500 |
parents | a5eb8f87bc17 |
children | 217eb87dde31 |
comparison
equal
deleted
inserted
replaced
1061:e8a35d710ab9 | 1062:3bc726a822fb |
---|---|
72 val (xets, s) = | 72 val (xets, s) = |
73 ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) => | 73 ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) => |
74 let | 74 let |
75 fun tagIt (ek, newAttr) = | 75 fun tagIt (ek, newAttr) = |
76 let | 76 let |
77 val eOrig = e | |
78 | |
77 fun unravel (e, _) = | 79 fun unravel (e, _) = |
78 case e of | 80 case e of |
79 ENamed n => (n, []) | 81 ENamed n => (n, []) |
80 | EApp (e1, e2) => | 82 | EApp (e1, e2) => |
81 let | 83 let |
82 val (n, es) = unravel e1 | 84 val (n, es) = unravel e1 |
83 in | 85 in |
84 (n, es @ [e2]) | 86 (n, es @ [e2]) |
85 end | 87 end |
86 | _ => (ErrorMsg.errorAt loc "Invalid link expression"; | 88 | _ => (ErrorMsg.errorAt loc ("Invalid " ^ newAttr |
89 ^ " expression"); | |
90 Print.epreface ("Expression", | |
91 CorePrint.p_exp CoreEnv.empty eOrig); | |
87 (0, [])) | 92 (0, [])) |
88 | 93 |
89 val (f, args) = unravel e | 94 val (f, args) = unravel e |
90 | 95 |
91 val (cn, count, tags, newTags) = | 96 val (cn, count, tags, newTags) = |