[clean up some Grin stuff, make primitives take a list of arguments rather than a tuple.
John Meacham <john@repetae.net>**20051013064526] hunk ./CanType.hs 8
+-- typechecking
+class CanTypeCheck env a ty | a -> ty env where
+    typecheck :: Monad m => env -> a -> m ty
+    tc :: Monad m => env -> a -> m ty
+    tc = typecheck
hunk ./Grin/FromE.hs 319
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup (map (Ty . toAtom) as),tyUnit), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ((map (Ty . toAtom) as),tyUnit), primAPrim = ap }
hunk ./Grin/FromE.hs 322
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup (map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ((map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
hunk ./Grin/FromE.hs 327
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup (map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ((map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
hunk ./Grin/FromE.hs 330
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup [Ty (toAtom "HsPtr")],pt), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ([Ty (toAtom "HsPtr")],pt), primAPrim = ap }
hunk ./Grin/FromE.hs 335
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup [Ty (toAtom "HsPtr"),pt],tyUnit), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ([Ty (toAtom "HsPtr"),pt],tyUnit), primAPrim = ap }
hunk ./Grin/FromE.hs 339
-        let p = Primitive { primName = toAtom ('&':s), primRets = Nothing, primType = (tyUnit,ptype), primAPrim = aprim }
+        let p = Primitive { primName = toAtom ('&':s), primRets = Nothing, primType = ([],ptype), primAPrim = aprim }
hunk ./Grin/FromE.hs 343
-        let p = Primitive { primName = toAtom s, primRets = Nothing, primType = (tyUnit,ptype), primAPrim = aprim }
+        let p = Primitive { primName = toAtom s, primRets = Nothing, primType = ([],ptype), primAPrim = aprim }
hunk ./Grin/FromE.hs 386
-        let p = Primitive { primName = toAtom ("(" ++ to ++ ")"), primRets = Nothing, primType = (TyTup [ptypefrom'],ptypeto'), primAPrim = aprim }
+        let p = Primitive { primName = toAtom ("(" ++ to ++ ")"), primRets = Nothing, primType = ([ptypefrom'],ptypeto'), primAPrim = aprim }
hunk ./Grin/FromE.hs 389
-        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = (TyTup (map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
+        let p = Primitive { primName = Atom.fromString (pprint ap), primRets = Nothing, primType = ((map (Ty . toAtom) as),Ty (toAtom r)), primAPrim = ap }
hunk ./Grin/Grin.hs 1
-{-# OPTIONS -funbox-strict-fields #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
hunk ./Grin/Grin.hs 34
-    HasType(..),
+    CanTypeCheck(..),
hunk ./Grin/Grin.hs 136
-     Exp :>>= !Lam
-    | App Atom [Val]  -- ^ this handles applications of functions and builtins
-    | Prim Primitive [Val]
-    | Case Val [Lam]
+     Exp :>>= Lam
+    | App { expFunction :: Atom, expArgs :: [Val] }    -- ^ this handles applications of functions and builtins
+    | Prim { expPrimitive :: Primitive, expArgs :: [Val] }
+    | Case { expValue :: Val, expAlts :: [Lam] }
hunk ./Grin/Grin.hs 144
-    | Error String Ty -- ^ abort with an error message, non recoverably.
-    | Cast Val Ty     -- ^ reinterpret Val as a different type, also used to box\/unbox lifted types
+    | Error { expError :: String, expType :: Ty }      -- ^ abort with an error message, non recoverably.
+    | Cast { expValue :: Val, expType :: Ty }          -- ^ reinterpret Val as a different type, also used to box\/unbox lifted types
hunk ./Grin/Grin.hs 195
-    primType :: (Ty,Ty),
+    primType :: ([Ty],Ty),
hunk ./Grin/Grin.hs 197
-    --primProps :: Props
-    --primCallingConvention :: (),
hunk ./Grin/Grin.hs 316
---valIsNF Unit = True
hunk ./Grin/Grin.hs 321
-{-
-
--- create an eval suitable for inlining.
-createEval' :: Bool -> TyEnv -> [Tag] -> Lam
-createEval' shared  te ts
-
-    | null cs = p1 :-> Error "Empty Eval" TyNode
-    | all tagIsWHNF [ t | t <- ts , tagIsTag t] = p1 :-> Fetch p1
-    | otherwise = p1 :->
-        Fetch p1 :>>= n2 :->
-        Case n2 cs :>>= n3 :->
-        Update p1 n3 :>>= unit :->
-        Return n3
-    where
-    cs = [f t | t <- ts, tagIsTag t ]
-    g t vs
-        | tagIsWHNF t = Return n2
-        | 'F':fn <- fromAtom t  = ap ('f':fn) vs
-        | 'B':fn <- fromAtom t  = ap ('b':fn) vs
-        | otherwise = Error ("Bad Tag: " ++ fromAtom t) TyNode
-    f t = (NodeC t vs :-> g t vs ) where
-        (ts,_) = runIdentity $ findArgsType te t
-        vs = [ Var v ty |  v <- [V 4 .. ] | ty <- ts]
-    ap n vs
-    --    | shared =  App (toAtom $ n) vs :>>= n3 :-> Update p1 n3 :>>= unit :-> Return n3
-        | otherwise = App (toAtom $ n) vs
-
-
-createEval :: TyEnv -> [Tag] -> Exp
-createEval  te ts
-    | null cs = Error ("Empty Eval:" ++ show ts) TyNode
-    | otherwise =
-        Fetch p1 :>>= n2 :->
-        Case n2 cs :>>= n3 :->
-        Update p1 n3 :>>= unit :->
-        Return n3
-    where
-    cs = [f t | t <- ts, tagIsTag t ]
-    g t vs
-        | tagIsWHNF t = Return n2
-        | 'F':fn <- fromAtom t  = App (toAtom $ 'f':fn) vs -- :>>= n3 :-> Update p1 n3 :>>= unit :-> Return n3
-        | 'B':fn <- fromAtom t  = App (toAtom $ 'b':fn) vs
-        | otherwise = Error ("Bad Tag: " ++ fromAtom t) TyNode
-    f t = (NodeC t vs :-> g t vs ) where
-        (ts,_) = runIdentity $ findArgsType te t
-        vs = [ Var v ty |  v <- [V 4 .. ] | ty <- ts]
-        -}
-
-
hunk ./Grin/Grin.hs 371
-
--- typechecking
-class HasType a where
-    typecheck :: Monad m => TyEnv -> a -> m Ty
-    tc :: Monad m => TyEnv -> a -> m Ty
-    tc = typecheck
-
-
-instance HasType a => HasType [a] where
+instance CanTypeCheck TyEnv a Ty => CanTypeCheck TyEnv [a] Ty where
hunk ./Grin/Grin.hs 391
-instance HasType Exp where
+instance CanTypeCheck TyEnv Exp Ty where
hunk ./Grin/Grin.hs 398
-        let (TyTup as',t') = primType p
+        let (as',t') = primType p
hunk ./Grin/Grin.hs 431
-instance HasType Val where
+instance CanTypeCheck TyEnv Val Ty where
hunk ./Grin/Grin.hs 451
+
hunk ./Main.hs 41
-import CanType
+import CanType(getType)