[lots of cleanups in E.FromHs
John Meacham <john@repetae.net>**20060301035905] hunk ./E/FromHs.hs 70
-ump sl e = EError  (srcLocShow sl ++ ": Unmatched pattern") e
-srcLocShow sl = concat [srcLocFileName sl, ":",show $ srcLocLine sl,":", show $ srcLocColumn sl ]
-nameToInt n = atomIndex $ toAtom n
+ump sl e = EError (show sl ++ ": Unmatched pattern") e
hunk ./E/FromHs.hs 86
-lt :: Name -> Int
-lt n | nameType n == TypeVal =  atomIndex $ toAtom $  n
hunk ./E/FromHs.hs 105
+    lt n | nameType n == TypeVal = toId n  -- verifies namespace
hunk ./E/FromHs.hs 136
-{-
-convertVal assumps n = (mp EPi ts (tipe t), mp eLam ts) where
-    (Forall _ (_ :=> t)) = case Map.lookup n assumps of
-        Just z -> z
-        Nothing -> error $ "convertVal.Lookup failed: " ++ (show n)
-    mp fn (((Tyvar _ n k _)):rs) t = fn (tVr (lt n) (kind k)) (mp fn rs t)
-    mp _ [] t = t
-    ts = ctgen t
-    lt n =  nameToInt n
--}
-
hunk ./E/FromHs.hs 142
+convertValue n = do
+    assumps <- asks ceAssumps
+    t <- Map.lookup n assumps
+    let (vs,_) = fromSigma t
+        ty = tipe t
+    return (tVr (toId n) ty,ty,flip (foldr eLam) vs)
+
hunk ./E/FromHs.hs 155
-    mp fn (((Tyvar _ n k _)):rs) t = fn (tVr (lt n) (kind k)) (mp fn rs t)
+    mp fn (((Tyvar _ n k _)):rs) t = fn (tVr (toId n) (kind k)) (mp fn rs t)
hunk ./E/FromHs.hs 158
-    lt n =  nameToInt n
hunk ./E/FromHs.hs 159
-toTVr assumps n = tVr ( nameToInt n) (typeOfName n) where
+toTVr assumps n = tVr (toId n) (typeOfName n) where
hunk ./E/FromHs.hs 187
-            theMainTvr =  tVr (nameToInt theMainName) (infertype dataTable be)
+            theMainTvr =  tVr (toId theMainName) (infertype dataTable be)
hunk ./E/FromHs.hs 205
-        methodVar = tVr (nameToInt methodName) ty
+        methodVar = tVr (toId methodName) ty
hunk ./E/FromHs.hs 233
-    method classRecord methodName | isJust _methodTVr = [(methodName ,setProperty prop_METHOD (tVr ( nameToInt methodName) ty),v)] where
+    method classRecord methodName | isJust _methodTVr = [(methodName ,setProperty prop_METHOD (tVr (toId methodName) ty),v)] where
hunk ./E/FromHs.hs 263
-    cClass classRecord =  [ setProperty prop_METHOD $ tVr (nameToInt $ n) (convertOneVal t) | n :>: t <- classAssumps classRecord ]
+    cClass classRecord =  [ setProperty prop_METHOD $ tVr (toId n) (convertOneVal t) | n :>: t <- classAssumps classRecord ]
hunk ./E/FromHs.hs 335
+
hunk ./E/FromHs.hs 351
-    pval = convertVal assumps
hunk ./E/FromHs.hs 354
-            var       = tVr (nameToInt name) ty
-            (ty,lamt) = pval name
-            (ts,rt)   = argTypes' ty
+        (var,ty,lamt) <- convertValue name
+        let (ts,rt)   = argTypes' ty
hunk ./E/FromHs.hs 361
-        let (ty,lamt)  = pval name
-            (ts,rt)    = argTypes' ty
-            name       = toName Name.Val n
+        let name       = toName Name.Val n
+        (var,ty,lamt) <- convertValue name
+        let (ts,rt)    = argTypes' ty
hunk ./E/FromHs.hs 366
-        let var        = tVr (nameToInt name) ty
-            expr x     = return [(name,var,lamt x)]
+        let expr x     = return [(name,var,lamt x)]
hunk ./E/FromHs.hs 371
-            (ty,lamt) = pval name
-            var = tVr (nameToInt name) ty
-            (ts,rt) = argTypes' ty
+        (var,ty,lamt) <- convertValue name
+        let (ts,rt) = argTypes' ty
hunk ./E/FromHs.hs 405
-            var = tVr (nameToInt name) ty
-            (ty,lamt) = pval name
+        (var,ty,lamt) <- convertValue name
hunk ./E/FromHs.hs 411
-            var = tVr ( nameToInt name) ty
-            (ty,lamt) = pval name
+        (var,ty,lamt) <- convertValue name
hunk ./E/FromHs.hs 417
-            v = tVr (nameToInt name) t -- lp ps (hsLet wh e)
-            (t,lamt) = pval name
-            (targs,eargs) = argTypes t
+        (var,t,lamt) <- convertValue name
+        let (targs,eargs) = argTypes t
hunk ./E/FromHs.hs 425
-        return [(name,v,lamt $ z ms )]
+        return [(name,var,lamt $ z ms )]
hunk ./E/FromHs.hs 493
-        convertMatches funcs dataTable tv cType bs pg els
+        convertMatches funcs tv cType bs pg els
hunk ./E/FromHs.hs 525
-    cType (n::HsName) = fst $ pval (toName Name.Val n)
+    cType (n::HsName) = fst $ convertVal assumps (toName Name.Val n)
hunk ./E/FromHs.hs 537
-            cClass classRecord =  [ f n (nameToInt n) (convertOneVal t) | n :>: t <- classAssumps classRecord ] where
+            cClass classRecord =  [ f n (toId n) (convertOneVal t) | n :>: t <- classAssumps classRecord ] where
hunk ./E/FromHs.hs 586
-convertMatches funcs dataTable tv cType bs ms err = match bs ms err where
+convertMatches funcs tv cType bs ms err = match bs ms err where
hunk ./E/FromHs.hs 637
+                dataTable <- asks ceDataTable
hunk ./E/FromHs.hs 645
+                        dataTable <- asks ceDataTable