[look up C type for foreign function calls in dedicated map
John Meacham <john@repetae.net>**20070525003912] hunk ./C/Op.hs 186
+bool = TyBool
+bits_ptr = TyBits (BitsArch BitsPtr) HintNone
+bits_max = TyBits (BitsArch BitsMax) HintNone
+bits_int = TyBits (BitsArch BitsInt) HintNone
+bits8    = TyBits (Bits 8)  HintNone
+bits16   = TyBits (Bits 16) HintNone
+bits32   = TyBits (Bits 32) HintNone
+bits64   = TyBits (Bits 64) HintNone
hunk ./DataConstructors.hs 24
+    extractIO,
+    extractIO',
hunk ./DataConstructors.hs 369
-typeTable = [
+typeTable = Map.fromList [
hunk ./DataConstructors.hs 404
-    (tc_CTime, "time_t")
+    (tc_CTime, "time_t"),
+    (tc_Unit,  "void"),
+    (tc_World__,  "void")
hunk ./DataConstructors.hs 409
+lookupCType :: Monad m => E -> m String
+lookupCType e = f e where
+    f (ELit LitCons { litName = c })
+        | Just s <- Map.lookup c typeTable = return s
+    f (ELit LitCons { litAliasFor = Just af, litArgs = as }) = f (foldl eAp af as)
+    f _ = fail "lookupCType: Not C Type"
hunk ./DataConstructors.hs 416
-lookupCType dataTable e = case followAliases (mappend dataTablePrims dataTable) e of
-    ELit LitCons { litName = c, litArgs = [], litType = _ }
-        | c == tc_Unit -> return (c,"void")
-        | c == tc_World__ -> return (c,"void")
-        | Just pt <- Map.lookup c ctypeMap -> return (c,pt)
hunk ./DataConstructors.hs 417
-    e' -> fail $ "lookupCType: " ++ show (e,e')
+extractIO :: Monad m => E -> m E
+extractIO e = f e where
+    f (ELit LitCons { litName = c, litArgs = [x] }) | c == tc_IO  = return x
+    f (ELit LitCons { litAliasFor = Just af, litArgs = as }) = f (foldl eAp af as)
+    f _ = fail "extractIO: not an IO type"
+
+extractIO' :: E -> (Bool,E)
+extractIO' e = case extractIO e of
+    Just x -> (True,x)
+    Nothing -> (False,e)
hunk ./E/FromHs.hs 170
-        let e = case ioLike (getType maine) of
+        let e = case extractIO (getType maine) of
hunk ./E/FromHs.hs 182
-    ioLike ty = case ty of
-        ELit LitCons { litName = n, litArgs = [x] } | n ==  tc_IO -> Just x
---        (EPi ioc (EPi tvr (ELit LitCons { litName = n, litArgs = [x] }))) | n == tc_IOResult -> Just x
-        _ -> Nothing
+
hunk ./E/FromHs.hs 367
-            (isIO,rt') = case  rt of
-                ELit (LitCons { litName = c, litArgs = [x] }) | c == tc_IO -> (True,x)
-                _ -> (False,rt)
+            (isIO,rt') =  extractIO' rt
hunk ./E/FromHs.hs 369
-        (_,pt) <- lookupCType dataTable rt'
+        pt <- lookupCType rt'
hunk ./E/FromHs.hs 390
-            (isIO,rt') = case  rt of
-                ELit (LitCons { litName = c, litArgs = [x] }) | c == tc_IO -> (True,x)
-                _ -> (False,rt)
+            (isIO,rt') = extractIO' rt
hunk ./E/FromHs.hs 392
-        (_,pt) <- lookupCType dataTable rt'
+        pt <- lookupCType rt'
hunk ./data/PrimitiveOperators-in.hs 3
-module PrimitiveOperators(primitiveInsts,constantMethods,theMethods,allCTypes,ctypeMap) where
+module PrimitiveOperators(primitiveInsts,constantMethods,theMethods,allCTypes) where
hunk ./data/PrimitiveOperators-in.hs 38
-ctypeMap = Map.fromList [ (tc,v) | (_,tc,_,v,_) <- allCTypes ]
hunk ./data/PrimitiveOperators-in.hs 248
-{-# NOINLINE ctypeMap #-}