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

git.iko.soy/project-m36

catch type mismatch error between relation type hint and tuples

resolves #256

commit6f677d8f698b704e815f03031f2bcf333286bac1 authorAgentM <agentm@themactionfaction.com> dateSun 12 Apr 2020, 16:58 (7 years ago) parent8c005db

2 files changed+13−3

compare with master

unifiedsplit

src/lib/ProjectM36/AtomType.hs+6−2 test/TutorialD/Interpreter.hs+7−1

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

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

224224

225225resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

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

227− ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

227+ ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

228228resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

229229 Right typeFromRelation

230230 else

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

257257 subType@(ConstructedAtomType _ _) -> do

258258 resSubType <- resolveAtomType resType subType

259259 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

261265 Nothing ->

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

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

test/TutorialD/Interpreter.hs+7−1

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

7575 testWithClause,

7676 testAtomFunctionArgumentMismatch,

7777 testInvalidDataConstructor,

78− testBasicList

78+ testBasicList,

79+ testRelationDeclarationMismatch

7980 ]

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

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

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

656657testBasicList = TestCase $ do

657658 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

658659 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\"}}"