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

Can set meta on non-existing binders (enables docstrings etc before

Browse Source 
the definition).
This commit is contained in:
Erik Svedäng 2018-03-26 16:20:09 +02:00
parent 79bf4115a8
commit c3ab3a43e3
2 changed files with 26 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/temp.carp
View File

@ -9,6 +9,8 @@
(defmodule Foo
(defn f [] 666)
(meta-set! f "doc" "This is an evil function.")
(defn g [] 10000))
(defn g [] 10000)
(meta-set! no "doc" "I don't exist yet.")
)
(meta-set! Foo.g "doc" "The 10000 dollar function.")

32
src/Eval.hs
View File

@ -840,16 +840,30 @@ specialCommandMetaSet path key value =
let pathStrings = contextPath ctx
globalEnv = contextGlobalEnv ctx
case lookupInEnv (consPath pathStrings path) globalEnv of
Just (_, binder@(Binder metaData xobj)) ->
do let newMetaData = MetaData (Map.insert key value (getMeta metaData))
xobjPath = getPath xobj
newBinder = binder { binderMeta = newMetaData }
newEnv = envInsertAt globalEnv xobjPath newBinder
liftIO (putStrLn ("Added meta data on " ++ show xobjPath ++ ", '" ++ key ++ "' = " ++ pretty value))
put (ctx { contextGlobalEnv = newEnv })
return dynamicNil
Just (_, binder@(Binder _ xobj)) ->
-- | Set meta on existing binder
setMetaOn ctx binder
Nothing ->
return (Left (EvalError ("Special command 'meta-set!' failed, can't find '" ++ show path ++ "'.")))
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,
XObj (Sym (SymPath pathStrings name) Symbol) Nothing Nothing])
(Just dummyInfo)
(Just (VarTy "a"))))
(SymPath _ _) ->
return (Left (EvalError ("Special command 'meta-set!' failed, can't find '" ++ show path ++ "'.")))
where
setMetaOn :: Context -> Binder -> StateT Context IO (Either EvalError XObj)
setMetaOn ctx binder@(Binder metaData xobj) =
do let globalEnv = contextGlobalEnv ctx
newMetaData = MetaData (Map.insert key value (getMeta metaData))
xobjPath = getPath xobj
newBinder = binder { binderMeta = newMetaData }
newEnv = envInsertAt globalEnv xobjPath newBinder
--liftIO (putStrLn ("Added meta data on " ++ show xobjPath ++ ", '" ++ key ++ "' = " ++ pretty value))
put (ctx { contextGlobalEnv = newEnv })
return dynamicNil
-- | Get meta data for a Binder
specialCommandMetaGet :: SymPath -> String -> StateT Context IO (Either EvalError XObj)