carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-11 12:37:32 +03:00
Code Issues Projects Releases Wiki Activity

More cleanup of instantiateGenericStructType.

Browse Source
This commit is contained in:
Erik Svedäng 2018-02-01 17:27:27 +01:00
parent 1c6377c06e
commit ad2d5fe5f7
1 changed files with 21 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/Concretize.hs
View File

@ -200,30 +200,32 @@ concretizeType _ ft@(FuncTy _ _) =
concretizeType typeEnv arrayTy@(StructTy "Array" varTys) =
[defineArrayTypeAlias arrayTy] ++
concatMap (concretizeType typeEnv) varTys
concretizeType typeEnv structTy@(StructTy name _) =
concretizeType typeEnv genericStructTy@(StructTy name _) =
case lookupInEnv (SymPath [] name) (getTypeEnv typeEnv) of
Just (_, Binder (XObj (Lst (XObj (Typ originalStructTy) _ _ : _ : rest)) _ _)) ->
if isTypeGeneric originalStructTy
then let fake1 = XObj (Sym (SymPath [] "a") Symbol) Nothing Nothing
fake2 = XObj (Sym (SymPath [] "b") Symbol) Nothing Nothing
XObj (Arr memberXObjs) _ _ = head rest
in case solve [Constraint originalStructTy structTy fake1 fake2 OrdMultiSym] of
Right mappings -> instantiateGenericStructType typeEnv mappings structTy memberXObjs
Left e -> error (show e)
then instantiateGenericStructType typeEnv originalStructTy genericStructTy rest
else []
Just (_, Binder (XObj (Lst (XObj ExternalType _ _ : _)) _ _)) ->
[]
Just (_, Binder x) -> error ("Non-typedef found in type env: " ++ show x)
Nothing -> error ("Can't find type " ++ show structTy ++ " with name '" ++ name ++ "' in type env.")
Just (_, Binder x) -> error ("Non-deftype found in type env: " ++ show x)
Nothing -> error ("Can't find type " ++ show genericStructTy ++ " with name '" ++ name ++ "' in type env.")
concretizeType _ t =
[] -- ignore all other types
instantiateGenericStructType :: TypeEnv -> Map.Map String Ty -> Ty -> [XObj] -> [XObj]
instantiateGenericStructType typeEnv mappings structTy@(StructTy _ _) memberXObjs =
-- | Given an generic struct type and a concrete version of it, generate all dependencies needed to use the concrete one.
instantiateGenericStructType :: TypeEnv -> Ty -> Ty -> [XObj] -> [XObj]
instantiateGenericStructType typeEnv originalStructTy genericStructTy membersXObjs =
-- Turn (deftype (A a) [x a, y a]) into (deftype (A Int) [x Int, y Int])
let fake1 = XObj (Sym (SymPath [] "a") Symbol) Nothing Nothing
fake2 = XObj (Sym (SymPath [] "b") Symbol) Nothing Nothing
XObj (Arr memberXObjs) _ _ = head membersXObjs
in case solve [Constraint originalStructTy genericStructTy fake1 fake2 OrdMultiSym] of
Left e -> error (show e)
Right mappings ->
let concretelyTypedMembers = replaceGenericTypeSymbolsOnMembers mappings memberXObjs
in [ XObj (Lst (XObj (Typ structTy) Nothing Nothing :
XObj (Sym (SymPath [] (tyToC structTy)) Symbol) Nothing Nothing :
in [ XObj (Lst (XObj (Typ genericStructTy) Nothing Nothing :
XObj (Sym (SymPath [] (tyToC genericStructTy)) Symbol) Nothing Nothing :
[(XObj (Arr concretelyTypedMembers) Nothing Nothing)])
) (Just dummyInfo) (Just TypeTy)
]