6f677d8 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

catch type mismatch error between relation type hint and tuples

6f677d8AgentM7 years ago

src/lib/ProjectM36/AtomType.hs+6−2

compare with master

unifiedsplit

@@ -224,7 +224,7 @@ findTypeConstructor name = foldr tConsFolder Nothing

224

225resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

226resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) =

227− ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

227+ ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

228resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

229 Right typeFromRelation

230 else

@@ -257,7 +257,11 @@ resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

257 subType@(ConstructedAtomType _ _) -> do

258 resSubType <- resolveAtomType resType subType

259 pure (resKey, resSubType)

260− _ -> pure (resKey, resType)

260+ TypeVariableType _ -> pure (resKey, resType)

261+ typ -> if typ == resType then

262+ pure (resKey, resType)

263+ else

264+ Left $ AtomTypeMismatchError typ resType

261 Nothing ->

265 Nothing ->

262 pure (resKey, resType) --swipe the missing type var from the expected map

266 pure (resKey, resType) --swipe the missing type var from the expected map

263 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

267 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

test/TutorialD/Interpreter.hs+7−1

@@ -75,7 +75,8 @@ main = do

75 testWithClause,

76 testAtomFunctionArgumentMismatch,

77 testInvalidDataConstructor,

78− testBasicList

78+ testBasicList,

79+ testRelationDeclarationMismatch

79 ]

80 ]

80 simpleRelTests = [("x:=true", Right relationTrue),

81 simpleRelTests = [("x:=true", Right relationTrue),

81 ("x:=false", Right relationFalse),

82 ("x:=false", Right relationFalse),

@@ -656,3 +657,8 @@ testBasicList :: Test

656testBasicList = TestCase $ do

657testBasicList = TestCase $ do

657 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

658 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

658 executeTutorialD sessionId dbconn "x := relation{tuple{ a (Cons 1 (Cons 2 Empty)) }}"

659 executeTutorialD sessionId dbconn "x := relation{tuple{ a (Cons 1 (Cons 2 Empty)) }}"

660+

661+testRelationDeclarationMismatch :: Test

662+testRelationDeclarationMismatch = TestCase $ do

663+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

664+ expectTutorialDErr sessionId dbconn (T.isPrefixOf "AtomTypeMismatchError") "data A a = A a | B | C; a := relation{a A Integer}{tuple{a A \"1\"}}"