Skip to content

Commit

Permalink
Examples for Unfolder episode 13
Browse files Browse the repository at this point in the history
This also adds a `--hide-term` command line option for hiding specific terms
from the prelude.
  • Loading branch information
edsko committed Oct 26, 2023
1 parent 0b6ab38 commit f4069b2
Show file tree
Hide file tree
Showing 7 changed files with 74 additions and 10 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -6,3 +6,4 @@ dist-newstyle/
.cabal-sandbox
.stack-work
.cabal.sandbox.config
.envrc
15 changes: 15 additions & 0 deletions examples/open_rec_version0.hs
Original file line number Diff line number Diff line change
@@ -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)))
20 changes: 20 additions & 0 deletions examples/open_rec_version1.hs
Original file line number Diff line number Diff line change
@@ -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)))
24 changes: 24 additions & 0 deletions examples/open_rec_version2.hs
Original file line number Diff line number Diff line change
@@ -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)))
1 change: 0 additions & 1 deletion minimal.html
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
4 changes: 4 additions & 0 deletions src/CBN/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
19 changes: 10 additions & 9 deletions src/CBN/Trace.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,7 @@ data SummarizeOptions = SummarizeOptions {
summarizeCollapseBeta :: Bool
, summarizeMaxNumSteps :: Int
, summarizeHidePrelude :: Bool
, summarizeHideTerms :: [String]
, summarizeHideGC :: Bool
}
deriving (Show)
Expand Down Expand Up @@ -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

0 comments on commit f4069b2

Please sign in to comment.