Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Propagate type application, temporary remove nested pattern matching, fix void output

Browse source
This commit is contained in:
Martin Fredin 2023-05-12 11:40:24 +02:00
parent 6260dc2c41
commit c3bcdfa81b
4 changed files with 175 additions and 140 deletions
Download patch file Download diff file Expand all files Collapse all files

60
tests/TestTypeCheckerBidir.hs
View file

@ -1,28 +1,28 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PatternSynonyms #-}
{-# HLINT ignore "Use camelCase" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module TestTypeCheckerBidir (test, testTypeCheckerBidir) where
import Test.Hspec
import Test.Hspec
import AnnForall (annotateForall)
import Control.Monad ((<=<))
import Desugar.Desugar (desugar)
import Grammar.Abs (Program)
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 TypeChecker.RemoveForall (removeForall)
import TypeChecker.ReportTEVar (reportTEVar)
import TypeChecker.TypeChecker (TypeChecker (Bi))
import TypeChecker.TypeCheckerBidir (typecheck)
import TypeChecker.TypeCheckerIr qualified as T
import AnnForall (annotateForall)
import Control.Monad ((<=<))
import Desugar.Desugar (desugar)
import Grammar.Abs (Program)
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 TypeChecker.RemoveForall (removeForall)
import TypeChecker.ReportTEVar (reportTEVar)
import TypeChecker.TypeChecker (TypeChecker (Bi))
import TypeChecker.TypeCheckerBidir (typecheck)
import qualified TypeChecker.TypeCheckerIr as T
test = hspec testTypeCheckerBidir
@ -189,16 +189,16 @@ tc_pol_case = describe "Polymophic and recursive pattern matching" $ do
run (fs ++ wrong2) `shouldNotSatisfy` ok
specify "Third wrong case expression rejected" $
run (fs ++ wrong3) `shouldNotSatisfy` ok
specify "Forth wrong case expression rejected" $
run (fs ++ wrong4) `shouldNotSatisfy` ok
specify "First correct case expression accepted" $
run (fs ++ correct1) `shouldSatisfy` ok
-- specify "Forth wrong case expression rejected" $
-- run (fs ++ wrong4) `shouldNotSatisfy` ok
-- specify "First correct case expression accepted" $
-- run (fs ++ correct1) `shouldSatisfy` ok
specify "Second correct case expression accepted" $
run (fs ++ correct2) `shouldSatisfy` ok
specify "Third correct case expression accepted" $
run (fs ++ correct3) `shouldSatisfy` ok
specify "Forth correct case expression accepted" $
run (fs ++ correct4) `shouldSatisfy` ok
-- specify "Third correct case expression accepted" $
-- run (fs ++ correct3) `shouldSatisfy` ok
-- specify "Forth correct case expression accepted" $
-- run (fs ++ correct4) `shouldSatisfy` ok
where
fs =
[ "data List a where"
@ -254,9 +254,9 @@ tc_pol_case = describe "Polymophic and recursive pattern matching" $ do
correct4 =
[ "elems : List (List c) -> Int"
, "elems = \\list. case list of"
, " Nil => 0"
, " Cons Nil Nil => 0"
, " Cons Nil xs => elems xs"
--, " Nil => 0"
--, " Cons Nil Nil => 0"
--, " Cons Nil xs => elems xs"
, " Cons (Cons _ ys) xs => 1 + elems (Cons ys xs)"
]
@ -329,5 +329,5 @@ runPrint =
["double x = x + x"]
ok = \case
Ok _ -> True
Ok _ -> True
Bad _ -> False