Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
P
prog3-coursework
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Package registry
Model registry
Operate
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
GitLab community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
ik1g19
prog3-coursework
Commits
10551cb5
Commit
10551cb5
authored
4 years ago
by
ik1g19
Browse files
Options
Downloads
Patches
Plain Diff
formatted for submission, fuck challenge 6
parent
5af70b30
No related branches found
No related tags found
No related merge requests found
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
cw/src/Challenges.hs
+92
-107
92 additions, 107 deletions
cw/src/Challenges.hs
with
92 additions
and
107 deletions
cw/src/Challenges.hs
+
92
−
107
View file @
10551cb5
...
@@ -4,10 +4,9 @@
...
@@ -4,10 +4,9 @@
-- Skeleton code to be updated with your solutions
-- Skeleton code to be updated with your solutions
-- The dummy functions here simply return an arbitrary value that is usually wrong
-- The dummy functions here simply return an arbitrary value that is usually wrong
-- DO NOT MODIFY THE FOLLOWING LINES OF CODE
module
Challenges
(
WordSearchGrid
,
Placement
,
Posn
,
Orientation
(
..
),
solveWordSearch
,
createWordSearch
,
module
Challenges
(
WordSearchGrid
,
Placement
,
Posn
,
Orientation
(
..
),
solveWordSearch
,
createWordSearch
,
LamMacroExpr
(
..
),
LamExpr
(
..
),
prettyPrint
,
parseLamMacro
,
LamMacroExpr
(
..
),
LamExpr
(
..
),
prettyPrint
,
parseLamMacro
,
cpsTransform
,
innerRedn1
,
outerRedn1
,
compareInnerOuter
,
ex6'1
,
ex6'2
,
ex6'3
,
ex6'4
,
ex6'5
,
ex6'6
,
ex6'7
,
eval1cbv
,
eval1cbn
,
reductions
,
trace
,
ex5'1
,
ex5'2
,
ex5'3
,
ex5'4
,
highestVar
,
exId
,
freeVar
,
unique
,
closed
)
where
cpsTransform
,
innerRedn1
,
outerRedn1
,
compareInnerOuter
)
where
-- Import standard library and parsing definitions from Hutton 2016, Chapter 13
-- Import standard library and parsing definitions from Hutton 2016, Chapter 13
-- We import System.Random - make sure that your installation has it installed - use stack ghci and stack ghc
-- We import System.Random - make sure that your installation has it installed - use stack ghci and stack ghc
...
@@ -98,9 +97,12 @@ nextPos DownForward (x,y) = (x+1,y+1)
...
@@ -98,9 +97,12 @@ nextPos DownForward (x,y) = (x+1,y+1)
nextPos
DownBack
(
x
,
y
)
=
(
x
-
1
,
y
+
1
)
nextPos
DownBack
(
x
,
y
)
=
(
x
-
1
,
y
+
1
)
----------------------------Utility Functions-----------------------------------
elemAt
::
[[
a
]]
->
Posn
->
a
elemAt
::
[[
a
]]
->
Posn
->
a
elemAt
ass
(
x
,
y
)
=
(
ass
!!
y
)
!!
x
-- | ass means list of list of a's,
elemAt
ass
(
x
,
y
)
=
(
ass
!!
y
)
!!
x
-- | not associated with any other meaning
{--| returns specified adjacent element in grid, |--
{--| returns specified adjacent element in grid, |--
--| relative to given position |--}
--| relative to given position |--}
...
@@ -260,6 +262,10 @@ prettyPrint :: LamMacroExpr -> String
...
@@ -260,6 +262,10 @@ prettyPrint :: LamMacroExpr -> String
prettyPrint
(
LamDef
ms
e
)
=
macroDef
ms
++
exprToStr
ms
e
prettyPrint
(
LamDef
ms
e
)
=
macroDef
ms
++
exprToStr
ms
e
----------------------------Primary Functions-----------------------------------
{--| converts bindings to strings |--}
macroDef
::
[(
String
,
LamExpr
)]
->
String
macroDef
::
[(
String
,
LamExpr
)]
->
String
macroDef
[]
=
""
macroDef
[]
=
""
macroDef
(
(
name
,
expr
)
:
ms
)
=
foldl1
(
++
)
[
"def "
,
name
,
" = "
,
exprToStr
[]
expr
,
" in "
,
macroDef
ms
]
macroDef
(
(
name
,
expr
)
:
ms
)
=
foldl1
(
++
)
[
"def "
,
name
,
" = "
,
exprToStr
[]
expr
,
" in "
,
macroDef
ms
]
...
@@ -284,8 +290,8 @@ exprToStr ms e@(LamApp e1 e2) | e == eNone = none
...
@@ -284,8 +290,8 @@ exprToStr ms e@(LamApp e1 e2) | e == eNone = none
|
e
==
eRight
=
right
|
e
==
eRight
=
right
|
e
==
eBoth
=
both
|
e
==
eBoth
=
both
where
where
none
=
foldl1
(
++
)
[
catchMacro
ms
e1
,
" "
,
catchMacro
ms
e2
]
none
=
foldl1
(
++
)
[
catchMacro
ms
e1
,
" "
,
catchMacro
ms
e2
]
-- | applying different uses of parenthese to
left
=
foldl1
(
++
)
[
"("
,
catchMacro
ms
e1
,
") "
,
catchMacro
ms
e2
]
left
=
foldl1
(
++
)
[
"("
,
catchMacro
ms
e1
,
") "
,
catchMacro
ms
e2
]
-- | determine when they are necessary
right
=
foldl1
(
++
)
[
catchMacro
ms
e1
,
" ("
,
catchMacro
ms
e2
,
")"
]
right
=
foldl1
(
++
)
[
catchMacro
ms
e1
,
" ("
,
catchMacro
ms
e2
,
")"
]
both
=
foldl1
(
++
)
[
"("
,
catchMacro
ms
e1
,
") ("
,
catchMacro
ms
e2
,
")"
]
both
=
foldl1
(
++
)
[
"("
,
catchMacro
ms
e1
,
") ("
,
catchMacro
ms
e2
,
")"
]
...
@@ -315,13 +321,16 @@ exprToStr ms (LamMacro m ) = m
...
@@ -315,13 +321,16 @@ exprToStr ms (LamMacro m ) = m
parseLamMacro
::
String
->
Maybe
LamMacroExpr
parseLamMacro
::
String
->
Maybe
LamMacroExpr
parseLamMacro
str
|
parsed
==
[]
=
Nothing
parseLamMacro
str
|
parsed
==
[]
=
Nothing
|
foldl1
(
&&
)
$
|
foldl1
(
&&
)
$
-- | if anything is left unparsed then the
map
(
(
""
/=
)
.
snd
)
parsed
=
Nothing
map
(
(
""
/=
)
.
snd
)
parsed
=
Nothing
-- | parsing has failed
|
otherwise
=
Just
$
fstHead
parsed
|
otherwise
=
Just
$
fstHead
parsed
where
where
parsed
=
parse
(
macroExpr
[]
)
str
parsed
=
parse
(
macroExpr
[]
)
str
----------------------------Primary Functions-----------------------------------
macroExpr
::
[
(
String
,
LamExpr
)
]
->
Parser
LamMacroExpr
macroExpr
::
[
(
String
,
LamExpr
)
]
->
Parser
LamMacroExpr
macroExpr
ms
=
do
string
"def"
macroExpr
ms
=
do
string
"def"
name
<-
unique
(
map
fst
ms
)
(
token
macroName
)
name
<-
unique
(
map
fst
ms
)
(
token
macroName
)
...
@@ -335,31 +344,11 @@ macroExpr ms = do string "def"
...
@@ -335,31 +344,11 @@ macroExpr ms = do string "def"
return
$
LamDef
ms
e
return
$
LamDef
ms
e
{--| parses an element only if it is unique to a |--
--| given list |--}
unique
::
Eq
a
=>
[
a
]
->
Parser
a
->
Parser
a
unique
xs
p
=
do
x
<-
p
if
x
`
elem
`
xs
then
empty
else
return
x
{--| parses an expr if it is closed |--}
{--| parses an expr if it is closed |--}
closedParse
::
Parser
LamExpr
->
Parser
LamExpr
closedParse
::
Parser
LamExpr
->
Parser
LamExpr
closedParse
p
=
do
e
<-
p
closedParse
p
=
do
e
<-
p
if
closed
e
e
then
return
e
else
empty
if
closed
e
e
then
return
e
else
empty
{--| finds if an expression is closed |--}
closed
::
LamExpr
->
LamExpr
->
Bool
closed
expr
(
LamVar
x
)
=
not
$
freeVar
x
expr
closed
expr
(
LamAbs
_
e
)
=
closed
expr
e
closed
expr
(
LamApp
e1
e2
)
=
closed
expr
e1
&&
closed
expr
e2
{--| finds if a given variable is free in an expr |--}
freeVar
::
Int
->
LamExpr
->
Bool
freeVar
x
(
LamVar
y
)
=
x
==
y
freeVar
x
(
LamAbs
y
e
)
|
x
==
y
=
False
|
otherwise
=
freeVar
x
e
freeVar
x
(
LamApp
e1
e2
)
=
freeVar
x
e1
||
freeVar
x
e2
expr
::
Parser
LamExpr
expr
::
Parser
LamExpr
expr
=
do
terms
<-
some
$
token
term
expr
=
do
terms
<-
some
$
token
term
...
@@ -398,7 +387,31 @@ fstHead :: [(a,b)] -> a
...
@@ -398,7 +387,31 @@ fstHead :: [(a,b)] -> a
fstHead
=
fst
.
head
fstHead
=
fst
.
head
-- Challenge 5
----------------------------Utility Functions-----------------------------------
{--| parses an element only if it is unique to a |--
--| given list |--}
unique
::
Eq
a
=>
[
a
]
->
Parser
a
->
Parser
a
unique
xs
p
=
do
x
<-
p
if
x
`
elem
`
xs
then
empty
else
return
x
{--| finds if an expression is closed |--}
closed
::
LamExpr
->
LamExpr
->
Bool
closed
expr
(
LamVar
x
)
=
not
$
freeVar
x
expr
closed
expr
(
LamAbs
_
e
)
=
closed
expr
e
closed
expr
(
LamApp
e1
e2
)
=
closed
expr
e1
&&
closed
expr
e2
{--| finds if a given variable is free in an expr |--}
freeVar
::
Int
->
LamExpr
->
Bool
freeVar
x
(
LamVar
y
)
=
x
==
y
freeVar
x
(
LamAbs
y
e
)
|
x
==
y
=
False
|
otherwise
=
freeVar
x
e
freeVar
x
(
LamApp
e1
e2
)
=
freeVar
x
e1
||
freeVar
x
e2
------------------------------------------Challenge 5-------------------------------------------------
{--| Repeated for Clarity: |--
{--| Repeated for Clarity: |--
...
@@ -411,24 +424,24 @@ fstHead = fst . head
...
@@ -411,24 +424,24 @@ fstHead = fst . head
cpsTransform
::
LamMacroExpr
->
LamMacroExpr
cpsTransform
::
LamMacroExpr
->
LamMacroExpr
cpsTransform
(
LamDef
ms
e
)
=
LamDef
ms'
e'
cpsTransform
(
LamDef
ms
e
)
=
LamDef
ms'
e'
where
where
nextFreeInExpr
=
if
highestVar
e
==
-
1
then
nextFreeInExpr
=
if
highestVar
e
==
-
1
then
-- | the next free variable name in the expression
1
1
else
else
(
+
1
)
$
highestVar
e
(
+
1
)
$
highestVar
e
nextFreeInMacro
=
if
ms
==
[]
then
nextFreeInMacro
=
if
ms
==
[]
then
-- | the next free variable name in the bindings
1
1
else
else
(
+
1
)
$
foldl1
max
$
map
(
highestVar
.
snd
)
ms
(
+
1
)
$
foldl1
max
$
map
(
highestVar
.
snd
)
ms
(
ms'
,
k
)
=
cpsMacro
[]
ms
$
max
nextFreeInMacro
nextFreeInExpr
(
ms'
,
k
)
=
cpsMacro
[]
ms
$
max
nextFreeInMacro
nextFreeInExpr
-- | next free variable name is passed to converter
(
e'
,
_
)
=
cpsExpr
e
k
(
e'
,
_
)
=
cpsExpr
e
k
-- | for use in creating new variables
----------------------------Primary Functions-----------------------------------
{--| finds the variable name with the highest value |--
{--| finds the variable name with the highest value |--
--| in an expression |--
--| in an expression |--}
--| params: |--
--| -expression to search |--
--| -highest variable name |--}
highestVar
::
LamExpr
->
Int
highestVar
::
LamExpr
->
Int
highestVar
(
LamVar
x
)
=
x
highestVar
(
LamVar
x
)
=
x
highestVar
(
LamMacro
_
)
=
-
1
highestVar
(
LamMacro
_
)
=
-
1
...
@@ -472,12 +485,7 @@ cpsExpr (LamApp e1 e2) k = (LamAbs k $ LamApp e1' $
...
@@ -472,12 +485,7 @@ cpsExpr (LamApp e1 e2) k = (LamAbs k $ LamApp e1' $
cpsExpr
(
LamMacro
name
)
k
=
(
LamMacro
name
,
k
)
cpsExpr
(
LamMacro
name
)
k
=
(
LamMacro
name
,
k
)
-- Examples in the instructions
exId
=
(
LamAbs
1
(
LamVar
1
))
exId
=
(
LamAbs
1
(
LamVar
1
))
ex5'1
=
LamDef
[]
(
LamApp
(
LamVar
1
)
(
LamVar
2
))
ex5'2
=
(
LamDef
[
(
"F"
,
exId
)
]
(
LamVar
2
)
)
ex5'3
=
(
LamDef
[
(
"F"
,
exId
)
]
(
LamMacro
"F"
)
)
ex5'4
=
(
LamDef
[
(
"F"
,
exId
)
]
(
LamApp
(
LamMacro
"F"
)
(
LamMacro
"F"
)))
-- Challenge 6
-- Challenge 6
...
@@ -492,6 +500,43 @@ ex5'4 = (LamDef [ ("F", exId) ] (LamApp (LamMacro "F") (LamMacro "F")))
...
@@ -492,6 +500,43 @@ ex5'4 = (LamDef [ ("F", exId) ] (LamApp (LamMacro "F") (LamMacro "F")))
--| freeVar x (LamApp e1 e2) = freeVar x e1 || freeVar x e2 |--}
--| freeVar x (LamApp e1 e2) = freeVar x e1 || freeVar x e2 |--}
compareInnerOuter
::
LamMacroExpr
->
Int
->
(
Maybe
Int
,
Maybe
Int
,
Maybe
Int
,
Maybe
Int
)
compareInnerOuter
e
b
=
(
innerSteps
,
outerSteps
,
innerCps
,
outerCps
)
where
innerSteps
=
let
reduces
=
trace
innerRedn1
b
e
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
outerSteps
=
let
reduces
=
trace
outerRedn1
b
e
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
innerCps
=
let
LamDef
ms'
e'
=
cpsTransform
e
reduces
=
trace
innerRedn1
b
$
LamDef
ms'
$
LamApp
e'
exId
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
outerCps
=
let
LamDef
ms'
e'
=
cpsTransform
e
reduces
=
trace
outerRedn1
b
$
LamDef
ms'
$
LamApp
e'
exId
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
innerRedn1
::
LamMacroExpr
->
Maybe
LamMacroExpr
innerRedn1
(
LamDef
ms
e
)
|
redex
e
=
Just
$
LamDef
ms
e'
|
otherwise
=
Nothing
where
e'
=
eval1cbv
ms
e
outerRedn1
::
LamMacroExpr
->
Maybe
LamMacroExpr
outerRedn1
(
LamDef
ms
e
)
|
redex
e
=
Just
$
LamDef
ms
e'
|
otherwise
=
Nothing
where
e'
=
eval1cbn
ms
e
----------------------------Primary Functions-----------------------------------
{--| substitutes an expression into another expr |--
{--| substitutes an expression into another expr |--
--| params: |--
--| params: |--
--| -expr to sub in to |--
--| -expr to sub in to |--
...
@@ -509,11 +554,11 @@ subst (LamAbs x e) y e' | x /= y && not (freeVar x e') = LamAbs x $ subst e y
...
@@ -509,11 +554,11 @@ subst (LamAbs x e) y e' | x /= y && not (freeVar x e') = LamAbs x $ subst e y
subst
(
LamApp
e1
e2
)
y
e
=
LamApp
(
subst
e1
y
e
)
(
subst
e2
y
e
)
subst
(
LamApp
e1
e2
)
y
e
=
LamApp
(
subst
e1
y
e
)
(
subst
e2
y
e
)
rename
::
Int
->
LamExpr
->
Int
rename
::
Int
->
LamExpr
->
Int
rename
x
e
=
highestVar
e
+
1
rename
x
e
=
highestVar
e
+
1
{--| returns true if an expression contains a redex |--}
redex
::
LamExpr
->
Bool
redex
::
LamExpr
->
Bool
redex
(
LamAbs
_
_
)
=
False
redex
(
LamAbs
_
_
)
=
False
redex
(
LamVar
_
)
=
False
redex
(
LamVar
_
)
=
False
...
@@ -522,11 +567,6 @@ redex (LamApp (LamAbs _ _) _) = True
...
@@ -522,11 +567,6 @@ redex (LamApp (LamAbs _ _) _) = True
redex
(
LamApp
e1
e2
)
=
redex
e1
||
redex
e2
redex
(
LamApp
e1
e2
)
=
redex
e1
||
redex
e2
innerRedn1
::
LamMacroExpr
->
Maybe
LamMacroExpr
innerRedn1
(
LamDef
ms
e
)
|
redex
e
=
Just
$
LamDef
ms
e'
|
otherwise
=
Nothing
where
e'
=
eval1cbv
ms
e
eval1cbv
::
[
(
String
,
LamExpr
)
]
->
LamExpr
->
LamExpr
eval1cbv
::
[
(
String
,
LamExpr
)
]
->
LamExpr
->
LamExpr
eval1cbv
ms
(
LamAbs
x
e
)
=
LamAbs
x
e
eval1cbv
ms
(
LamAbs
x
e
)
=
LamAbs
x
e
eval1cbv
ms
(
LamMacro
name
)
=
(
snd
.
head
)
$
filter
((
name
==
)
.
fst
)
ms
eval1cbv
ms
(
LamMacro
name
)
=
(
snd
.
head
)
$
filter
((
name
==
)
.
fst
)
ms
...
@@ -535,11 +575,6 @@ eval1cbv ms (LamApp e1@(LamAbs x e) e2) = LamApp e1 $ eval1cbv ms e2
...
@@ -535,11 +575,6 @@ eval1cbv ms (LamApp e1@(LamAbs x e) e2) = LamApp e1 $ eval1cbv ms e2
eval1cbv
ms
(
LamApp
e1
e2
)
=
LamApp
(
eval1cbv
ms
e1
)
e2
eval1cbv
ms
(
LamApp
e1
e2
)
=
LamApp
(
eval1cbv
ms
e1
)
e2
outerRedn1
::
LamMacroExpr
->
Maybe
LamMacroExpr
outerRedn1
(
LamDef
ms
e
)
|
redex
e
=
Just
$
LamDef
ms
e'
|
otherwise
=
Nothing
where
e'
=
eval1cbn
ms
e
eval1cbn
::
[
(
String
,
LamExpr
)
]
->
LamExpr
->
LamExpr
eval1cbn
::
[
(
String
,
LamExpr
)
]
->
LamExpr
->
LamExpr
eval1cbn
ms
(
LamAbs
x
e
)
=
LamAbs
x
e
eval1cbn
ms
(
LamAbs
x
e
)
=
LamAbs
x
e
eval1cbn
ms
(
LamMacro
name
)
=
(
snd
.
head
)
$
filter
((
name
==
)
.
fst
)
ms
eval1cbn
ms
(
LamMacro
name
)
=
(
snd
.
head
)
$
filter
((
name
==
)
.
fst
)
ms
...
@@ -547,13 +582,6 @@ eval1cbn ms (LamApp (LamAbs x e1) e2) = subst e1 x e2
...
@@ -547,13 +582,6 @@ eval1cbn ms (LamApp (LamAbs x e1) e2) = subst e1 x e2
eval1cbn
ms
(
LamApp
e1
e2
)
=
LamApp
(
eval1cbn
ms
e1
)
e2
eval1cbn
ms
(
LamApp
e1
e2
)
=
LamApp
(
eval1cbn
ms
e1
)
e2
reductions
::
(
LamMacroExpr
->
Maybe
LamMacroExpr
)
->
LamMacroExpr
->
[
Maybe
LamMacroExpr
]
reductions
ssev
e
=
drop
1
evals
where
evals
::
[
Maybe
LamMacroExpr
]
evals
=
iterate
(
>>=
ssev
)
$
Just
e
{--| returns the trace of reductions for an
{--| returns the trace of reductions for an
--| expression |--
--| expression |--
--| params: |--
--| params: |--
...
@@ -561,53 +589,10 @@ reductions ssev e = drop 1 evals
...
@@ -561,53 +589,10 @@ reductions ssev e = drop 1 evals
--| -bound for reductions |--
--| -bound for reductions |--
--| -expr to be reduced |--}
--| -expr to be reduced |--}
trace
::
(
LamMacroExpr
->
Maybe
LamMacroExpr
)
->
Int
->
LamMacroExpr
->
[
Maybe
LamMacroExpr
]
trace
::
(
LamMacroExpr
->
Maybe
LamMacroExpr
)
->
Int
->
LamMacroExpr
->
[
Maybe
LamMacroExpr
]
--trace ssev e = (map fst) $ (takeWhile (uncurry (/=)) $ reductions ssev e) ++ [( head . dropWhile (uncurry (/=)) ssev e)]
trace
ssev
b
e
=
take
b
$
reductions
ssev
e
trace
ssev
b
e
=
take
b
$
reductions
ssev
e
reductions
::
(
LamMacroExpr
->
Maybe
LamMacroExpr
)
->
LamMacroExpr
->
[
Maybe
LamMacroExpr
]
compareInnerOuter
::
LamMacroExpr
->
Int
->
(
Maybe
Int
,
Maybe
Int
,
Maybe
Int
,
Maybe
Int
)
reductions
ssev
e
=
drop
1
evals
compareInnerOuter
e
b
=
(
innerSteps
,
outerSteps
,
innerCps
,
outerCps
)
where
where
innerSteps
=
let
reduces
=
trace
innerRedn1
b
e
evals
::
[
Maybe
LamMacroExpr
]
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
evals
=
iterate
(
>>=
ssev
)
$
Just
e
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
\ No newline at end of file
outerSteps
=
let
reduces
=
trace
outerRedn1
b
e
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
innerCps
=
let
LamDef
ms'
e'
=
cpsTransform
e
reduces
=
trace
innerRedn1
b
$
LamDef
ms'
$
LamApp
e'
exId
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
outerCps
=
let
LamDef
ms'
e'
=
cpsTransform
e
reduces
=
trace
outerRedn1
b
$
LamDef
ms'
$
LamApp
e'
exId
tillNoRedex
=
takeWhile
(
Nothing
/=
)
reduces
in
if
Nothing
`
elem
`
reduces
then
Just
$
length
tillNoRedex
else
Nothing
-- Examples in the instructions
-- (\x1 -> x1 x2)
ex6'1
=
LamDef
[]
(
LamAbs
1
(
LamApp
(
LamVar
1
)
(
LamVar
2
)))
-- def F = \x1 -> x1 in F
ex6'2
=
LamDef
[
(
"F"
,
exId
)
]
(
LamMacro
"F"
)
-- (\x1 -> x1) (\x2 -> x2)
ex6'3
=
LamDef
[]
(
LamApp
exId
(
LamAbs
2
(
LamVar
2
)))
-- (\x1 -> x1 x1)(\x1 -> x1 x1)
wExp
=
(
LamAbs
1
(
LamApp
(
LamVar
1
)
(
LamVar
1
)))
ex6'4
=
LamDef
[]
(
LamApp
wExp
wExp
)
-- def ID = \x1 -> x1 in def FST = (\x1 -> λx2 -> x1) in FST x3 (ID x4)
ex6'5
=
LamDef
[
(
"ID"
,
exId
)
,
(
"FST"
,
LamAbs
1
(
LamAbs
2
(
LamVar
1
)))
]
(
LamApp
(
LamApp
(
LamMacro
"FST"
)
(
LamVar
3
))
(
LamApp
(
LamMacro
"ID"
)
(
LamVar
4
)))
-- def FST = (\x1 -> λx2 -> x1) in FST x3 ((\x1 ->x1) x4))
ex6'6
=
LamDef
[
(
"FST"
,
LamAbs
1
(
LamAbs
2
(
LamVar
1
))
)
]
(
LamApp
(
LamApp
(
LamMacro
"FST"
)
(
LamVar
3
))
(
LamApp
(
exId
)
(
LamVar
4
)))
-- def ID = \x1 -> x1 in def SND = (\x1 -> λx2 -> x2) in SND ((\x1 -> x1 x1 ) (\x1 -> x1 x1)) ID
ex6'7
=
LamDef
[
(
"ID"
,
exId
)
,
(
"SND"
,
LamAbs
1
(
LamAbs
2
(
LamVar
2
)))
]
(
LamApp
(
LamApp
(
LamMacro
"SND"
)
(
LamApp
wExp
wExp
)
)
(
LamMacro
"ID"
)
)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment