add smoke tests
This commit is contained in:
2
Makefile
2
Makefile
@@ -9,7 +9,7 @@ build/exec/newt.js: ${SRCS}
|
|||||||
idris2 --cg node -o newt.js -p contrib -c src/Main.idr
|
idris2 --cg node -o newt.js -p contrib -c src/Main.idr
|
||||||
|
|
||||||
test: build/exec/newt
|
test: build/exec/newt
|
||||||
build/exec/newt newt/*.newt
|
scripts/test
|
||||||
|
|
||||||
vscode:
|
vscode:
|
||||||
cd newt-vscode && vsce package && code --install-extension *.vsix
|
cd newt-vscode && vsce package && code --install-extension *.vsix
|
||||||
|
|||||||
@@ -17,9 +17,8 @@ data D : (A : Type) -> Type where
|
|||||||
-- We do need to sort this out
|
-- We do need to sort this out
|
||||||
|
|
||||||
unV : { A : U} -> D A -> A
|
unV : { A : U} -> D A -> A
|
||||||
unV = \ v => case v of
|
unV (V y) = y
|
||||||
V y => y
|
unV (F f) = ? -- was TRUSTME
|
||||||
-- F f => TRUSTME
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -27,8 +26,8 @@ unV = \ v => case v of
|
|||||||
unF : {A : Type} -> D A -> D A -> D A
|
unF : {A : Type} -> D A -> D A -> D A
|
||||||
unF = \ {A} v x =>
|
unF = \ {A} v x =>
|
||||||
case v of
|
case v of
|
||||||
F {A} f => ? -- f x
|
F f => f x
|
||||||
V y => TRUSTME
|
V y => ? -- was TRUSTME
|
||||||
|
|
||||||
-- fix : {A : U} -> (A -> A) -> A
|
-- fix : {A : U} -> (A -> A) -> A
|
||||||
-- fix = \ {A} g =>
|
-- fix = \ {A} g =>
|
||||||
|
|||||||
@@ -1,14 +0,0 @@
|
|||||||
module Data
|
|
||||||
|
|
||||||
-- The code to handle this is full of TODO
|
|
||||||
-- stuff is not checked and it's not read as data, just
|
|
||||||
-- type signatures.
|
|
||||||
|
|
||||||
data Nat : U where
|
|
||||||
Z : Nat
|
|
||||||
S : Nat -> Nat
|
|
||||||
|
|
||||||
-- My initial version of this needed unbound implicits
|
|
||||||
data Maybe : U -> U where
|
|
||||||
Nothing : {a : U} -> Maybe a
|
|
||||||
Just : {a : U} -> a -> Maybe a
|
|
||||||
@@ -1,12 +0,0 @@
|
|||||||
module Bug
|
|
||||||
|
|
||||||
Nat : U
|
|
||||||
Nat = (N : U) -> (N -> N) -> N -> N
|
|
||||||
|
|
||||||
zero : Nat
|
|
||||||
zero = \ U s z => z
|
|
||||||
|
|
||||||
-- This fails unification if we allow U on the LHS, because U is special on the RHS.
|
|
||||||
-- We need to not parse it on the LHS if we're not pattern matching.
|
|
||||||
succ : Nat -> Nat
|
|
||||||
succ = \ n U s z => s (n U s z)
|
|
||||||
11
scripts/test
Executable file
11
scripts/test
Executable file
@@ -0,0 +1,11 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
for i in tests/black/*.newt; do
|
||||||
|
./build/exec/newt $i
|
||||||
|
if [ $? != "0" ]; then
|
||||||
|
echo FAIL $i
|
||||||
|
exit -1
|
||||||
|
fi
|
||||||
|
echo $?
|
||||||
|
done
|
||||||
|
|
||||||
@@ -168,6 +168,13 @@ parameters (ctx: Context)
|
|||||||
case lookup k' !(get) of
|
case lookup k' !(get) of
|
||||||
Just (MkEntry name ty (Fn tm)) => unify l t !(vappSpine !(eval [] CBN tm) sp')
|
Just (MkEntry name ty (Fn tm)) => unify l t !(vappSpine !(eval [] CBN tm) sp')
|
||||||
_ => error ctx.fc "unify failed \{show t'} =?= \{show u'} [no Fn]\n env is \{show ctx.env} \{show $ map fst ctx.types}"
|
_ => error ctx.fc "unify failed \{show t'} =?= \{show u'} [no Fn]\n env is \{show ctx.env} \{show $ map fst ctx.types}"
|
||||||
|
|
||||||
|
(VRef fc k def sp, u) => do
|
||||||
|
debug "expand %ref \{k} =?= \{show u}"
|
||||||
|
case lookup k !(get) of
|
||||||
|
Just (MkEntry name ty (Fn tm)) => unify l !(vappSpine !(eval [] CBN tm) sp) u
|
||||||
|
_ => error ctx.fc "unify failed \{show t'} [no Fn] =?= \{show u'}\n env is \{show ctx.env} \{show $ map fst ctx.types}"
|
||||||
|
|
||||||
-- REVIEW I'd like to quote this back, but we have l that aren't in the environment.
|
-- REVIEW I'd like to quote this back, but we have l that aren't in the environment.
|
||||||
_ => error ctx.fc "unify failed \{show t'} =?= \{show u'} \n env is \{show ctx.env} \{show $ map fst ctx.types}"
|
_ => error ctx.fc "unify failed \{show t'} =?= \{show u'} \n env is \{show ctx.env} \{show $ map fst ctx.types}"
|
||||||
where
|
where
|
||||||
|
|||||||
13
src/Main.idr
13
src/Main.idr
@@ -24,6 +24,9 @@ import System
|
|||||||
import System.Directory
|
import System.Directory
|
||||||
import System.File
|
import System.File
|
||||||
|
|
||||||
|
fail : String -> M ()
|
||||||
|
fail msg = putStrLn msg >> exitFailure
|
||||||
|
|
||||||
dumpContext : TopContext -> M ()
|
dumpContext : TopContext -> M ()
|
||||||
dumpContext top = do
|
dumpContext top = do
|
||||||
putStrLn "Context:"
|
putStrLn "Context:"
|
||||||
@@ -46,11 +49,11 @@ processFile fn = do
|
|||||||
| Left err => printLn err
|
| Left err => printLn err
|
||||||
let toks = tokenise src
|
let toks = tokenise src
|
||||||
let Right res = parse parseMod toks
|
let Right res = parse parseMod toks
|
||||||
| Left y => putStrLn (showError src y)
|
| Left y => fail (showError src y)
|
||||||
putStrLn $ render 80 $ pretty res
|
putStrLn $ render 80 $ pretty res
|
||||||
printLn "process Decls"
|
printLn "process Decls"
|
||||||
Right _ <- tryError $ traverse_ processDecl (collectDecl res.decls)
|
Right _ <- tryError $ traverse_ processDecl (collectDecl res.decls)
|
||||||
| Left y => putStrLn (showError src y)
|
| Left y => fail (showError src y)
|
||||||
|
|
||||||
dumpContext !get
|
dumpContext !get
|
||||||
dumpSource
|
dumpSource
|
||||||
@@ -61,8 +64,6 @@ main' = do
|
|||||||
putStrLn "Args: \{show args}"
|
putStrLn "Args: \{show args}"
|
||||||
let (_ :: files) = args
|
let (_ :: files) = args
|
||||||
| _ => putStrLn "Usage: newt foo.newt"
|
| _ => putStrLn "Usage: newt foo.newt"
|
||||||
-- Right files <- listDir "eg"
|
|
||||||
-- | Left err => printLn err
|
|
||||||
when ("-v" `elem` files) $ modify { verbose := True }
|
when ("-v" `elem` files) $ modify { verbose := True }
|
||||||
traverse_ processFile (filter (".newt" `isSuffixOf`) files)
|
traverse_ processFile (filter (".newt" `isSuffixOf`) files)
|
||||||
|
|
||||||
@@ -71,5 +72,7 @@ main = do
|
|||||||
-- we'll need to reset for each file, etc.
|
-- we'll need to reset for each file, etc.
|
||||||
ctx <- empty
|
ctx <- empty
|
||||||
Right _ <- runEitherT $ runStateT ctx $ main'
|
Right _ <- runEitherT $ runStateT ctx $ main'
|
||||||
| Left (E (c, r) str) => putStrLn "ERROR at (\{show c}, \{show r}): \{show str}"
|
| Left (E (c, r) str) => do
|
||||||
|
putStrLn "ERROR at (\{show c}, \{show r}): \{show str}"
|
||||||
|
exitFailure
|
||||||
putStrLn "done"
|
putStrLn "done"
|
||||||
|
|||||||
Reference in New Issue
Block a user