replacing known values in output now (pretty sick)
This commit is contained in:
jackjohn7
parent
9d209fee17
commit
3046beaef2
6 changed files with 276 additions and 7 deletions
12
lamb.cabal
12
lamb.cabal
|
|
@ -14,8 +14,9 @@ executable lamb
|
|||
main-is: Main.hs
|
||||
other-modules: Parser,
|
||||
Evaluation,
|
||||
Bruijn
|
||||
build-depends: base, containers, parsec
|
||||
Bruijn,
|
||||
Niceties
|
||||
build-depends: base, bimap, containers, parsec
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
@ -27,7 +28,10 @@ test-suite lamb-tests
|
|||
ParserSpec,
|
||||
Evaluation,
|
||||
EvaluationSpec,
|
||||
BruijnSpec
|
||||
build-depends: base, containers, hspec, parsec
|
||||
Bruijn,
|
||||
BruijnSpec,
|
||||
Niceties,
|
||||
NicetiesSpec
|
||||
build-depends: base, bimap, containers, hspec, parsec
|
||||
build-tool-depends: hspec-discover:hspec-discover
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
module Main where
|
||||
|
||||
import Evaluation (run)
|
||||
import Niceties (replaceKnowns)
|
||||
import Parser (parse)
|
||||
import System.Environment (getArgs)
|
||||
import System.IO (IOMode (ReadMode), hGetContents, openFile)
|
||||
|
|
@ -15,5 +16,5 @@ main = do
|
|||
case command of
|
||||
"run" -> do
|
||||
content <- openFile path ReadMode >>= hGetContents
|
||||
either putStrLn putStrLn $ show . run <$> parse content
|
||||
either putStrLn putStrLn $ show . replaceKnowns . run <$> parse content
|
||||
_ -> putStrLn $ "Unrecognized command: " ++ command
|
||||
|
|
|
|||
245
src/Niceties.hs
Normal file
245
src/Niceties.hs
Normal file
|
|
@ -0,0 +1,245 @@
|
|||
module Niceties where
|
||||
|
||||
import Bruijn (toDeBruijn)
|
||||
import Data.Bimap (Bimap, fromList, lookupR)
|
||||
import Parser (Expr (Abstraction, Application, Variable))
|
||||
|
||||
findKnown :: Expr -> Maybe String
|
||||
findKnown e = lookupR (toDeBruijn e) knownValues
|
||||
|
||||
-- | Replace known values in expression with proper names
|
||||
replaceKnowns :: Expr -> Expr
|
||||
replaceKnowns a@(Abstraction name body) = case findKnown a of
|
||||
Just name' -> Variable name'
|
||||
Nothing -> Abstraction name $ replaceKnowns body
|
||||
replaceKnowns (Application f arg) = Application (replaceKnowns f) (replaceKnowns arg)
|
||||
replaceKnowns v = v
|
||||
|
||||
knownValues :: Bimap String Expr
|
||||
knownValues =
|
||||
Data.Bimap.fromList
|
||||
[ ( "I",
|
||||
toDeBruijn $ Abstraction "x" (Variable "x")
|
||||
),
|
||||
( "true",
|
||||
-- same as K
|
||||
toDeBruijn $
|
||||
Abstraction "x" (Abstraction "y" (Variable "x"))
|
||||
),
|
||||
( "false",
|
||||
-- same as K*, `0`, `nil`
|
||||
toDeBruijn $
|
||||
Abstraction "x" (Abstraction "y" (Variable "y"))
|
||||
),
|
||||
( "S",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" $
|
||||
Abstraction "z" $
|
||||
Application
|
||||
(Application (Variable "x") (Variable "z"))
|
||||
(Application (Variable "y") (Variable "z"))
|
||||
),
|
||||
( "B",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" $
|
||||
Abstraction "z" $
|
||||
Application
|
||||
(Variable "x")
|
||||
(Application (Variable "y") (Variable "z"))
|
||||
),
|
||||
( "C",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" $
|
||||
Abstraction "z" $
|
||||
Application
|
||||
(Application (Variable "x") (Variable "z"))
|
||||
(Variable "y")
|
||||
),
|
||||
( "W",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" $
|
||||
Application
|
||||
(Application (Variable "x") (Variable "y"))
|
||||
(Variable "y")
|
||||
),
|
||||
( "ω",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Application (Variable "x") (Variable "x")
|
||||
),
|
||||
-- Fixed points
|
||||
( "Y",
|
||||
toDeBruijn $
|
||||
Abstraction "f" $
|
||||
Application
|
||||
( Abstraction "x" $
|
||||
Application
|
||||
(Variable "f")
|
||||
(Application (Variable "x") (Variable "x"))
|
||||
)
|
||||
( Abstraction "x" $
|
||||
Application
|
||||
(Variable "f")
|
||||
(Application (Variable "x") (Variable "x"))
|
||||
)
|
||||
),
|
||||
( "Z",
|
||||
toDeBruijn $
|
||||
Abstraction "f" $
|
||||
Application
|
||||
( Abstraction "x" $
|
||||
Application (Variable "f") $
|
||||
Abstraction "v" $
|
||||
Application
|
||||
(Application (Variable "x") (Variable "x"))
|
||||
(Variable "v")
|
||||
)
|
||||
( Abstraction "x" $
|
||||
Application (Variable "f") $
|
||||
Abstraction "v" $
|
||||
Application
|
||||
(Application (Variable "x") (Variable "x"))
|
||||
(Variable "v")
|
||||
)
|
||||
),
|
||||
-- Church numerals
|
||||
-- Note: if you use the Church numeral recognition algorithm,
|
||||
-- you may not need these in the Bimap at all.
|
||||
( "succ",
|
||||
toDeBruijn $
|
||||
Abstraction "n" $
|
||||
Abstraction "f" $
|
||||
Abstraction "x" $
|
||||
Application
|
||||
(Variable "f")
|
||||
( Application
|
||||
(Application (Variable "n") (Variable "f"))
|
||||
(Variable "x")
|
||||
)
|
||||
),
|
||||
( "plus",
|
||||
toDeBruijn $
|
||||
Abstraction "m" $
|
||||
Abstraction "n" $
|
||||
Abstraction "f" $
|
||||
Abstraction "x" $
|
||||
Application
|
||||
(Application (Variable "m") (Variable "f"))
|
||||
( Application
|
||||
(Application (Variable "n") (Variable "f"))
|
||||
(Variable "x")
|
||||
)
|
||||
),
|
||||
( "mult",
|
||||
toDeBruijn $
|
||||
Abstraction "m" $
|
||||
Abstraction "n" $
|
||||
Abstraction "f" $
|
||||
Application
|
||||
(Variable "m")
|
||||
(Application (Variable "n") (Variable "f"))
|
||||
),
|
||||
( "exp",
|
||||
toDeBruijn $
|
||||
Abstraction "m" $
|
||||
Abstraction "n" $
|
||||
Application (Variable "n") (Variable "m")
|
||||
),
|
||||
( "pred",
|
||||
toDeBruijn $
|
||||
Abstraction "n" $
|
||||
Abstraction "f" $
|
||||
Abstraction "x" $
|
||||
Application
|
||||
( Application
|
||||
( Application (Variable "n") $
|
||||
Abstraction "g" $
|
||||
Abstraction "h" $
|
||||
Application
|
||||
(Variable "h")
|
||||
(Application (Variable "g") (Variable "f"))
|
||||
)
|
||||
(Abstraction "u" (Variable "x"))
|
||||
)
|
||||
(Abstraction "u" (Variable "u"))
|
||||
),
|
||||
( "isZero",
|
||||
toDeBruijn $
|
||||
Abstraction "n" $
|
||||
Application
|
||||
( Application (Variable "n") $
|
||||
Abstraction "x" $
|
||||
Abstraction "a" $
|
||||
Abstraction "b" (Variable "b")
|
||||
)
|
||||
(Abstraction "a" $ Abstraction "b" (Variable "a"))
|
||||
),
|
||||
-- Church booleans
|
||||
( "and",
|
||||
toDeBruijn $
|
||||
Abstraction "p" $
|
||||
Abstraction "q" $
|
||||
Application
|
||||
(Application (Variable "p") (Variable "q"))
|
||||
(Variable "p")
|
||||
),
|
||||
( "or",
|
||||
toDeBruijn $
|
||||
Abstraction "p" $
|
||||
Abstraction "q" $
|
||||
Application
|
||||
(Application (Variable "p") (Variable "p"))
|
||||
(Variable "q")
|
||||
),
|
||||
( "not",
|
||||
toDeBruijn $
|
||||
Abstraction "p" $
|
||||
Abstraction "a" $
|
||||
Abstraction "b" $
|
||||
Application
|
||||
(Application (Variable "p") (Variable "b"))
|
||||
(Variable "a")
|
||||
),
|
||||
-- Pairs
|
||||
( "pair",
|
||||
toDeBruijn $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" $
|
||||
Abstraction "f" $
|
||||
Application
|
||||
(Application (Variable "f") (Variable "x"))
|
||||
(Variable "y")
|
||||
),
|
||||
( "fst",
|
||||
toDeBruijn $
|
||||
Abstraction "p" $
|
||||
Application (Variable "p") $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" (Variable "x")
|
||||
),
|
||||
( "snd",
|
||||
toDeBruijn $
|
||||
Abstraction "p" $
|
||||
Application (Variable "p") $
|
||||
Abstraction "x" $
|
||||
Abstraction "y" (Variable "y")
|
||||
),
|
||||
-- Lists
|
||||
( "cons",
|
||||
toDeBruijn $
|
||||
Abstraction "h" $
|
||||
Abstraction "t" $
|
||||
Abstraction "f" $
|
||||
Abstraction "x" $
|
||||
Application
|
||||
(Application (Variable "f") (Variable "h"))
|
||||
( Application
|
||||
(Application (Variable "t") (Variable "f"))
|
||||
(Variable "x")
|
||||
)
|
||||
)
|
||||
]
|
||||
|
|
@ -6,7 +6,7 @@ import Text.Parsec
|
|||
import Text.Parsec.String (Parser)
|
||||
|
||||
data Expr = Variable String | Abstraction String Expr | Application Expr Expr
|
||||
deriving (Eq)
|
||||
deriving (Eq, Ord)
|
||||
|
||||
instance Show Expr where
|
||||
show (Variable name) = name
|
||||
|
|
|
|||
2
test.lm
2
test.lm
|
|
@ -1 +1 @@
|
|||
(λx.λy.λz. x z (y z)) (λa.λb. a) (λa.λb. a)
|
||||
(λn. n (λx. λa. λb. b) (λa. λb. a)) (λf. λx. x)
|
||||
|
|
|
|||
19
test/NicetiesSpec.hs
Normal file
19
test/NicetiesSpec.hs
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
module NicetiesSpec (spec) where
|
||||
|
||||
import Bruijn (toDeBruijn)
|
||||
import Niceties (findKnown, replaceKnowns)
|
||||
import Parser (Expr (Abstraction, Application, Variable))
|
||||
import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "can find knowns" $ do
|
||||
it "can find identity" $
|
||||
findKnown identity `shouldBe` Just "I"
|
||||
describe "replaceKnowns" $ do
|
||||
it "can replace identity" $
|
||||
replaceKnowns identity `shouldBe` Variable "I"
|
||||
it "can replace identity of identity" $
|
||||
replaceKnowns (Application identity identity) `shouldBe` Application (Variable "I") (Variable "I")
|
||||
where
|
||||
identity = toDeBruijn $ Abstraction "x" (Variable "x")
|
||||
Loading…
Add table
Add a link
Reference in a new issue