[add lots of primitives for dealing with numbers, useful to not depend on the 'Num' class for various operations
John Meacham <john@repetae.net>**20061104044836] hunk ./E/PrimOpt.hs 31
+{-
+
+The primitive operators provided which may be imported into code are
+
+'seq' - evaluate first argument to WHNF, return second one
+plus/divide/minus  - perform operation on primitive type
+zero/one - the zero and one values for primitive types
+const.<foo> - evaluates to the C constant <foo>
+error.<err> - equivalent to 'error <err>'
+exitFailure__ - abort program immediately with no message
+integralCast - cast between primitive integral types with c semantics
+increment/decrement - increment or decrement a primitive numeric type by 1
+
+-}
hunk ./E/PrimOpt.hs 165
+        primopt (PrimPrim "plus") [a,b] t = ans where
+            (vara:varb:varc:_) = freeNames (freeVars (a,b,t))
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = do
+                (_,ta) <- lookupCType dataTable (getType a)
+                (_,tb) <- lookupCType dataTable (getType b)
+                (_,tr) <- lookupCType dataTable t
+                unless (ta == tb && tb == tr) $ fail "bad plus"
+                return $ unbox dataTable a vara $ \tvra ->
+                    unbox dataTable b varb $ \tvrb ->
+                        eStrictLet (tVr varc sta) (EPrim (APrim (Operator "+" [ta,ta] ta) mempty) [EVar tvra, EVar tvrb] sta) (ELit (litCons { litName = cna, litArgs = [EVar (tVr varc sta)], litType = t }))
+        primopt (PrimPrim "minus") [a,b] t = ans where
+            (vara:varb:varc:_) = freeNames (freeVars (a,b,t))
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = do
+                (_,ta) <- lookupCType dataTable (getType a)
+                (_,tb) <- lookupCType dataTable (getType b)
+                (_,tr) <- lookupCType dataTable t
+                unless (ta == tb && tb == tr) $ fail "bad minus"
+                return $ unbox dataTable a vara $ \tvra ->
+                    unbox dataTable b varb $ \tvrb ->
+                        eStrictLet (tVr varc sta) (EPrim (APrim (Operator "-" [ta,ta] ta) mempty) [EVar tvra, EVar tvrb] sta) (ELit (litCons { litName = cna, litArgs = [EVar (tVr varc sta)], litType = t }))
+
+        primopt (PrimPrim "increment") [a] t = ans where
+            (vara:varc:_) = freeNames (freeVars (a,t))
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = do
+                (_,ta) <- lookupCType dataTable (getType a)
+                (_,tr) <- lookupCType dataTable t
+                unless (ta == tr) $ fail "bad increment"
+                return $ unbox dataTable a vara $ \tvra ->
+                        eStrictLet (tVr varc sta) (EPrim (APrim (Operator "+" [ta,ta] ta) mempty) [EVar tvra, ELit (LitInt 1 $ rawType ta)] sta) (ELit (litCons { litName = cna, litArgs = [EVar (tVr varc sta)], litType = t }))
+
+        primopt (PrimPrim "decrement") [a] t = ans where
+            (vara:varc:_) = freeNames (freeVars (a,t))
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = do
+                (_,ta) <- lookupCType dataTable (getType a)
+                (_,tr) <- lookupCType dataTable t
+                unless (ta == tr) $ fail "bad decrement"
+                return $ unbox dataTable a vara $ \tvra ->
+                        eStrictLet (tVr varc sta) (EPrim (APrim (Operator "-" [ta,ta] ta) mempty) [EVar tvra, ELit (LitInt 1 $ rawType ta)] sta) (ELit (litCons { litName = cna, litArgs = [EVar (tVr varc sta)], litType = t }))
+
+        primopt (PrimPrim "zero") [] t = ans where
+            (varc:_) = freeNames (freeVars t)
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = return (ELit (litCons { litName = cna, litArgs = [ELit (LitInt 0 $ rawType ta)], litType = t }))
+        primopt (PrimPrim "one") [] t = ans where
+            (varc:_) = freeNames (freeVars t)
+            Just (cna,sta,ta) = lookupCType' dataTable t
+            ans = return (ELit (litCons { litName = cna, litArgs = [ELit (LitInt 1 $ rawType ta)], litType = t }))
hunk ./E/PrimOpt.hs 223
+        primopt (PrimPrim pn) [] t | Just c <-  getPrefix "error." pn = return (EError c t)