[major refactoring of grin data type. no more first class tuples, it compiles.
John Meacham <john@repetae.net>**20070601024010] hunk ./C/FromGrin2.hs 109
-convertFunc ffie (n,~(Tup as) :-> body) = do
+convertFunc ffie (n,as :-> body) = do
hunk ./C/FromGrin2.hs 112
-            mmalloc (TyPtr _) = [a_MALLOC]
-            mmalloc TyNode = [a_MALLOC]
+            mmalloc [TyPtr TyNode] = [a_MALLOC]
+            mmalloc [TyNode] = [a_MALLOC]
hunk ./C/FromGrin2.hs 119
-        fr <- convertType bt
+        fr <- convertTypes bt
hunk ./C/FromGrin2.hs 140
+convertVals :: [Val] -> C Expression
+convertVals [] = return emptyExpression
+convertVals [x] = convertVal x
+convertVals xs = do
+    ts <- mapM convertType (map getType xs)
+    xs <- mapM convertVal xs
+    return (structAnon (zip xs ts))
+
hunk ./C/FromGrin2.hs 149
-convertVal (Tup [x]) = convertVal x
+--convertVal (Tup [x]) = convertVal x
hunk ./C/FromGrin2.hs 167
-convertVal (Tup xs) = do
-    ts <- mapM convertType (map getType xs)
-    xs <- mapM convertVal xs
-    return (structAnon (zip xs ts))
+--convertVal (Tup xs) = do
+--    ts <- mapM convertType (map getType xs)
+--    xs <- mapM convertVal xs
+--    return (structAnon (zip xs ts))
hunk ./C/FromGrin2.hs 187
+convertTypes [] = return voidType
+convertTypes [t] = convertType t
+convertTypes xs = do
+    xs <- mapM convertType xs
+    return (anonStructType xs)
+
hunk ./C/FromGrin2.hs 199
-convertType (TyTup []) = return voidType
-convertType (TyTup [x]) = convertType x
-convertType (TyTup xs) = do
-    xs <- mapM convertType xs
-    return (anonStructType xs)
+--convertType (TyTup []) = return voidType
+--convertType (TyTup [x]) = convertType x
+--convertType (TyTup xs) = do
+--    xs <- mapM convertType xs
+--    return (anonStructType xs)
hunk ./C/FromGrin2.hs 228
-convertBody (Prim p [a,b] :>>= Tup [q,r] :-> e') | primName p == toAtom "@primQuotRem" = do
-    a' <- convertVal a
-    b' <- convertVal b
-    r' <- convertVal r
-    q' <- convertVal q
-    ss' <- convertBody e'
-    return $ mconcat [ q' =* (operator "/" a' b'), r' =* (operator "%" a' b'), ss' ]
hunk ./C/FromGrin2.hs 230
-    nn <- flip mapM defs $ \FuncDef { funcDefName = name, funcDefBody = Tup as :-> _ } -> do
+    nn <- flip mapM defs $ \FuncDef { funcDefName = name, funcDefBody = as :-> _ } -> do
hunk ./C/FromGrin2.hs 238
-    rs <- flip mapM defs $ \FuncDef { funcDefName = name, funcDefBody = Tup as :-> b } -> do
+    rs <- flip mapM defs $ \FuncDef { funcDefName = name, funcDefBody = as :-> b } -> do
hunk ./C/FromGrin2.hs 245
-convertBody (e :>>= Tup [x] :-> e') = convertBody (e :>>= x :-> e')
-convertBody (e :>>= Tup [] :-> e') = do
+convertBody (e :>>= [] :-> e') = do
hunk ./C/FromGrin2.hs 249
-convertBody (Return v :>>= (NodeC t as) :-> e') = nodeAssign v t as e'
-convertBody (Return v :>>= (NodeV t []) :-> e') = do
+convertBody (Return [v] :>>= [(NodeC t as)] :-> e') = nodeAssign v t as e'
+convertBody (Return [v] :>>= [(NodeV t [])] :-> e') = do
hunk ./C/FromGrin2.hs 254
-convertBody (Fetch v :>>= (NodeC t as) :-> e') = nodeAssign v t as e'
-convertBody (Case v@(Var _ ty) [p1@(NodeC t _) :-> e1,p2 :-> e2]) | ty == TyNode = do
+convertBody (Fetch v :>>= [(NodeC t as)] :-> e') = nodeAssign v t as e'
+convertBody (Case v@(Var _ ty) [[p1@(NodeC t _)] :-> e1,[p2] :-> e2]) | ty == TyNode = do
hunk ./C/FromGrin2.hs 263
-        da n1@(NodeC t _) (Return n2@NodeC {}) | n1 == n2 = convertBody (Return v)
+        da n1@(NodeC t _) (Return [n2@NodeC {}]) | n1 == n2 = convertBody (Return [v])
hunk ./C/FromGrin2.hs 281
-convertBody (Case v@Var {} [v1, v2@(Lit n _ :-> _)]) | n == 0 = convertBody (Case v [v2,v1])
-convertBody (Case v@(Var _ t) [p1 :-> e1, p2 :-> e2]) | Set.null ((freeVars p2 :: Set.Set Var) `Set.intersection` freeVars e2) = do
+convertBody (Case v@Var {} [v1, v2@([Lit n _] :-> _)]) | n == 0 = convertBody (Case v [v2,v1])
+convertBody (Case v@(Var _ t) [[p1] :-> e1, [p2] :-> e2]) | Set.null ((freeVars p2 :: Set.Set Var) `Set.intersection` freeVars e2) = do
hunk ./C/FromGrin2.hs 296
-        da (v@(Var {}) :-> e) = do
+        da ([v@(Var {})] :-> e) = do
hunk ./C/FromGrin2.hs 300
-        da (n1@(NodeC t _) :-> Return n2@NodeC {}) | n1 == n2 = do
+        da ([n1@(NodeC t _)] :-> Return [n2@NodeC {}]) | n1 == n2 = do
hunk ./C/FromGrin2.hs 302
-            e' <- convertBody (Return v)
+            e' <- convertBody (Return [v])
hunk ./C/FromGrin2.hs 304
-        da ((NodeC t as) :-> e) = do
+        da ([(NodeC t as)] :-> e) = do
hunk ./C/FromGrin2.hs 320
-        da (v@(Var {}) :-> e) = do
+        da ([v@(Var {})] :-> e) = do
hunk ./C/FromGrin2.hs 324
-        da ((Lit i _) :-> e) = do
+        da ([(Lit i _)] :-> e) = do
hunk ./C/FromGrin2.hs 327
-        da (Tag t :-> e) = do
+        da ([Tag t] :-> e) = do
hunk ./C/FromGrin2.hs 330
-        da (~(Tup [x]) :-> e) = da ( x :-> e )
+        --da (~[x] :-> e) = da ( x :-> e )
hunk ./C/FromGrin2.hs 339
-        f (TyTup []) = return emptyExpression
-        f (TyTup xs) = do ts <- mapM convertType xs; xs <- mapM f xs ; return $ structAnon (zip xs ts)
hunk ./C/FromGrin2.hs 340
-        --f (Ty x) = return $ cast (basicType (show x)) (constant $ number 0)
hunk ./C/FromGrin2.hs 342
+        g [] = return emptyExpression
+        g [x] = f x
+        g xs = do ts <- mapM convertType xs; xs <- mapM f xs ; return $ structAnon (zip xs ts)
hunk ./C/FromGrin2.hs 349
-            v <- f t
+            v <- g t
hunk ./C/FromGrin2.hs 353
-convertBody (Return n@NodeC {})  = newNode wptr_t n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
+convertBody (Return [n@NodeC {}])  = newNode wptr_t n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)
hunk ./C/FromGrin2.hs 356
-convertBody (e :>>= (Var vn vt) :-> e') | not $ isCompound e = do
+convertBody (e :>>= [(Var vn vt)] :-> e') | not $ isCompound e = do
hunk ./C/FromGrin2.hs 362
-convertBody (e :>>= v@(Var _ _) :-> e') = do
+convertBody (e :>>= [v@(Var _ _)] :-> e') = do
hunk ./C/FromGrin2.hs 368
-convertBody (e :>>= ~(Tup xs) :-> e') = do
+convertBody (e :>>= xs@(_:_:_) :-> e') = do
hunk ./C/FromGrin2.hs 404
-convertBody (Return (Tup xs)) = do
+convertBody (Return []) = simpleRet emptyExpression
+convertBody (Return [v]) = simpleRet =<< convertVal v
+convertBody (Return xs@(_:_:_)) = do
hunk ./C/FromGrin2.hs 413
-        _ -> simpleRet =<< convertVal (Tup xs)
-convertBody (Return v) = simpleRet =<< convertVal v
+        _ -> simpleRet =<< convertVals xs
hunk ./C/FromGrin2.hs 449
-convertExp (Prim p vs) | APrim _ req <- primAPrim p  =  do
+convertExp (Prim p vs ty) | APrim _ req <- p  =  do
hunk ./C/FromGrin2.hs 451
-    e <- convertPrim p vs
+    e <- convertPrim p vs ty
hunk ./C/FromGrin2.hs 523
-convertConst (Tup [x]) = convertConst x
-convertConst (Tup []) = return emptyExpression
+--convertConst (Tup [x]) = convertConst x
+--convertConst (Tup []) = return emptyExpression
hunk ./C/FromGrin2.hs 551
-convertPrim p vs
-    | APrim (CConst s _) _ <- primAPrim p = do
+convertPrim p vs ty
+    | APrim (CConst s _) _ <- p = do
hunk ./C/FromGrin2.hs 554
-    | APrim Op {} _ <- primAPrim p = do
-        let (_,rt) = primType p
-        convertVal (ValPrim (primAPrim p) vs rt)
-    | APrim (Func _ n as r) _ <- primAPrim p = do
+    | APrim Op {} _ <- p = do
+        let [rt] = ty
+        convertVal (ValPrim (p) vs rt)
+    | APrim (Func _ n as r) _ <- p = do
hunk ./C/FromGrin2.hs 560
-    | APrim (Peek t) _ <- primAPrim p, [v] <- vs = do
+    | APrim (Peek t) _ <- p, [v] <- vs = do
hunk ./C/FromGrin2.hs 563
-    | APrim (Poke t) _ <- primAPrim p, [v,x] <- vs = do
+    | APrim (Poke t) _ <- p, [v,x] <- vs = do
hunk ./C/FromGrin2.hs 567
-    | APrim (AddrOf t) _ <- primAPrim p, [] <- vs = do
+    | APrim (AddrOf t) _ <- p, [] <- vs = do
hunk ./C/FromGrin2.hs 657
-            nonPtr (TyTup xs) = all nonPtr xs
+--            nonPtr (TyTup xs) = all nonPtr xs
hunk ./Grin/DeadCode.hs 81
-    let newArgTags = concatMap foo (Map.toList $ grinArgTags grin)
+    let --newArgTags = concatMap foo (Map.toList $ grinArgTags grin)
hunk ./Grin/DeadCode.hs 92
-        grinArgTags = Map.fromList newArgTags,
+        --grinArgTags = Map.fromList newArgTags,
hunk ./Grin/DeadCode.hs 98
-go fixer pappFuncs suspFuncs usedFuncs usedArgs usedCafs postInline (fn,~(Tup as) :-> body) = ans where
+go fixer pappFuncs suspFuncs usedFuncs usedArgs usedCafs postInline (fn,as :-> body) = ans where
hunk ./Grin/DeadCode.hs 140
-            g (Return n) = addRule $ doNode n
+            g (Return ns) = mapM_ (addRule . doNode) ns
hunk ./Grin/DeadCode.hs 145
-            h (p,Return v) = addRule $ mconcat $ [ conditionalRule id  (varValue pv) (doNode v) | pv <- freeVars p]
+            h (p,Return vs) = mapM_ (h . \v -> (p,Fetch v)) vs -- addRule $ mconcat $ [ conditionalRule id  (varValue pv) (doNode v) | pv <- freeVars p]
hunk ./Grin/DeadCode.hs 157
-            doConst (Tup ns) = mconcatMap doConst ns
+--            doConst (Tup ns) = mconcatMap doConst ns
hunk ./Grin/DeadCode.hs 162
-        (nl,_) <- whiz (\_ -> id) h' f whizState (Tup as :-> body)
+        (nl,_) <- whiz (\_ -> id) h' f whizState (as :-> body)
hunk ./Grin/DeadCode.hs 168
-    margs fn (Tup as :-> e) | a `Set.member` directFuncs = (Tup (removeArgs fn as) :-> e)
+    margs fn (as :-> e) | a `Set.member` directFuncs = ((removeArgs fn as) :-> e)
hunk ./Grin/DeadCode.hs 174
-    f (Return (NodeC fn as)) | Just fn' <- tagToFunction fn = do
+    f (Return [NodeC fn as]) | Just fn' <- tagToFunction fn = do
hunk ./Grin/DeadCode.hs 177
-        return $ Return (NodeC fn as)
+        return $ Return [NodeC fn as]
hunk ./Grin/DeadCode.hs 184
-        return $ Return unit
+        return $ Return []
hunk ./Grin/DeadCode.hs 205
-    clearCaf (Tup xs) = do
-        xs <- mapM clearCaf xs
-        return $ Tup xs
+--    clearCaf (Tup xs) = do
+--        xs <- mapM clearCaf xs
+--        return $ Tup xs
hunk ./Grin/Devolve.hs 33
-                z fd@FuncDef { funcDefName = name, funcDefBody = ~(Tup as) :-> r }
-                    | name `Set.member` nonTail = Left ((name,Tup (as ++ xs) :-> proc r),xs)
-                    | otherwise = Right fd { funcDefBody = Tup as :-> proc r }
-                  where xs = [ Var v t |  (v,t) <- Set.toList $ freeVars (Tup as :-> r)]
+                z fd@FuncDef { funcDefName = name, funcDefBody = as :-> r }
+                    | name `Set.member` nonTail = Left ((name,(as ++ xs) :-> proc r),xs)
+                    | otherwise = Right fd { funcDefBody = as :-> proc r }
+                  where xs = [ Var v t |  (v,t) <- Set.toList $ freeVars (as :-> r)]
hunk ./Grin/EvalInline.hs 19
+{-
hunk ./Grin/EvalInline.hs 98
-
-createApply :: Ty -> Ty -> TyEnv -> [Tag] -> Lam
+ -}
+createApply :: Ty -> [Ty] -> TyEnv -> [Tag] -> Lam
hunk ./Grin/EvalInline.hs 101
-    | null cs && argType == tyUnit = Tup [n1] :-> Error ("Empty Apply:" ++ show ts)  retType
-    | null cs = Tup [n1,a2] :-> Error ("Empty Apply:" ++ show ts)  retType
-    | argType == tyUnit = Tup [n1] :-> Case n1 cs
-    | otherwise = Tup [n1,a2] :-> Case n1 cs
+    | null cs && argType == TyUnit = [n1] :-> Error ("Empty Apply:" ++ show ts)  retType
+    | null cs = [n1,a2] :-> Error ("Empty Apply:" ++ show ts)  retType
+    | argType == TyUnit = [n1] :-> Case n1 cs
+    | otherwise = [n1,a2] :-> Case n1 cs
hunk ./Grin/EvalInline.hs 110
-         (Just argType == mt || (argType == tyUnit && Nothing == mt)) && (fmap snd $ findArgsType te w) == Just retType
+         (Just argType == mt || (argType == TyUnit && Nothing == mt)) && (fmap snd $ findArgsType te w) == Just retType
hunk ./Grin/EvalInline.hs 117
-    f t = (NodeC t vs :-> g ) where
+    f t = ([NodeC t vs] :-> g ) where
hunk ./Grin/EvalInline.hs 121
-        a2s = if argType == tyUnit then [] else [a2]
+        a2s = if argType == TyUnit then [] else [a2]
hunk ./Grin/EvalInline.hs 123
-          | n > 1 = Return $ NodeC (partialTag fn (n - 1)) (vs ++ a2s)
+          | n > 1 = Return $ [NodeC (partialTag fn (n - 1)) (vs ++ a2s)]
hunk ./Grin/EvalInline.hs 143
-            fn' <- runOnceMap appMap (tyUnit,ty) $ do
+            fn' <- runOnceMap appMap (TyUnit,ty) $ do
hunk ./Grin/EvalInline.hs 156
-        cf ((targ,tret),name) | targ == tyUnit = ((name,appBody),(name,tyTy { tySlots = [TyNode],tyReturn = tret })) where
+        cf ((targ,tret),name) | targ == TyUnit = ((name,appBody),(name,tyTy { tySlots = [TyNode],tyReturn = tret })) where
hunk ./Grin/FromE.hs 74
-    (tc_World__,tyUnit),
+    (tc_World__,TyUnit),
hunk ./Grin/FromE.hs 88
-    lfuncMap  :: IdMap (Atom,Int,Ty)
+    lfuncMap  :: IdMap (Atom,Int,[Ty])
hunk ./Grin/FromE.hs 92
-    scMap :: IdMap (Atom,[Ty],Ty),
+    scMap :: IdMap (Atom,[Ty],[Ty]),
hunk ./Grin/FromE.hs 96
-    errorOnce :: OnceMap (Ty,String) Atom,
+    errorOnce :: OnceMap ([Ty],String) Atom,
hunk ./Grin/FromE.hs 122
-        f x = (x,map (toType (TyPtr TyNode) . tvrType )  as,toType TyNode (getType (e::E) :: E))
+        f x = (x,map (toType (TyPtr TyNode) . tvrType )  as,toTypes TyNode (getType (e::E) :: E))
hunk ./Grin/FromE.hs 133
-    toty (ELit LitCons { litName = n, litArgs = es, litType = ty }) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = (tuple (keepIts $ map (toType (TyPtr TyNode) ) es))
+--    toty (ELit LitCons { litName = n, litArgs = es, litType = ty }) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = (tuple (keepIts $ map (toType (TyPtr TyNode) ) es))
hunk ./Grin/FromE.hs 141
+toTypes :: Ty -> E -> [Ty]
+toTypes node = toty . followAliases mempty where
+    toty (ELit LitCons { litName = n, litArgs = es, litType = ty }) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = ((keepIts $ map (toType (TyPtr TyNode) ) es))
+    toty (ELit LitCons { litName = n, litArgs = [], litType = ty }) |  ty == eHash, Just t <- rawNameToTy n = [t]
+    toty e@(ELit LitCons { litName = n, litType = ty }) |  ty == eHash = case lookup n unboxedMap of
+        Just TyUnit -> []
+        Just x -> [x]
+        Nothing -> error $ "Grin.FromE.toType: " ++ show e
+    toty _ = [node]
+
hunk ./Grin/FromE.hs 192
-                  return (n, Tup [] :-> discardResult (App (scTag x) [] tyUnit))
+                  return (n, [] :-> discardResult (App (scTag x) [] []))
hunk ./Grin/FromE.hs 206
-    let newTyEnv = TyEnv $ Map.fromList (Map.toList endTyEnv ++ [(funcMain, toTyTy ([],tyUnit))] ++ [(en, toTyTy ([],tyUnit)) | en <- enames])
+    let newTyEnv = TyEnv $ Map.fromList (Map.toList endTyEnv ++ [(funcMain, toTyTy ([],[]))] ++ [(en, toTyTy ([],[])) | en <- enames])
hunk ./Grin/FromE.hs 213
-        a @>> b = a :>>= (unit :-> b)
-        sequenceG_ [] = Return unit
+        a @>> b = a :>>= ([] :-> b)
+        sequenceG_ [] = Return []
hunk ./Grin/FromE.hs 222
-        theFuncs = (funcMain ,Tup [] :-> initCafs :>>= unit :->  discardResult (App (scTag mainEntry) [] tyUnit)) : efv ++ ds'
+        theFuncs = (funcMain ,[] :-> initCafs :>>= [] :->  discardResult (App (scTag mainEntry) [] [])) : efv ++ ds'
hunk ./Grin/FromE.hs 227
-    con c | (EPi (TVr { tvrType = a }) b,_) <- fromLam $ conExpr c = return $ (tagArrow,toTyTy ([TyPtr TyNode, TyPtr TyNode],TyNode))
-    con c | keepCon = return $ (n,TyTy { tyThunk = TyNotThunk, tySlots = keepIts as, tyReturn = TyNode, tySiblings = fmap (map convertName) sibs}) where
+    con c | (EPi (TVr { tvrType = a }) b,_) <- fromLam $ conExpr c = return $ (tagArrow,toTyTy ([TyPtr TyNode, TyPtr TyNode],[TyNode]))
+    con c | keepCon = return $ (n,TyTy { tyThunk = TyNotThunk, tySlots = keepIts as, tyReturn = [TyNode], tySiblings = fmap (map convertName) sibs}) where
hunk ./Grin/FromE.hs 236
-discardResult exp = case getType exp of
-    TyTup [] -> exp
-    t -> exp :>>= et t :-> Return unit
-    where
-    et (TyTup xs) = Tup (map et xs)
-    et t = Var v0 t
+discardResult exp = exp :>>= map (Var v0) (getType exp) :-> Return []
hunk ./Grin/FromE.hs 240
-shouldKeep e = tyUnit /= toType TyNode e
+shouldKeep e = TyUnit /= toType TyNode e
hunk ./Grin/FromE.hs 248
-    keepIt t = t /= tyUnit
+    keepIt t = t /= TyUnit
hunk ./Grin/FromE.hs 250
-    keepIt t = getType t /= tyUnit
+    keepIt t = getType t /= TyUnit
hunk ./Grin/FromE.hs 254
-tySusp fn ts = (partialTag fn 0,(toTyTy (keepIts ts,TyNode)) { tyThunk = TySusp fn })
+tySusp fn ts = (partialTag fn 0,(toTyTy (keepIts ts,[TyNode])) { tyThunk = TySusp fn })
hunk ./Grin/FromE.hs 258
-    f nfn n (t:ts) = (mfn,(toTyTy (reverse $ keepIts ts,TyNode)) { tyThunk = TyPApp (if keepIt t then Just t else Nothing) nfn }):f mfn (n + 1) ts  where
+    f nfn n (t:ts) = (mfn,(toTyTy (reverse $ keepIts ts,[TyNode])) { tyThunk = TyPApp (if keepIt t then Just t else Nothing) nfn }):f mfn (n + 1) ts  where
hunk ./Grin/FromE.hs 265
-    (tagArrow,([TyPtr TyNode, TyPtr TyNode],TyNode)),
-    (funcEval, ([TyPtr TyNode],TyNode)),
-    (tagHole, ([],TyNode))
+    (tagArrow,([TyPtr TyNode, TyPtr TyNode],[TyNode])),
+    (funcEval, ([TyPtr TyNode],[TyNode])),
+    (tagHole, ([],[TyNode]))
hunk ./Grin/FromE.hs 293
-    conv e | Just v <- literal e = v
+    conv e | Just [v] <- literal e = v
hunk ./Grin/FromE.hs 321
-        TyTup [] -> Tup []
+--        TyTup [] -> Tup []
hunk ./Grin/FromE.hs 328
+evalVar :: [Ty] -> TVr -> C Exp
hunk ./Grin/FromE.hs 334
-            return (Return v)
+            return (Return [v])
hunk ./Grin/FromE.hs 349
-        return (nn,(Tup (keepIts $ map toVal as) :-> x))
+        return (nn,((keepIts $ map toVal as) :-> x))
hunk ./Grin/FromE.hs 356
-    ce (EError s e) = return (Error s (toType TyNode e))
+    ce (EError s e) = return (Error s (toTypes TyNode e))
hunk ./Grin/FromE.hs 358
-        return (Return (toVal tvr))
+        return (Return [toVal tvr])
hunk ./Grin/FromE.hs 365
-        let fty = toType TyNode (getType e)
+        let fty = toTypes TyNode (getType e)
hunk ./Grin/FromE.hs 367
-            Just (Const c) -> app fty (Return c) as
+            Just (Const c) -> app fty (Return [c]) as
hunk ./Grin/FromE.hs 379
-                        return $ Return (NodeC pt (keepIts as))
+                        return $ Return [NodeC pt (keepIts as)]
hunk ./Grin/FromE.hs 387
-                            ee <- evalVar TyNode tvr
+                            ee <- evalVar [TyNode] tvr
hunk ./Grin/FromE.hs 390
-    ce e | Just (Const z) <- constant e = return (Return z)
+    ce e | Just (Const z) <- constant e = return (Return [z])
hunk ./Grin/FromE.hs 398
-        f "newHole__" [_] = do
-            let var = Var v2 (TyPtr TyNode)
-            return $ Store (NodeC (toAtom "@hole") []) :>>= var :-> Return (tuple [var])
-        f "fillHole__" [r,v,_] = do
-            let var = Var v2 TyNode
-                [r',v'] = args [r,v]
-            return $ gEval v' :>>= n1 :-> Update r' n1
+--        f "newHole__" [_] = do
+--            let var = Var v2 (TyPtr TyNode)
+--            return $ Store (NodeC (toAtom "@hole") []) :>>= var :-> Return (tuple [var])
+--        f "fillHole__" [r,v,_] = do
+--            let var = Var v2 TyNode
+--                [r',v'] = args [r,v]
+--            return $ gEval v' :>>= n1 :-> Update r' n1
hunk ./Grin/FromE.hs 408
-            return $ Return unit
+            return $ Return []
hunk ./Grin/FromE.hs 442
-            return $ Return v'
+            return $ Return [v']
hunk ./Grin/FromE.hs 448
-        let prim = Primitive { primName = Atom.fromString (pprint ap), primAPrim = ap, primRets = Nothing, primType = ([],tyUnit) }
+        let prim = ap
hunk ./Grin/FromE.hs 450
-            ty' = toType TyNode ty
+            ty' = toTypes TyNode ty
hunk ./Grin/FromE.hs 453
-            Func True fn as "void" -> return $ Prim prim { primType = (map getType xs',ty') } xs'
+            Func True fn as "void" -> return $ Prim ap  xs' ty'
hunk ./Grin/FromE.hs 455
-                let p = prim { primType = (map getType xs', ty') }
-                return $ Prim p xs'
+                return $ Prim ap xs' ty'
hunk ./Grin/FromE.hs 457
-                let p = prim { primType = (map getType xs', ty') }
-                return $ Prim p xs'
+                return $ Prim ap xs' ty'
hunk ./Grin/FromE.hs 459
-                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
-                    pt = toType (TyPrim pt') ty
-                return $ Prim p (args [addr])
+                return $ Prim ap (args [addr]) ty'
hunk ./Grin/FromE.hs 461
-                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_)],pt) }
-                    [_,addr] = xs
-                    pt = TyPrim pt'
-                return $ Prim p (args [addr])
+                let [_,addr] = xs
+                return $ Prim ap (args [addr]) ty'
hunk ./Grin/FromE.hs 464
-                let p = prim { primType = ([stringNameToTy (show rt_bits_ptr_),pt],tyUnit) }
-                    [_,addr,val] = xs
-                    pt = TyPrim pt'
-                return $  Prim p (args [addr,val])
+                let [_,addr,val] = xs
+                return $  Prim ap (args [addr,val]) []
hunk ./Grin/FromE.hs 467
-                let p = prim { primType = ([TyPrim a1,TyPrim a2],TyPrim rt) }
-                return $ Prim p (args xs)
+                return $ Prim ap (args xs) ty'
hunk ./Grin/FromE.hs 469
-                let p = prim { primType = ([TyPrim a1], TyPrim rt) }
-                return $ Prim p (args xs)
+                return $ Prim ap (args xs) ty'
hunk ./Grin/FromE.hs 471
-                let p = prim { primType = ([TyPrim a1], TyPrim rt) }
-                return $ Prim p (args xs)
+                return $ Prim ap (args xs) ty'
hunk ./Grin/FromE.hs 481
-        return $ e :>>= tuple (keepIts $ map toVal xs) :-> wh
+        return $ e :>>= (keepIts $ map toVal xs) :-> wh
hunk ./Grin/FromE.hs 485
-        return $ e :>>= unit :-> r
+        return $ e :>>= [] :-> r
hunk ./Grin/FromE.hs 492
-                e :>>= v :-> Case v (as' ++ def)
+                e :>>= [v] :-> Case v (as' ++ def)
hunk ./Grin/FromE.hs 500
-                    return $ e :>>= v :-> Case v (as ++ def)
+                    return $ e :>>= [v] :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 504
-                    return $ e :>>= v :-> Return (toVal etvr) :>>= toVal b :-> Case v (as ++ def)
+                    return $ e :>>= [v] :-> Return [toVal etvr] :>>= [toVal b] :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 508
-                return $ e :>>= v :-> Case v (as ++ def)
+                return $ e :>>= [v] :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 512
-                    return $ e :>>= v :-> Store v :>>= toVal b :-> Case v (as ++ def)
+                    return $ e :>>= [v] :-> Store v :>>= [toVal b] :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 524
-        return [nv :-> x]
+        return [[nv] :-> x]
hunk ./Grin/FromE.hs 528
-        return (NodeC nn (keepIts $ map toVal es) :-> x)
+        return ([NodeC nn (keepIts $ map toVal es)] :-> x)
hunk ./Grin/FromE.hs 533
-        return (Lit i ty :-> x)
+        return ([Lit i ty] :-> x)
hunk ./Grin/FromE.hs 537
-    app :: Ty -> Exp -> [Val] -> C Exp
+    app :: [Ty] -> Exp -> [Val] -> C Exp
hunk ./Grin/FromE.hs 541
-        return (e :>>= v :-> App funcApply [v] ty)
+        return (e :>>= [v] :-> App funcApply [v] ty)
hunk ./Grin/FromE.hs 544
-        return (e :>>= v :-> doApply v a ty)
+        return (e :>>= [v] :-> doApply v a ty)
hunk ./Grin/FromE.hs 547
-        app ty (e :>>= v :-> App funcApply [v] TyNode) as
+        app ty (e :>>= [v] :-> App funcApply [v] [TyNode]) as
hunk ./Grin/FromE.hs 550
-        app ty (e :>>= v :-> doApply v a TyNode) as
+        app ty (e :>>= [v] :-> doApply v a [TyNode]) as
hunk ./Grin/FromE.hs 552
-    app' e [] = return $ Return e
hunk ./Grin/FromE.hs 566
+    app' e [] = return $ Return [e]
hunk ./Grin/FromE.hs 574
-        d <- app TyNode (gEval p1) (tail targs)
-        liftIO $ addNewFunction cenv (tl,Tup (keepIts targs) :-> d)
+        d <- app [TyNode] (gEval p1) (tail targs)
+        liftIO $ addNewFunction cenv (tl,(keepIts targs) :-> d)
hunk ./Grin/FromE.hs 577
-    addNewFunction cenv tl@(n,Tup args :-> body) = do
+    addNewFunction cenv tl@(n,args :-> body) = do
hunk ./Grin/FromE.hs 588
-    cc e | Just z <- constant e = return (Return z)
-    cc e | Just z <- con e = return (Store z)
+    cc e | Just z <- constant e = return (Return [z])
+    cc e | Just [z] <- con e = return (Store z)
hunk ./Grin/FromE.hs 591
-        let ty = toType TyNode e
+        let ty = toTypes TyNode e
hunk ./Grin/FromE.hs 596
-            addNewFunction cenv (tl,Tup [] :-> Error s ty)
+            addNewFunction cenv (tl,[] :-> Error s ty)
hunk ./Grin/FromE.hs 598
-        return $ Return (Const (NodeC a []))
+        return $ Return [Const (NodeC a [])]
hunk ./Grin/FromE.hs 610
-                    return $ s :>>= nv :-> z
+                    return $ s :>>= [nv] :-> z
hunk ./Grin/FromE.hs 619
-                      then Return (Const (NodeC pt as))
+                      then Return [Const (NodeC pt as)]
hunk ./Grin/FromE.hs 625
-        return $ Return (toVal v)
+        return $ Return [toVal v]
hunk ./Grin/FromE.hs 637
-            return $ (e :>>= z :-> Store z) :>>= toVal t :-> v
+            return $ (e :>>= [z] :-> Store z) :>>= [toVal t] :-> v
hunk ./Grin/FromE.hs 641
-            return $ e :>>= toVal t :-> v
+            return $ e :>>= [toVal t] :-> v
hunk ./Grin/FromE.hs 647
-                    return $ [createFuncDef True nn (Tup (keepIts $ map toVal as) :-> x)]
+                    return $ [createFuncDef True nn ((keepIts $ map toVal as) :-> x)]
hunk ./Grin/FromE.hs 651
-                    in (tvrIdent t,(nn,length as,toType TyNode (getType a)))
+                    in (tvrIdent t,(nn,length as,toTypes TyNode (getType a)))
hunk ./Grin/FromE.hs 665
-                    u rs (\y -> Store (NodeC t (map ValUnknown ts)) :>>= toVal tvr :-> ss y) (\y -> du :>>= unit :-> dus y)
+                    u rs (\y -> Store (NodeC t (map ValUnknown ts)) :>>= [toVal tvr] :-> ss y) (\y -> du :>>= [] :-> dus y)
hunk ./Grin/FromE.hs 675
-        f x | Just z <- literal x = z
+        f x | Just [z] <- literal x = z
hunk ./Grin/FromE.hs 695
-    constant e | Just l <- literal e = return l
+    constant e | Just [l] <- literal e = return l
hunk ./Grin/FromE.hs 701
-    con :: Monad m => E -> m Val
+    con :: Monad m => E -> m [Val]
hunk ./Grin/FromE.hs 703
-        return $  NodeC tagArrow (args [x,y])
+        return $  [NodeC tagArrow (args [x,y])]
hunk ./Grin/FromE.hs 707
-            return (tuple (keepIts $ args es))
+            return ((keepIts $ args es))
hunk ./Grin/FromE.hs 709
-            return (NodeC cn (keepIts $ args es))
+            return [NodeC cn (keepIts $ args es)]
hunk ./Grin/FromE.hs 711
-            return (NodeC (partialTag cn (nargs - length es)) $ keepIts (args es))
+            return [NodeC (partialTag cn (nargs - length es)) $ keepIts (args es)]
hunk ./Grin/FromE.hs 734
-literal :: Monad m =>  E -> m Val
-literal (ELit LitCons { litName = n, litArgs = xs })  |  Just xs <- mapM literal xs, Just _ <- fromUnboxedNameTuple n = return (tuple $ keepIts xs)
-literal (ELit (LitInt i ty)) | Just ptype <- fromRawType ty = return $ Lit i ptype
+literal :: Monad m =>  E -> m [Val]
+literal (ELit LitCons { litName = n, litArgs = xs })  |  Just xs <- mapM literal xs, Just _ <- fromUnboxedNameTuple n = return (keepIts $ concat xs)
+literal (ELit (LitInt i ty)) | Just ptype <- fromRawType ty = return $ [Lit i ptype]
hunk ./Grin/FromE.hs 739
-    return $ ValPrim aprim xs ptype
+    return $ [ValPrim aprim (concat xs) ptype]
hunk ./Grin/Grin.hs 9
-    HeapType(..),
+    --HeapType(..),
hunk ./Grin/Grin.hs 11
-    HeapValue(HV),
-    Item(..),
+--    HeapValue(HV),
+--    Item(..),
hunk ./Grin/Grin.hs 14
-    NodeValue(NV),
+--    NodeValue(NV),
hunk ./Grin/Grin.hs 16
-    Primitive(..),
hunk ./Grin/Grin.hs 27
-    combineItems,
+--    combineItems,
hunk ./Grin/Grin.hs 41
-    isVar,isTup,
-    itemTag,
+    isVar,
+--    itemTag,
hunk ./Grin/Grin.hs 57
-    tyUnit,
-    unit,
hunk ./Grin/Grin.hs 58
-    valToItem,
+--    valToItem,
hunk ./Grin/Grin.hs 64
-import Data.IORef
hunk ./Grin/Grin.hs 80
-import Support.Tuple
hunk ./Grin/Grin.hs 83
+import qualified Stats
hunk ./Grin/Grin.hs 99
-    tyReturn :: Ty,
+    tyReturn :: [Ty],
hunk ./Grin/Grin.hs 104
-tyTy = TyTy { tySlots = [], tyReturn = TyUnknown, tySiblings = Nothing, tyThunk = TyNotThunk }
+tyTy = TyTy { tySlots = [], tyReturn = [], tySiblings = Nothing, tyThunk = TyNotThunk }
hunk ./Grin/Grin.hs 115
-gEval x = App funcEval [x] TyNode
+gEval x = App funcEval [x] [TyNode]
hunk ./Grin/Grin.hs 145
-tyUnit = TyTup []
-unit = Tup []
-
-data Lam = Val :-> Exp
+data Lam = [Val] :-> Exp
hunk ./Grin/Grin.hs 150
-    | App       { expFunction  :: Atom, expArgs :: [Val], expType :: Ty } -- ^ Application of functions and builtins
-    | Prim      { expPrimitive :: Primitive, expArgs :: [Val] }           -- ^ Primitive operation
+    | App       { expFunction  :: Atom,
+                  expArgs :: [Val],
+                  expType :: [Ty] }                                       -- ^ Application of functions and builtins
+    | Prim      { expPrimitive :: APrim,
+                  expArgs :: [Val],
+                  expType :: [Ty] }                                       -- ^ Primitive operation
hunk ./Grin/Grin.hs 157
-    | Return    { expValue :: Val }                                       -- ^ Return a value
+    | Return    { expValues :: [Val] }                                    -- ^ Return a value
hunk ./Grin/Grin.hs 161
-    | Error     { expError :: String, expType :: Ty }                     -- ^ Abort with an error message, non recoverably.
+    | Error     { expError :: String, expType :: [Ty] }                   -- ^ Abort with an error message, non recoverably.
hunk ./Grin/Grin.hs 164
-                  expType :: Ty,
+                  expType :: [Ty],
hunk ./Grin/Grin.hs 182
-                  expType :: Ty,
+                  expType :: [Ty],
hunk ./Grin/Grin.hs 196
-    | Tup [Val]               -- ^ Unboxed tuple
+    | Unit                    -- ^ Empty value used as placeholder
hunk ./Grin/Grin.hs 200
-    | ValUnknown Ty           -- ^ Unknown or empty value
-    | Addr {-# UNPACK #-} !(IORef Val)  -- ^ Used only in interpreter
+    | ValUnknown Ty           -- ^ Unknown value
hunk ./Grin/Grin.hs 209
-    | TyTup [Ty]               -- ^ unboxed list of values
-    | TyCall Callable [Ty] Ty  -- ^ something call,jump, or cut-to-able
+    | TyUnit                   -- ^ type of Unit
+    | TyCall Callable [Ty] [Ty]  -- ^ something call,jump, or cut-to-able
hunk ./Grin/Grin.hs 224
-createFuncDef local name body@(~(Tup args) :-> rest)  = updateFuncDefProps FuncDef { funcDefName = name, funcDefBody = body, funcDefCall = call, funcDefProps = funcProps } where
+createFuncDef local name body@(args :-> rest)  = updateFuncDefProps FuncDef { funcDefName = name, funcDefBody = body, funcDefCall = call, funcDefProps = funcProps } where
hunk ./Grin/Grin.hs 228
-updateFuncDefProps fd@FuncDef { funcDefBody = body@(~(Tup args) :-> rest) } =  fd { funcDefProps = props } where
+updateFuncDefProps fd@FuncDef { funcDefBody = body@(args :-> rest) } =  fd { funcDefProps = props } where
hunk ./Grin/Grin.hs 244
-    funcType    :: ([Ty],Ty),
+    funcType    :: ([Ty],[Ty]),
hunk ./Grin/Grin.hs 271
-    show (TyTup []) = "()"
-    show (TyTup ts) =  tupled (map show ts)
+    show (TyUnit) = "()"
hunk ./Grin/Grin.hs 277
-instance Show (IORef a) where
-    show _ = "IORef"
-instance Ord (IORef a) where
-    compare a b = EQ
hunk ./Grin/Grin.hs 295
-    showsPrec _ (Tup xs)  = tupled $ map shows xs
+    showsPrec _ Unit  = showString "()"
hunk ./Grin/Grin.hs 299
-    showsPrec _ (Addr _) = text "<ref>"
hunk ./Grin/Grin.hs 312
-    grinReturnTags :: Map.Map Atom Item,
-    grinArgTags :: Map.Map Atom [Item],
+--    grinReturnTags :: Map.Map Atom Item,
+--    grinArgTags :: Map.Map Atom [Item],
hunk ./Grin/Grin.hs 316
+    grinStats :: Stats.Stat,
hunk ./Grin/Grin.hs 326
-    grinReturnTags = mempty,
-    grinArgTags = mempty,
+--    grinReturnTags = mempty,
+--    grinArgTags = mempty,
hunk ./Grin/Grin.hs 336
-
-
-data Primitive = Primitive {
-    primName :: Atom,
-    primRets :: Maybe [Atom],
-    primType :: ([Ty],Ty),
-    primAPrim :: APrim
-    } deriving(Show)
-
-instance Eq Primitive where
-    a == b = primName a == primName b
-    a /= b = primName a /= primName b
-
-instance Ord Primitive where
-    compare a b = compare (primName a) (primName b)
-
-
-
-
-
-
hunk ./Grin/Grin.hs 410
-valIsNF (Tup xs) = all valIsNF xs
hunk ./Grin/Grin.hs 436
-findTyTy _ a | "@hole" `isPrefixOf` fromAtom a  = return tyTy { tySlots = [], tyReturn = TyNode }
+findTyTy _ a | "@hole" `isPrefixOf` fromAtom a  = return tyTy { tySlots = [], tyReturn = [TyNode] }
hunk ./Grin/Grin.hs 461
+instance CanType e t => CanType [e] [t] where
+    getType es = map getType es
hunk ./Grin/Grin.hs 464
-instance CanType Exp Ty where
+instance CanType Exp [Ty] where
hunk ./Grin/Grin.hs 466
-    getType (Prim p _) = snd (primType p)
+    getType (Prim _ _ ty) = ty
hunk ./Grin/Grin.hs 468
-    getType (Store v) = TyPtr (getType v)
+    getType (Store v) = [TyPtr (getType v)]
hunk ./Grin/Grin.hs 471
-        TyPtr t -> t
+        TyPtr t -> [t]
hunk ./Grin/Grin.hs 474
-    getType (Update w v) = tyUnit
+    getType (Update w v) = []
hunk ./Grin/Grin.hs 478
-    getType Alloc { expValue = v } = TyPtr (getType v)
+    getType Alloc { expValue = v } = [TyPtr (getType v)]
hunk ./Grin/Grin.hs 490
-    getType (Tup xs) = TyTup (map getType xs)
+    getType Unit = TyUnit
hunk ./Grin/Grin.hs 493
-    getType (Addr _) = TyPtr (error "typecheck: Addr")
hunk ./Grin/Grin.hs 511
-    freeVars (Tup vs) = freeVars vs
hunk ./Grin/Grin.hs 519
-    freeVars (Tup vs) = freeVars vs
hunk ./Grin/Grin.hs 538
-    freeVars (Prim _ x) = freeVars x
+    freeVars (Prim _ x _) = freeVars x
hunk ./Grin/Grin.hs 555
-    freeVars (Prim _ x) = freeVars x
+    freeVars (Prim _ x _) = freeVars x
hunk ./Grin/Grin.hs 574
-    freeVars (Tup xs) = freeVars xs
hunk ./Grin/Grin.hs 597
-    freeVars (Prim _ x) = freeVars x
+    freeVars (Prim _ x _) = freeVars x
hunk ./Grin/Grin.hs 608
+{-
hunk ./Grin/Grin.hs 624
-valToItem (Tup as) = TupledValue (map valToItem as)
+--valToItem (Tup as) = TupledValue (map valToItem as)
hunk ./Grin/Grin.hs 633
-    getType (TupledValue xs) = TyTup (map getType xs)
+--    getType (TupledValue xs) = TyTup (map getType xs)
hunk ./Grin/Grin.hs 676
+-}
hunk ./Grin/Grin.hs 684
-isTup Tup {} = True
-isTup _ = False
+--isTup Tup {} = True
+--isTup _ = False
hunk ./Grin/Lint.hs 123
-tcLam :: Maybe Ty -> Lam -> Tc Ty
+tcLam :: Maybe [Ty] -> Lam -> Tc [Ty]
hunk ./Grin/Lint.hs 125
-    f Nothing = ans (tcVal v)
+    f Nothing = ans (mapM tcVal v)
hunk ./Grin/Lint.hs 127
-        t <- tcVal v
+        t <- mapM tcVal v
hunk ./Grin/Lint.hs 131
-tcExp :: Exp -> Tc Ty
+tcExp :: Exp -> Tc [Ty]
hunk ./Grin/Lint.hs 136
-    f n@(Prim p as) = do
-        let (as',t') = primType p
-        as'' <- mapM tcVal as
-        if as'' == as' then return t' else
-            fail $ "Prim: arguments do not match " ++ show n
+    f n@(Prim p as t') = do
+        mapM_ tcVal as
+        return t'
hunk ./Grin/Lint.hs 161
-        return (TyPtr t)
+        return [TyPtr t]
hunk ./Grin/Lint.hs 164
-        return (TyPtr t)
-    f (Return v) = tcVal v
+        return [TyPtr t]
+    f (Return v) = mapM tcVal v
hunk ./Grin/Lint.hs 168
-        return t
+        return [t]
hunk ./Grin/Lint.hs 174
-        return tyUnit
+        return []
hunk ./Grin/Lint.hs 178
-        es <- mapM (tcLam (Just tv)) as
+        es <- mapM (tcLam (Just [tv])) as
hunk ./Grin/Lint.hs 197
-    f (Tup xs) = do
-        xs <- mapM f xs
-        return $ TyTup xs
+    f Unit = return TyUnit
hunk ./Grin/Lint.hs 206
-    f (Addr _) = return $ TyPtr (error "typecheck: Addr")
hunk ./Grin/NodeAnalyze.hs 16
-import Support.Tuple
hunk ./Grin/NodeAnalyze.hs 147
-        let rts = fromTuple $ getType body
+        let rts = getType body
hunk ./Grin/NodeAnalyze.hs 149
-        forMn_ (fromTuple arg) $ \ (~(Var v vt),i) -> do
+        forMn_ arg $ \ (~(Var v vt),i) -> do
hunk ./Grin/NodeAnalyze.hs 154
-        f (x :>>= Var v vt :-> rest) = do
+        f (x :>>= [Var v vt] :-> rest) = do
hunk ./Grin/NodeAnalyze.hs 158
-        f (x :>>= Tup vs :-> rest) = do
+        f (x :>>= vs@(_:_:_) :-> rest) = do
hunk ./Grin/NodeAnalyze.hs 184
-            dres [Right (if TyNode == t then N WHNF Top else top) | t <- fromTuple ty ]
+            dres [Right (if TyNode == t then N WHNF Top else top) | t <- ty ]
hunk ./Grin/NodeAnalyze.hs 206
-            dres [Left $ fr fn i t | i <- [ 0 .. ] | t <- fromTuple ty ]
+            dres [Left $ fr fn i t | i <- [ 0 .. ] | t <- ty ]
hunk ./Grin/NodeAnalyze.hs 211
-            dres [Left $ fr fn i t | i <- [ 0 .. ] | t <- fromTuple ty ]
+            dres [Left $ fr fn i t | i <- [ 0 .. ] | t <- ty ]
hunk ./Grin/NodeAnalyze.hs 213
-            ww' <- mapM convertVal (fromTuple x)
+            ww' <- mapM convertVal x
hunk ./Grin/NodeAnalyze.hs 220
-            dunno (TyPtr (getType w))
+            dunno [TyPtr (getType w)]
hunk ./Grin/NodeAnalyze.hs 234
-            dunno (TyPtr tyINode)
+            dunno [TyPtr tyINode]
hunk ./Grin/Noodle.hs 11
-import Grin.Val
-import Name.Names
hunk ./Grin/Noodle.hs 65
-    f lf (Return (Tag t)) = return [t]
-    f lf (Return (NodeC t _)) = return [t]
+    --f lf (Return (Tag t)) = return [t]
+    f lf (Return [(NodeC t _)]) = return [t]
hunk ./Grin/Noodle.hs 85
-valIsConstant (Tup xs) = all valIsConstant xs
+--valIsConstant (Tup xs) = all valIsConstant xs
hunk ./Grin/Noodle.hs 102
-valIsMutable NodeC {} = False
+--valIsMutable NodeC {} = False
hunk ./Grin/Noodle.hs 112
-isOmittable Prim { expPrimitive = Primitive { primAPrim = aprim } } = aprimIsCheap aprim
+isOmittable Prim { expPrimitive = aprim } = aprimIsCheap aprim
hunk ./Grin/Noodle.hs 179
-    f lf (Return (NodeV t as)) = tells (ReturnNode (Nothing,map getType as))
-    f lf (Return (NodeC t as)) = tells (ReturnNode (Just t,map getType as))
-    f lf (Return z) | valIsConstant z = tell [ReturnConst z]
+    f lf (Return [(NodeV t as)]) = tells (ReturnNode (Nothing,map getType as))
+    f lf (Return [(NodeC t as)]) = tells (ReturnNode (Just t,map getType as))
+    f lf (Return [z]) | valIsConstant z = tell [ReturnConst z]
hunk ./Grin/Optimize.hs 14
-import Support.Tuple
hunk ./Grin/Optimize.hs 21
-    pexpBind :: Val,
+    pexpBind :: [Val],
hunk ./Grin/Optimize.hs 84
-            (exp',mv') | Just vv <- mv = let mv' = tuple $ fromTuple vv ++ ebinds in (exp :>>= vv :-> Return mv',mv')
-                       | otherwise = (exp,unit)
+            (exp',mv') | Just vv <- mv = let mv' = vv ++ ebinds in (exp :>>= vv :-> Return mv',mv')
+                       | otherwise = (exp,[])
hunk ./Grin/Optimize.hs 185
-            return (App t' xs TyNode :>>= n1 :-> Store n1)
+            return (App t' xs [TyNode] :>>= [n1] :-> Store n1)
hunk ./Grin/Optimize.hs 189
-            return (App t' xs TyNode :>>= n1 :-> Update v n1)
+            return (App t' xs [TyNode] :>>= [n1] :-> Update v n1)
hunk ./Grin/Optimize.hs 197
-    graph = newGraph [ (a,concatMap f (freeVars l)) | (a,_ :-> l) <- grinFuncs grin, isSpeculatable l, getType l == TyNode ] fst snd
+    graph = newGraph [ (a,concatMap f (freeVars l)) | (a,_ :-> l) <- grinFuncs grin, isSpeculatable l, getType l == [TyNode] ] fst snd
hunk ./Grin/Optimize.hs 205
-    isSpeculatable Prim { expPrimitive = Primitive { primAPrim = APrim p _ } } = primIsConstant p
+    isSpeculatable Prim { expPrimitive = APrim p _ } = primIsConstant p
hunk ./Grin/Show.hs 21
-import CharIO
-import Data.Graph.Inductive.Basic(elfilter)
hunk ./Grin/Show.hs 35
-import Support.Tuple
hunk ./Grin/Show.hs 48
-pVar v | v == unit = empty
-pVar v  = prettyVal v <+> operator "<- "
+pVar [] = empty
+pVar v  = prettyVals v <+> operator "<- "
hunk ./Grin/Show.hs 51
-pVar' v  = prettyVal v <+> operator "<- "
+pVar' v  = prettyVals v <+> operator "<- "
+
+prettyVals [] = prettyVal Unit
+prettyVals [x] = prettyVal x
+prettyVals xs = tupled (map prettyVal xs)
hunk ./Grin/Show.hs 88
-prettyExp vl (Return v) = vl <> keyword "return" <+> prettyVal v
+prettyExp vl (Return []) = vl <> keyword "return" <+> text "()"
+prettyExp vl (Return [v]) = vl <> keyword "return" <+> prettyVal v
+prettyExp vl (Return vs) = vl <> keyword "return" <+> tupled (map prettyVal vs)
hunk ./Grin/Show.hs 99
-prettyExp vl (Prim Primitive { primAPrim = APrim (Peek t) _ } [v])  = vl <> prim (show t) <> char '[' <> prettyVal v <> char ']'
-prettyExp vl (Prim Primitive { primName = nm } vs)  = vl <> prim (fromAtom nm) <+> hsep (map prettyVal vs)
+prettyExp vl Prim { expPrimitive = APrim (Peek t) _, expArgs = [v] }  = vl <> prim (show t) <> char '[' <> prettyVal v <> char ']'
+prettyExp vl Prim { expPrimitive = ap, expArgs = vs } = vl <> prim (pprint ap) <+> hsep (map prettyVal vs)
hunk ./Grin/Show.hs 103
-    f (v :-> e) | isOneLine e = prettyVal v <+> operator "->" <+> prettyExp empty e
-    f (v :-> e) = prettyVal v <+> operator "->" <+> keyword "do" <$> indent 2 (prettyExp empty e)
-prettyExp vl NewRegion { expLam = (r :-> body)} = vl <> keyword "region" <+> text "\\" <> prettyVal r <+> text "-> do" <$> indent 2 (prettyExp empty body)
+    f (~[v] :-> e) | isOneLine e = prettyVal v <+> operator "->" <+> prettyExp empty e
+    f (~[v] :-> e) = prettyVal v <+> operator "->" <+> keyword "do" <$> indent 2 (prettyExp empty e)
+prettyExp vl NewRegion { expLam = (r :-> body)} = vl <> keyword "region" <+> text "\\" <> prettyVals r <+> text "-> do" <$> indent 2 (prettyExp empty body)
hunk ./Grin/Show.hs 108
-    f FuncDef { funcDefName = name, funcDefBody = as :-> body } = func (show name) <+> hsep (map prettyVal $ fromTuple as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty body)
+    f FuncDef { funcDefName = name, funcDefBody = as :-> body } = func (show name) <+> hsep (map prettyVal as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty body)
hunk ./Grin/Show.hs 147
-prettyVal (Tup xs)  = tupled $ map prettyVal xs
hunk ./Grin/Show.hs 148
-prettyVal (Addr _) = text "<ref>"
hunk ./Grin/Show.hs 160
-prettyFun (n,(Tup as :-> e)) = func (fromAtom n) <+> hsep (map prettyVal as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty e)
+prettyFun (n,(as :-> e)) = func (fromAtom n) <+> hsep (map prettyVal as) <+> operator "=" <+> keyword "do" <$> indent 2 (prettyExp empty e)
hunk ./Grin/Show.hs 175
-        hPutStrLn handle . render $ func (fromAtom n) <+> operator "::" <+> hsep (map (tshow . getType) (fromTuple l))  <+> operator "->" <+> tshow (getType e)
+        hPutStrLn handle . render $ func (fromAtom n) <+> operator "::" <+> hsep (map (tshow . getType) l)  <+> operator "->" <+> tshow (getType e)
hunk ./Grin/Show.hs 179
+{-
hunk ./Grin/Show.hs 205
+-}
hunk ./Grin/Simplify.hs 24
-import Support.Tuple
hunk ./Grin/Simplify.hs 74
-        return $ (Return x :>>= d)
+        return $ (Return [x] :>>= d)
hunk ./Grin/Simplify.hs 82
-        gs (Return unit)
+        gs (Return [])
hunk ./Grin/Simplify.hs 88
-        gs (Return (Const n))
+        gs (Return [Const n])
hunk ./Grin/Simplify.hs 97
-        gs (Return n)
+        gs (Return [n])
hunk ./Grin/Simplify.hs 100
-        gs (Return n)
+        gs (Return [n])
hunk ./Grin/Simplify.hs 109
-                return $ Just (p,Return x :>>= d)
+                return $ Just (p,Return [x] :>>= d)
hunk ./Grin/Simplify.hs 111
-    gv (NodeC t xs,Return (NodeC t' xs')) | t == t' = do
+    gv ([NodeC t xs],Return [NodeC t' xs']) | t == t' = do
hunk ./Grin/Simplify.hs 113
-            gv (Tup xs,Return (Tup xs'))
+            gv (xs,Return xs')
hunk ./Grin/Simplify.hs 117
-    gv (NodeC t xs,Return (NodeC t' xs')) | t /= t' = do
+    gv ([NodeC t xs],Return [(NodeC t' xs')]) | t /= t' = do
hunk ./Grin/Simplify.hs 119
-            gv (NodeC t xs,Error ("Bad Assignment: " ++ show (t,t')) TyNode)
+            gv (xs,Error ("Bad Assignment: " ++ show (t,t')) (map getType xs))
hunk ./Grin/Simplify.hs 131
-            Return v | valIsNF v, Just n <- varBind' p v -> do
+            Return v | all valIsNF v, Just n <- zipWithM varBind' p v -> do
hunk ./Grin/Simplify.hs 133
-                modify (`mappend` (n,mempty))
+                modify (`mappend` (Map.unions n,mempty))
hunk ./Grin/Simplify.hs 135
-            Return v | Just n <- varBind p v -> do
+            Return v | Just n <- zipWithM varBind p v -> do
hunk ./Grin/Simplify.hs 137
-                modify (`mappend` (n,mempty))
+                modify (`mappend` (Map.unions n,mempty))
hunk ./Grin/Simplify.hs 154
-            return $ Return (Tup as) :>>= l
+            return $ Return as :>>= l
hunk ./Grin/Simplify.hs 164
-    getCS (b,app@(App a [vr@Var {}] _)) | a == funcEval = return $ Map.fromList [(app,Return b), (Store b,Return vr)]
+--    getCS (b,app@(App a [vr@Var {}] _)) | a == funcEval = return $ Map.fromList [(app,Return [b]), (Store b,Return [vr])]
hunk ./Grin/Simplify.hs 167
-    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), tagIsWHNF t, not (isHoly v) = return $ Map.fromList [(Store v,Return b),(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
-    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), not (isHoly v) = return $ Map.fromList [(Store v,Return b)]
+--    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), tagIsWHNF t, not (isHoly v) = return $ Map.fromList [(Store v,Return b),(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
+--    getCS (b@Var {},Store v@(NodeC t _)) | not (isMutableNodeTag t), not (isHoly v) = return $ Map.fromList [(Store v,Return [b])]
hunk ./Grin/Simplify.hs 171
-    getCS (b@Var {},Return (Const v)) = return $ Map.fromList [(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
-    getCS (b@Var {},Return v) = return $ Map.fromList [(Return b,Return v), (Store b, Store v), (Fetch b, Fetch v)]
+--    getCS (b@Var {},Return (Const v)) = return $ Map.fromList [(Fetch b,Return v),(App funcEval [b] TyNode,Return v)]
+--    getCS (b@Var {},Return v) = return $ Map.fromList [(Return b,Return v), (Store b, Store v), (Fetch b, Fetch v)]
hunk ./Grin/Simplify.hs 190
-    | tagIsWHNF t = Return n
+    | tagIsWHNF t = Return [n]
hunk ./Grin/Simplify.hs 203
-varBind (Tup xs) (Tup ys) | length xs == length ys  = liftM mconcat $ sequence $  zipWith varBind xs ys
+--varBind (Tup xs) (Tup ys) | length xs == length ys  = liftM mconcat $ sequence $  zipWith varBind xs ys
hunk ./Grin/Simplify.hs 214
-varBind' (Tup xs) (Tup ys) | length xs == length ys  = liftM mconcat $ sequence $  zipWith varBind' xs ys
+--varBind' (Tup xs) (Tup ys) | length xs == length ys  = liftM mconcat $ sequence $  zipWith varBind' xs ys
hunk ./Grin/Simplify.hs 246
-    f lf (Return z) | z /= unit && valIsConstant z = return [UnboxConst z]
-    f lf (Return (NodeC t xs)) = return [UnboxTup (t,map getType xs)]
+    f lf (Return [z]) | valIsConstant z = return [UnboxConst z]
+    f lf (Return [NodeC t xs]) = return [UnboxTup (t,map getType xs)]
hunk ./Grin/Simplify.hs 269
-    f (Return v) | valIsConstant v  = Return unit
-    f (Return (NodeC t xs)) = Return (tuple xs)
+    f (Return v) | all valIsConstant v  = Return []
+    f (Return [NodeC t xs]) = Return xs
hunk ./Grin/Simplify.hs 274
-editTail :: Ty -> (Exp -> Exp) -> Exp -> Exp
+editTail :: [Ty] -> (Exp -> Exp) -> Exp -> Exp
hunk ./Grin/Simplify.hs 309
-    f (Return t@NodeC {} :>>= v@Var {} :-> Update w v' :>>= lr) | v == v' = do
-        mtick "Optimize.optimize.return-update"
-        f (Return t :>>= v :-> Update w t :>>= lr)
-    f (Return t@NodeV {} :>>= v@Var {} :-> Update w v' :>>= lr) | v == v' = do
-        mtick "Optimize.optimize.return-update"
-        f (Return t :>>= v :-> Update w t :>>= lr)
-    f (e :>>= v1 :-> Return v2) | (isTup v1 || isVar v1) && v1 == v2 = do
+--    f (Return t@NodeC {} :>>= v@Var {} :-> Update w v' :>>= lr) | v == v' = do
+--        mtick "Optimize.optimize.return-update"
+--        f (Return t :>>= v :-> Update w t :>>= lr)
+--    f (Return t@NodeV {} :>>= v@Var {} :-> Update w v' :>>= lr) | v == v' = do
+--        mtick "Optimize.optimize.return-update"
+--        f (Return t :>>= v :-> Update w t :>>= lr)
+    f (e :>>= v1 :-> Return v2) | (all isVar v1) && v1 == v2 = do
hunk ./Grin/Simplify.hs 318
-    f (Store t :>>= v :-> Fetch v' :>>= lr) | v == v' = do
+    f (Store t :>>= [v] :-> Fetch v' :>>= lr) | v == v' = do
hunk ./Grin/Simplify.hs 320
-        f (Store t :>>= v :-> Return t :>>= lr)
-    f (Store t :>>= v@(Var vr _) :-> Update  v' w :>>= lr) | v == v', vr `notElem` freeVars w = do
+        f (Store t :>>= [v] :-> Return [t] :>>= lr)
+    f (Store t :>>= [v@(Var vr _)] :-> Update  v' w :>>= lr) | v == v', vr `notElem` freeVars w = do
hunk ./Grin/Simplify.hs 323
-        f (Store w :>>= v :-> Return unit :>>= lr)
-    f (Update v t :>>= Tup [] :-> Fetch v' :>>= lr) | v == v' = do
+        f (Store w :>>= [v] :-> Return [] :>>= lr)
+    f (Update v t :>>= [] :-> Fetch v' :>>= lr) | v == v' = do
hunk ./Grin/Simplify.hs 326
-        f (Update v t :>>= Tup [] :-> Return t :>>= lr)
-    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
-        mtick "Optimize.optimize.return-apply"
-        f (Return t :>>= v :-> doApply Return True t [a] typ :>>= lr)
-    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
-        mtick "Optimize.optimize.return-apply"
-        f (Return t :>>= v :-> doApply Return True t [a] typ)
-    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | fa == funcApply, v == v' = do
+        f (Update v t :>>= [] :-> Return [t] :>>= lr)
+--    f (Return [t@NodeC {}] :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
+--        mtick "Optimize.optimize.return-apply"
+--        f (Return [t] :>>= v :-> doApply Return True t [a] typ :>>= lr)
+--    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
+--        mtick "Optimize.optimize.return-apply"
+--        f (Return t :>>= v :-> doApply Return True t [a] typ)
+--    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | fa == funcApply, v == v' = do
hunk ./Grin/Simplify.hs 335
-        mtick "Optimize.optimize.return-apply0"
-        f (Return t :>>= v :-> doApply Return True t [] typ :>>= lr)
-    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ) | fa == funcApply, v == v' = do
-        mtick "Optimize.optimize.return-apply0"
-        f (Return t :>>= v :-> doApply Return True t [] typ)
-    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | not (valIsMutable t), fa == funcEval, v == v' = do
-
-        mtick "Optimize.optimize.store-eval"
-        f (Store t :>>= v :-> doEval t typ :>>= lr)
-    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ) | not (valIsMutable t), fa == funcEval, v == v' = do
-        mtick "Optimize.optimize.store-eval"
-        f (Store t :>>= v :-> doEval t typ)
-    f (Update v t@NodeC {} :>>= Tup [] :-> App fa [v'] typ :>>= lr) | fa == funcEval, v == v' = do
-        mtick "Optimize.optimize.update-eval"
-        f (Update v t :>>= Tup [] :-> doEval t typ :>>= lr)
-    f (Update v t@NodeC {} :>>= Tup [] :-> App fa [v'] typ) | fa == funcEval, v == v' = do
-        mtick "Optimize.optimize.update-eval"
-        f (Update v t :>>= Tup [] :-> doEval t typ)
+--        mtick "Optimize.optimize.return-apply0"
+--        f (Return t :>>= v :-> doApply Return True t [] typ :>>= lr)
+--    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ) | fa == funcApply, v == v' = do
+--        mtick "Optimize.optimize.return-apply0"
+--        f (Return t :>>= v :-> doApply Return True t [] typ)
+--    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | not (valIsMutable t), fa == funcEval, v == [v'] = do
+--        mtick "Optimize.optimize.store-eval"
+--        f (Store t :>>= v :-> doEval t typ :>>= lr)
+--    f (Store t@NodeC {} :>>= v :-> App fa [v'] typ) | not (valIsMutable t), fa == funcEval, v == v' = do
+--        mtick "Optimize.optimize.store-eval"
+--        f (Store t :>>= v :-> doEval t typ)
+--    f (Update v t@NodeC {} :>>= [] :-> App fa [v'] typ :>>= lr) | fa == funcEval, v == v' = do
+--        mtick "Optimize.optimize.update-eval"
+--        f (Update v t :>>= [] :-> doEval t typ :>>= lr)
+--    f (Update v t@NodeC {} :>>= [] :-> App fa [v'] typ) | fa == funcEval, v == v' = do
+--        mtick "Optimize.optimize.update-eval"
+--        f (Update v t :>>= [] :-> doEval t typ)
hunk ./Grin/Simplify.hs 358
-    f (Return n :>>= b :-> Case b' as :>>= lr) | isKnown n, b == b' = do
+        {-
+    f (Return n :>>= b :-> Case b' as :>>= lr) | isKnown n, b == [b'] = do
hunk ./Grin/Simplify.hs 363
-    f (Return n :>>= b :-> Case b' as ) | isKnown n, b == b' = do
+    f (Return n :>>= b :-> Case b' as ) | isKnown n, b == [b'] = do
hunk ./Grin/Simplify.hs 367
-    f (Case x as :>>= Tup [] :-> (Case x' as') :>>= lr) | x == x', not $ any (isVar . lamBind) as = do
+    f (Case x as :>>= [] :-> (Case x' as') :>>= lr) | x == x', not $ any (isVar . lamBind) as = do
hunk ./Grin/Simplify.hs 370
-    f (Case x as :>>= Tup [] :-> (Case x' as')) | x == x', not $ any (isVar . lamBind) as = do
+    f (Case x as :>>= [] :-> (Case x' as')) | x == x', not $ any (isVar . lamBind) as = do
hunk ./Grin/Simplify.hs 373
-        {-
hunk ./Grin/Simplify.hs 376
-        -}
-    f (cc@Case {} :>>= v :-> Return v' :>>= NodeC t as :-> lr ) | v == v' = do
+    f (cc@Case {} :>>= v :-> Return v' :>>= [NodeC t as] :-> lr ) | v == v' = do
hunk ./Grin/Simplify.hs 381
-            mc = modifyTail ( var :-> Return var :>>=  NodeC t as :-> Return (tuple as))
-        return (mc cc :>>= tuple as :-> Return (NodeC t as) :>>= v :-> lr)
-    f (lt@Let { expIsNormal = True } :>>= v :-> Return v' :>>= NodeC t as :-> lr ) | v == v' = do
+            mc = modifyTail ( var :-> Return var :>>=  [NodeC t as] :-> Return as)
+        return (mc cc :>>= as :-> Return [NodeC t as] :>>= v :-> lr)
+    f (lt@Let { expIsNormal = True } :>>= v :-> Return v' :>>= [NodeC t as] :-> lr ) | v == v' = do
hunk ./Grin/Simplify.hs 388
-            mc = modifyTail ( var :-> Return var :>>=  NodeC t as :-> Return (tuple as))
-        return (mc lt :>>= tuple as :-> Return (NodeC t as) :>>= v :-> lr)
+            mc = modifyTail ( var :-> Return var :>>=  [NodeC t as] :-> Return (as))
+        return (mc lt :>>= as :-> Return [NodeC t as] :>>= v :-> lr)
+        -}
hunk ./Grin/Simplify.hs 416
-  -}
hunk ./Grin/Simplify.hs 426
-        return ((Case x (map (combineLam postEval tyUnit) as) :>>= unit :-> Return val) :>>= lr)
+        return ((Case x (map (combineLam postEval []) as) :>>= [] :-> Return val) :>>= lr)
hunk ./Grin/Simplify.hs 437
+  -}
hunk ./Grin/Simplify.hs 448
-    f (hexp@Case {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
-        c <- caseHoist hexp v as' (getType rc)
-        lr <- g lr
-        return $ c :>>= lr
-    f (hexp@Case {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
-        caseHoist hexp v as' (getType rc)
+--    f (hexp@Case {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
+--        c <- caseHoist hexp v as' (getType rc)
+--        lr <- g lr
+--        return $ c :>>= lr
+--    f (hexp@Case {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
+--        caseHoist hexp v as' (getType rc)
hunk ./Grin/Simplify.hs 459
-            UnboxTag -> do
-                mtick "Optimize.optimize.let-unbox-tag"
-                let (va:_vr) = [ v | v <- [v1..], not $ v `Set.member` fv ]
-                return ((combine postEval TyTag cs :>>= Var va TyTag :-> Return (NodeV va [])) :>>= lr)
+--            UnboxTag -> do
+--                mtick "Optimize.optimize.let-unbox-tag"
+--                let (va:_vr) = [ v | v <- [v1..], not $ v `Set.member` fv ]
+--                return ((combine postEval TyTag cs :>>= Var va TyTag :-> Return (NodeV va [])) :>>= lr)
hunk ./Grin/Simplify.hs 467
-                return ((combine postEval (tuple ts) cs :>>= tuple vars  :-> Return (NodeC t vars)) :>>= lr)
+                return ((combine postEval (ts) cs :>>= vars  :-> Return [NodeC t vars]) :>>= lr)
hunk ./Grin/Simplify.hs 470
-                return ((combine postEval tyUnit cs :>>= unit :-> Return val) :>>= lr)
+                return ((combine postEval [] cs :>>= [] :-> Return [val]) :>>= lr)
hunk ./Grin/Simplify.hs 473
-    f (hexp@Let {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
-        c <- caseHoist hexp v as' (getType rc)
-        lr <- g lr
-        return $ c :>>= lr
-    f (hexp@Let {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
-        caseHoist hexp v as' (getType rc)
+--    f (hexp@Let {} :>>= v@(Var vnum _) :-> rc@(Case v' as') :>>= lr) | v == v', not (vnum `Set.member` freeVars lr) = do
+--        c <- caseHoist hexp v as' (getType rc)
+--        lr <- g lr
+--        return $ c :>>= lr
+--    f (hexp@Let {} :>>= v@Var {} :-> rc@(Case v' as')) | v == v'  = do
+--        caseHoist hexp v as' (getType rc)
hunk ./Grin/Simplify.hs 501
-            return $ Return (Tup xs) :>>= funcDefBody fd
+            return $ Return xs :>>= funcDefBody fd
hunk ./Grin/Simplify.hs 509
-    caseHoist hexp v as' ty | sizeLTE 1 (filter (\x -> x /= ReturnError && notReturnNode x ) (getReturnInfo hexp))= do
-        mtick $ "Optimize.optimize.case-hoist" -- .{" ++ show (Prelude.map (isManifestNode . lamExp) as :: [Maybe [Atom]])
-        nic <- f (Case v as')
-        --True <- return $ Set.null $ Set.intersection (freeVars nic) (freeVars (map lamBind as) :: Set.Set Var)
-        return $ modifyTail (v :-> nic) hexp -- Case x [ b :-> e :>>= v :-> Case v as' | b :-> e <- as ]
-    caseHoist hexp v as' ty | False && grinPhase grin >= PostDevolve  = do
-        let ufuncs = freeVars fbody
-            fbody = Tup [v] :-> Case v as'
-            cfname = do
-                uniq <- newUniq
-                let fname = toAtom $ "fjumppoint-" ++ show n ++ "-" ++ show uniq
-                if fname `member` (ufuncs :: Set.Set Atom) then cfname else return fname
-        fname <- cfname
-        let f e@(Return NodeC {}) = e :>>= v :-> Case v as'
-            f e@(Return Lit {}) = e :>>= v :-> Case v as'
-            f e = e :>>= v :-> App fname [v] ty
-            nbody = editTail ty f hexp -- (v :-> App fname [v] (getType $ Case v as')) (Case x as)
-        mtick $ "Optimize.optimize.case-hoist-jumppoint.{" ++ show fname -- .{" ++ show (Prelude.map (isManifestNode . lamExp) as :: [Maybe [Atom]])
-        return $ grinLet [createFuncDef True fname fbody] nbody
-    caseHoist hexp v as' ty = do
-       mfc <- f hexp
-       fc <- f (Case v as')
-       return $ mfc :>>= v :-> fc
+--    caseHoist hexp v as' ty | sizeLTE 1 (filter (\x -> x /= ReturnError && notReturnNode x ) (getReturnInfo hexp))= do
+--        mtick $ "Optimize.optimize.case-hoist" -- .{" ++ show (Prelude.map (isManifestNode . lamExp) as :: [Maybe [Atom]])
+--        nic <- f (Case v as')
+--        --True <- return $ Set.null $ Set.intersection (freeVars nic) (freeVars (map lamBind as) :: Set.Set Var)
+--        return $ modifyTail ([v] :-> nic) hexp -- Case x [ b :-> e :>>= v :-> Case v as' | b :-> e <- as ]
+--    caseHoist hexp v as' ty | False && grinPhase grin >= PostDevolve  = do
+--        let ufuncs = freeVars fbody
+--            fbody = [v] :-> Case v as'
+--            cfname = do
+--                uniq <- newUniq
+--                let fname = toAtom $ "fjumppoint-" ++ show n ++ "-" ++ show uniq
+--                if fname `member` (ufuncs :: Set.Set Atom) then cfname else return fname
+--        fname <- cfname
+--        let f e@(Return NodeC {}) = e :>>= v :-> Case v as'
+--            f e@(Return Lit {}) = e :>>= v :-> Case v as'
+--            f e = e :>>= v :-> App fname [v] ty
+--            nbody = editTail ty f hexp -- (v :-> App fname [v] (getType $ Case v as')) (Case x as)
+--        mtick $ "Optimize.optimize.case-hoist-jumppoint.{" ++ show fname -- .{" ++ show (Prelude.map (isManifestNode . lamExp) as :: [Maybe [Atom]])
+--        return $ grinLet [createFuncDef True fname fbody] nbody
+--    caseHoist hexp v as' ty = do
+--       mfc <- f hexp
+--       fc <- f (Case v as')
+--       return $ mfc :>>= v :-> fc
hunk ./Grin/Simplify.hs 536
-            f ((v@Var {} :-> b):_) = Return n :>>= v :-> b
-            f ((NodeC t' vs' :-> b):_) | t == t' =  Return (Tup vs) :>>= Tup vs' :-> b
+            f ((v@[Var {}] :-> b):_) = Return [n] :>>= v :-> b
+            f (([NodeC t' vs'] :-> b):_) | t == t' =  Return (vs) :>>= vs' :-> b
hunk ./Grin/Simplify.hs 544
-            f ((v@Var {} :-> b):_) = Return n :>>= v :-> b
-            f ((Lit l' _ :-> b):_) | l == l' = b
-            f (_:as) = f as
-        return $ f as
-    knownCase (Tag t) as = do
-        mtick $ "Optimize.optimize.known-case-tag.{" ++ show t
-        let f [] =  Error "known-case: No known case" (getType (Case (Tag t) as))
-            f ((v@Var {} :-> b):_) = Return (Tag t) :>>= v :-> b
-            f ((Tag t' :-> b):_) | t == t' = b
+            f ((v@[Var {}] :-> b):_) = Return [n] :>>= v :-> b
+            f (([Lit l' _] :-> b):_) | l == l' = b
hunk ./Grin/Simplify.hs 548
-    caseCombine x as as' = do
-        mtick $ "Optimize.optimize.case-combine"
-        let etags = [ bd | bd@(NodeC t _ :-> _) <- as, t `notElem` [ t | NodeC t _ :-> _ <- as' ] ]
-            ttags = [ bd | bd@(Tag t:-> _) <- as, t `notElem` [ t | Tag t :-> _ <- as' ] ]
-            as'' = Prelude.map f as'
-            f (v@Var {} :-> b) | getType v == TyTag = v :-> Case v ttags :>>= unit :-> b
-            f (v@Var {} :-> b) = v :-> Case v etags :>>= unit :-> b
-            f (n@(NodeC t _) :-> b) = case [ a | a@(NodeC t' _ :-> _) <-  as, t == t'] of
-                [bind :-> body] -> n :-> Return n :>>= bind :-> body :>>= unit :-> b
-            f (n@(Tag t) :-> b) = case [ a | a@(Tag t' :-> _) <-  as, t == t'] of
-                [bind :-> body] -> n :-> Return n :>>= bind :-> body :>>= unit :-> b
-            -- f r
-        return $ Case x as''
+--    knownCase (Tag t) as = do
+--        mtick $ "Optimize.optimize.known-case-tag.{" ++ show t
+--        let f [] =  Error "known-case: No known case" (getType (Case (Tag t) as))
+--            f ((v@[Var {}] :-> b):_) = Return (Tag t) :>>= v :-> b
+----            f ((Tag t' :-> b):_) | t == t' = b
+--            f (_:as) = f as
+--        return $ f as
+--    caseCombine x as as' = do
+--        mtick $ "Optimize.optimize.case-combine"
+--        let etags = [ bd | bd@(NodeC t _ :-> _) <- as, t `notElem` [ t | NodeC t _ :-> _ <- as' ] ]
+--  --          ttags = [ bd | bd@(Tag t:-> _) <- as, t `notElem` [ t | Tag t :-> _ <- as' ] ]
+--            as'' = Prelude.map f as'
+-- --           f ([v@Var {}] :-> b) | getType v == TyTag = v :-> Case v ttags :>>= [] :-> b
+--            f ([v@Var {}] :-> b) = v :-> Case v etags :>>= [] :-> b
+--            f (n@[(NodeC t _)] :-> b) = case [ a | a@(NodeC t' _ :-> _) <-  as, t == t'] of
+--                [bind :-> body] -> n :-> Return n :>>= bind :-> body :>>= [] :-> b
+----            f (n@[(Tag t)] :-> b) = case [ a | a@(Tag t' :-> _) <-  as, t == t'] of
+----                [bind :-> body] -> n :-> Return n :>>= bind :-> body :>>= [] :-> b
+--            -- f r
+--        return $ Case x as''
hunk ./Grin/Simplify.hs 573
-untagPat _ (NodeC t [] :-> e) = Tag t :-> e
-untagPat vb (v@Var{} :-> e) = Var vb TyTag :-> Return (NodeV vb []) :>>= v :-> e
+--untagPat _ ([NodeC t []] :-> e) = [Tag t] :-> e
+--untagPat vb ([v@Var{}] :-> e) = [Var vb TyTag] :-> Return [NodeV vb []] :>>= [v] :-> e
hunk ./Grin/Simplify.hs 592
-    gv w@(Tup vs,Case x xs) = do
+    gv w@(vs,Case x xs) = do
hunk ./Grin/Simplify.hs 600
-                let ml = modifyTail (tuple vs :-> Return (tuple nvs))
-                return (Just (tuple nvs,ml (Case x xs) ))
+                let ml = modifyTail (vs :-> Return nvs)
+                return (Just (nvs,ml (Case x xs) ))
hunk ./Grin/Simplify.hs 671
-collectUsedFuncs (Tup as :-> exp) = (snub $ concatMap tagToFunction (Seq.toList iu),sort $ Seq.toList du) where
+collectUsedFuncs (as :-> exp) = (snub $ concatMap tagToFunction (Seq.toList iu),sort $ Seq.toList du) where
hunk ./Grin/Val.hs 47
-instance ToVal () where
-    toVal () = vUnit
-    toUnVal () = unit
hunk ./Grin/Val.hs 81
-instance FromVal () where
-    fromVal n | n == toVal () = return ()
-    fromVal n = fail $ "Val is not (): " ++ show n
-    fromUnVal (Tup []) = return ()
-    fromUnVal n = fail $ "Val is not Un(): " ++ show n
hunk ./Grin/Whiz.hs 52
-    (forall a . Val -> m a -> m a)         -- ^ called for each sub-code block, such as in case statements
-    -> ((Val,Exp) -> m (Maybe (Val,Exp)))  -- ^ routine to transform or omit simple bindings
+    (forall a . [Val] -> m a -> m a)         -- ^ called for each sub-code block, such as in case statements
+    -> (([Val],Exp) -> m (Maybe ([Val],Exp)))  -- ^ routine to transform or omit simple bindings
hunk ./Grin/Whiz.hs 61
-    f a@(Return (Tup xs@(_:_))) ((senv,p@(Tup ys@(_:_)),b):rs) env | length xs == length ys  = do
-        Return (Tup xs) <- g env a
-        (Tup ys,env') <- renamePattern p
-        ts <- lift $ mapM te [(y,Return x) | x <- xs | y <- ys ]
+    f a@(Return (xs@(_:_:_))) ((senv,p@(ys@(_:_:_)),b):rs) env | length xs == length ys  = do
+        Return xs <- g env a
+        (ys,env') <- renamePattern p
+        ts <- lift $ mapM te [([y],Return [x]) | x <- xs | y <- ys ]
hunk ./Grin/Whiz.hs 117
-    (forall a . Val -> m a -> m a)         -- ^ called for each sub-code block, such as in case statements
-    -> ((Val,Exp) -> m (Maybe (Val,Exp)))  -- ^ routine to transform or omit simple bindings
+    (forall a . [Val] -> m a -> m a)         -- ^ called for each sub-code block, such as in case statements
+    -> (([Val],Exp) -> m (Maybe ([Val],Exp)))  -- ^ routine to transform or omit simple bindings
hunk ./Grin/Whiz.hs 126
-    f a@(Return (Tup xs@(_:_))) ((senv,p@(Tup ys@(_:_)),b):rs) env | length xs == length ys  = do
-        Return (Tup xs) <- g env a
-        (Tup ys,env') <- renamePattern p
+    f a@(Return (xs@(_:_:_))) ((senv,p@ys,b):rs) env | length xs == length ys  = do
+        Return xs <- g env a
+        (ys,env') <- renamePattern p
hunk ./Grin/Whiz.hs 130
-        ts <- lift $ mapM te (reverse [(y,Return x) | x <- xs | y <- ys ])
+        ts <- lift $ mapM te (reverse [([y],Return [x]) | x <- xs | y <- ys ])
hunk ./Grin/Whiz.hs 178
-        v <- g v
+        v <- mapM g v
hunk ./Grin/Whiz.hs 180
-    f (Prim x vs) = do
+    f (Prim x vs t) = do
hunk ./Grin/Whiz.hs 182
-        return $ Prim x vs
+        return $ Prim x vs t
hunk ./Grin/Whiz.hs 211
-    f (Tup vs) = do
-        vs' <- mapM f vs
-        return $ Tup vs'
+--    f (Tup vs) = do
+--        vs' <- mapM f vs
+--        return $ Tup vs'
hunk ./Grin/Whiz.hs 220
-    f Addr {} = error "Address in subst"
hunk ./Grin/Whiz.hs 222
-renamePattern :: MonadState (WhizState) m => Val ->  m (Val,WhizEnv)
-renamePattern x = runWriterT (f x) where
+renamePattern :: MonadState (WhizState) m => [Val] ->  m ([Val],WhizEnv)
+renamePattern x = runWriterT (mapM f x) where
hunk ./Grin/Whiz.hs 234
-    f (Tup vs) = do
-        vs' <- mapM f vs
-        return $ Tup vs'
+--    f (Tup vs) = do
+--        vs' <- mapM f vs
+--        return $ Tup vs'
hunk ./Grin/Whiz.hs 242
-    f Addr {} = error "Address in pattern"