Changeset 4922 for src/Pugs/Bind.hs

Timestamp:

06/23/05 21:00:37 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6771

Message:

* clean up theorbtwo's vCast patch. I expect most tests

to still break... :)

Files:

• src/Pugs/Bind.hs (modified) (3 diffs)

src/Pugs/Bind.hs

@@ -42 +42 @@
         = ( ((prm, exp) : bound), exps )
         | otherwise
-        = ( bound, (Syn "=>" [Val (VStr name), exp]:exps) )
+        = ( bound, (App (Var "&infix:=>") Nothing [Val (VStr name), exp]:exps) )
+
 
 matchNamedAttribute :: String -> String -> Bool
@@ -156 +157 @@
 isPair (Pos _ exp) = isPair exp
 isPair (Cxt _ exp) = isPair exp
-isPair (Syn "=>" [(Val _), _])   = True
 isPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val _)), _])   = True
 isPair (App (Var "&infix:=>") Nothing [(Val _), _])   = True
@@ -168 +168 @@
 unPair (Pos _ exp) = unPair exp
 unPair (Cxt _ exp) = unPair exp
-unPair (Syn "=>" [(Val k), exp]) = (vCast k, exp)
-unPair (App (Var "&infix:=>") Nothing [(Cxt _ (Val k)), exp]) = (vCast k, exp)
-unPair (App (Var "&infix:=>") Nothing [(Val k), exp]) = (vCast k, exp)
-unPair x                                = error ("Not a pair: " ++ show x)
+unPair (App (Var "&infix:=>") Nothing [key, exp])
+    | Val (VStr k) <- unwrap key = (k, exp)
+unPair x = error ("Not a pair: " ++ show x)
 
 {-|