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) =