[remove 'Operator' from Primitive, make foreign calls store the C type rather than the jhc internal type
John Meacham <john@repetae.net>**20070526011943] hunk ./C/FromGrin2.hs 36
+import qualified C.Op as Op
hunk ./C/FromGrin2.hs 175
-        Operator n [_] r ->  return $ cast (basicType r) (uoperator n x')
+--        Operator n [_] r ->  return $ cast (basicType r) (uoperator n x')
hunk ./C/FromGrin2.hs 181
-        Operator n [_,_] r -> return $ cast (basicType r) (operator n x' y')
+--        Operator n [_,_] r -> return $ cast (basicType r) (operator n x' y')
hunk ./C/FromGrin2.hs 191
+convertType (TyPrim Op.TyBool) = return (basicType "bool")
+convertType (TyPrim (Op.TyBits (Op.BitsExt s) _)) = return (basicType s)
+convertType (TyPrim (Op.TyBits (Op.Bits n) _)) = return (basicType $ "uint" ++ show n ++ "_t")
+convertType (TyPrim (Op.TyBits (Op.BitsArch Op.BitsInt) _)) = return $ basicType "unsigned"
+convertType (TyPrim (Op.TyBits (Op.BitsArch Op.BitsMax) _)) = return $ basicType "uintmax_t"
+convertType (TyPrim (Op.TyBits (Op.BitsArch Op.BitsPtr) _)) = return $ basicType "uintptr_t"
hunk ./C/FromGrin2.hs 514
-        Operator n [_] r ->  return $ cast (basicType r) (uoperator n x')
+--        Operator n [_] r ->  return $ cast (basicType r) (uoperator n x')
hunk ./C/FromGrin2.hs 520
-        Operator n [_,_] r -> return $ cast (basicType r) (operator n x' y')
+--        Operator n [_,_] r -> return $ cast (basicType r) (operator n x' y')
hunk ./C/FromGrin2.hs 532
-    | APrim (Operator n [ta] r) _ <- primAPrim p, [a] <- vs = do
-        a' <- convertVal a
-        return $ cast (basicType r) (uoperator n a')
-    | APrim (Operator n [ta,tb] r) _ <- primAPrim p, [a,b] <- vs = do
-        a' <- convertVal a
-        b' <- convertVal b
-        return $ cast (basicType r) (operator n a' b')
+--    | APrim (Operator n [ta] r) _ <- primAPrim p, [a] <- vs = do
+--        a' <- convertVal a
+--        return $ cast (basicType r) (uoperator n a')
+--    | APrim (Operator n [ta,tb] r) _ <- primAPrim p, [a,b] <- vs = do
+--        a' <- convertVal a
+--        b' <- convertVal b
+--        return $ cast (basicType r) (operator n a' b')
hunk ./C/FromGrin2.hs 551
+    | otherwise = return $ err ("prim: " ++ show (p,vs))
hunk ./C/Prims.hs 34
-    | Operator {
-        primOp :: String,
-        primArgTypes ::  [ExtType],
-        primRetType :: ExtType
-        }   -- C operator
hunk ./C/Prims.hs 84
-primIsCheap Operator {} = True
+--primIsCheap Operator {} = True
hunk ./C/Prims.hs 101
-primIsConstant Operator { primOp = op } | op `elem` safeOps = True  where
-    safeOps = ["+","-","*","==",">=","<=",">","<","&","|","^","~",">>","<<"]
+--primIsConstant Operator { primOp = op } | op `elem` safeOps = True  where
+--    safeOps = ["+","-","*","==",">=","<=",">","<","&","|","^","~",">>","<<"]
hunk ./C/Prims.hs 114
-primEagerSafe Operator { primOp = op } | op `elem` safeOps = True  where
-    safeOps = ["+","-","*","==",">=","<=",">","<","&","|","^","~",">>","<<"]
+--primEagerSafe Operator { primOp = op } | op `elem` safeOps = True  where
+--    safeOps = ["+","-","*","==",">=","<=",">","<","&","|","^","~",">>","<<"]
hunk ./C/Prims.hs 146
-    pprint (Operator s xs r) = parens (text r) <> text s <> tupled (map text xs)
+--    pprint (Operator s xs r) = parens (text r) <> text s <> tupled (map text xs)
hunk ./DataConstructors.hs 429
-    ELit LitCons { litName = c, litArgs = [], litType = _ }
+    ELit LitCons { litName = c, litArgs = [] }
hunk ./DataConstructors.hs 431
-          Just Constructor { conOrigSlots = [SlotNormal st@(ELit LitCons { litName = n, litArgs = [], litType = _ })] } <- getConstructor cn dataTable
+          Just Constructor { conOrigSlots = [SlotNormal st@(ELit LitCons { litName = n, litArgs = [] })] } <- getConstructor cn dataTable
hunk ./DataConstructors.hs 433
-    ELit LitCons { litName = c, litArgs = [], litType = _ } | Just cn  <- getConstructor c dataTable -> fail $ "lookupCType: " ++ show cn
+    ELit LitCons { litName = c, litArgs = [] } | Just cn  <- getConstructor c dataTable -> fail $ "lookupCType: " ++ show cn
hunk ./E/FromHs.hs 358
-        (cn,st,ct) <- lookupCType' dataTable rt
+        (cn,st,_ct) <- lookupCType' dataTable rt
hunk ./E/FromHs.hs 370
+        cts <- mapM lookupCType ts
hunk ./E/FromHs.hs 373
-            prim io rs rtt = EPrim (APrim (Func io (packString rcn) (snds rs) rtt) req)
+            prim io  = EPrim (APrim (Func io (packString rcn) cts pt) req)
hunk ./E/FromHs.hs 376
-                        eStrictLet tvrWorld2 (prim True rs "void" (EVar tvrWorld:[EVar t | (t,_) <- rs ]) tWorld__) (eJustIO (EVar tvrWorld2) vUnit)
+                        eStrictLet tvrWorld2 (prim True  (EVar tvrWorld:[EVar t | (t,_) <- rs ]) tWorld__) (eJustIO (EVar tvrWorld2) vUnit)
hunk ./E/FromHs.hs 379
-                (cn,rtt',rtt) <- lookupCType' dataTable rt'
+                (cn,rtt',_) <- lookupCType' dataTable rt'
hunk ./E/FromHs.hs 384
-                    False -> cFun $ \rs -> (,) id $ eStrictLet rtVar' (prim False rs rtt [ EVar t | (t,_) <- rs ] rtt') (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' })
+                    False -> cFun $ \rs -> (,) id $ eStrictLet rtVar' (prim False [ EVar t | (t,_) <- rs ] rtt') (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' })
hunk ./E/FromHs.hs 386
-                                eCaseTup' (prim True rs rtt (EVar tvrWorld:[EVar t | (t,_) <- rs ]) rttIO')  [tvrWorld2,rtVar'] (eLet rtVar (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' }) (eJustIO (EVar tvrWorld2) (EVar rtVar)))
+                                eCaseTup' (prim True (EVar tvrWorld:[EVar t | (t,_) <- rs ]) rttIO')  [tvrWorld2,rtVar'] (eLet rtVar (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' }) (eJustIO (EVar tvrWorld2) (EVar rtVar)))
hunk ./E/FromHs.hs 723
-        match (b:bs) ps err = do
+        match ~(b:bs) ps err = do
hunk ./E/PrimOpt.hs 72
+primOpt' _  x = return x
+
+{-
hunk ./E/PrimOpt.hs 136
+-}
hunk ./E/Show.hs 185
-        f (EPrim (APrim Operator { primOp = op } _) [x,y] t) = do
-            x <- showE x
-            y <- showE y
-            t <- showE t
-            return $ atom $ angles $ unparse $ atom ((unparse x) <+> text op <+> (unparse y)) `inhabit` t
+--        f (EPrim (APrim Operator { primOp = op } _) [x,y] t) = do
+--            x <- showE x
+--            y <- showE y
+--            t <- showE t
+--            return $ atom $ angles $ unparse $ atom ((unparse x) <+> text op <+> (unparse y)) `inhabit` t
hunk ./E/ToHs.hs 290
-transE (EPrim (APrim Operator { primOp = "-", primRetType = rt } _) [x] _) = mparen $ do
-    x <- transE x
-    return (hsep [text "negateInt#",x])
-transE (EPrim (APrim Operator { primOp = op, primRetType = rt } _) [x,y] _) | Just z <- op2Table (op,rt) = mparen $ do
-    x <- transE x
-    y <- transE y
-    return (hsep [text z,x,y])
-transE (EPrim (APrim Operator { primOp = op, primArgTypes = [at,_] } _) [x,y] _) | Just z <- op2TableCmp (op,showCType at) = mparen $ do
-    x <- transE x
-    y <- transE y
-    return $ text "fromBool" <+> (parens $ hsep [text z,x,y])
+--transE (EPrim (APrim Operator { primOp = "-", primRetType = rt } _) [x] _) = mparen $ do
+--    x <- transE x
+--    return (hsep [text "negateInt#",x])
+--transE (EPrim (APrim Operator { primOp = op, primRetType = rt } _) [x,y] _) | Just z <- op2Table (op,rt) = mparen $ do
+--    x <- transE x
+--    y <- transE y
+--    return (hsep [text z,x,y])
+--transE (EPrim (APrim Operator { primOp = op, primArgTypes = [at,_] } _) [x,y] _) | Just z <- op2TableCmp (op,showCType at) = mparen $ do
+--    x <- transE x
+--    y <- transE y
+--    return $ text "fromBool" <+> (parens $ hsep [text z,x,y])