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

Fix Ident print instance

Browse source
This commit is contained in:
Martin Fredin 2023-03-27 20:51:00 +02:00
parent ad2bd645d9
commit a38e96a83b
2 changed files with 24 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

30
src/TypeChecker/TypeCheckerIr.hs
View file

@ -1,4 +1,4 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
module TypeChecker.TypeCheckerIr ( module TypeChecker.TypeCheckerIr (
@ -6,11 +6,11 @@ module TypeChecker.TypeCheckerIr (
module TypeChecker.TypeCheckerIr, module TypeChecker.TypeCheckerIr,
) where ) where
import Data.String (IsString) import Data.String (IsString)
import Grammar.Abs (Lit (..), TVar (..)) import Grammar.Abs (Lit (..), TVar (..))
import Grammar.Print import Grammar.Print
import Prelude import Prelude
import Prelude qualified as C (Eq, Ord, Read, Show) import qualified Prelude as C (Eq, Ord, Read, Show)
newtype Program' t = Program [Def' t] newtype Program' t = Program [Def' t]
deriving (C.Eq, C.Ord, C.Show, C.Read) deriving (C.Eq, C.Ord, C.Show, C.Read)
@ -66,7 +66,7 @@ data Branch' t = Branch (Pattern' t, t) (ExpT' t)
deriving (C.Eq, C.Ord, C.Show, C.Read) deriving (C.Eq, C.Ord, C.Show, C.Read)
instance Print Ident where instance Print Ident where
prt i (Ident s) = prt i s prt _ (Ident s) = doc $ showString s
instance Print t => Print (Program' t) where instance Print t => Print (Program' t) where
prt i (Program sc) = prPrec i 0 $ prt 0 sc prt i (Program sc) = prPrec i 0 $ prt 0 sc
@ -102,8 +102,8 @@ instance Print t => Print (ExpT' t) where
] ]
instance Print t => Print [Bind' t] where instance Print t => Print [Bind' t] where
prt _ [] = concatD [] prt _ [] = concatD []
prt _ [x] = concatD [prt 0 x] prt _ [x] = concatD [prt 0 x]
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
prtIdPs :: Print t => Int -> [Id' t] -> Doc prtIdPs :: Print t => Int -> [Id' t] -> Doc
@ -168,13 +168,13 @@ instance Print t => Print (Branch' t) where
prt i (Branch (pattern_, t) exp) = prPrec i 0 (concatD [doc (showString "("), prt 0 pattern_, doc (showString " : "), prt 0 t, doc (showString ")"), doc (showString "=>"), prt 0 exp]) prt i (Branch (pattern_, t) exp) = prPrec i 0 (concatD [doc (showString "("), prt 0 pattern_, doc (showString " : "), prt 0 t, doc (showString ")"), doc (showString "=>"), prt 0 exp])
instance Print t => Print [Branch' t] where instance Print t => Print [Branch' t] where
prt _ [] = concatD [] prt _ [] = concatD []
prt _ [x] = concatD [prt 0 x] prt _ [x] = concatD [prt 0 x]
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
instance Print t => Print (Def' t) where instance Print t => Print (Def' t) where
prt i = \case prt i = \case
DBind bind -> prPrec i 0 (concatD [prt 0 bind]) DBind bind -> prPrec i 0 (concatD [prt 0 bind])
DData data_ -> prPrec i 0 (concatD [prt 0 data_]) DData data_ -> prPrec i 0 (concatD [prt 0 data_])
instance Print t => Print (Data' t) where instance Print t => Print (Data' t) where
@ -194,12 +194,12 @@ instance Print t => Print (Pattern' t) where
PInj uident patterns -> prPrec i 0 (concatD [prt 0 uident, prt 1 patterns]) PInj uident patterns -> prPrec i 0 (concatD [prt 0 uident, prt 1 patterns])
instance Print t => Print [Def' t] where instance Print t => Print [Def' t] where
prt _ [] = concatD [] prt _ [] = concatD []
prt _ [x] = concatD [prt 0 x] prt _ [x] = concatD [prt 0 x]
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs] prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
instance Print [Type] where instance Print [Type] where
prt _ [] = concatD [] prt _ [] = concatD []
prt _ (x : xs) = concatD [prt 0 x, doc (showString " "), prt 0 xs] prt _ (x : xs) = concatD [prt 0 x, doc (showString " "), prt 0 xs]
instance Print Type where instance Print Type where

17
tests/TestTypeCheckerHm.hs
View file

@ -1,16 +1,17 @@
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QualifiedDo #-}
module TestTypeCheckerHm where module TestTypeCheckerHm where
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import DoStrings qualified as D import qualified DoStrings as D
import Grammar.Par (myLexer, pProgram) import Grammar.Par (myLexer, pProgram)
import Test.Hspec import Prelude (Bool (..), Either (..), IO, foldl1,
import Prelude (Bool (..), Either (..), IO, foldl1, mapM_, not, ($), (.), (>>)) mapM_, not, ($), (.), (>>))
import Test.Hspec
-- import Test.QuickCheck -- import Test.QuickCheck
import TypeChecker.TypeCheckerHm (typecheck) import TypeChecker.TypeCheckerHm (typecheck)
testTypeCheckerHm = describe "Hindley-Milner type checker test" $ do testTypeCheckerHm = describe "Hindley-Milner type checker test" $ do
foldl1 (>>) goods foldl1 (>>) goods
@ -178,7 +179,7 @@ testBe desc test shouldbe = specify desc $ run test `shouldBe` run shouldbe
run = typecheck <=< pProgram . myLexer run = typecheck <=< pProgram . myLexer
ok (Right _) = True ok (Right _) = True
ok (Left _) = False ok (Left _) = False
bad = not . ok bad = not . ok