iterate failing

Author: vidsinghal

gibbon-compiler/examples/layout_bench/GenerateLayout1.hs

@@ -15,8 +15,8 @@ mkBlogs_layout1 length =
           id     = (ID (10 - (mod length 10)))
           author = (Author (getRandomString 5))
           date   =  (Date (getRandomString 5))
-          content = (Content (Plain (mkRandomInlineList 5)))
-          tags    = (TagList (mkSomeTags 50))
+          content = (Content (Plain (mkRandomInlineList 50)))
+          tags    = (TagList (mkSomeTags 10))
           rst     = (mkBlogs_layout1 (length - 1))
          in Layout1 header id author date content tags rst
 

gibbon-compiler/examples/layout_bench/manyFuncs.hs

@@ -28,12 +28,11 @@ filterByKeywordInTagList keyword blogs = case blogs of
 emphKeywordInTag :: Text -> Blog -> Blog
 emphKeywordInTag keyword blogs = case blogs of 
                                     End -> End
-                                    Layout1 header id author date content tags rst -> let present = iterate (searchBlogTags keyword tags)
+                                    Layout1 header id author date content tags rst -> let present = searchBlogTags keyword tags
                                                                                           in if (present) 
-                                                                                             then let --newContent  = iterate (emphasizeBlogContent keyword content)
-                                                                                                      newContent = case content of 
+                                                                                             then let newContent  = case content of 
                                                                                                                          Content block -> Content (emphasizeKeywordInBlock keyword block) 
-                                                                                                      newRst      = iterate (emphKeywordInTag keyword rst)
+                                                                                                      newRst      = emphKeywordInTag keyword rst
                                                                                                     in Layout1 header id author date newContent tags newRst
                                                                                              else
                                                                                                let newRst = emphKeywordInTag keyword rst
@@ -42,10 +41,10 @@ emphKeywordInTag keyword blogs = case blogs of
 
 -- main function 
 gibbon_main = 
-   let blogs = mkBlogs_layout1 1000000
+   let blogs = mkBlogs_layout1 2
        keyword :: Vector Char  
        keyword = "a"
-       newblgs   = iterate (emphKeywordInContent keyword blogs)
-       newblgs'  = iterate (emphKeywordInTag keyword newblgs) 
-       newblgs'' = iterate (filterByKeywordInTagList keyword newblgs')
-   in () --printPacked newblgs''
+       newblgs   = emphKeywordInContent keyword blogs
+       newblgs'  = emphKeywordInTag keyword newblgs 
+       newblgs'' = filterByKeywordInTagList keyword newblgs'
+   in printPacked newblgs''

gibbon-compiler/examples/test_iterate.hs

@@ -0,0 +1,29 @@
+
+
+data List = Cons Int List | Nil 
+
+addOneList :: List -> List 
+addOneList lst = case lst of 
+		Nil -> Nil 
+		Cons x rst -> let newVal = iterate (addOne x)  
+ 				  newRst = addOneList rst  
+                                in Cons newVal newRst   
+
+
+length :: List -> Int 
+length lst = case lst of 
+		Nil -> 0 
+		Cons x rst -> 1 + length rst
+
+addOne :: Int -> Int 
+addOne x = x + 1
+
+
+mkList :: Int -> List 
+mkList len = if len <= 0 then Nil 
+	     else Cons len (mkList (len-1))
+
+
+
+
+gibbon_main = length (addOneList (mkList 10)) 

gibbon-compiler/src/Gibbon/Passes/AccessPatternsAnalysis.hs

@@ -84,7 +84,7 @@ getGreedyOrder edges fieldLength =
                   completeOrder = P.foldl (\lst val -> if S.member val (S.fromList lst) then lst
                                                  else lst ++ [val]
                                     ) partial_order [0 .. (fieldLength - 1)]
-                in P.map P.toInteger completeOrder --dbgTraceIt (sdoc (edges, completeOrder)) P.map P.toInteger completeOrder
+                in dbgTraceIt (sdoc (edges, completeOrder)) P.map P.toInteger completeOrder
 
 greedyOrderOfVertices :: [((Integer, Integer), Integer)] -> [Int]
 greedyOrderOfVertices ee = let     edges' = P.map (\((a, b), c) -> ((P.fromIntegral a, P.fromIntegral b), P.fromIntegral c)) ee
@@ -244,7 +244,7 @@ freeVarsInOrder exp =
           var_list = L.concat var_list_list
        in var_list
     ProjE i e -> error "freeVarsInOrder: TODO ProjE"
-    TimeIt e ty b -> freeVarsInOrder e
+    TimeIt e ty b -> error "freeVarsInOrder: TODO TimeIt"
     WithArenaE v e -> error "freeVarsInOrder: TODO WithArenaE"
     SpawnE f locs args -> error "freeVarsInOrder: TODO SpawnE"
     SyncE -> error "freeVarsInOrder: TODO SyncE"

gibbon-compiler/src/Gibbon/Passes/OptimizeADTLayout.hs

@@ -165,7 +165,7 @@ dataConsInFunBody funBody = case funBody of
             IfE a b c -> S.unions $ [dataConsInFunBody a] ++ [dataConsInFunBody b] ++ [dataConsInFunBody c]
             MkProdE xs -> S.unions $ P.map dataConsInFunBody xs
             ProjE i e -> error "getGeneratedVariable: TODO ProjE"
-            TimeIt e ty b -> dataConsInFunBody e
+            TimeIt e ty b -> error "getGeneratedVariable: TODO TimeIt"
             WithArenaE v e -> error "getGeneratedVariable: TODO WithArenaE"
             SpawnE f locs args -> error "getGeneratedVariable: TODO SpawnE"
             SyncE -> error "getGeneratedVariable: TODO SyncE"
@@ -611,7 +611,7 @@ changeCallNameInRecFunction
           IfE a b c -> IfE (fixExp a) (fixExp b) (fixExp c)
           MkProdE xs -> MkProdE (P.map fixExp xs)
           ProjE i e -> error "getExpTyEnv: TODO ProjE"
-          TimeIt e ty b -> TimeIt (fixExp e) ty b
+          TimeIt e ty b -> error "getExpTyEnv: TODO TimeIt"
           WithArenaE v e -> error "getExpTyEnv: TODO WithArenaE"
           SpawnE f locs args -> error "getExpTyEnv: TODO SpawnE"
           SyncE -> error "getExpTyEnv: TODO SyncE"
@@ -1492,8 +1492,7 @@ reOrderLetExpHelper (Just var) letExpOrder expr = fst $ run letExpOrder expr
           MkProdE xs -> let (xs', releasedBinds) = lambdaHandleExpList xs letExpOrder'
                           in (MkProdE xs', releasedBinds)
           ProjE {} -> error "reOrderLetExpHelper: TODO ProjE"
-          TimeIt e ty b -> let (e', releasedBinds) = run letExpOrder' e  
-                         in (TimeIt e' ty b, releasedBinds)
+          TimeIt {} -> error "reOrderLetExpHelper: TODO TimeIt"
           WithArenaE {} -> error "reOrderLetExpHelper: TODO WithArenaE"
           SpawnE {} -> error "reOrderLetExpHelper: TODO SpawnE"
           SyncE -> error "reOrderLetExpHelper: TODO SyncE"

gibbon-compiler/tests/test-gibbon-examples.yaml

@@ -915,3 +915,6 @@ tests:
     answer-file: examples/layout_bench/manyFuncsGlobal.ans
     failing: [interp1,pointer,gibbon1, gibbon3]
     run-modes: ["gibbon2"]
+
+  - name: test_iterate.hs
+    skip: true