diff --git a/flake.nix b/flake.nix index c655d07..a56eecd 100644 --- a/flake.nix +++ b/flake.nix @@ -26,6 +26,7 @@ gyehoek = final.haskell-nix.project' { src = ./.; compiler-nix-name = "ghc912"; + configureArgs = "-f-doctest"; modules = [({ pkgs, lib, ...}: { packages.gyehoek.components.tests.test.preCheck = let diff --git a/golden/exec/factorial/exec b/golden/exec/factorial/exec index f17cfa4..5133d63 100644 --- a/golden/exec/factorial/exec +++ b/golden/exec/factorial/exec @@ -1,2 +1,2 @@ ret > ExitSuccess -out > 720 +out > 2432902008176640000 diff --git a/golden/exec/factorial/source.scm b/golden/exec/factorial/source.scm index ccc9aad..ff18514 100644 --- a/golden/exec/factorial/source.scm +++ b/golden/exec/factorial/source.scm @@ -2,5 +2,4 @@ (if (zero? n) 1 (* n (fac (- n 1))))))) - ;; 20 is the greatest `n` for which n! ≤ maxBount @Int (fac 20)) diff --git a/gyehoek.cabal b/gyehoek.cabal index a29f415..c247dcb 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -13,6 +13,11 @@ build-type: Simple -- extra-doc-files: CHANGELOG.md -- extra-source-files: +flag doctest + description: enable the doctest suite + default: True + manual: True + common ghcstuffs-dev ghc-options: -Wno-unused-matches -Wno-missing-signatures -Wno-typed-holes @@ -156,11 +161,14 @@ test-suite test default-language: GHC2024 -- https://github.com/martijnbastiaan/doctest-parallel/pull/66 --- test-suite doctest --- import: ghcstuffs, ghcstuffs-dev --- type: exitcode-stdio-1.0 --- hs-source-dirs: test --- main-is: doctest.hs --- build-depends: --- , base --- , doctest-parallel >=0.1 +test-suite doctest + import: ghcstuffs, ghcstuffs-dev + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: base + default-extensions: CPP + main-is: doctest.hs + if flag(doctest) + build-depends: doctest-parallel >=0.1 + else + cpp-options: "-DGYEHOEK_NO_DOCTEST" diff --git a/src/Gyehoek/Stack/Syntax.hs b/src/Gyehoek/Stack/Syntax.hs index 79549e4..ddca7a1 100644 --- a/src/Gyehoek/Stack/Syntax.hs +++ b/src/Gyehoek/Stack/Syntax.hs @@ -107,7 +107,7 @@ instance S.DataIso Block where instance S.DatumIso Tail where datumIso = S.match - $ S.With (S.headTagged1' "tail-call!" S.datumIso S.datumIso >>>) + $ S.With (S.headTagged1' "tail-call" S.datumIso S.datumIso >>>) $ S.With (if_ >>>) $ S.End where diff --git a/test/Gyehoek/Test/Stack/VM.hs b/test/Gyehoek/Test/Stack/VM.hs index 857b8bd..b9923f3 100644 --- a/test/Gyehoek/Test/Stack/VM.hs +++ b/test/Gyehoek/Test/Stack/VM.hs @@ -16,23 +16,23 @@ test_root = testGroup "stack machine" evalsTo [ObjImm (ImmInt 3)] [stkP| (define ($main) (pop-cont! %ktail) - (tail-call! %ktail 3)) + (tail-call %ktail 3)) |] , testCase "return constant" do evalsTo [ObjImm (ImmInt 123)] [stkP| (define ($main) - (tail-call! $silly)) + (tail-call $silly)) (define ($silly) (pop-cont! %ktail) - (tail-call! %ktail 123)) + (tail-call %ktail 123)) |] , testCase "identity function" do evalsTo [ObjImm (ImmInt 45)] [stkP| (define ($main) - (tail-call! $id 45)) + (tail-call $id 45)) (define ($id %x) (pop-cont! %ktail) - (tail-call! %ktail %x)) + (tail-call %ktail %x)) |] -- , testCase "square" do -- evalsTo [ObjImm (ImmInt 16)] [stkP| @@ -41,11 +41,11 @@ test_root = testGroup "stack machine" , testCase "square" do evalsTo [ObjImm (ImmInt 16)] [stkP| (define ($main) - (tail-call! $square 4)) + (tail-call $square 4)) (define ($square %x) (prim %x2 (* %x %x)) (pop-cont! %ktail) - (tail-call! %ktail %x2)) + (tail-call %ktail %x2)) |] , testCase "factorial" do let hsfac (n :: Int) = foldr (*) (1) [1..n] @@ -54,18 +54,18 @@ test_root = testGroup "stack machine" (prim %x0 (zero? %n)) (if %x0 (then (pop-cont! %ktail) - (tail-call! %ktail 1)) + (tail-call %ktail 1)) (else (push! %n) (prim %x1 (- %n 1)) (push-cont! $fac-k0) - (tail-call! $fac %x1)))) + (tail-call $fac %x1)))) (define ($fac-k0 %x2) (pop! %n) (prim %x3 (* %x2 %n)) (pop-cont! %ktail) - (tail-call! %ktail %x3)) + (tail-call %ktail %x3)) (define ($main) - (tail-call! $fac #{n})) + (tail-call $fac #{n})) |] evalsTo [ObjImm (ImmInt 1)] $ fac 0 evalsTo [ObjImm (ImmInt 1)] $ fac 1 @@ -73,32 +73,3 @@ test_root = testGroup "stack machine" -- 20 is the greatest `n` for which n! ≤ maxBount @Int evalsTo [ObjImm (ImmInt 2432902008176640000)] $ fac 20 ] - --- ] - --- prims = testGroup "prims" --- [ arith --- , testCase "zero?" do --- trivialPrimTest [ObjImm (ImmBool True)] $ --- PrimZeroP $ ValImm $ ImmInt 0 --- trivialPrimTest [ObjImm (ImmBool False)] $ --- PrimZeroP $ ValImm $ ImmInt 12 --- ] - --- trivialPrimTest rs p = --- evalsTo rs --- [ MkRoutine "main" [] --- [ PopCont "ktail" --- , Prim "x1" p --- , Call (ValReg "ktail") [ValReg "x1"] --- ] --- ] - --- arith = testGroup "arith" --- [ testCase "multipy" do --- trivialPrimTest [ObjImm (ImmInt 12)] --- (PrimMul (ValImm $ ImmInt 3) (ValImm $ ImmInt 4)) --- , testCase "subtract" do --- trivialPrimTest [ObjImm (ImmInt 14)] --- (PrimSub (ValImm $ ImmInt 20) (ValImm $ ImmInt 6)) --- ] diff --git a/test/doctest.hs b/test/doctest.hs index 625343f..ba3125d 100644 --- a/test/doctest.hs +++ b/test/doctest.hs @@ -1,10 +1,16 @@ -{-# LANGUAGE DoAndIfThenElse #-} module Main where +#ifndef GYEHOEK_NO_DOCTEST import Test.DocTest (mainFromCabal) -import System.Environment (getArgs, lookupEnv) +#endif +import System.Environment (getArgs) import System.IO (stderr, hPutStrLn) main :: IO () -main = mainFromCabal "gyehoek" =<< getArgs +main = +#ifndef GYEHOEK_NO_DOCTEST + mainFromCabal "gyehoek" =<< getArgs +#else + hPutStrLn stderr "skipping doctests due to broken nix environment." +#endif