mirror of
https://github.com/grin-compiler/grin.git
synced 2024-09-11 07:25:28 +03:00
Compiler test: expected files can be any text file.
This commit is contained in:
parent
a3d25d6668
commit
d95f5e09e0
2
.gitignore
vendored
2
.gitignore
vendored
@ -25,3 +25,5 @@ output/
|
|||||||
.output
|
.output
|
||||||
.grin-output/
|
.grin-output/
|
||||||
.vscode/
|
.vscode/
|
||||||
|
*.out
|
||||||
|
|
||||||
|
@ -232,6 +232,7 @@ executable grin-test
|
|||||||
, system-posix-redirect
|
, system-posix-redirect
|
||||||
, process
|
, process
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, MissingH
|
||||||
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Transformations.Simplifying.RegisterIntroductionSpec
|
Transformations.Simplifying.RegisterIntroductionSpec
|
||||||
@ -316,6 +317,7 @@ executable grin-end-to-end-test
|
|||||||
, system-posix-redirect
|
, system-posix-redirect
|
||||||
, process
|
, process
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, MissingH
|
||||||
other-modules:
|
other-modules:
|
||||||
Transformations.Simplifying.RegisterIntroductionSpec
|
Transformations.Simplifying.RegisterIntroductionSpec
|
||||||
Transformations.Simplifying.CaseSimplificationSpec
|
Transformations.Simplifying.CaseSimplificationSpec
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
|
||||||
grinMain =
|
grinMain =
|
||||||
a0 <- pure (CInt 5)
|
a0 <- pure (CInt 5)
|
||||||
a1 <- pure (CInt 5)
|
a1 <- pure (CInt 5)
|
||||||
@ -5,34 +6,27 @@ grinMain =
|
|||||||
p0 <- store a0
|
p0 <- store a0
|
||||||
p1 <- store a1
|
p1 <- store a1
|
||||||
p2 <- store a2
|
p2 <- store a2
|
||||||
|
|
||||||
foo3 <- pure (P3foo)
|
foo3 <- pure (P3foo)
|
||||||
pfoo3 <- store foo3
|
pfoo3 <- store foo3
|
||||||
|
foo3ap <- pure (Fap pfoo3 p0)
|
||||||
foo3ap <- pure (Fap pfoo3 p0)
|
|
||||||
pfoo3ap <- store foo3ap
|
pfoo3ap <- store foo3ap
|
||||||
foo2 <- eval pfoo3ap
|
foo2 <- eval $ pfoo3ap
|
||||||
pfoo2 <- store foo2
|
pfoo2 <- store foo2
|
||||||
|
foo2ap <- pure (Fap pfoo2 p1)
|
||||||
foo2ap <- pure (Fap pfoo2 p1)
|
|
||||||
pfoo2ap <- store foo2ap
|
pfoo2ap <- store foo2ap
|
||||||
foo1 <- eval pfoo2ap
|
foo1 <- eval $ pfoo2ap
|
||||||
pfoo1 <- store foo1
|
pfoo1 <- store foo1
|
||||||
|
foo1ap <- pure (Fap pfoo1 p2)
|
||||||
foo1ap <- pure (Fap pfoo1 p2)
|
|
||||||
pfoo1ap <- store foo1ap
|
pfoo1ap <- store foo1ap
|
||||||
fooRet <- eval pfoo1ap
|
fooRet <- eval $ pfoo1ap
|
||||||
|
|
||||||
pure fooRet
|
pure fooRet
|
||||||
|
|
||||||
|
|
||||||
foo y0 =
|
foo y0 =
|
||||||
z0 <- pure (#undefined :: #ptr)
|
z0 <- pure (#undefined :: #ptr)
|
||||||
x0 <- pure (#undefined :: #ptr)
|
x0 <- pure (#undefined :: #ptr)
|
||||||
y0' <- eval y0
|
y0' <- eval $ y0
|
||||||
pure y0'
|
pure y0'
|
||||||
|
|
||||||
-- apply always gets the function node in whnf
|
|
||||||
apply pf cur =
|
apply pf cur =
|
||||||
case pf of
|
case pf of
|
||||||
(P3foo) ->
|
(P3foo) ->
|
||||||
@ -42,31 +36,33 @@ apply pf cur =
|
|||||||
n1 <- pure (P1foo v0 cur)
|
n1 <- pure (P1foo v0 cur)
|
||||||
pure n1
|
pure n1
|
||||||
(P1foo v1 v2) ->
|
(P1foo v1 v2) ->
|
||||||
n2 <- foo v2
|
n2 <- foo $ v2
|
||||||
pure n2
|
pure n2
|
||||||
|
|
||||||
ap f x =
|
ap f x =
|
||||||
f' <- eval f
|
f' <- eval $ f
|
||||||
apply f' x
|
apply $ f' x
|
||||||
|
|
||||||
eval p =
|
eval p =
|
||||||
v <- fetch p
|
v <- fetch p
|
||||||
case v of
|
case v of
|
||||||
(CInt n) -> pure v
|
(CInt n) ->
|
||||||
|
pure v
|
||||||
(P3foo) -> pure v
|
(P3foo) ->
|
||||||
(P2foo v3) -> pure v
|
pure v
|
||||||
(P1foo v4 v5) -> pure v
|
(P2foo v3) ->
|
||||||
|
pure v
|
||||||
|
(P1foo v4 v5) ->
|
||||||
|
pure v
|
||||||
(Ffoo b0 b1 b2) ->
|
(Ffoo b0 b1 b2) ->
|
||||||
w0 <- foo b1
|
w0 <- foo $ b1
|
||||||
update p w0
|
update p w0
|
||||||
pure w0
|
pure w0
|
||||||
(Fapply g y) ->
|
(Fapply g y) ->
|
||||||
w1 <- apply g y
|
w1 <- apply $ g y
|
||||||
update p w1
|
update p w1
|
||||||
pure w1
|
pure w1
|
||||||
(Fap h z) ->
|
(Fap h z) ->
|
||||||
w2 <- ap h z
|
w2 <- ap $ h z
|
||||||
update p w2
|
update p w2
|
||||||
pure w2
|
pure w2
|
||||||
|
@ -0,0 +1,3 @@
|
|||||||
|
- "--quiet"
|
||||||
|
- "--dpe"
|
||||||
|
- "--save-grin=$$$OUT$$$"
|
@ -20,6 +20,7 @@ import Control.Exception (catch)
|
|||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Char (isDigit)
|
import Data.Char (isDigit)
|
||||||
import Data.List (isSuffixOf)
|
import Data.List (isSuffixOf)
|
||||||
|
import Data.String.Utils (replace)
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
|
||||||
|
|
||||||
@ -51,7 +52,7 @@ evaluatePipelineTest input options expected params actionWith progressCallback =
|
|||||||
Binary fp -> [fp, "--load-binary"]
|
Binary fp -> [fp, "--load-binary"]
|
||||||
Textual fp -> [fp]
|
Textual fp -> [fp]
|
||||||
let outFile = inputToFilePath input <.> "out"
|
let outFile = inputToFilePath input <.> "out"
|
||||||
mainWithArgs $ args ++ options ++ ["--save-grin=" ++ outFile]
|
mainWithArgs $ args ++ (map (replace "$$$OUT$$$" outFile) options)
|
||||||
content <- readFile outFile
|
content <- readFile outFile
|
||||||
expected <- readFile expected
|
expected <- readFile expected
|
||||||
if (content == expected)
|
if (content == expected)
|
||||||
|
Loading…
Reference in New Issue
Block a user