Fakultas Ilmu Komputer UI
Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Ari Angga Nugraha
ariangganugraha-funpro2020-lambda
Commits
c8ab7d2d
Commit
c8ab7d2d
authored
Jan 27, 2018
by
Sean Gillespie
Browse files
Add let support in Lambda evaluator
parent
0e5d2f7d
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Language/Lambda.hs
View file @
c8ab7d2d
...
...
@@ -25,8 +25,7 @@ type Globals = Map.Map String (LambdaExpr String)
evalString
::
Globals
->
String
->
Either
ParseError
(
LambdaExpr
String
,
Globals
)
evalString
globals
str
=
flip
(,)
globals
<$>
eval'
where
eval'
=
evalExpr
uniques
<$>
parseExpr
str
evalString
globals
str
=
evalExpr
globals
uniques
<$>
parseExpr
str
uniques
::
[
String
]
uniques
=
concatMap
(
\
p
->
map
(
:
p
)
.
reverse
$
[
'a'
..
'z'
])
suffix
...
...
src/Language/Lambda/Eval.hs
View file @
c8ab7d2d
...
...
@@ -3,18 +3,50 @@ module Language.Lambda.Eval where
import
Data.List
import
Data.Maybe
import
qualified
Data.Map
as
Map
import
Language.Lambda.Expression
evalExpr
::
Eq
n
=>
[
n
]
->
LambdaExpr
n
->
LambdaExpr
n
evalExpr
uniqs
(
Abs
name
expr
)
=
Abs
name
.
evalExpr
uniqs
$
expr
evalExpr
_
expr
@
(
Var
_
)
=
expr
evalExpr
uniqs
(
App
e1
e2
)
=
betaReduce
uniqs
(
evalExpr
uniqs
e1
)
(
evalExpr
uniqs
e2
)
-- | Evaluate an expression
evalExpr
::
(
Eq
n
,
Ord
n
)
=>
Map
.
Map
n
(
LambdaExpr
n
)
-- ^ globals
->
[
n
]
-- ^ unique supply
->
LambdaExpr
n
-- ^ the expression to evaluate
->
(
LambdaExpr
n
,
Map
.
Map
n
(
LambdaExpr
n
))
evalExpr
globals
uniqs
(
Let
name
expr
)
=
(
Let
name
expr'
,
Map
.
insert
name
expr'
globals
)
where
expr'
=
evalExpr'
uniqs
(
subGlobals
globals
expr
)
evalExpr
globals
uniqs
expr
=
(
evalExpr'
uniqs
expr'
,
globals
)
where
expr'
=
subGlobals
globals
expr
betaReduce
::
Eq
n
=>
[
n
]
->
LambdaExpr
n
->
LambdaExpr
n
->
LambdaExpr
n
betaReduce
uniqs
(
App
e1
e1'
)
e2
=
App
(
betaReduce
uniqs
e1
e1'
)
e2
subGlobals
::
(
Eq
n
,
Ord
n
)
=>
Map
.
Map
n
(
LambdaExpr
n
)
-- ^ globals
->
LambdaExpr
n
-- ^ the expression
->
LambdaExpr
n
subGlobals
g
e
@
(
Var
x
)
=
Map
.
findWithDefault
e
x
g
subGlobals
g
(
App
e1
e2
)
=
App
(
subGlobals
g
e1
)
(
subGlobals
g
e2
)
subGlobals
g
(
Abs
n
expr
)
=
Abs
n
(
subGlobals
g
expr
)
subGlobals
_
expr
=
expr
-- | Evaluate an expression; does not support `let`
evalExpr'
::
Eq
n
=>
[
n
]
-- ^ unique supply
->
LambdaExpr
n
-- ^ the expression to evaluate
->
LambdaExpr
n
evalExpr'
_
expr
@
(
Var
_
)
=
expr
evalExpr'
uniqs
(
Abs
name
expr
)
=
Abs
name
.
evalExpr'
uniqs
$
expr
evalExpr'
uniqs
(
Let
name
expr
)
=
Let
name
.
evalExpr'
uniqs
$
expr
evalExpr'
uniqs
(
App
e1
e2
)
=
betaReduce
uniqs
(
evalExpr'
uniqs
e1
)
(
evalExpr'
uniqs
e2
)
betaReduce
::
Eq
n
=>
[
n
]
->
LambdaExpr
n
->
LambdaExpr
n
->
LambdaExpr
n
betaReduce
_
expr
@
(
Var
_
)
e2
=
App
expr
e2
betaReduce
uniqs
(
Abs
n
e1
)
e2
=
evalExpr
uniqs
.
sub
n
e1'
$
e2
betaReduce
uniqs
(
App
e1
e1'
)
e2
=
App
(
betaReduce
uniqs
e1
e1'
)
e2
betaReduce
uniqs
(
Abs
n
e1
)
e2
=
evalExpr'
uniqs
.
sub
n
e1'
$
e2
where
fvs
=
freeVarsOf
e2
e1'
=
alphaConvert
uniqs
fvs
e1
...
...
test/Language/Lambda/EvalSpec.hs
View file @
c8ab7d2d
module
Language.Lambda.EvalSpec
where
import
Data.Map
(
empty
,
insert
)
import
Test.Hspec
import
Language.Lambda
...
...
@@ -9,7 +10,7 @@ import Language.Lambda.Expression
spec
::
Spec
spec
=
do
describe
"evalExpr"
$
do
let
evalExpr'
=
evalExpr
uniques
let
evalExpr'
=
fst
<$>
evalExpr
empty
uniques
it
"beta reduces"
$
do
let
expr
=
App
(
Abs
"x"
(
Var
"x"
))
(
Var
"z"
)
...
...
@@ -28,6 +29,23 @@ spec = do
(
Abs
"f"
(
Var
"x"
))
evalExpr'
expr
`
shouldBe
`
Abs
"z"
(
Var
"x"
)
it
"reduces let bodies"
$
do
let
expr
=
Let
"x"
$
App
(
Abs
"y"
(
Var
"y"
))
(
Var
"z"
)
evalExpr'
expr
`
shouldBe
`
Let
"x"
(
Var
"z"
)
it
"let expressions update state"
$
do
let
expr
=
Let
"w"
(
Var
"x"
)
(
_
,
globals
)
=
evalExpr
empty
uniques
expr
globals
`
shouldBe
`
insert
"w"
(
Var
"x"
)
empty
it
"subs global variables"
$
do
let
globals
=
insert
"w"
(
Var
"x"
)
empty
expr
=
Var
"w"
fst
(
evalExpr
globals
uniques
expr
)
`
shouldBe
`
Var
"x"
describe
"betaReduce"
$
do
let
betaReduce'
=
betaReduce
[]
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment