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

Add implicit foralls for bidir, update and unify pipeline

Browse source
This commit is contained in:
Martin Fredin 2023-04-03 17:34:33 +02:00
parent 12bca1c32d
commit 9870802371
33 changed files with 1010 additions and 1055 deletions
Download patch file Download diff file Expand all files Collapse all files

96
tests/TestRenamer.hs Normal file
View file

@ -0,0 +1,96 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# HLINT ignore "Use camelCase" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE QualifiedDo #-}
module TestRenamer (testRenamer, test, runPrint) where
import AnnForall (annotateForall)
import Control.Exception (ErrorCall (ErrorCall),
Exception (displayException),
SomeException (SomeException),
evaluate, try)
import Control.Exception.Extra (try_)
import Control.Monad (unless, (<=<))
import Control.Monad.Except (throwError)
import Data.Either.Extra (fromEither)
import qualified DoStrings as D
import GHC.Generics (Generic, Generic1)
import Grammar.Abs (Program (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 System.IO.Error (catchIOError, tryIOError)
import Test.Hspec (anyErrorCall, anyException,
describe, hspec, shouldBe,
shouldNotSatisfy, shouldReturn,
shouldSatisfy, shouldThrow,
specify)
import TypeChecker.ReportTEVar (reportTEVar)
import TypeChecker.TypeCheckerBidir (typecheck)
import qualified TypeChecker.TypeCheckerIr as T
-- FIXME tests sucks
test = hspec testRenamer
testRenamer = describe "Test Renamer" $ do
rn_data1
rn_data2
rn_sig
rn_bind1
rn_bind2
rn_data1 = specify "Rename data type" . shouldSatisfyOk $
D.do "data forall a. forall b. Either (a b) where"
" Left : a -> Either (a b)"
" Right : b -> Either (a b)"
rn_data2 = specify "Rename data type forall in constructor " . shouldSatisfyOk $
D.do "data forall a. forall b. Either (a b) where"
" Left : forall c. c -> a -> Either (a b)"
" Right : b -> Either (a b)"
rn_sig = specify "Rename signature" $ shouldSatisfyOk
"f : forall a. forall b. a -> b -> (forall a. a -> a) -> a"
rn_bind1 = specify "Rename simple bind" $ shouldSatisfyOk
"f x = (\\y. let y2 = y + 1 in y2) (x + 1)"
rn_bind2 = specify "Rename bind with case" . shouldSatisfyOk $
D.do "data forall a. List (a) where"
" Nil : List (a) "
" Cons : a -> List (a) -> List (a)"
"length : forall a. List (a) -> Int"
"length list = case list of"
" Nil => 0"
" Cons x Nil => 1"
" Cons x (Cons y ys) => 2 + length ys"
runPrint = putStrLn . either show printTree . run $
D.do "data forall a. List (a) where"
" Nil : List (a) "
" Cons : a -> List (a) -> List (a)"
"length : forall a. List (a) -> Int"
"length list = case list of"
" Nil => 0"
" Cons x Nil => 1"
" Cons x (Cons y ys) => 2 + length ys"
shouldSatisfyOk s = run s `shouldSatisfy` ok
ok = \case
Ok !_ -> True
Bad !_ -> False
shouldBeErr s err = run s `shouldBe` Bad err
run = rename <=< run'
run' = pProgram . resolveLayout True . myLexer