128 lines
3.8 KiB
Haskell
128 lines
3.8 KiB
Haskell
{-# LANGUAGE PatternSynonyms #-}
|
|
{-# LANGUAGE QualifiedDo #-}
|
|
{-# HLINT ignore "Use camelCase" #-}
|
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
|
|
module TestAnnForall (testAnnForall, test) where
|
|
|
|
import AnnForall (annotateForall)
|
|
import Control.Monad ((<=<))
|
|
import Desugar.Desugar (desugar)
|
|
import DoStrings qualified as D
|
|
import Grammar.ErrM (Err, pattern Bad, pattern Ok)
|
|
import Grammar.Layout (resolveLayout)
|
|
import Grammar.Par (myLexer, pProgram)
|
|
import Grammar.Print (printTree)
|
|
import Renamer.Renamer (rename)
|
|
import ReportForall (reportForall)
|
|
import Test.Hspec (
|
|
describe,
|
|
hspec,
|
|
shouldBe,
|
|
shouldNotSatisfy,
|
|
shouldSatisfy,
|
|
shouldThrow,
|
|
specify,
|
|
)
|
|
import TypeChecker.ReportTEVar (reportTEVar)
|
|
import TypeChecker.TypeChecker (TypeChecker (Bi, Hm))
|
|
import TypeChecker.TypeCheckerBidir (typecheck)
|
|
import TypeChecker.TypeCheckerIr qualified as T
|
|
|
|
test = hspec testAnnForall
|
|
|
|
testAnnForall = describe "Test AnnForall" $ do
|
|
ann_data1
|
|
ann_data2
|
|
ann_bad_data1
|
|
ann_bad_data2
|
|
ann_bad_data3
|
|
ann_sig1
|
|
ann_sig2
|
|
ann_bind
|
|
|
|
ann_data1 =
|
|
specify "Annotate data type" $
|
|
D.do
|
|
"data Either a b where"
|
|
" Left : a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
`shouldBePrg` D.do
|
|
"data forall a. forall b. Either a b where"
|
|
" Left : a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
|
|
ann_data2 =
|
|
specify "Annotate constructor with additional type variable" $
|
|
D.do
|
|
"data forall a. forall b. Either a b where"
|
|
" Left : c -> a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
`shouldBePrg` D.do
|
|
"data forall a. forall b. Either a b where"
|
|
" Left : forall c. c -> a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
|
|
ann_bad_data1 =
|
|
specify "Bad data type variables" $
|
|
D.do
|
|
"data Either Int b where"
|
|
" Left : a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
`shouldBeErr` "Misformed data declaration: Non type variable argument"
|
|
|
|
ann_bad_data2 =
|
|
specify "Bad data identifer" $
|
|
D.do
|
|
"data Int -> Either a b where"
|
|
" Left : a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
`shouldBeErr` "Misformed data declaration"
|
|
|
|
ann_bad_data3 =
|
|
specify "Constructor forall duplicate" $
|
|
D.do
|
|
"data Int -> Either a b where"
|
|
" Left : forall a. a -> Either a b"
|
|
" Right : b -> Either a b"
|
|
`shouldBeErr` "Misformed data declaration"
|
|
|
|
ann_sig1 =
|
|
specify "Annotate signature" $
|
|
"f : a -> b -> (forall a. a -> a) -> a"
|
|
`shouldBePrg` "f : forall a. forall b. a -> b -> (forall a. a -> a) -> a"
|
|
|
|
ann_sig2 =
|
|
specify "Annotate signature 2" $
|
|
D.do
|
|
"const : forall a. forall b. a -> b -> a"
|
|
"const x y = x"
|
|
"main = const 'a' 65"
|
|
`shouldBePrg` D.do
|
|
"const : forall a. forall b. a -> b -> a"
|
|
"const x y = x"
|
|
"main = const 'a' 65"
|
|
|
|
ann_bind =
|
|
specify "Annotate bind" $
|
|
"f = (\\x.\\y. x : a -> b -> a) 4"
|
|
`shouldBePrg` "f = (\\x.\\y. x : forall a. forall b. a -> b -> a) 4"
|
|
|
|
shouldBeErr s err = run s `shouldBe` Bad err
|
|
|
|
shouldBePrg s1 s2
|
|
| Ok p2 <- run' s2 = run s1 `shouldBe` Ok p2
|
|
| otherwise = error ("Faulty expectation \n" ++ show (run' s2))
|
|
|
|
run = annotateForall <=< run'
|
|
run' s = do
|
|
p <- run'' s
|
|
reportForall Bi p
|
|
pure p
|
|
run'' = fmap desugar . pProgram . resolveLayout True . myLexer
|
|
|
|
runPrint = (putStrLn . either show printTree . run) $
|
|
D.do
|
|
"data forall a. forall b. Either a b where"
|
|
" Left : c -> a -> Either a b"
|
|
" Right : b -> Either a b"
|