Skip to content

Commit 0a7be70

Browse files
committed
Typechecker: more tests, format errore message text, bug fix in ASTtoIASTConverter.
1 parent 4ee6e82 commit 0a7be70

22 files changed

+206
-48
lines changed

lambdaQ.cabal

+8
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ library
5252
, hspec
5353
, mtl
5454
, parsec
55+
, text-format-simple
5556
default-language: Haskell2010
5657

5758
executable lambdaQ
@@ -70,6 +71,7 @@ executable lambdaQ
7071
, lambdaQ
7172
, mtl
7273
, parsec
74+
, text-format-simple
7375
default-language: Haskell2010
7476

7577
executable runCodeGenerator
@@ -88,6 +90,7 @@ executable runCodeGenerator
8890
, lambdaQ
8991
, mtl
9092
, parsec
93+
, text-format-simple
9194
default-language: Haskell2010
9295

9396
executable runIASTConversion
@@ -106,6 +109,7 @@ executable runIASTConversion
106109
, lambdaQ
107110
, mtl
108111
, parsec
112+
, text-format-simple
109113
default-language: Haskell2010
110114

111115
executable runParser
@@ -124,6 +128,7 @@ executable runParser
124128
, lambdaQ
125129
, mtl
126130
, parsec
131+
, text-format-simple
127132
default-language: Haskell2010
128133

129134
executable runSemanticAnalysis
@@ -142,6 +147,7 @@ executable runSemanticAnalysis
142147
, lambdaQ
143148
, mtl
144149
, parsec
150+
, text-format-simple
145151
default-language: Haskell2010
146152

147153
executable runTypeChecker
@@ -160,6 +166,7 @@ executable runTypeChecker
160166
, lambdaQ
161167
, mtl
162168
, parsec
169+
, text-format-simple
163170
default-language: Haskell2010
164171

165172
test-suite lambdaQ-test
@@ -183,4 +190,5 @@ test-suite lambdaQ-test
183190
, lambdaQ
184191
, mtl
185192
, parsec
193+
, text-format-simple
186194
default-language: Haskell2010

package.yaml

+1
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ dependencies:
2727
- mtl
2828
- parsec
2929
- QuickCheck
30+
- text-format-simple
3031

3132
ghc-options:
3233
- -Wall

