[declare a lot more variables in local scope, declare local scope in more places.
John Meacham <john@repetae.net>**20070517222722] hunk ./C/FromGrin2.hs 32
+import Util.SetLike
hunk ./C/FromGrin2.hs 41
-data Todo = TodoReturn | TodoExp Expression | TodoNothing
+data Todo = TodoReturn | TodoExp Expression | TodoNothing  | TodoDecl Name Type
hunk ./C/FromGrin2.hs 55
+    rInscope :: Set.Set Name,
hunk ./C/FromGrin2.hs 67
-runC grin (C m) =  execUniq1 (runRWST m Env { rGrin = grin, rTodo = TodoNothing, rEMap = mempty } emptyHcHash)
+runC grin (C m) =  execUniq1 (runRWST m Env { rGrin = grin, rTodo = TodoNothing, rEMap = mempty, rInscope = mempty } emptyHcHash)
hunk ./C/FromGrin2.hs 125
-    return $ (localVariable t (varName v))
+    is <- asks rInscope
+    let n = varName v
+    return $ if n `member` is then variable n else localVariable t n
hunk ./C/FromGrin2.hs 129
+fetchVar' :: Var -> Ty -> C (Name,Type)
+fetchVar' (V n) _ | n < 0 = error "fetchVar': CAF"
+fetchVar' v ty = do
+    t <- convertType ty
+    return $ (varName v,t)
hunk ./C/FromGrin2.hs 151
-            return $ variable (name $  'c':show i )
+            return $ f_PROMOTE (variable (name $  'c':show i ))
hunk ./C/FromGrin2.hs 208
-        let nm = (toName (show name ++ show u))
+        let nm = (toName (show name ++ "_" ++ show u))
hunk ./C/FromGrin2.hs 216
-       return (annotate (show as) (label (toName (show name ++ show u))) & subBlock ss)
+       return (annotate (show as) (label (toName (show name ++ "_" ++ show u))) & subBlock ss)
hunk ./C/FromGrin2.hs 218
-convertBody (e :>>= v@(Var _ _) :-> e') = do
-    v' <- convertVal v
-    ss <- localTodo (TodoExp v')  (convertBody e)
-    ss' <- convertBody e'
-    return (ss & ss')
hunk ./C/FromGrin2.hs 328
+        TodoDecl {} -> return jerr
hunk ./C/FromGrin2.hs 333
-convertBody (Store  n@NodeC {})  = newNode n >>= \(x,y) -> simpleRet (cast sptr_t y) >>= \v -> return (x & v)
-convertBody (Return n@NodeC {})  = newNode n >>= \(x,y) -> simpleRet (cast wptr_t y) >>= \v -> return (x & v)
+convertBody (Store  n@NodeC {})  = newNode sptr_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)
+
+--convertBody (Store  n@NodeC {} :>>= (Var vn vt) :-> e') = do
+--    (x,y) <- newNode sptr_t n
+--    (vn,vt) <- fetchVar' vn vt
+--    d <- newAssignVar vt vn y
+--    e'' <- convertBody e'
+--    return (x & d & e'')
+
+convertBody (e :>>= (Var vn vt) :-> e') | not $ isCompound e = do
+    (vn,vt) <- fetchVar' vn vt
+    ss <- localTodo (TodoDecl vn vt) (convertBody e)
+    ss' <- local (rInscope_u (Set.insert vn)) $ convertBody e'
+    return (ss & ss')
+
+convertBody (e :>>= v@(Var _ _) :-> e') = do
+    v' <- convertVal v
+    ss <- localTodo (TodoExp v')  (convertBody e)
+    ss' <- convertBody e'
+    return (ss & ss')
hunk ./C/FromGrin2.hs 389
+        TodoDecl n t -> do newAssignVar t n er
hunk ./C/FromGrin2.hs 401
+isCompound Fetch {} = False
+isCompound Return {} = False
+isCompound Store {} = False
+isCompound Prim {} = False
+--isCompound App {} = False
+--isCompound Call {} = False
+isCompound _ = True
+
hunk ./C/FromGrin2.hs 447
-        (nns, nn) <- newNode tn
-        return (nns & getHead (f_NODEP(f_DETAG v')) =* cast fptr_t nn,emptyExpression)
+        (nns, nn) <- newNode fptr_t tn
+        return (nns & getHead (f_NODEP(f_DETAG v')) =* nn,emptyExpression)
hunk ./C/FromGrin2.hs 565
+{-
+newNode ty node = do
+    u <- newUniq
+    let n = name $ 'x':show u
+    d <- newVarNode ty n node
+    return (d,localVariable ty n)
+-}
hunk ./C/FromGrin2.hs 573
-newNode (NodeC t _) | t == tagHole = do
-    fail "newNode.tagHole"
-newNode (NodeC t as) = do
+newNode ty (NodeC t as) = do
hunk ./C/FromGrin2.hs 581
-        --tmp <- newVar (if sf then sptr_t else wptr_t)
hunk ./C/FromGrin2.hs 587
-        (dtmp,tmp) <- (if sf then sptr_t else wptr_t) `newTmpVar` malloc
+        (dtmp,tmp) <- ty `newTmpVar` malloc
hunk ./C/FromGrin2.hs 595
-{-
-
-newNode (NodeC t as) | tagIsSuspFunction t = do
-    en <- declareEvalFunc t
-    st <- nodeType t
-    as' <- mapM convertVal as
-    tmp <- newVar sptr_t
-    let tmp' = concrete t tmp
-        malloc =  tmp =* jhc_malloc (sizeof st)
-        tagassign = getTag tmp' =* f_EVALTAG (reference (variable en))
-        ass = [ if isValUnknown aa then mempty else project' i tmp' =* a | a <- as' | aa <- as | i <- map arg [(1 :: Int) ..] ]
-        nonPtr TyPtr {} = False
-        nonPtr TyNode = False
-        nonPtr (TyTup xs) = all nonPtr xs
-        nonPtr _ = True
-        tmp'' = f_EVALTAG tmp
-    return (mconcat $ malloc:tagassign:ass, cast sptr_t tmp'')
-newNode (NodeC t as) | tagIsWHNF t = do -- && not (tagIsPartialAp t) = do
-    st <- nodeType t
-    tell mempty { wTags = Set.singleton t }
-    declareStruct t
-    as' <- mapM convertVal as
-    tmp <- newVar wptr_t
-    let tmp' = concrete t tmp
-        wmalloc = if all (nonPtr . getType) as then jhc_malloc_atomic else jhc_malloc
-        malloc =  tmp =* wmalloc (sizeof st)
-        tagassign = getTag tmp' =* constant (enum $ nodeTagName t)
-        wmalloc = if tagIsWHNF t && all (nonPtr . getType) as then jhc_malloc_atomic else jhc_malloc
-        ass = [ if isValUnknown aa then mempty else project' i tmp' =* a | a <- as' | aa <- as | i <- map arg [(1 :: Int) ..] ]
-        nonPtr TyPtr {} = False
-        nonPtr TyNode = False
-        nonPtr (TyTup xs) = all nonPtr xs
-        nonPtr _ = True
-    return (mconcat $ malloc:tagassign:ass, tmp)
-newNode e = return (err (show e),err "newNode")
-
--}
hunk ./C/FromGrin2.hs 681
+f_PROMOTE e   = functionCall (name "PROMOTE") [e]
hunk ./C/FromGrin2.hs 769
-{-
-convertExp (Store n@NodeV {}) = newNode n
-convertExp (Return n@NodeV {}) = newNode n
-convertExp (Store n@NodeC {}) = newNode n
-convertExp (Return n@NodeC {}) = newNode n
-
-convertExp (Store n@Var {}) | getType n == TyNode = do
-    (ss,nn) <- newNode (NodeC tagHole [])
-    tmp <- newVar pnode_t
-    n <- convertVal n
-    let tag = project' anyTag n
-        update = expr (functionCall (name "memcpy") [tmp,n,functionCall  (name "jhc_sizeof") [tag]])
-    return (ss `mappend` (tmp `assign` nn) `mappend` update, tmp)
-convertExp Alloc { expValue = v, expCount = c, expRegion = r } | r == region_heap, TyPtr TyNode == getType v  = do
-    v' <- convertVal v
-    c' <- convertVal c
-    tmp <- newVar ppnode_t
-    let malloc = tmp `assign` jhc_malloc (operator "*" (sizeof pnode_t) c')
-    fill <- case v of
-        ValUnknown _ -> return mempty
-        _ -> do
-            i <- newVar (basicType "int")
-            return $ forLoop i (expressionRaw "0") c' $ indexArray tmp i `assign` v'
-    return (malloc `mappend` fill, tmp)
-convertExp e@(Update v z) | getType v /= TyPtr (getType z) = do
-    return (err (show e),err "nothing")
-convertExp (Update v z) | getType z == TyNode = do  -- TODO eliminate unknown updates
-    v' <- convertVal v
-    z' <- convertVal z
-    let tag = project' anyTag z'
-    return $ (profile_update_inc,functionCall (name "memcpy") [v',z',functionCall  (name "jhc_sizeof") [tag]])
-convertExp e = return (err (show e),err "nothing")
-newNode (NodeV t []) = do
-    tmp <- newVar pnode_t
-    var <- fetchVar t TyTag
-    let tmp' = getTag tmp
-        malloc =  tmp =* jhc_malloc (sizeof  node_t)
-        tagassign = tmp' =* var
-    return (mappend malloc tagassign, tmp)
-
--}
-{-
-convertBody (Return v :>>= (NodeV t []) :-> e') = nodeAssignV v t e'
-convertBody (Fetch v :>>= (NodeV t []) :-> e') = nodeAssignV v t e'
--}
-
hunk ./C/Generate.hs 34
+    newAssignVar,
hunk ./C/Generate.hs 165
-        sc (Just x,ss) = do ss <- draw ss ; x <- draw x; return $ text "case" <+> x <> char ':' $$ nest 4 (ss $$ text "break;")
-        sc (Nothing,ss) = do ss <- draw ss; return $ text "default:"  $$  ( nest 4 ss $$ text "break;")
+        sc (Just x,ss) = do ss <- draw (SBlock ss); x <- draw x; return $ text "case" <+> x <> char ':' $$ nest 4 (ss $$ text "break;")
+        sc (Nothing,ss) = do ss <- draw (SBlock ss); return $ text "default:"  $$  ( nest 4 ss $$ text "break;")
hunk ./C/Generate.hs 255
-    f (SGoto l) y@(SLabel l') | l == l' = Just y
+    f (SGoto l) y@(SLabel l')
+        | l == l' = Just y
+        | otherwise = Nothing
hunk ./C/Generate.hs 352
+
hunk ./C/Generate.hs 362
+newAssignVar t n e = do
+    let d = sd $ do
+            va <- draw (variable n `assign` e)
+            t <- draw t
+            return $ t <+> va
+    return d
hunk ./data/jhc_rts2.c 14
+#define PROMOTE(n)   ((wptr_t)(n))
+#define DEMOTE(n)    ((sptr_t)(n))