Merge pull request #21 from well-typed/edsko/unfolder-episode-13

Examples for Unfolder episode 13

.gitignore

@@ -6,3 +6,4 @@ dist-newstyle/
 .cabal-sandbox
 .stack-work
 .cabal.sandbox.config
+.envrc

examples/open_rec_version0.hs

@@ -0,0 +1,15 @@
+object = (\f -> f (@object f))
+
+mkCounter = (\this -> \n ->
+      Counter (this (add 1 n)) n
+    )
+
+tick = (\c -> case c of {
+      Counter t d -> t
+    })
+
+value = (\c -> case c of {
+      Counter t d -> d
+    })
+
+main = @value (@tick (@tick (@object @mkCounter 0)))

examples/open_rec_version1.hs

@@ -0,0 +1,20 @@
+object = (\f -> f (@object f))
+
+mkCounter = (\this -> \n ->
+      Counter (this (add 1 n)) n
+    )
+
+faster = (\this -> \n ->
+      let c = @mkCounter this n
+      in Counter (this (add 2 n)) (@value c)
+    )
+
+tick = (\c -> case c of {
+      Counter t d -> t
+    })
+
+value = (\c -> case c of {
+      Counter t d -> d
+    })
+
+main = @value (@tick (@tick (@object @faster 0)))

examples/open_rec_version2.hs

@@ -0,0 +1,24 @@
+object = (\f -> f undefined (@object f))
+
+mkCounter = (\super -> \this -> \n ->
+      Counter (this (add 1 n)) n
+    )
+
+faster = (\super -> \this -> \n ->
+      let c = super n
+      in Counter (this (add 2 n)) (@value c)
+    )
+
+tick = (\c -> case c of {
+      Counter t d -> t
+    })
+
+value = (\c -> case c of {
+      Counter t d -> d
+    })
+
+mixin = (\f -> \g -> \super -> \this ->
+      f (g super this) this
+    )
+
+main = @value (@tick (@tick (@object (@mixin @faster @mkCounter) 0)))

minimal.html

@@ -9,7 +9,6 @@
 <table width="100%" border="1" cellpadding="5" style="border-collapse: collapse;">
 <tr><td><div style="font-family: monospace;" id="cbn_term">Term</div></td></tr>
 <tr><td><div style="font-family: monospace;" id="cbn_heap">Heap</div></td></tr>
-<tr><td><div id="cbn_graph">Graph</div></td></tr>
 </table>
 
 <script type="text/javascript" src="foo.js"></script>

src/CBN/Options.hs

@@ -77,6 +77,10 @@ parseSummarizeOptions = SummarizeOptions
              long "hide-prelude"
            , help "Hide the prelude from the help"
            ])
+    <*> (many $ option str $ mconcat [
+             long "hide-term"
+           , help "Hide specific term from the prelude (can be used multiple times)"
+           ])
     <*> (switch $ mconcat [
              long "hide-gc"
            , help "Hide GC steps"

src/CBN/Trace.hs

@@ -66,6 +66,7 @@ data SummarizeOptions = SummarizeOptions {
       summarizeCollapseBeta :: Bool
     , summarizeMaxNumSteps  :: Int
     , summarizeHidePrelude  :: Bool
+    , summarizeHideTerms    :: [String]
     , summarizeHideGC       :: Bool
     }
   deriving (Show)
@@ -103,12 +104,12 @@ summarize SummarizeOptions{..} = go 0
 
     -- | Cleanup the heap
     goHeap :: Heap Term -> Heap Term
-    goHeap (Heap next heap) = Heap next $
-      if not summarizeHidePrelude
-        then heap
-        else Map.filterWithKey (\ptr -> not . isPrelude ptr) heap
-
-    -- | Does this entry in the heap come from the prelude?
-    isPrelude :: Ptr -> Term -> Bool
-    isPrelude (Ptr Nothing (Just _)) _ = True
-    isPrelude _ _ = False
+    goHeap (Heap next heap) =
+        Heap next $ Map.filterWithKey shouldShow heap
+      where
+        shouldShow :: Ptr -> Term -> Bool
+        shouldShow (Ptr Nothing (Just name)) _ = and [
+              not summarizeHidePrelude
+            , not (name `elem` summarizeHideTerms)
+            ]
+        shouldShow (Ptr _ _) _ = True