[allow boxed but unlifted values in grin code, interpret type arguments as these
John Meacham <john@repetae.net>**20070605055427] hunk ./Grin/FromE.hs 122
-        f x = (x,map (toType (TyPtr TyNode) . tvrType )  as,toTypes TyNode (getType (e::E) :: E))
+        f x = (x,map (toType tyINode . tvrType )  as,toTypes TyNode (getType (e::E) :: E))
hunk ./Grin/FromE.hs 140
+    toty e |  sortKindLike e = tyDNode
hunk ./Grin/FromE.hs 145
-    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 = es, litType = ty }) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = keepIts $ map (toType tyINode) es
hunk ./Grin/FromE.hs 151
+    toty e |  sortKindLike e = [tyDNode]
hunk ./Grin/FromE.hs 230
-    con c | (EPi (TVr { tvrType = a }) b,_) <- fromLam $ conExpr c = return $ (tagArrow,toTyTy ([TyPtr TyNode, TyPtr TyNode],[TyNode]))
+    con c | (EPi (TVr { tvrType = a }) b,_) <- fromLam $ conExpr c = return $ (tagArrow,toTyTy ([tyDNode, tyDNode],[TyNode]))
hunk ./Grin/FromE.hs 268
-    (tagArrow,([TyPtr TyNode, TyPtr TyNode],[TyNode])),
-    (funcEval, ([TyPtr TyNode],[TyNode])),
+    (tagArrow,([tyDNode, tyDNode],[TyNode])),
+    (funcEval, ([tyINode],[tyDNode])),
hunk ./Grin/FromE.hs 302
-    conv (EVar v) = Var (cafNum v) (TyPtr TyNode)
+    conv e@(EVar v) | isLifted e = Var (cafNum v) tyINode
+                    | otherwise = Var (cafNum v) tyDNode
hunk ./Grin/FromE.hs 334
+    let v = toVal tvr
+    if getType v == tyDNode then return $ Return [v] else do
hunk ./Grin/FromE.hs 367
-        return (Fetch (toVal tvr))
+        return (Return $ keepIts [toVal tvr])
+        --return (Fetch (toVal tvr))
hunk ./Grin/FromE.hs 389
-                    app fty (Fetch $ toVal tvr) as
+                    app fty (Return [toVal tvr]) as
hunk ./Grin/FromE.hs 404
-        -- holes - are these still useful?
---        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 414
-            --return $ Store v'
hunk ./Grin/FromE.hs 471
-    --        Operator n as r | Just _ <- fromRawType ty -> do
-    --            let p = prim { primType = ((map (Ty . toAtom) as),Ty (toAtom r)) }
-    --            return $ Prim p (args xs)
hunk ./Grin/FromE.hs 505
-            (_,_) -> localEvaled [b] v $ do
+            (_,_) | isLifted scrut -> localEvaled [b] v $ do
hunk ./Grin/FromE.hs 509
+            (_,_) | otherwise -> do
+                    as <- mapM cp as
+                    def <- createDef d newNodeVar
+                    return $ e :>>= [toVal b] :-> Case v (as ++ def)
hunk ./Grin/FromE.hs 552
---    app' (Const (NodeC t cs)) (a:as) | tagIsPartialAp t = do
---        let Just (n,frs) = tagUnfunction t
---            lazy = do
---                mtick "Grin.FromE.lazy-app-const"
---                app' (Const (NodeC (partialTag frs (n - 1)) (cs ++ [a]))) as
---        case a of
---            Const {} -> lazy
---            Lit {} -> lazy
---            Var (V n) _ | n < 0 -> lazy
---            _ -> do
---                mtick "Grin.FromE.lazy-app-store"
---                tpv <- newNodePtrVar
---                x <- app' tpv as
---                return $ Store  (NodeC (partialTag frs (n - 1)) (cs ++ [a])) :>>= tpv :-> x
hunk ./Grin/FromE.hs 575
-    cc e | Just [z] <- con e = return (Store z)
+    cc e | Just [z] <- con e = return $ if isLifted e then Store z else Return [z]
hunk ./Grin/FromE.hs 623
-            return $ (e :>>= [z] :-> Store z) :>>= [toVal t] :-> v
+            return $ (e :>>= [z] :-> Return [z]) :>>= [toVal t] :-> v
hunk ./Grin/FromE.hs 680
-                         , t <- partialTag v (length as), tagIsWHNF t = return $ Const $ NodeC t []
+                         , t <- partialTag v (length as), tagIsWHNF t = if isLifted (EVar tvr) then return $ Const $ NodeC t [] else return (NodeC t [])
hunk ./Grin/FromE.hs 683
-    constant (ELit lc@LitCons { litName = n, litArgs = es }) | Just es <- mapM constant es, Just nn <- getName lc = (return $ Const (NodeC nn (keepIts es)))
-    constant (EPi (TVr { tvrIdent = 0, tvrType = a}) b) | Just a <- constant a, Just b <- constant b = return $ Const $ NodeC tagArrow [a,b]
+    constant e@(ELit lc@LitCons { litName = n, litArgs = es }) | Just es <- mapM constant es, Just nn <- getName lc = if isLifted e
+        then return $ Const (NodeC nn (keepIts es))
+        else return (NodeC nn (keepIts es))
+    constant (EPi (TVr { tvrIdent = 0, tvrType = a}) b) | Just a <- constant a, Just b <- constant b = return $ NodeC tagArrow [a,b]
hunk ./Grin/HashConst.hs 39
+            g n@NodeC {} = liftM (Right . snd) $ f n
hunk ./Main.hs 711
+
hunk ./Main.hs 713
-    lintCheckGrin x
+    x <- Grin.SSimplify.simplify x
+    --x <- transformGrin simplifyParms x
+
hunk ./Main.hs 721
+
hunk ./Main.hs 723
-    lintCheckGrin x
+    --x <- transformGrin simplifyParms x
+
hunk ./Main.hs 726
-    lintCheckGrin x
+    --lintCheckGrin x
hunk ./Main.hs 728
---    x <- return $ normalizeGrin x
hunk ./Main.hs 737
-    --x <- return $ normalizeGrin x
-    --x <- unboxReturnValues x
+
hunk ./Main.hs 927
-
-
-
hunk ./Main.hs 934
-
-
hunk ./Main.hs 937
-
-
-
-
-
-
-