[start adding real array support to grin, add Index value constructor
John Meacham <john@repetae.net>**20061116065635] hunk ./C/FromGrin.hs 26
+import Grin.Val
hunk ./C/FromGrin.hs 73
+--convertVal (Index x y) = do
+--    x <- convertVal x
+--    y <- convertVal y
+--    return $ indexArray x y
hunk ./C/FromGrin.hs 126
+convertExp (Fetch (Index base off)) | getType base == TyPtr (TyPtr TyNode) = do
+    base <- convertVal base
+    off <- convertVal off
+    return (mempty,indexArray base off)
hunk ./C/FromGrin.hs 149
+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)
hunk ./C/FromGrin.hs 182
+convertExp (Update (Index base off) z) | getType z == TyPtr TyNode = do
+    base <- convertVal base
+    off <- convertVal off
+    z' <- convertVal z
+    return $ (indexArray base off `assign` z',emptyExpression)
hunk ./C/FromGrin.hs 190
-    let tag = project' anyTag z'
hunk ./C/Generate.hs 20
+    indexArray,
hunk ./C/Generate.hs 34
+    forLoop,
hunk ./C/Generate.hs 170
+indexArray :: Expression -> Expression -> Expression
+indexArray w i = expD (pdraw w <> char '[' <> pdraw i <> char ']')
+
hunk ./C/Generate.hs 316
+
+forLoop :: Expression -> Expression -> Expression -> Statement -> Statement
+forLoop i from to body = sd $ do
+    i <- draw i
+    from <- draw from
+    to <- draw to
+    body <- draw body
+    return $ text "for" <> parens (i <+> equals <+> from <> semi <+> i <> text "++" <> semi <+> i <+> text "<" <+> to) <+> lbrace <$> nest 4 body <$> rbrace
+
+
hunk ./Grin/DeadCode.hs 120
-            g (Update vv@(Var v _) n@(~(NodeC x vs)))
-                | v < v0 = do
-                    v' <- supplyValue usedCafs v
-                    addRule $ conditionalRule id v' $ doNode n
-                | otherwise = addRule $ (doNode vv) `mappend` (doNode n)
+            g (Update (Var v _) n) | v < v0 = do
+                v' <- supplyValue usedCafs v
+                addRule $ conditionalRule id v' $ doNode n
+            g (Update vv@(Index (Var v _) r) n) | v < v0 = do
+                v' <- supplyValue usedCafs v
+                addRule (doNode r)
+                addRule $ conditionalRule id v' $ doNode n
+            g (Update vv n) = addRule $ (doNode vv) `mappend` (doNode n)
hunk ./Grin/DeadCode.hs 130
+            g Alloc { expValue = v, expCount = c, expRegion = r } = addRule $ doNode v `mappend` doNode c `mappend` doNode r
hunk ./Grin/DeadCode.hs 143
+            h (p,Alloc { expValue = v, expCount = c, expRegion = r }) = addRule $ mconcat $ [ conditionalRule id  (varValue pv) (doNode v `mappend` doNode c `mappend` doNode r) | pv <- freeVars p]
hunk ./Grin/DeadCode.hs 213
-    clearCaf (Const a) = do
-        a <- clearCaf a
-        return $ Const a
+    clearCaf (Index a b) = return Index `ap` clearCaf a `ap` clearCaf b
+    clearCaf (Const a) = Const `liftM` clearCaf a
hunk ./Grin/FromE.hs 399
+
+    -- arrays
+    ce (EPrim ap@(APrim (PrimPrim "newMutArray__") _) [v,def,_] _) = do
+        let [v',def'] = args [v,def]
+        return $ Alloc { expValue = def', expCount = v', expRegion = region_heap, expInfo = mempty }
+    ce (EPrim ap@(APrim (PrimPrim "newBlankMutArray__") _) [v,_] _) = do
+        let [v'] = args [v]
+        return $ Alloc { expValue = ValUnknown (TyPtr TyNode), expCount = v', expRegion = region_heap, expInfo = mempty }
+    ce (EPrim ap@(APrim (PrimPrim "readArray__") _) [r,o,_] _) = do
+        let [r',o'] = args [r,o]
+        return $ Fetch (Index r' o')
+    ce (EPrim ap@(APrim (PrimPrim "indexArray__") _) [r,o] _) = do
+        let [r',o'] = args [r,o]
+        return $ Fetch (Index r' o')
+    ce (EPrim ap@(APrim (PrimPrim "writeArray__") _) [r,o,v,_] _) = do
+        let [r',o',v'] = args [r,o,v]
+        return $ Update (Index r' o') v'
+
+    ce (EPrim ap@(APrim (PrimPrim ft) _) [v,_] _) | ft `elem` ["unsafeFreezeArray__", "unsafeThawArray__"] = do
+        let [v'] = args [v]
+        return $ Return v'
hunk ./Grin/Grin.hs 183
+    | Index Val Val           -- ^ A pointer incremented some number of values (Index v 0) == v
hunk ./Grin/Grin.hs 271
+    showsPrec _ (Index v o) = shows v <> char '[' <> shows o <> char ']'
hunk ./Grin/Grin.hs 552
+    typecheck te (Index v offset) = do
+        t <- typecheck te v
+        Ty _ <- typecheck te offset
+        return t
hunk ./Grin/Grin.hs 587
+    getType (Index v _) = getType v
hunk ./Grin/Grin.hs 609
+    freeVars (Index a b) = freeVars (a,b)
hunk ./Grin/Grin.hs 618
+    freeVars (Index a b) = freeVars (a,b)
hunk ./Grin/Grin.hs 677
+    freeVars (Index a b) = freeVars (a,b)
hunk ./Grin/Grin.hs 722
+valToItem (Index v _) = valToItem v
hunk ./Grin/Linear.hs 64
+    h (Fetch (Index (Var v _) _)) = eval v -- XXX can this be weakened?
hunk ./Grin/Linear.hs 68
+    h Alloc { expValue = NodeC a vs } | tagIsSuspFunction a =  fuse (tagFlipFunction a) vs
hunk ./Grin/Linear.hs 72
+    h Alloc { expValue = NodeC a vs } = mapM_ omegaize vs
hunk ./Grin/Linear.hs 79
+    h Alloc {} = return ()
hunk ./Grin/Noodle.hs 94
+valIsConstant (Index v t) = valIsConstant v && valIsConstant t
hunk ./Grin/PointsToAnalysis.hs 495
+    f (Alloc { expValue = val } :>>= var@(Var v _) :-> exp2) = do
+        p <- toPos val
+        lmap <- ask
+        p' <- if Map.lookup v lmap == Just One then newHeap UnsharedEval p else newHeap SharedEval p
+        bind var p'
+        f exp2
hunk ./Grin/PointsToAnalysis.hs 544
+    g (Alloc { expValue = val }) = do
+        v <- toPos val
+        newHeap SharedEval v
hunk ./Grin/PointsToAnalysis.hs 597
+toPos (Index v _) = toPos v
hunk ./Grin/Show.hs 122
+prettyVal (Index p off) = prettyVal p <> char '[' <> prettyVal off <> char ']'
hunk ./Grin/Val.hs 1
-module Grin.Val(FromVal(..),ToVal(..),tn_2Tup,world__,pworld__,valToList,convertName,region_heap) where
+module Grin.Val(FromVal(..),ToVal(..),tn_2Tup,valToList,convertName,region_heap) where
hunk ./Grin/Val.hs 26
-world__ = NodeC (toAtom "World#") []
-pworld__ = Const world__
-
hunk ./Grin/Whiz.hs 211
+    f (Index a b) = return Index `ap` f a `ap` f b
hunk ./Grin/Whiz.hs 235
+    f (Index a b) = return Index `ap` f a `ap` f b
hunk ./lib/base/Jhc/Array.hs 32
-        f :: MutArray__ a -> World__ -> [(Int,a)] -> Array__ a
-        f arr w [] = case unsafeFreezeArray__ arr w  of (# _, r #) -> r
+        f :: MutArray__ a -> World__ -> [(Int,a)] -> World__
+        f arr w [] = w
hunk ./lib/base/Jhc/Array.hs 35
-            in f arr w xs
+            in case f arr w xs of w -> case unsafeFreezeArray__ arr w  of (# _, r #) -> r