mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +03:00
fix: Allow types defined in modules to be members (#1303)
This commit fixes issue #1302, whereby types defined in modules were not recognized as valid member types by our validation routines. We simply need to account for types defined in modules in the global env, threading the global env along through validation (previously we only passed the top-level type env, which contains no modules).
This commit is contained in:
parent
03b453cb36
commit
ae2186f4b7
@ -612,7 +612,7 @@ instantiateGenericStructType typeEnv env originalStructTy@(StructTy _ _) generic
|
||||
let nameFixedMembers = renameGenericTypeSymbolsOnProduct renamedOrig memberXObjs
|
||||
validMembers = replaceGenericTypeSymbolsOnMembers mappings' nameFixedMembers
|
||||
concretelyTypedMembers = replaceGenericTypeSymbolsOnMembers mappings memberXObjs
|
||||
validateMembers AllowAnyTypeVariableNames typeEnv renamedOrig validMembers
|
||||
validateMembers AllowAnyTypeVariableNames typeEnv env renamedOrig validMembers
|
||||
deps <- mapM (depsForStructMemberPair typeEnv env) (pairwise concretelyTypedMembers)
|
||||
let xobj =
|
||||
XObj
|
||||
@ -646,7 +646,7 @@ instantiateGenericSumtype typeEnv env originalStructTy@(StructTy _ originalTyVar
|
||||
let nameFixedCases = map (renameGenericTypeSymbolsOnSum (zip originalTyVars renamedOrig)) cases
|
||||
concretelyTypedCases = map (replaceGenericTypeSymbolsOnCase mappings) nameFixedCases
|
||||
deps = mapM (depsForCase typeEnv env) concretelyTypedCases
|
||||
in case toCases typeEnv AllowAnyTypeVariableNames renamedOrig concretelyTypedCases of -- Don't care about the cases, this is done just for validation.
|
||||
in case toCases typeEnv env AllowAnyTypeVariableNames renamedOrig concretelyTypedCases of -- Don't care about the cases, this is done just for validation.
|
||||
Left err -> Left err
|
||||
Right _ ->
|
||||
case deps of
|
||||
|
@ -60,7 +60,7 @@ moduleForDeftype innerEnv typeEnv env pathStrings typeName typeVariables rest i
|
||||
-- For example (module Vec2 [x Float]) creates bindings like Vec2.create, Vec2.x, etc.
|
||||
insidePath = pathStrings ++ [typeName]
|
||||
in do
|
||||
validateMemberCases typeEnv typeVariables rest
|
||||
validateMemberCases typeEnv env typeVariables rest
|
||||
let structTy = StructTy (ConcreteNameTy (SymPath pathStrings typeName)) typeVariables
|
||||
(okMembers, membersDeps) <- templatesForMembers typeEnv env insidePath structTy rest
|
||||
okInit <- binderForInit insidePath structTy rest
|
||||
@ -83,7 +83,7 @@ bindingsForRegisteredType typeEnv env pathStrings typeName rest i existingEnv =
|
||||
moduleTypeEnv = fromMaybe (new (Just typeEnv) (Just typeName)) (fmap snd existingEnv)
|
||||
insidePath = pathStrings ++ [typeName]
|
||||
in do
|
||||
validateMemberCases typeEnv [] rest
|
||||
validateMemberCases typeEnv env [] rest
|
||||
let structTy = StructTy (ConcreteNameTy (SymPath pathStrings typeName)) []
|
||||
(binders, deps) <- templatesForMembers typeEnv env insidePath structTy rest
|
||||
okInit <- binderForInit insidePath structTy rest
|
||||
|
@ -11,17 +11,17 @@ data SumtypeCase = SumtypeCase
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
toCases :: TypeEnv -> TypeVarRestriction -> [Ty] -> [XObj] -> Either TypeError [SumtypeCase]
|
||||
toCases typeEnv restriction typeVars = mapM (toCase typeEnv restriction typeVars)
|
||||
toCases :: TypeEnv -> Env -> TypeVarRestriction -> [Ty] -> [XObj] -> Either TypeError [SumtypeCase]
|
||||
toCases typeEnv globalEnv restriction typeVars = mapM (toCase typeEnv globalEnv restriction typeVars)
|
||||
|
||||
toCase :: TypeEnv -> TypeVarRestriction -> [Ty] -> XObj -> Either TypeError SumtypeCase
|
||||
toCase typeEnv restriction typeVars x@(XObj (Lst [XObj (Sym (SymPath [] name) Symbol) _ _, XObj (Arr tyXObjs) _ _]) _ _) =
|
||||
toCase :: TypeEnv -> Env -> TypeVarRestriction -> [Ty] -> XObj -> Either TypeError SumtypeCase
|
||||
toCase typeEnv globalEnv restriction typeVars x@(XObj (Lst [XObj (Sym (SymPath [] name) Symbol) _ _, XObj (Arr tyXObjs) _ _]) _ _) =
|
||||
let tys = map xobjToTy tyXObjs
|
||||
in case sequence tys of
|
||||
Nothing ->
|
||||
Left (InvalidSumtypeCase x)
|
||||
Just okTys ->
|
||||
let validated = map (\t -> canBeUsedAsMemberType restriction typeEnv typeVars t x) okTys
|
||||
let validated = map (\t -> canBeUsedAsMemberType restriction typeEnv globalEnv typeVars t x) okTys
|
||||
in case sequence validated of
|
||||
Left e ->
|
||||
Left e
|
||||
@ -31,11 +31,11 @@ toCase typeEnv restriction typeVars x@(XObj (Lst [XObj (Sym (SymPath [] name) Sy
|
||||
{ caseName = name,
|
||||
caseTys = okTys
|
||||
}
|
||||
toCase _ _ _ (XObj (Sym (SymPath [] name) Symbol) _ _) =
|
||||
toCase _ _ _ _ (XObj (Sym (SymPath [] name) Symbol) _ _) =
|
||||
Right $
|
||||
SumtypeCase
|
||||
{ caseName = name,
|
||||
caseTys = []
|
||||
}
|
||||
toCase _ _ _ x =
|
||||
toCase _ _ _ _ x =
|
||||
Left (InvalidSumtypeCase x)
|
||||
|
@ -54,7 +54,7 @@ moduleForSumtype innerEnv typeEnv env pathStrings typeName typeVariables rest i
|
||||
insidePath = pathStrings ++ [typeName]
|
||||
in do
|
||||
let structTy = StructTy (ConcreteNameTy (SymPath pathStrings typeName)) typeVariables
|
||||
cases <- toCases typeEnv AllowOnlyNamesInScope typeVariables rest
|
||||
cases <- toCases typeEnv env AllowOnlyNamesInScope typeVariables rest
|
||||
okIniters <- initers insidePath structTy cases
|
||||
okTag <- binderForTag insidePath structTy
|
||||
(okStr, okStrDeps) <- binderForStrOrPrn typeEnv env insidePath structTy cases "str"
|
||||
|
@ -21,16 +21,16 @@ data TypeVarRestriction
|
||||
-- | Make sure that the member declarations in a type definition
|
||||
-- | Follow the pattern [<name> <type>, <name> <type>, ...]
|
||||
-- | TODO: This function is only called by the deftype parts of the codebase, which is more specific than the following check implies.
|
||||
validateMemberCases :: TypeEnv -> [Ty] -> [XObj] -> Either TypeError ()
|
||||
validateMemberCases typeEnv typeVariables rest = mapM_ visit rest
|
||||
validateMemberCases :: TypeEnv -> Env -> [Ty] -> [XObj] -> Either TypeError ()
|
||||
validateMemberCases typeEnv globalEnv typeVariables rest = mapM_ visit rest
|
||||
where
|
||||
visit (XObj (Arr membersXObjs) _ _) =
|
||||
validateMembers AllowOnlyNamesInScope typeEnv typeVariables membersXObjs
|
||||
validateMembers AllowOnlyNamesInScope typeEnv globalEnv typeVariables membersXObjs
|
||||
visit xobj =
|
||||
Left (InvalidSumtypeCase xobj)
|
||||
|
||||
validateMembers :: TypeVarRestriction -> TypeEnv -> [Ty] -> [XObj] -> Either TypeError ()
|
||||
validateMembers typeVarRestriction typeEnv typeVariables membersXObjs =
|
||||
validateMembers :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> [XObj] -> Either TypeError ()
|
||||
validateMembers typeVarRestriction typeEnv globalEnv typeVariables membersXObjs =
|
||||
checkUnevenMembers >> checkDuplicateMembers >> checkMembers >> checkKindConsistency
|
||||
where
|
||||
pairs = pairwise membersXObjs
|
||||
@ -61,17 +61,17 @@ validateMembers typeVarRestriction typeEnv typeVariables membersXObjs =
|
||||
-- todo? be safer anyway?
|
||||
varsOnly = filter isTypeGeneric (map (fromJust . xobjToTy . snd) pairs)
|
||||
checkMembers :: Either TypeError ()
|
||||
checkMembers = mapM_ (okXObjForType typeVarRestriction typeEnv typeVariables . snd) pairs
|
||||
checkMembers = mapM_ (okXObjForType typeVarRestriction typeEnv globalEnv typeVariables . snd) pairs
|
||||
|
||||
okXObjForType :: TypeVarRestriction -> TypeEnv -> [Ty] -> XObj -> Either TypeError ()
|
||||
okXObjForType typeVarRestriction typeEnv typeVariables xobj =
|
||||
okXObjForType :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> XObj -> Either TypeError ()
|
||||
okXObjForType typeVarRestriction typeEnv globalEnv typeVariables xobj =
|
||||
case xobjToTy xobj of
|
||||
Just t -> canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables t xobj
|
||||
Just t -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables t xobj
|
||||
Nothing -> Left (NotAType xobj)
|
||||
|
||||
-- | Can this type be used as a member for a deftype?
|
||||
canBeUsedAsMemberType :: TypeVarRestriction -> TypeEnv -> [Ty] -> Ty -> XObj -> Either TypeError ()
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables ty xobj =
|
||||
canBeUsedAsMemberType :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> Ty -> XObj -> Either TypeError ()
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables ty xobj =
|
||||
case ty of
|
||||
UnitTy -> pure ()
|
||||
IntTy -> pure ()
|
||||
@ -86,7 +86,7 @@ canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables ty xobj =
|
||||
FuncTy {} -> pure ()
|
||||
PointerTy UnitTy -> pure ()
|
||||
PointerTy inner ->
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables inner xobj
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables inner xobj
|
||||
>> pure ()
|
||||
-- Struct variables may appear as complete applications or individual
|
||||
-- components in the head of a definition; that is the forms:
|
||||
@ -112,16 +112,16 @@ canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables ty xobj =
|
||||
where
|
||||
checkStruct :: Ty -> [Ty] -> Either TypeError ()
|
||||
checkStruct (ConcreteNameTy (SymPath [] "Array")) [innerType] =
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables innerType xobj
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables innerType xobj
|
||||
>> pure ()
|
||||
checkStruct (ConcreteNameTy (SymPath _ name)) vars =
|
||||
case E.getTypeBinder typeEnv name of
|
||||
checkStruct (ConcreteNameTy path@(SymPath _ name)) vars =
|
||||
case E.getTypeBinder typeEnv name <> E.findTypeBinder globalEnv path of
|
||||
Right (Binder _ (XObj (Lst (XObj (ExternalType _) _ _ : _)) _ _)) ->
|
||||
pure ()
|
||||
Right (Binder _ (XObj (Lst (XObj (Deftype t) _ _ : _)) _ _)) ->
|
||||
checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables typ xobj) () vars
|
||||
checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
|
||||
Right (Binder _ (XObj (Lst (XObj (DefSumtype t) _ _ : _)) _ _)) ->
|
||||
checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables typ xobj) () vars
|
||||
checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
|
||||
_ -> Left (NotAmongRegisteredTypes ty xobj)
|
||||
where
|
||||
checkInhabitants :: Ty -> Either TypeError ()
|
||||
@ -131,8 +131,8 @@ canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables ty xobj =
|
||||
else Left (UninhabitedConstructor ty xobj (length vs) (length vars))
|
||||
checkInhabitants _ = Left (InvalidMemberType ty xobj)
|
||||
checkStruct v@(VarTy _) vars =
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables v xobj
|
||||
>> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv typeVariables typ xobj) () vars
|
||||
canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables v xobj
|
||||
>> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
|
||||
checkStruct _ _ = error "checkstruct"
|
||||
checkVar :: Ty -> Either TypeError ()
|
||||
checkVar variable =
|
||||
|
Loading…
Reference in New Issue
Block a user