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

Fixed bug with meta data on modules not being propagated in 'envInsertAt'.

Browse Source
This commit is contained in:
Erik Svedäng 2019-06-07 14:57:36 +02:00
parent 9de8b95e5f
commit a2945cdc40
26 changed files with 95 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
docs/core/Array.html
View File

@ -138,6 +138,9 @@
<h1>
Array
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/Bench.html
View File

@ -138,6 +138,9 @@
<h1>
Bench
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#bench">
<h3 id="bench">

3
docs/core/Bool.html
View File

@ -138,6 +138,9 @@
<h1>
Bool
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/Char.html
View File

@ -138,6 +138,9 @@
<h1>
Char
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/Debug.html
View File

@ -138,6 +138,9 @@
<h1>
Debug
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#assert-balanced">
<h3 id="assert-balanced">

3
docs/core/Double.html
View File

@ -138,6 +138,9 @@
<h1>
Double
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#*">
<h3 id="*">

3
docs/core/Dynamic.html
View File

@ -138,6 +138,9 @@
<h1>
Dynamic
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#*">
<h3 id="*">

3
docs/core/Float.html
View File

@ -138,6 +138,9 @@
<h1>
Float
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#*">
<h3 id="*">

3
docs/core/Geometry.html
View File

@ -138,6 +138,9 @@
<h1>
Geometry
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#degree-to-radians">
<h3 id="degree-to-radians">

5
docs/core/IO.html
View File

@ -138,6 +138,9 @@
<h1>
IO
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#EOF">
<h3 id="EOF">
@ -262,7 +265,7 @@
</h3>
</a>
<div class="description">
external
doc-stub
</div>
<p class="sig">
a

3
docs/core/Int.html
View File

@ -138,6 +138,9 @@
<h1>
Int
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#*">
<h3 id="*">

3
docs/core/Long.html
View File

@ -138,6 +138,9 @@
<h1>
Long
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#*">
<h3 id="*">

3
docs/core/Map.html
View File

@ -138,6 +138,9 @@
<h1>
Map
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#=">
<h3 id="=">

3
docs/core/Maybe.html
View File

@ -138,6 +138,9 @@
<h1>
Maybe
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#=">
<h3 id="=">

3
docs/core/Pattern.html
View File

@ -138,6 +138,9 @@
<h1>
Pattern
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#=">
<h3 id="=">

3
docs/core/Result.html
View File

@ -138,6 +138,9 @@
<h1>
Result
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#=">
<h3 id="=">

5
docs/core/Statistics.html
View File

@ -138,6 +138,9 @@
<h1>
Statistics
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#Summary">
<h3 id="Summary">
@ -304,7 +307,7 @@
</h3>
</a>
<div class="description">
external
doc-stub
</div>
<p class="sig">
a

3
docs/core/String.html
View File

@ -138,6 +138,9 @@
<h1>
String
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/System.html
View File

@ -138,6 +138,9 @@
<h1>
System
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#exit">
<h3 id="exit">

3
docs/core/Test.html
View File

@ -138,6 +138,9 @@
<h1>
Test
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#State">
<h3 id="State">

3
docs/core/Vector2.html
View File

@ -138,6 +138,9 @@
<h1>
Vector2
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/Vector3.html
View File

@ -138,6 +138,9 @@
<h1>
Vector3
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

3
docs/core/VectorN.html
View File

@ -138,6 +138,9 @@
<h1>
VectorN
</h1>
<div class="module-description">
</div>
<div class="binder">
<a class="anchor" href="#/=">
<h3 id="/=">

27
src/Eval.hs
View File

