[remove APrim type, use Prim directly, clean up corresponding cruft.
John Meacham <john@repetae.net>**20120209104920
 Ignore-this: 8a3fbeea72e7f52809a3468df2b8b228
] hunk ./src/C/FromGrin2.hs 267
-    cv (ValPrim (APrim p _) [x] (TyPrim opty)) = do
+    cv (ValPrim p [x] (TyPrim opty)) = do
hunk ./src/C/FromGrin2.hs 273
-    cv (ValPrim (APrim p _) [x,y] _) = do
+    cv (ValPrim p [x,y] _) = do
hunk ./src/C/FromGrin2.hs 563
-convertExp (Prim p vs ty) | APrim _ req <- p  =  do
-    tell mempty { wRequires = req }
+convertExp (Prim p vs ty) =  do
+    tell mempty { wRequires = primReqs p }
hunk ./src/C/FromGrin2.hs 654
-    f (ValPrim (APrim p _) [] ty) = case p of
-        CConst s -> return $ expressionRaw $ unpackPS s
-        AddrOf t -> do rt <- convertType ty; return . cast rt $ expressionRaw ('&':unpackPS t)
+    f (ValPrim p [] ty) = case p of
+        CConst _ s -> return $ expressionRaw $ unpackPS s
+        AddrOf _ t -> do rt <- convertType ty; return . cast rt $ expressionRaw ('&':unpackPS t)
hunk ./src/C/FromGrin2.hs 663
-    f (ValPrim (APrim p _) [x] (TyPrim opty)) = do
+    f (ValPrim p [x] (TyPrim opty)) = do
hunk ./src/C/FromGrin2.hs 669
-    f (ValPrim (APrim p _) [x,y] _) = do
+    f (ValPrim p [x,y] _) = do
hunk ./src/C/FromGrin2.hs 679
-    | APrim (CConst s) _ <- p = do
+    | (CConst _ s) <- p = do
hunk ./src/C/FromGrin2.hs 681
-    | APrim Op {} _ <- p = do
+    | Op {} <- p = do
hunk ./src/C/FromGrin2.hs 683
-        convertVal (ValPrim (p) vs rt)
-    | APrim (Func _ n as r) _ <- p = do
+        convertVal (ValPrim p vs rt)
+    | (Func _ n as r) <- p = do
hunk ./src/C/FromGrin2.hs 688
-    | APrim (IFunc _ as r) _ <- p = do
+    | (IFunc _ as r) <- p = do
hunk ./src/C/FromGrin2.hs 693
-    | APrim (Peek t) _ <- p, [v] <- vs = do
+    | (Peek t) <- p, [v] <- vs = do
hunk ./src/C/FromGrin2.hs 696
-    | APrim (Poke t) _ <- p, [v,x] <- vs = do
+    | (Poke t) <- p, [v,x] <- vs = do
hunk ./src/C/FromGrin2.hs 700
-    | APrim (AddrOf t) _ <- p, [] <- vs = do
+    | (AddrOf _ t) <- p, [] <- vs = do
hunk ./src/C/Prims.hs 48
+primReqs p = f p where
+    f CConst {} = primRequires p
+    f Func {} = primRequires p
+    f IFunc {} = primRequires p
+    f AddrOf {} = primRequires p
+    f _ = mempty
+
hunk ./src/C/Prims.hs 58
+        primRequires :: Requires,
hunk ./src/C/Prims.hs 62
-        funcIOLike :: {-# UNPACK #-} !Bool,
+        primRequires :: Requires,
hunk ./src/C/Prims.hs 68
-        funcIOLike :: {-# UNPACK #-} !Bool,
+        primRequires :: Requires,
hunk ./src/C/Prims.hs 72
-    | AddrOf !PackedString         -- address of linker name
+    | AddrOf {
+        primRequires :: Requires,
+        primConst :: !PackedString         -- address of linker name
+        }
hunk ./src/C/Prims.hs 125
-aprimIsCheap (APrim p _) = primIsCheap p
-
hunk ./src/C/Prims.hs 148
-            '&':s -> AddrOf (packString s)
-            s -> Func False (packString s) [] ""
-    let f opt@('-':'l':_) = Requires [] [opt]
+            '&':s -> AddrOf { primConst = (packString s), primRequires = reqs }
+            s -> Func { funcName = (packString s), primArgTypes = [], primRetType = "" }
+        f opt@('-':'l':_) = Requires [] [opt]
hunk ./src/C/Prims.hs 152
-    return (APrim v (mconcat (map f (init ws))))
-
-primPrim s = APrim (PrimPrim $ toAtom s) mempty
-
-data APrim = APrim Prim Requires
-    deriving(Typeable,  Eq, Ord)
-    {-! derive: Binary !-}
+        reqs = (mconcat (map f (init ws)))
+    return v
hunk ./src/C/Prims.hs 155
-instance Show APrim where
-    showsPrec n (APrim p r) | r == mempty = showsPrec n p
-    showsPrec n (APrim p r) = showsPrec n p . shows r
+primPrim s = PrimPrim $ toAtom s
hunk ./src/C/Prims.hs 157
-instance PPrint d Prim  => PPrint d APrim where
-    pprintAssoc a n (APrim p _) = pprintAssoc a n p
+instance DocLike d => PPrint d ExtType where
+    pprint t = tshow t
+--instance DocLike d => PPrint d PackedString where
+--    pprint t = text $ unpackPS t
hunk ./src/C/Prims.hs 164
-    pprint (CConst s) = parens (text $ unpackPS s)
-    pprint (Func _ s xs r) = parens (tshow r) <> text (unpackPS s) <> tupled (map tshow xs)
-    pprint (IFunc _ xs r) = parens (tshow r) <> parens (char '*') <> tupled (map tshow xs)
-    pprint (AddrOf s) = char '&' <> text (unpackPS s)
+    pprint (CConst _ s) = parens (text $ unpackPS s)
+    pprint Func { .. } = parens (tshow primRetType) <> text (unpackPS funcName) <> tupled (map pprint primArgTypes)
+    pprint IFunc { .. } = parens (tshow primRetType) <> parens (char '*') <> tupled (map pprint primArgTypes)
+    pprint (AddrOf _ s) = char '&' <> text (unpackPS s)
hunk ./src/DataConstructors.hs 287
-primitiveTable = []
-{-
-primitiveTable = concatMap f allCTypes  where
-    f (dc,tc,rt) = [typeCons,dataCons] where
-        dataCons = emptyConstructor {
-            conName = dc,
-            conType = tipe,
-            conOrigSlots = [SlotNormal rt],
-            conExpr = ELam (tVr va1 rt) (ELit (litCons { litName = dc, litArgs = [EVar (tVr va1 rt)], litType = tipe })),
-            conInhabits = tc
-           }
-        typeCons = emptyConstructor {
-            conName = tc,
-            conType = eStar,
-            conExpr = tipe,
-            conInhabits = s_Star,
-            conChildren = DataNormal [dc]
-           }
-        tipe = ELit (litCons { litName = tc, litArgs = [], litType = eStar })
-        -}
-
hunk ./src/DataConstructors.hs 415
-        | otherwise = fail $ "lookupExtTypeInfo: " ++ show (oe,e)
+    g _ e = fail $ "lookupExtTypeInfo: " ++ show (oe,e)
hunk ./src/DataConstructors.hs 430
-dataTablePrims = DataTable $ Map.fromList ([ (conName x,x) | x <- tarrow:primitiveTable ])
+dataTablePrims = DataTable $ Map.fromList ([ (conName x,x) | x <- [tarrow] ])
hunk ./src/DataConstructors.hs 501
-    oper_IIB op a b = EPrim (APrim (Op (Op.BinOp op Op.bits16 Op.bits16) Op.bits16) mempty) [a,b] tBoolzh
+    oper_IIB op a b = EPrim (Op (Op.BinOp op Op.bits16 Op.bits16) Op.bits16) [a,b] tBoolzh
hunk ./src/DataConstructors.hs 512
-        eStrictLet  tvrb (EPrim (APrim (Op (Op.ConvOp conv n1') n2') mempty) [EVar tvra] t2)  (ELit (litCons { litName = c2, litArgs = [EVar tvrb], litType = t }))
+        eStrictLet  tvrb (EPrim (Op (Op.ConvOp conv n1') n2') [EVar tvra] t2)  (ELit (litCons { litName = c2, litArgs = [EVar tvrb], litType = t }))
hunk ./src/E/FromHs.hs 445
-            prim       = APrim (AddrOf $ packString rcn) req
+            prim       = (AddrOf req $ packString rcn)
hunk ./src/E/FromHs.hs 460
-                      EPrim (APrim (Func io (packString rcn) cts crt) req) args rt)
+                      EPrim (Func req (packString rcn) cts crt) args rt)
hunk ./src/E/FromHs.hs 472
-                      EPrim (APrim (IFunc io (tail cts) crt) (Requires [] [])) args rt)
+                      EPrim (IFunc mempty (tail cts) crt) args rt)
hunk ./src/E/FromHs.hs 486
-            prim rs rtt = EPrim (APrim dnet { primIOLike = isIO } mempty)
+            prim rs rtt = EPrim dnet
hunk ./src/E/FromHs.hs 605
-    cExpr (HsLit (HsStringPrim s)) = return $ EPrim (APrim (PrimString (packString s)) mempty) [] r_bits_ptr_
+    cExpr (HsLit (HsStringPrim s)) = return $ EPrim (PrimString (packString s)) [] r_bits_ptr_
hunk ./src/E/FromHs.hs 946
-packupString s | all (\c -> c > '\NUL' && c <= '\xff') s = (EPrim (APrim (PrimString (packString s)) mempty) [] r_bits_ptr_,True)
+packupString s | all (\c -> c > '\NUL' && c <= '\xff') s = (EPrim (PrimString (packString s)) [] r_bits_ptr_,True)
hunk ./src/E/PrimDecode.hs 109
-ePrim prim as t = EPrim (APrim prim mempty) as t
+ePrim prim as t = EPrim prim as t
hunk ./src/E/PrimDecode.hs 120
-    passThrough = EPrim (APrim (PrimPrim pName) req) args rType
+    passThrough = EPrim (PrimPrim pName) args rType
hunk ./src/E/PrimDecode.hs 170
-        return (ePrim (CConst (packString $ "JHC_" ++ c)) [] rType)
+        return (ePrim (CConst req (packString $ "JHC_" ++ c)) [] rType)
hunk ./src/E/PrimDecode.hs 173
-            ePrim (CConst $ packString c) [] str
+            ePrim (CConst req $ packString c) [] str
hunk ./src/E/PrimOpt.hs 8
-import Data.Monoid
hunk ./src/E/PrimOpt.hs 81
-primConv cop t1 t2 e rt = EPrim (APrim (Op (Op.ConvOp cop t1) t2) mempty) [e] rt
+primConv cop t1 t2 e rt = EPrim (Op (Op.ConvOp cop t1) t2) [e] rt
hunk ./src/E/PrimOpt.hs 91
-primOpt' e@(EPrim (APrim s _) xs t) = do
+primOpt' e@(EPrim s xs t) = do
hunk ./src/E/PrimOpt.hs 125
-                EPrim (APrim Op { primCOp = Op.BinOp bop t1 t2,
-                                  primRetTy = tr } mempty) [e1, e2] str
+                EPrim Op { primCOp = Op.BinOp bop t1 t2,
+                                  primRetTy = tr } [e1, e2] str
hunk ./src/E/PrimOpt.hs 128
-                EPrim (APrim Op { primCOp = Op.UnOp bop t1,
-                                  primRetTy = tr } mempty) [e1] str
-    fromBinOp (EPrim (APrim Op { primCOp = Op.BinOp bop t1 t2,
-                                 primRetTy = tr } mempty) [e1, e2] str) =
+                EPrim Op { primCOp = Op.UnOp bop t1,
+                                  primRetTy = tr } [e1] str
+    fromBinOp (EPrim Op { primCOp = Op.BinOp bop t1 t2,
+                                 primRetTy = tr } [e1, e2] str) =
hunk ./src/E/PrimOpt.hs 134
-    fromUnOp (EPrim (APrim Op {
+    fromUnOp (EPrim Op {
hunk ./src/E/PrimOpt.hs 136
-        primRetTy = tr } mempty) [e1] str) = Just (bop,t1,tr,e1,str)
+        primRetTy = tr } [e1] str) = Just (bop,t1,tr,e1,str)
hunk ./src/E/SSimplify.hs 547
-            [(t,ec@ECase { eCaseScrutinee = sc@(EPrim (APrim p _) _ _), eCaseAlts = [], eCaseDefault = Just def })] | primEagerSafe p && not (getProperty prop_CYCLIC t) -> do
+            [(t,ec@ECase { eCaseScrutinee = sc@(EPrim p _ _), eCaseAlts = [], eCaseDefault = Just def })] | primEagerSafe p && not (getProperty prop_CYCLIC t) -> do
hunk ./src/E/SSimplify.hs 550
-            [(t,ec@ECase { eCaseScrutinee = sc@(EPrim (APrim p _) _ _), eCaseAlts = [Alt c def], eCaseDefault = Nothing })] | primEagerSafe p && not (getProperty prop_CYCLIC t) -> do
+            [(t,ec@ECase { eCaseScrutinee = sc@(EPrim p _ _), eCaseAlts = [Alt c def], eCaseDefault = Nothing })] | primEagerSafe p && not (getProperty prop_CYCLIC t) -> do
hunk ./src/E/SSimplify.hs 742
-    isOmittable _ (EPrim (APrim p _) _ _) = primIsConstant p
+    isOmittable _ (EPrim p _ _) = primIsConstant p
hunk ./src/E/Type.hs 142
-    | EPrim APrim [E] E
+    | EPrim Prim [E] E
hunk ./src/E/Values.hs 191
-isFullyConst (EPrim (APrim p _) as _) = primIsConstant p && all isFullyConst as
+isFullyConst (EPrim p as _) = primIsConstant p && all isFullyConst as
hunk ./src/E/Values.hs 227
-isCheap (EPrim p _ _) = aprimIsCheap p
+isCheap (EPrim p _ _) = primIsCheap p
hunk ./src/E/Values.hs 255
-    | EPrim p _ _ <- eCaseScrutinee ec, aprimIsCheap p = all safeToDup (caseBodies ec)
-safeToDup (EPrim p _ _) = aprimIsCheap p
+    | EPrim p _ _ <- eCaseScrutinee ec, primIsCheap p = all safeToDup (caseBodies ec)
+safeToDup (EPrim p _ _) = primIsCheap p
hunk ./src/Grin/FromE.hs 403
-    ce (EPrim ap@(APrim (PrimPrim prim) _) as _) = f prim as where
+    ce (EPrim ap@(PrimPrim prim) as _) = f prim as where
hunk ./src/Grin/FromE.hs 440
-    ce (EPrim ap@(APrim p _) xs ty) = do
+    ce (EPrim ap xs ty) = do
hunk ./src/Grin/FromE.hs 445
-        case p of
+        case ap of
hunk ./src/Grin/FromE.hs 447
-            Func True fn as "void" -> return $ Prim ap xs' ty'
-            Func True fn as r      -> return $ Prim ap xs' ty'
-            Func False _ as r | Just _ <- toCmmTy ty ->  do
-                return $ Prim ap xs' ty'
-            IFunc True _ _ ->
-                return $ Prim ap xs' ty'
-            IFunc False _ _ | Just _ <- toCmmTy ty ->
-                return $ Prim ap xs' ty'
+            Func {} -> return $ Prim ap xs' ty'
+            IFunc {} -> return $ Prim ap xs' ty'
+            --Func True fn as "void" -> return $ Prim ap xs' ty'
+            --Func True fn as r      -> return $ Prim ap xs' ty'
+            --Func False _ as r | Just _ <- toCmmTy ty ->  do
+            --    return $ Prim ap xs' ty'
+            --IFunc True _ _ ->
+            --    return $ Prim ap xs' ty'
+            --IFunc False _ _ | Just _ <- toCmmTy ty ->
+            --    return $ Prim ap xs' ty'
hunk ./src/Grin/FromE.hs 573
-    cc (EPrim (APrim (PrimPrim "fromBang_") _) (args -> [e]) _) = return $ if getType e == tyDNode then demote e else Return [e] -- $ demote e
+    cc (EPrim (PrimPrim "fromBang_") (args -> [e]) _) = return $ if getType e == tyDNode then demote e else Return [e] -- $ demote e
hunk ./src/Grin/FromE.hs 724
-literal (EPrim aprim@(APrim p _) xs ty) | Just ptype <- toCmmTy ty, primIsConstant p = do
+literal (EPrim prim xs ty) | Just ptype <- toCmmTy ty, primIsConstant prim = do
hunk ./src/Grin/FromE.hs 726
-    return $ [ValPrim aprim (concat xs) (TyPrim ptype)]
+    return $ [ValPrim prim (concat xs) (TyPrim ptype)]
hunk ./src/Grin/Grin.hs 125
-    | Prim      { expPrimitive :: APrim,
+    | Prim      { expPrimitive :: Prim,
hunk ./src/Grin/Grin.hs 166
-    | ValPrim APrim [Val] Ty  -- ^ Primitive value
+    | ValPrim Prim [Val] Ty   -- ^ Primitive value
hunk ./src/Grin/Noodle.hs 172
-isOmittable Prim { expPrimitive = aprim } = aprimIsCheap aprim
+isOmittable Prim { expPrimitive = aprim } = primIsCheap aprim
hunk ./src/Grin/Optimize.hs 201
-    isSpeculatable Prim { expPrimitive = APrim p _ } = primIsConstant p
+    isSpeculatable Prim { expPrimitive = p } = primIsConstant p
hunk ./src/Grin/Show.hs 78
-prettyExp vl Prim { expPrimitive = APrim (Op (Op.BinOp bo _ _) _) _, expArgs = [x,y] } | Just (op,_) <- Op.binopInfix bo = vl <> prettyVal x <+> operator op <+> prettyVal y
-prettyExp vl Prim { expPrimitive = APrim (Op (Op.BinOp bo _ _) _) _, expArgs = [x,y] } = vl <> prettyVal x <+> char '`' <> tshow bo <> char '`' <+> prettyVal y
-prettyExp vl Prim { expPrimitive = APrim (Peek t) _, expArgs = [v] }  = vl <> prim (show t) <> char '[' <> prettyVal v <> char ']'
+prettyExp vl Prim { expPrimitive = (Op (Op.BinOp bo _ _) _), expArgs = [x,y] } | Just (op,_) <- Op.binopInfix bo = vl <> prettyVal x <+> operator op <+> prettyVal y
+prettyExp vl Prim { expPrimitive = (Op (Op.BinOp bo _ _) _), expArgs = [x,y] } = vl <> prettyVal x <+> char '`' <> tshow bo <> char '`' <+> prettyVal y
+prettyExp vl Prim { expPrimitive = (Peek t), expArgs = [v] }  = vl <> prim (show t) <> char '[' <> prettyVal v <> char ']'
hunk ./src/Grin/Show.hs 137
-    f (APrim (Op (Op.BinOp bo _ _) _) _) [x,y] | Just (op,prec) <- Op.binopInfix bo = parens (pprintPrec prec x <+> text op <+> pprintPrec prec y)
-    f (APrim (Op (Op.BinOp bo _ _) _) _) [x,y] =  parens $ pprintPrec 1 x <+> char '`' <> tshow bo <> char '`' <+> pprintPrec 1 y
+    f ((Op (Op.BinOp bo _ _) _)) [x,y] | Just (op,prec) <- Op.binopInfix bo = parens (pprintPrec prec x <+> text op <+> pprintPrec prec y)
+    f ((Op (Op.BinOp bo _ _) _)) [x,y] =  parens $ pprintPrec 1 x <+> char '`' <> tshow bo <> char '`' <+> pprintPrec 1 y
hunk ./src/Ho/Binary.hs 22
-current_version = 9
+current_version = 10