diff src/unpoly.sml @ 1180:ac3dbbc85c6e

Standard library moduls Incl and Mem; tweaks to Especialize and Unpoly
author Adam Chlipala <adamc@hcoop.net>
date Sat, 06 Mar 2010 16:15:26 -0500
parents 85d194409b17
children 338be96f8533
line wrap: on
line diff
--- a/src/unpoly.sml	Thu Mar 04 16:59:13 2010 -0500
+++ b/src/unpoly.sml	Sat Mar 06 16:15:26 2010 -0500
@@ -258,9 +258,9 @@
                         fun kind _ = false
                         fun con _ = false
 
-                        fun exp e =
+                        fun exp (cn, e) =
                             case e of
-                                ECApp (e, c) =>
+                                orig as ECApp (e, c) =>
                                 let
                                     fun isIrregular (e, pos) =
                                         case #1 e of
@@ -268,20 +268,24 @@
                                             IS.member (ns, n)
                                             andalso
                                             (case #1 c of
-                                                 CRel i => i <> nargs - pos
+                                                 CRel i => i <> nargs - pos + cn
                                                | _ => true)
                                           | ECApp (e, _) => isIrregular (e, pos + 1)
                                           | _ => false
                                 in
                                     isIrregular (e, 1)
                                 end
-                              | ECAbs _ => true
                               | _ => false
 
-                        val irregular = U.Exp.exists {kind = kind, con = con, exp = exp}
+                        fun bind (cn, b) =
+                            case b of
+                                U.Exp.RelC _ => cn+1
+                              | _ => cn
+
+                        val irregular = U.Exp.existsB {kind = kind, con = con, exp = exp, bind = bind} 0
                     in
                         if List.exists (fn x => irregular (deAbs (#4 x, cargs))) vis then
-                            (d, st)
+                            (print "Poppycock!\n"; (d, st))
                         else
                             (d, {funcs = foldl (fn (vi, funcs) =>
                                                    IM.insert (funcs, #2 vi, {kinds = cargs,