quox/tests/Tests/Parser.idr
2022-05-09 18:31:30 +02:00

144 lines
3.9 KiB
Idris
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Tests.Parser
import Quox.Syntax
import Quox.Parser
import Quox.Lexer
import Tests.Lexer
import Quox.Pretty
import TermImpls
import Data.SnocVect
import Text.Parser
import TAP
export
Show tok => ToInfo (ParsingError tok) where
toInfo (Error msg Nothing) = [("msg", msg)]
toInfo (Error msg (Just loc)) = [("loc", show loc), ("msg", msg)]
numberErrs : List1 Info -> Info
numberErrs (head ::: []) = head
numberErrs (head ::: tail) = go 0 (head :: tail) where
number1 : Nat -> Info -> Info
number1 n = map $ \(k, v) => (show n ++ k, v)
go : Nat -> List Info -> Info
go k [] = []
go k (x :: xs) = number1 k x ++ go (S k) xs
export
ToInfo Parser.Error where
toInfo (Lex err) = toInfo err
toInfo (Parse errs) = numberErrs $ map toInfo errs
toInfo (Leftover toks) = toInfo [("leftover", toks)]
RealError = Quox.Parser.Error
%hide Lexer.RealError
%hide Quox.Parser.Error
data Error a
= Parser RealError
| Unexpected a a
| ShouldFail a
export
Show a => ToInfo (Error a) where
toInfo (Parser err) = toInfo err
toInfo (Unexpected exp got) = toInfo $
[("expected", exp), ("received", got)]
toInfo (ShouldFail got) = toInfo [("success", got)]
parameters {c : Bool} (grm : Grammar c a) (note : String) (input : String)
parsesNote : (Show a, Eq a) => a -> Test
parsesNote exp = test "\"\{input}\"\{note}" $ delay $
case lexParseAll grm input of
Right got => if got == exp then Right ()
else Left $ Unexpected exp got
Left err => Left $ Parser err
rejectsNote : Show a => Test
rejectsNote = test "\"\{input}\"\{note} reject" $ do
case lexParseAll grm input of
Left err => Right ()
Right val => Left $ ShouldFail val
parameters {c : Bool} (grm : Grammar c a) (input : String)
parses : (Show a, Eq a) => a -> Test
parses = parsesNote grm "" input
rejects : Show a => Test
rejects = rejectsNote grm "" input
tests = "parser" :- [
"numbers" :-
let parses = parses number
in [
parses "0" 0,
parses "1" 1,
parses "1000" 1000
],
"bound vars (x, y, z | a ⊢)" :-
let grm = bound "test" {bound = [< "x", "y", "z"], avoid = [< "a"]}
parses = parses grm; rejects = rejects grm; rejectsNote = rejectsNote grm
in [
parses "x" (V 2),
parses "y" (V 1),
parses "z" (V 0),
rejects "M.x",
rejects "x.a",
rejectsNote " (avoid)" "a",
rejectsNote " (not in scope)" "c"
],
"bound or free vars (x, y, z ⊢)" :-
let parses = parses $ nameWith {bound = [< "x", "y", "z"], avoid = [<]}
in [
parses "x" (Left (V 2)),
parses "y" (Left (V 1)),
parses "z" (Left (V 0)),
parses "a" (Right (MakeName [<] (UN "a"))),
parses "a.b.c" (Right (MakeName [< "a", "b"] (UN "c"))),
parses "a . b . c" (Right (MakeName [< "a", "b"] (UN "c"))),
parses "M.x" (Right (MakeName [< "M"] (UN "x"))),
parses "x.a" (Right (MakeName [< "x"] (UN "a")))
],
"dimension (i, j | x, y, z ⊢)" :-
let grm = dimension {dvars = [< "i", "j"], tvars = [< "x", "y", "z"]}
parses = parses grm; rejects = rejects grm; rejectsNote = rejectsNote grm
in [
parses "0" (K Zero),
parses "1" (K One),
rejects "2",
parses "i" (B (V 1)),
rejectsNote " (tvar)" "x",
rejectsNote " (not in scope)" "a"
],
"terms & elims (i, j | x, y, z ⊢)" :-
let dvars = [< "i", "j"]; tvars = [< "x", "y", "z"]
tgrm = term {dvars, tvars}; egrm = elim {dvars, tvars}
tparses = parsesNote tgrm " (term)"
eparses = parsesNote egrm " (elim)"
trejects = rejectsNote tgrm " (term)"
erejects = rejectsNote egrm " (elim)"
in [
"universes" :- [
tparses "★0" (TYPE 0),
tparses "★1000" (TYPE 1000)
],
"variables" :- [
eparses "a" (F "a"),
eparses "x" (BV 2),
trejects "a",
tparses "[a]" (FT "a"),
tparses "[x]" (BVT 2)
]
]
]