1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
module Minilang.REPLSpec where
import Control.Exception (bracket)
import Data.Either (isRight)
import Data.Text.IO
import Minilang.Lambda.Eval (Term (Lam, Var))
import Minilang.Lambda.Parser (AST (..))
import Minilang.Lambda.Unify (Type (TyVar))
import Minilang.REPL
import Minilang.REPL.Purer (PurerEnv (..))
import Minilang.REPL.Run (loadProgramInEnv)
import Minilang.REPL.Types (Out (Evaluated))
import System.Directory (getTemporaryDirectory, removeFile)
import System.FilePath ((<.>), (</>))
import System.IO (IOMode (..), hClose, withFile)
import System.Posix.Temp (mkstemp)
import Test.Hspec
import Prelude hiding (lines, readFile, writeFile)
spec :: Spec
spec = parallel $
describe "MiniLang REPL" $ do
it "evaluates untyped MiniLang terms read from pure Monad" $ do
let out =
withInput
["((lam (x) x) y)"]
out
`shouldBe` [ "Bye!",
"y : <?>"
]
it "evaluates untyped MiniLang terms with definitions" $ do
let out =
withInput
["(def id (lam (x) x))", "(id y)"]
out
`shouldBe` [ "Bye!",
"y : <?>",
"id : <?>"
]
it "evaluates typed MiniLang terms with definitions" $ do
let out =
withInput
[ ":lang Typed",
"(def id (lam (x) x))",
"(id y)"
]
out
`shouldBe` [ "Bye!",
"y : a",
"id : a -> a",
"Language set to Typed"
]
it "defaults untyped terms" $ do
let out =
withInput
[ "(let ((Succ (lam (n z s) (s n))) \
\ (Zero (lam (z s) z))) \
\ (Succ (Succ Zero)))"
]
out
`shouldBe` [ "Bye!",
"(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : <?>"
]
it "do typecheck term when language is set to 'Typed'" $ do
let out =
withInput
[ ":lang Typed",
"(let ((Succ (lam (n z s) (s n))) \
\ (Zero (lam (z s) z))) \
\ (Succ (Succ Zero)))"
]
out
`shouldBe` [ "Bye!",
"(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : a -> ((c -> ((e -> f -> e) -> g) -> g) -> h) -> h",
"Language set to Typed"
]
it "shows error when trying to load a non-existent file" $ do
withInput [":load foo"]
`shouldBe` [ "Bye!",
"REPLError \"cannot load file foo in Pure interpreter\""
]
it "can load 'bool-prog.lisp'" $ do
boolProg <- readFile "bool-prog.lisp"
let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
outputs
`shouldBe` [ Evaluated (Abs ["f", "t"] (Sym "t")) (Lam "f" (Lam "t" (Var "t"))) (TyVar "<?>"),
Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) (TyVar "<?>"),
Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) (TyVar "<?>")
]
it "can load 'bool.lisp'" $ do
boolProg <- readFile "bool.lisp"
let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
outputs
`shouldBe` [ Evaluated
(Abs ["f", "t"] (Sym "f"))
(Lam "f" (Lam "t" (Var "f")))
(TyVar "<?>")
]
it "can load 'fac.lisp'" $ do
boolProg <- readFile "fac.lisp"
let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
outputs
`shouldBe` [ Evaluated
(Abs ["f", "t"] (Sym "t"))
(Lam "f" (Lam "t" (Var "t")))
(TyVar "<?>")
]
around withTempFile $
it "evaluates single MiniLang term read from IO" $ \fileName -> do
let outputFileName = fileName <> ".out"
writeFile
fileName
"(let ((Succ (lam (n z s) (s n))) \
\ (Zero (lam (z s) z))) \
\ (Succ Zero))"
_ <- withFile fileName ReadMode $ \hin ->
withFile outputFileName AppendMode $ \hout ->
withHandles hin hout
out <- readFile outputFileName
out
`shouldBe` "\955\928> (lam (z s) (s (lam (z s) z))) : <?>\n\955\928> Bye!\n"
withTempFile :: (String -> IO ()) -> IO ()
withTempFile =
bracket mkTempFile rmTempFile
where
mkTempFile = getTemporaryDirectory >>= \dir -> mkstemp (dir </> "test-repl") >>= \(fp, h) -> hClose h >> pure fp
rmTempFile fn = removeFile fn >> removeFile (fn <.> "out")
|