src/Frontend/ASTtoIASTConverter.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -442,7 +442,7 @@ mapTerm _ (GeneratedAbstractSyntax.TermBasisState bs) = TermBasisState (mapBasis
442442
mapTerm _ (GeneratedAbstractSyntax.TermBoolExpression be) = TermBool (mapBoolExpression be)
443443
mapTerm _ (GeneratedAbstractSyntax.TermIntegerExpression be) = TermInteger (mapIntegerExpression be)
444444
mapTerm _ (GeneratedAbstractSyntax.TermGate g) = TermGate (mapGate g)
445-
mapTerm env (GeneratedAbstractSyntax.TermTuple term terms) = TermTuple (mapTerm env term) (map (mapTerm env) (term:terms))
445+
mapTerm env (GeneratedAbstractSyntax.TermTuple term terms) = TermTuple (mapTerm env term) (map (mapTerm env) terms)
446446
mapTerm env (GeneratedAbstractSyntax.TermApply l r) = TermApply (mapTerm env l) (mapTerm env r)
447447
mapTerm env (GeneratedAbstractSyntax.TermDollar l r) = TermDollar (mapTerm env l) (mapTerm env r)
448448
mapTerm env (GeneratedAbstractSyntax.TermCompose l r) = TermCompose (mapTerm env l) (mapTerm env r)

src/Frontend/TypeChecker.hs

+48-28
Original file line numberDiff line numberDiff line change
@@ -18,42 +18,45 @@ import qualified Control.Monad.State.Class
1818
import qualified Data.Map
1919
import qualified Data.Maybe
2020
import qualified Data.Set
21+
import Text.Format (format)
2122

2223
import Frontend.ASTtoIASTConverter (Function(..), Gate(..), Program, Term(..), Type(..), List(..), CaseExpression(..), simplifyTensorProd)
2324

2425
data TypeError
25-
= NotAFunction Type (Int, Int, String) -- this type should be a function but it is not
26-
| FunctionNotInScope String (Int, Int, String) -- this variable denotes a function which is not in scope at the point where it is used
27-
| TypeMismatch Type Type (Int, Int, String) -- this type does not match the type expected at the point where it was declared
28-
| NotAProductType Type (Int, Int, String) -- this type should be a product type but it is not
29-
| DuplicatedLinearVariable String (Int, Int, String) -- this linear variable is used more than once
30-
| NotALinearFunction String (Int, Int, String) -- this function is used more than once despite not being declared linear
31-
| NotALinearTerm Term Type (Int, Int, String) -- this term should be linear but is is not
32-
| NoCommonSupertype Type Type (Int, Int, String) -- these two types have no common supertype
26+
= NotAFunction Type (Int, Int, String) -- this type should be a function but it is not
27+
| FunctionNotInScope String (Int, Int, String) -- this variable denotes a function which is not in scope at the point where it is used
28+
| TypeMismatchFun Type Type (Int, Int, String) -- this type does not match the type expected at the point where it was declared
29+
| TypeMismatchIfElse Term Term Type Type (Int, Int, String) -- this type does not match the type expected at the point where it was declared
30+
| TypeMismatchApply Term Term Type Type (Int, Int, String) -- this type does not match the type expected at the point where it was declared
31+
| NotAProductType Type (Int, Int, String) -- this type should be a product type but it is not
32+
| DuplicatedLinearVariable String (Int, Int, String) -- this linear variable is used more than once
33+
| NotALinearFunction String (Int, Int, String) -- this function is used more than once despite not being declared linear
34+
| NotALinearTerm Term Type (Int, Int, String) -- this term should be linear but is is not
35+
| NoCommonSupertype Type Type (Int, Int, String) -- these two types have no common supertype
3336
deriving (Eq, Ord, Read)
3437

35-
instance Show TypeError where
38+
instance Show TypeError where
3639
show :: TypeError -> String
37-
show (NotAFunction typ (line, _, fname)) = "The inferred type: '" ++ show typ ++ "' of the top level function named: '" ++ fname ++ "' defined at line: " ++ show line ++ " should be a function type but it is not"
40+
41+
show (NotAFunction typ (line, _, fname)) = format "The inferred type: '{0}' of the top level function named: '{1}' defined at line: {2} should be a function type but it is not" [show typ, fname, show line]
3842

39-
show (FunctionNotInScope var (line, _, fname)) = "The variable named '" ++ var ++ "' in the top level function named: '" ++ fname ++ "' defined at line: "
40-
++ show line ++ " denotes a function which is not in scope"
43+
show (FunctionNotInScope var (line, _, fname)) = format "The variable named '{0}' in the top level function named: '{1}' defined at line: {2} denotes a function which is not in scope" [var, fname, show line]
44+
45+
show (TypeMismatchFun type1 type2 (line, _, fname)) = format "The expected type '{0}' of the top level function named: '{1}' defined at line: {2} cannot be matched with actual type: '{3}'" [show type1, fname, show line, show type2]
46+
47+
show (TypeMismatchIfElse term1 term2 type1 type2 (line, _, fname)) = format "The expected type '{0}' of the top level function named: '{1}' defined at line: {2} cannot be matched with actual type: '{3}'" [show type1, fname, show line, show type2]
4148

42-
show (TypeMismatch type1 type2 (line, _, fname)) = "The expected type '" ++ show type1 ++ "' of the top level function named: '" ++ fname ++ "' defined at line: " ++ show line ++ " cannot be matched with actual type: '" ++ show type2 ++ "'"
49+
show (TypeMismatchApply term1 term2 type1 type2 (line, _, fname)) = format "The expected type '{0}' of the top level function named: '{1}' defined at line: {2} cannot be matched with actual type: '{3}'" [show type1, fname, show line, show type2]
4350

44-
show (NotAProductType typ (line, _, fname)) = "The type '" ++ show typ ++ "' in the top level function named: '" ++ fname ++ "' defined at line: "
45-
++ show line ++ " is not a product type"
51+
show (NotAProductType typ (line, _, fname)) = format "The type '{0}' in the top level function named: '{1}' defined at line: {2} is not a product type" [show typ, fname, show line]
4652

47-
show (DuplicatedLinearVariable var (line, _, fname)) = "The linear variable '" ++ var ++ "' in the top level function named: '" ++ fname ++ "' defined at line: " ++ show line ++ " is used more than once"
53+
show (DuplicatedLinearVariable var (line, _, fname)) = format "The linear variable '{0}' in the top level function named: '{1}' defined at line: {2} is used more than once" [var, fname, show line]
4854

49-
show (NotALinearFunction fun (line, _, fname)) = "The function named: '" ++ fun ++ "' which is used in the top level function named: '" ++ fname
50-
++ "' defined at line: " ++ show line ++ " is used more than once despite not being declared linear"
55+
show (NotALinearFunction fun (line, _, fname)) = format "The function named: '{0}' which is used in the top level function named: '{1}' defined at line: {2} is used more than once despite not being declared linear" [fun, fname, show line]
5156

52-
show (NotALinearTerm term typ (line, _, fname)) = "Term: '" ++ show term ++ "' having as type: " ++ show typ
53-
++ " which occurs in function " ++ fname ++ " defined at line: " ++ show line ++ " is not linear"
57+
show (NotALinearTerm term typ (line, _, fname)) = format "Term: '{0}' having as type: {1} which occurs in function {2} defined at line: {3} is not linear" [show term, show typ, fname, show line]
5458

55-
show (NoCommonSupertype type1 type2 (line, _, fname)) = "Could not find a common super-type for types '"
56-
++ show type1 ++ " and '" ++ show type2 ++ "' expected by top level function '" ++ fname ++ "' defined at line: " ++ show line ++ "."
59+
show (NoCommonSupertype type1 type2 (line, _, fname)) = format "Could not find a common super-type for types '{0}' and '{1}' expected by top level function '{2}' defined at line: {3}." [show type1, show type2, fname, show line]
5760

5861
type LinearEnvironment = Data.Set.Set String
5962
type MainEnvironment = Data.Map.Map String Type
@@ -91,7 +94,7 @@ typeCheckFunction (Function functionName (line, col) functionType term) = do
9194
inferredType <- inferType [] term (line, col, functionName)
9295
if isSubtype inferredType functionType
9396
then return ()
94-
else Control.Monad.Except.throwError (TypeMismatch functionType inferredType (line, col, functionName))
97+
else Control.Monad.Except.throwError (TypeMismatchFun functionType inferredType (line, col, functionName))
9598

9699
-- typesMatch :: Type -> Type -> Bool
97100
-- typesMatch tl tr = (tl' == tr') || isSubtype tl tr
@@ -115,12 +118,25 @@ inferType _ (TermReset _) _ = return $ TypeNonLinear (TypeQbit :->: TypeQbit)
115118
inferType _ (TermId _) _ = return $ TypeNonLinear (TypeQbit :->: TypeQbit)
116119
inferType _ (TermPower _) _ = return $ TypeNonLinear (TypeQbits :->: TypeQbits)
117120
inferType _ (TermInverse _) _ = return $ TypeNonLinear (TypeQbits :->: TypeQbits)
118-
inferType _ (TermBit _) _ = return $ TypeNonLinear TypeBit
119-
inferType _ (TermGate gate) _ = return $ inferGateType gate
120121
inferType _ (TermBool _) _ = return $ TypeNonLinear TypeBool
122+
inferType _ (TermBit _) _ = return $ TypeNonLinear TypeBit
121123
inferType _ (TermInteger _) _ = return $ TypeNonLinear TypeInteger
122-
inferType _ TermUnit _ = return $ TypeNonLinear TypeUnit
123124
inferType _ (TermBasisState _) _ = return TypeBasisState
125+
inferType _ (TermGate gate) _ = return $ inferGateType gate
126+
inferType _ TermUnit _ = return $ TypeNonLinear TypeUnit
127+
128+
-- TermVariable
129+
-- TermBoundVariable
130+
-- TermFreeVariable
131+
-- TermList List
132+
-- TermListElement List Integer
133+
-- TermLet
134+
-- TermCase
135+
-- TermGateQuantumControl
136+
-- TermGateClassicControl
137+
-- TermDollar
138+
-- TermCompose
139+
-- TermTensorProduct
124140

125141
inferType context (TermLambda typ term) (line, col, fname) = do
126142
mainEnv <- Control.Monad.Reader.ask
@@ -139,15 +155,15 @@ inferType context (TermIfElse cond t f) (line, col, fname) = do
139155
typF <- inferType context f (line, col, fname)
140156
if isSubtype typCond TypeBit
141157
then supremum typT typF (line, col, fname)
142-
else Control.Monad.Except.throwError (TypeMismatch TypeBit typCond (line, col, fname))
158+
else Control.Monad.Except.throwError (TypeMismatchIfElse undefined undefined TypeBit typCond (line, col, fname))
143159

144160
inferType context (TermApply termLeft termRight) (line, col, fname) = do
145161
leftTermType <- inferType context termLeft (line, col, fname)
146162
rightTermType <- inferType context termRight (line, col, fname)
147163
case removeBangs leftTermType of
148164
(argsType :->: returnsType)
149165
| isSubtype rightTermType argsType -> return returnsType
150-
| otherwise -> Control.Monad.Except.throwError $ TypeMismatch argsType rightTermType (line, col, fname)
166+
| otherwise -> Control.Monad.Except.throwError $ TypeMismatchApply termLeft termRight argsType rightTermType (line, col, fname)
151167
_ -> Control.Monad.Except.throwError $ NotAFunction leftTermType (line, col, fname)
152168

153169
inferType context (TermTuple l [r]) (line, col, fname) = do
@@ -257,6 +273,7 @@ headBoundVariableCount = headBoundVarCount 0
257273
TermBasisState _ -> 0
258274
TermUnit -> 0
259275

276+
-- THIS SHOULD BE REVIEWD
260277
freeVariables :: Term -> [Integer]
261278
freeVariables = freeVars 0
262279
where
@@ -297,6 +314,7 @@ freeVariables = freeVars 0
297314
freeVars _ (TermBasisState _) = []
298315
freeVars _ TermUnit = []
299316

317+
-- THIS SHOULD BE REVIEWD
300318
extractFunctionNames :: Term -> [String]
301319
extractFunctionNames (TermFreeVariable fun) = [fun]
302320
extractFunctionNames (TermBoundVariable _) = []
@@ -334,6 +352,7 @@ extractFunctionNames (TermGate _) = []
334352
extractFunctionNames (TermBasisState _) = []
335353
extractFunctionNames TermUnit = []
336354

355+
-- smallest common supertype
337356
supremum :: Type -> Type -> (Int, Int, String) -> Check Type
338357
supremum t1 t2 _
339358
| t1 == t2 = return t1
@@ -357,6 +376,7 @@ supremum (t1 :->: t2) (t1' :->: t2') (line, col, fname)
357376
= (:->:) <$> infimum t1 t1' (line, col, fname) <*> supremum t2 t2' (line, col, fname)
358377
supremum t1 t2 (line, col, fname) = Control.Monad.Except.throwError (NoCommonSupertype t1 t2 (line, col, fname))
359378

379+
-- largest common subtype
360380
infimum :: Type -> Type -> (Int, Int, String) -> Check Type
361381
infimum t1 t2 _
362382
| t1 == t2 = return t1

stack.yaml

+2-1
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,8 @@ packages:
4040
# - git: https://github.com/commercialhaskell/stack.git
4141
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
4242
#
43-
# extra-deps: []
43+
extra-deps:
44+
- text-format-simple-1.1.0
4445

4546
# Override default flag values for local packages and extra-deps
4647
# flags: {}

stack.yaml.lock

+9-2
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,18 @@
33
# For more information, please see the documentation at:
44
# https://docs.haskellstack.org/en/stable/lock_files
55

6-
packages: []
6+
packages:
7+
- completed:
8+
hackage: text-format-simple-1.1.0@sha256:5815236396328f556b9896fdcb949d15b485ef05394c9dc846e94b0306cb4036,735
9+
pantry-tree:
10+
sha256: 026136165778e83cb04c587b3609d95731ccf35da07249c9eb0f29ceb6946cbb
11+
size: 215
12+
original:
13+
hackage: text-format-simple-1.1.0
714
snapshots:
815
- completed:
16+
sha256: a95a93bcb7132bf5f8ad3356998e223947852f57d4da63e0e145870ea90d9d18
917
size: 619170
1018
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/19.yaml
11-
sha256: a95a93bcb7132bf5f8ad3356998e223947852f57d4da63e0e145870ea90d9d18
1219
original:
1320
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/19.yaml

0 commit comments

Comments
 (0)