[convert OpTys into C types in more places properly
John Meacham <john@repetae.net>**20070526020814] hunk ./C/Arch.hs 100
-    Nothing -> case archGetPrimInfo ai s of
-        Nothing -> f s
-        Just pt -> case primTypeType pt of
-            PrimTypeIntegral -> Op.TyBits (Op.Bits $ 8 * primTypeSizeOf pt) (if primTypeIsSigned pt then Op.HintSigned else Op.HintUnsigned)
-            PrimTypeFloating ->  Op.TyBits (Op.Bits $ 8 * primTypeSizeOf pt) Op.HintFloat
-            _ -> f s
-  where
-    f "float" = Op.TyBits  (Op.Bits 32) Op.HintFloat
-    f "double" = Op.TyBits (Op.Bits 64) Op.HintFloat
-    f "int" = Op.TyBits (Op.BitsArch Op.BitsInt) Op.HintSigned
-    f "unsigned int" = Op.TyBits (Op.BitsArch Op.BitsInt) Op.HintUnsigned
-
-    f "uintmax_t" = Op.TyBits (Op.BitsArch Op.BitsMax) Op.HintUnsigned
-    f "intmax_t" = Op.TyBits (Op.BitsArch Op.BitsMax)  Op.HintSigned
-    f "uintptr_t" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
-    f "intptr_t" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintSigned
-    f "HsPtr" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
-    f "HsFunPtr" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
-    f s = Op.TyBits (Op.BitsExt s) Op.HintNone
+    _ -> error $ "archOpTy: " ++ show s
+--    Nothing -> case archGetPrimInfo ai s of
+--        Nothing -> f s
+--        Just pt -> case primTypeType pt of
+--            PrimTypeIntegral -> Op.TyBits (Op.Bits $ 8 * primTypeSizeOf pt) (if primTypeIsSigned pt then Op.HintSigned else Op.HintUnsigned)
+--            PrimTypeFloating ->  Op.TyBits (Op.Bits $ 8 * primTypeSizeOf pt) Op.HintFloat
+--            _ -> f s
+--  where
+--    f "float" = Op.TyBits  (Op.Bits 32) Op.HintFloat
+--    f "double" = Op.TyBits (Op.Bits 64) Op.HintFloat
+--    f "int" = Op.TyBits (Op.BitsArch Op.BitsInt) Op.HintSigned
+--    f "unsigned int" = Op.TyBits (Op.BitsArch Op.BitsInt) Op.HintUnsigned
+--
+--    f "uintmax_t" = Op.TyBits (Op.BitsArch Op.BitsMax) Op.HintUnsigned
+--    f "intmax_t" = Op.TyBits (Op.BitsArch Op.BitsMax)  Op.HintSigned
+--    f "uintptr_t" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
+--    f "intptr_t" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintSigned
+--    f "HsPtr" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
+--    f "HsFunPtr" = Op.TyBits (Op.BitsArch Op.BitsPtr) Op.HintUnsigned
+--    f s = Op.TyBits (Op.BitsExt s) Op.HintNone
hunk ./C/FromGrin2.hs 82
+stringNameToTy :: String -> Op.Ty
+stringNameToTy n = (archOpTy archInfo n)
+
hunk ./C/FromGrin2.hs 194
-convertType (TyPrim Op.TyBool) = return (basicType "bool")
+convertType (TyPrim opty) = return (opTyToC opty)
hunk ./C/FromGrin2.hs 206
+opTyToC opty = basicType (opTyToC' opty)
+
+opTyToC' Op.TyBool = "bool"
+opTyToC' (Op.TyBits (Op.BitsExt s) _) = s
+opTyToC' (Op.TyBits (Op.Bits n) _) =  "uint" ++ show n ++ "_t"
+opTyToC' (Op.TyBits (Op.BitsArch Op.BitsInt) _) = "unsigned"
+opTyToC' (Op.TyBits (Op.BitsArch Op.BitsMax) _) = "uintmax_t"
+opTyToC' (Op.TyBits (Op.BitsArch Op.BitsPtr) _) = "uintptr_t"
hunk ./C/FromGrin2.hs 521
-convertConst (ValPrim (APrim p _) [x] _) = do
+convertConst (ValPrim (APrim p _) [x] (TyPrim opty)) = do
hunk ./C/FromGrin2.hs 524
-        CCast _ to -> return $ cast (basicType to) x'
+        CCast _ to -> return $ cast (opTyToC opty) x'
hunk ./C/FromGrin2.hs 542
-        return $ cast (basicType to) a'
+        return $ cast (opTyToC (stringNameToTy to)) a'
hunk ./C/FromGrin2.hs 555
-        return $ expressionRaw ("*((" <> t <+> "*)" <> (parens $ renderG v') <> char ')')
+        return $ expressionRaw ("*((" <> (opTyToC' $ stringNameToTy t) <+> "*)" <> (parens $ renderG v') <> char ')')
hunk ./C/FromGrin2.hs 559
-        return $ expressionRaw ("*((" <> t <+> "*)" <> (parens $ renderG v') <> text ") = " <> renderG x')
+        return $ expressionRaw ("*((" <> (opTyToC' $ stringNameToTy t) <+> "*)" <> (parens $ renderG v') <> text ") = " <> renderG x')
hunk ./Grin/FromE.hs 445
-    ce (EPrim ap@(APrim p _) xs ty) = let
-      prim = Primitive { primName = Atom.fromString (pprint ap), primAPrim = ap, primRets = Nothing, primType = ([],tyUnit) }
-      in case p of
-        Func True fn as "void" -> return $ Prim prim { primType = (keepIts (map stringNameToTy as),tyUnit) } (args $ tail xs)
-        Func True fn as r -> do
-            let p = prim { primType = (keepIts (map stringNameToTy as),stringNameToTy r) }
-            return $ Prim p (keepIts $ args $ tail xs)
-        Func False _ as r | Just _ <- fromRawType ty ->  do
-            let p = prim { primType = (keepIts (map stringNameToTy as),stringNameToTy r) }
-            return $ Prim p (keepIts $ args xs)
-        Peek pt' | [addr] <- xs -> do
-            let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
-                pt = toType (stringNameToTy pt') ty
-            return $ Prim p (args [addr])
-        Peek pt' -> do
-            let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
-                [_,addr] = xs
-                pt = stringNameToTy pt'
-            return $ Prim p (args [addr])
-        Poke pt' ->  do
-            let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_),pt],tyUnit) }
-                [_,addr,val] = xs
-                pt = stringNameToTy pt'
-            return $  Prim p (args [addr,val])
-        CCast from to -> do
-            let ptypeto' = stringNameToTy to
-                ptypefrom' = stringNameToTy from
-            let p = prim { primName = toAtom ("(" ++ to ++ ")"), primType = ([ptypefrom'],ptypeto') }
-            return $  Prim p (args xs)
-        Op (Op.BinOp _ a1 a2) rt -> do
-            let p = prim { primType = ([TyPrim a1,TyPrim a2],TyPrim rt) }
-            return $ Prim p (args xs)
-        Op (Op.UnOp _ a1) rt -> do
-            let p = prim { primType = ([TyPrim a1], TyPrim rt) }
-            return $ Prim p (args xs)
-        Op (Op.ConvOp _ a1) rt -> do
-            let p = prim { primType = ([TyPrim a1], TyPrim rt) }
-            return $ Prim p (args xs)
---        Operator n as r | Just _ <- fromRawType ty -> do
---            let p = prim { primType = ((map (Ty . toAtom) as),Ty (toAtom r)) }
---            return $ Prim p (args xs)
-        other -> fail $ "ce unknown primitive: " ++ show other
+    ce (EPrim ap@(APrim p _) xs ty) = do
+        let prim = Primitive { primName = Atom.fromString (pprint ap), primAPrim = ap, primRets = Nothing, primType = ([],tyUnit) }
+            xs' = keepIts $ args xs
+            ty' = toType TyNode ty
+
+        case p of
+            Func True fn as "void" -> return $ Prim prim { primType = (map getType xs',ty') } xs'
+            Func True fn as r -> do
+                let p = prim { primType = (map getType xs', ty') }
+                return $ Prim p xs'
+            Func False _ as r | Just _ <- fromRawType ty ->  do
+                let p = prim { primType = (map getType xs', ty') }
+                return $ Prim p xs'
+            Peek pt' | [addr] <- xs -> do
+                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
+                    pt = toType (stringNameToTy pt') ty
+                return $ Prim p (args [addr])
+            Peek pt' -> do
+                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
+                    [_,addr] = xs
+                    pt = stringNameToTy pt'
+                return $ Prim p (args [addr])
+            Poke pt' ->  do
+                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_),pt],tyUnit) }
+                    [_,addr,val] = xs
+                    pt = stringNameToTy pt'
+                return $  Prim p (args [addr,val])
+            CCast from to -> do
+                let ptypeto' = stringNameToTy to
+                    ptypefrom' = stringNameToTy from
+                let p = prim { primName = toAtom ("(" ++ to ++ ")"), primType = ([ptypefrom'],ptypeto') }
+                return $  Prim p (args xs)
+            Op (Op.BinOp _ a1 a2) rt -> do
+                let p = prim { primType = ([TyPrim a1,TyPrim a2],TyPrim rt) }
+                return $ Prim p (args xs)
+            Op (Op.UnOp _ a1) rt -> do
+                let p = prim { primType = ([TyPrim a1], TyPrim rt) }
+                return $ Prim p (args xs)
+            Op (Op.ConvOp _ a1) rt -> do
+                let p = prim { primType = ([TyPrim a1], TyPrim rt) }
+                return $ Prim p (args xs)
+    --        Operator n as r | Just _ <- fromRawType ty -> do
+    --            let p = prim { primType = ((map (Ty . toAtom) as),Ty (toAtom r)) }
+    --            return $ Prim p (args xs)
+            other -> fail $ "ce unknown primitive: " ++ show other
hunk ./Grin/Show.hs 149
-prettyVal (ValPrim aprim [] _ty) = pprint aprim
-prettyVal (ValPrim aprim xs _ty) = pprint aprim <> tupled (map tshow xs)
+prettyVal (ValPrim aprim [] ty) = pprint aprim <> text "::" <> tshow ty
+prettyVal (ValPrim aprim xs ty) = pprint aprim <> tupled (map tshow xs) <> text "::" <> tshow ty
hunk ./data/PrimitiveOperators-in.hs 188
-    f "HsChar" = boxup $ ELit $ LitInt 0 (rawType "HsChar")
+    f "HsChar" = boxup $ ELit $ LitInt 0 (rawType "bits32")
hunk ./data/PrimitiveOperators-in.hs 195
-    f "HsChar" = boxup $ ELit $ LitInt 0x10ffff (rawType "HsChar")
+    f "HsChar" = boxup $ ELit $ LitInt 0x10ffff (rawType "bits32")