@ -826,23 +826,30 @@ specialCommandDefmodule xobj moduleName innerExpressions =
lastInput = contextLastInput ctx
execMode = contextExecMode ctx
proj = contextProj ctx
defineIt :: MetaData -> StateT Context IO (Either EvalError XObj)
defineIt meta = do let parentEnv = getEnv env pathStrings
innerEnv = Env (Map.fromList []) (Just parentEnv) (Just moduleName) [] ExternalEnv 0
newModule = XObj (Mod innerEnv) (info xobj) (Just ModuleTy)
globalEnvWithModuleAdded = envInsertAt env (SymPath pathStrings moduleName) (Binder meta newModule)
ctx' = Context globalEnvWithModuleAdded typeEnv (pathStrings ++ [moduleName]) proj lastInput execMode
ctxAfterModuleDef <- liftIO $ foldM folder ctx' innerExpressions
put (popModulePath ctxAfterModuleDef)
return dynamicNil
result <- case lookupInEnv (SymPath pathStrings moduleName) env of
Just (_, Binder _ (XObj (Mod _) _ _)) ->
do let ctx' = Context env typeEnv (pathStrings ++ [moduleName]) proj lastInput execMode -- use { = } syntax instead
ctxAfterModuleAdditions <- liftIO $ foldM folder ctx' innerExpressions
put (popModulePath ctxAfterModuleAdditions)
return dynamicNil -- TODO: propagate errors...
Just _ ->
Just (_, Binder existingMeta (XObj (Lst [(XObj DocStub _ _), _]) _ _)) ->
defineIt existingMeta
Just (_, Binder _ x) ->
return (makeEvalError ctx Nothing ("Can't redefine '" ++ moduleName ++ "' as module") (info xobj))
Nothing ->
do let parentEnv = getEnv env pathStrings
innerEnv = Env (Map.fromList []) (Just parentEnv) (Just moduleName) [] ExternalEnv 0
newModule = XObj (Mod innerEnv) (info xobj) (Just ModuleTy)
globalEnvWithModuleAdded = envInsertAt env (SymPath pathStrings moduleName) (Binder emptyMeta newModule)
ctx' = Context globalEnvWithModuleAdded typeEnv (pathStrings ++ [moduleName]) proj lastInput execMode -- TODO: also change
ctxAfterModuleDef <- liftIO $ foldM folder ctx' innerExpressions
put (popModulePath ctxAfterModuleDef)
return dynamicNil
defineIt emptyMeta
case result of
Left err -> return (Left err)
Right _ -> return dynamicNil
@ -1002,7 +1009,7 @@ specialCommandMetaSet path key value =
case path of
-- | If the path is unqualified, create a binder and set the meta on that one. This enables docstrings before function exists.
(SymPath [] name) ->
setMetaOn ctx (Binder emptyMeta (XObj (Lst [XObj (External Nothing) Nothing Nothing,
setMetaOn ctx (Binder emptyMeta (XObj (Lst [XObj DocStub Nothing Nothing,
XObj (Sym (SymPath pathStrings name) Symbol) Nothing Nothing])
(Just dummyInfo)
(Just (VarTy "a"))))

4
src/Lookup.hs
View File

@ -131,8 +131,8 @@ envInsertAt env (SymPath [] name) binder =
envAddBinding env name binder
envInsertAt env (SymPath (p:ps) name) xobj =
case Map.lookup p (envBindings env) of
Just (Binder _ (XObj (Mod innerEnv) i t)) ->
let newInnerEnv = Binder emptyMeta (XObj (Mod (envInsertAt innerEnv (SymPath ps name) xobj)) i t)
Just (Binder existingMeta (XObj (Mod innerEnv) i t)) ->
let newInnerEnv = Binder existingMeta (XObj (Mod (envInsertAt innerEnv (SymPath ps name) xobj)) i t)
in env { envBindings = Map.insert p newInnerEnv (envBindings env) }
Just _ -> error ("Can't insert into non-module: " ++ p)
Nothing -> error ("Can't insert into non-existing module: " ++ p)

4
src/Obj.hs
View File

@ -70,6 +70,7 @@ data Obj = Sym SymPath SymbolMode
| With
| External (Maybe String)
| ExternalType
| DocStub
| Deftemplate TemplateCreator
| Instantiate Template
| Defalias Ty
@ -189,6 +190,7 @@ getBinderDescription (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym _ _) _ _ :
getBinderDescription (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "alias"
getBinderDescription (XObj (Lst (XObj (External _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "external"
getBinderDescription (XObj (Lst (XObj ExternalType _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "external-type"
getBinderDescription (XObj (Lst (XObj DocStub _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "doc-stub"
getBinderDescription (XObj (Lst (XObj (Typ _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "deftype"
getBinderDescription (XObj (Lst (XObj (DefSumtype _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "deftype"
getBinderDescription (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym _ _) _ _ : _)) _ _) = "interface"
@ -227,6 +229,7 @@ getPath (XObj (Lst (XObj (Instantiate _) _ _ : XObj (Sym path _) _ _ : _)) _ _)
getPath (XObj (Lst (XObj (Defalias _) _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (External _) _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj ExternalType _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj DocStub _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Typ _) _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Mod _) _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
getPath (XObj (Lst (XObj (Interface _ _) _ _ : XObj (Sym path _) _ _ : _)) _ _) = path
@ -280,6 +283,7 @@ pretty = visit 0
External Nothing -> "external"
External (Just override) -> "external (override: " ++ show override ++ ")"
ExternalType -> "external-type"
DocStub -> "doc-stub"
Defalias _ -> "defalias"
Address -> "address"
SetBang -> "set!"