idCase test

This commit is contained in:
crumbtoo
2023-12-14 14:04:51 -07:00
parent eaac7ad7a3
commit 1d5af748b3
3 changed files with 14 additions and 2 deletions

View File

@@ -8,6 +8,7 @@ module Core.Examples
( fac3
, sumList
, constDivZero
, idCase
) where
----------------------------------------------------------------------------------
import Core.Syntax
@@ -181,6 +182,15 @@ constDivZero = [coreProg|
main = k 3 ((/#) 1 0);
|]
idCase :: Program'
idCase = [coreProg|
id x = x;
main = id (case Pack{1 0} of
{ 1 -> (+#) 2 3
})
|]
corePrelude :: Module Name
corePrelude = Module (Just ("Prelude", [])) $
-- non-primitive defs

View File

@@ -46,8 +46,7 @@ type Floater = StateT [Name] (Writer [ScDef'])
runFloater :: Floater a -> (a, [ScDef'])
runFloater = flip evalStateT ns >>> runWriter
where
-- TODO: safer, uncapturable names
ns = [ "nonstrict_case_" ++ showHex n "" | n <- [0..] ]
ns = [ "$nonstrict_case_" ++ showHex n "" | n <- [0..] ]
-- TODO: formally define a "strict context" and reference that here
-- the returned ScDefs are guaranteed to be free of non-strict cases.

View File

@@ -36,3 +36,6 @@ spec = do
it "k 3 ((/#) 1 0)" $ do
resultOf Ex.constDivZero `shouldBe` Just (NNum 3)
it "id (case ... of { ... })" $ do
resultOf Ex.idCase `shouldBe` Just (NNum 5)