aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCamil Staps2017-11-22 11:19:41 +0100
committerCamil Staps2017-11-22 11:19:41 +0100
commitf74dd82111c0f50fc7b1a222c796d258e82281fb (patch)
tree211974c5f39453853169d7f4fdfabc8783a44490
parentTest setup (diff)
Resolve run-time error for functions that use arguments twice further down the expression graph
-rw-r--r--pf.icl12
-rwxr-xr-xtest.sh2
-rw-r--r--test.tsv1
3 files changed, 8 insertions, 7 deletions
diff --git a/pf.icl b/pf.icl
index 7e0f76f..46016e1 100644
--- a/pf.icl
+++ b/pf.icl
@@ -134,20 +134,20 @@ optim (Lambda id e)
| otherwise = Ident "const" @ optim e
where
optApp :: Expr -> Expr
- optApp (f @ x)
- | hasIdent id f && hasIdent id x = Ident "ap" @ Lambda id f @ Lambda id x
- | otherwise = case moveOutside id (f @ x) of
+ optApp (f @ x) = case moveOutside id (f @ x) of
a=:(f @ Ident id`) -> if (id == id`) f (Ident "const" @ a)
a -> Ident "const" @ a
-optim (Ident "flip" @ Ident "ap" @ Ident "id") = Ident "join"
-optim (f @ x) = optim f @ optim x
+optim (f @ x) = case optim f @ optim x of
+ Ident "flip" @ Ident "ap" @ Ident "id" -> Ident "join"
+ Ident "ap" @ f @ Ident "id" -> Ident "join" @ f
+ e -> e
optim e = e
moveOutside :: Ident Expr -> Expr
moveOutside _ (Ident id) = Ident id
moveOutside _ (Literal l) = Literal l
moveOutside id (f @ x)
-| hasIdent id f && hasIdent id x = abort "moveOutside on @ with id in both sides"
+| hasIdent id f && hasIdent id x = Ident "ap" @ Lambda id f @ Lambda id x @ Ident id
| hasIdent id f = case moveOutside id f of
Ident id -> Ident "flip" @ Ident "id" @ x @ Ident id
g @ Ident id -> Ident "flip" @ g @ x @ Ident id
diff --git a/test.sh b/test.sh
index cc6a14b..66ffe88 100755
--- a/test.sh
+++ b/test.sh
@@ -4,7 +4,7 @@ SUCCESS=true
while IFS=$'\t' read -r req res; do
outcome="$(./pf -nt "$req" | grep Result | cut -d' ' -f3-)"
if [ "$res" != "$outcome" ]; then
- echo "Test failed: $req"
+ echo "Test failed: $req"
echo "Expected result: $res"
echo "Actual result: $outcome"
SUCCESS=false
diff --git a/test.tsv b/test.tsv
index bc25a74..e4e7840 100644
--- a/test.tsv
+++ b/test.tsv
@@ -13,3 +13,4 @@
\x y -> y 10 const (flip id 10)
\f a b c d -> f b c d a (o) flip ((o) ((o) flip) ((o) ((o) flip)))
\f x -> f x x join
+\f -> f f 10 flip (join id) 10