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

Prepping.

Browse Source
This commit is contained in:
Erik Svedäng 2018-08-28 13:58:24 +02:00
parent 3e8ea4c22b
commit a72f01e9ec
2 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Obj.hs
View File

@ -429,10 +429,10 @@ prettyEnvironmentChain env =
let bs = envBindings env
name = case envModuleName env of
Just n -> n
Nothing -> "nothing"
Nothing -> "<env has no name>"
in (if length bs < 20
then name ++ ":\n" ++ (joinWith "\n" $ filter (/= "") (map (showBinderIndented 4) (Map.toList (envBindings env))))
else name ++ ":\n Too big to show bindings.")
then "'" ++ name ++ "':\n" ++ (joinWith "\n" $ filter (/= "") (map (showBinderIndented 4) (Map.toList (envBindings env))))
else "'" ++ name ++ "':\n Too big to show bindings.")
++
(case envParent env of
Just parent -> "\nWITH PARENT ENV " ++ prettyEnvironmentChain parent

17
src/Qualify.hs
View File

@ -37,6 +37,13 @@ setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [defn@(XObj Defn _ _),
functionEnv = Env Map.empty (Just envWithSelf) Nothing [] InternalEnv
envWithArgs = foldl' (\e arg@(XObj (Sym (SymPath _ argSymName) _) _ _) -> extendEnv e argSymName arg) functionEnv argsArr
in XObj (Lst [defn, sym, args, setFullyQualifiedSymbols typeEnv globalEnv envWithArgs body]) i t
setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [fn@(XObj (Fn _ _) _ _),
args@(XObj (Arr argsArr) _ _),
body])
i t) =
let functionEnv = Env Map.empty (Just env) Nothing [] InternalEnv
envWithArgs = foldl' (\e arg@(XObj (Sym (SymPath _ argSymName) _) _ _) -> extendEnv e argSymName arg) functionEnv argsArr
in XObj (Lst [fn, args, setFullyQualifiedSymbols typeEnv globalEnv envWithArgs body]) i t
setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [the@(XObj The _ _), typeXObj, value]) i t) =
let value' = setFullyQualifiedSymbols typeEnv globalEnv env value
in XObj (Lst [the, typeXObj, value']) i t
@ -45,7 +52,8 @@ setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [def@(XObj Def _ _), s
in XObj (Lst [def, sym, expr']) i t
setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [letExpr@(XObj Let _ _), bind@(XObj (Arr bindings) bindi bindt), body]) i t) =
if even (length bindings)
then let innerEnv = Env Map.empty (Just env) (Just "LET") [] InternalEnv
then let Just ii = i
innerEnv = Env Map.empty (Just env) (Just ("let-env-" ++ show (infoIdentifier ii))) [] InternalEnv
(innerEnv', bindings') =
foldl' (\(e, bs) (s@(XObj (Sym (SymPath _ binderName) _) _ _), o) ->
let qualified = setFullyQualifiedSymbols typeEnv globalEnv e o
@ -86,6 +94,7 @@ setFullyQualifiedSymbols typeEnv globalEnv localEnv xobj@(XObj (Sym path _) i t)
where
createInterfaceSym name =
XObj (InterfaceSym name) i t
doesNotBelongToAnInterface :: Bool -> Env -> XObj
doesNotBelongToAnInterface finalRecurse theEnv =
let results = multiLookupQualified path theEnv in
@ -102,9 +111,11 @@ setFullyQualifiedSymbols typeEnv globalEnv localEnv xobj@(XObj (Sym path _) i t)
XObj (Sym (getPath foundOne) (LookupGlobalOverride overrideWithName)) i t
[(e, Binder _ foundOne)] ->
case envMode e of
ExternalEnv -> XObj (Sym (getPath foundOne) (LookupGlobal (if isExternalFunction foundOne then ExternalCode else CarpLand))) i t
ExternalEnv -> XObj (Sym (getPath foundOne)
(LookupGlobal (if isExternalFunction foundOne then ExternalCode else CarpLand))) i t
RecursionEnv -> XObj (Sym (getPath foundOne) LookupRecursive) i t
_ -> XObj (Sym (getPath foundOne) (LookupLocal NoCapture)) i t
_ -> --trace ("\nLOCAL variable " ++ show (getPath foundOne) ++ ":\n" ++ prettyEnvironmentChain e) $
XObj (Sym (getPath foundOne) (LookupLocal NoCapture)) i t
multiple ->
case filter (not . envIsExternal . fst) multiple of
-- There is at least one local binding, use the path of that one: