carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-17 16:38:14 +03:00
Code Issues Projects Releases Wiki Activity

fix: manage nested modules in the type environment (#1102)

Browse Source 
A misplaced type env reference caused a bug in which types could not be
placed in modules more than a single level deep. Similarly, existing
modules in the type env were always overwritten when new types were
added to modules that were not disjoint. This commit fixes both issues.

In the future, we should likely make module management functions more
general and call them to manage modules in both the value and type envs.
This commit is contained in:
Scott Olsen 2020-12-27 15:58:55 -05:00 committed by GitHub
parent 6c551a104b
commit e05cf0e022
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Primitives.hs
View File

@ -11,7 +11,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Either (rights)
import Data.Functor ((<&>))
import Data.List (union)
import Data.Maybe (fromJust, fromMaybe, mapMaybe, maybeToList)
import Data.Maybe (fromJust, fromMaybe, mapMaybe)
import Deftype
import Emit
import Env
@ -672,11 +672,15 @@ primitiveDeftype xobj ctx (name : rest) =
i
(Just TypeTy)
holderEnv name' prev = Env (Map.fromList []) (Just prev) (Just name') [] ExternalEnv 0
holderModule name'' prevEnv = Binder emptyMeta (XObj (Mod (holderEnv name'' prevEnv)) (Just dummyInfo) (Just ModuleTy))
folder (contx, prev) pathstring = (contx {contextTypeEnv = TypeEnv $ envInsertAt (getTypeEnv typeEnv) (SymPath (maybeToList (envModuleName prev)) pathstring) (holderModule pathstring prev)}, holderEnv pathstring prev)
wHolders = fst (foldl folder (ctx, getTypeEnv typeEnv) pathStrings)
holderModule name'' prevEnv priorPaths tyenv =
case lookupBinder (SymPath priorPaths name'') tyenv of
Just existing@(Binder _ (XObj (Mod _) _ _)) -> existing
_ -> Binder emptyMeta (XObj (Mod (holderEnv name'' prevEnv)) (Just dummyInfo) (Just ModuleTy))
folder (contx, prev, priorPaths) pathstring =
(contx {contextTypeEnv = TypeEnv $ envInsertAt (getTypeEnv (contextTypeEnv contx)) (SymPath priorPaths pathstring) (holderModule pathstring prev priorPaths (getTypeEnv (contextTypeEnv contx)))}, holderEnv pathstring prev, priorPaths ++ [pathstring])
(wHolders, _, _) = (foldl folder (ctx, getTypeEnv typeEnv, []) pathStrings)
ctx' =
( (fst (foldl folder (ctx, getTypeEnv typeEnv) pathStrings))
( wHolders
{ contextGlobalEnv = updatedGlobal,
contextTypeEnv = TypeEnv (envInsertAt (getTypeEnv (contextTypeEnv wHolders)) (SymPath pathStrings tyName) (Binder emptyMeta typeDefinition))
}