mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +03:00
feat: add machine-info primitive draft (#1269)
* feat: add machine-info primitive draft * feat: rename machine-info to structured-info * fix: use the right primitive name in structured-info error * refactor: remove unnecessary code
This commit is contained in:
parent
0adc1abd50
commit
fb1ee66ecc
@ -16,10 +16,12 @@ import Data.Maybe (fromJust, fromMaybe)
|
|||||||
import Deftype
|
import Deftype
|
||||||
import Emit
|
import Emit
|
||||||
import Env (addUsePath, contextEnv, insert, lookupBinderEverywhere, lookupEverywhere, lookupMeta, searchValueBinder)
|
import Env (addUsePath, contextEnv, insert, lookupBinderEverywhere, lookupEverywhere, lookupMeta, searchValueBinder)
|
||||||
|
import EvalError
|
||||||
import Infer
|
import Infer
|
||||||
import Info
|
import Info
|
||||||
import Interfaces
|
import Interfaces
|
||||||
import Managed
|
import Managed
|
||||||
|
import qualified Map
|
||||||
import qualified Meta
|
import qualified Meta
|
||||||
import Obj
|
import Obj
|
||||||
import PrimitiveError
|
import PrimitiveError
|
||||||
@ -347,6 +349,48 @@ primitiveInfo _ ctx target@(XObj (Sym path@(SymPath _ name) _) _ _) =
|
|||||||
primitiveInfo _ ctx notName =
|
primitiveInfo _ ctx notName =
|
||||||
argumentErr ctx "info" "a name" "first" notName
|
argumentErr ctx "info" "a name" "first" notName
|
||||||
|
|
||||||
|
-- | Get information about a binding.
|
||||||
|
primitiveStructuredInfo :: UnaryPrimitiveCallback
|
||||||
|
primitiveStructuredInfo (XObj _ i _) ctx (XObj (Sym path _) _ _) =
|
||||||
|
case lookupBinderInTypeEnv ctx path of
|
||||||
|
Right bind -> return (ctx, Right $ workOnBinder bind)
|
||||||
|
Left _ ->
|
||||||
|
case lookupBinderInContextEnv ctx path of
|
||||||
|
Right bind -> return (ctx, Right $ workOnBinder bind)
|
||||||
|
Left e -> return $ throwErr e ctx i
|
||||||
|
where
|
||||||
|
workOnBinder :: Binder -> XObj
|
||||||
|
workOnBinder (Binder metaData (XObj _ (Just (Info l c f _ _)) t)) =
|
||||||
|
makeX
|
||||||
|
( Lst
|
||||||
|
[ (maybe (makeX (Lst [])) reify t),
|
||||||
|
makeX
|
||||||
|
( Lst
|
||||||
|
[ makeX (Str f),
|
||||||
|
makeX (Num IntTy (Integral l)),
|
||||||
|
makeX (Num IntTy (Integral c))
|
||||||
|
]
|
||||||
|
),
|
||||||
|
metaList metaData
|
||||||
|
]
|
||||||
|
)
|
||||||
|
workOnBinder (Binder metaData (XObj _ _ t)) =
|
||||||
|
makeX
|
||||||
|
( Lst
|
||||||
|
[ (maybe (makeX (Lst [])) reify t),
|
||||||
|
makeX (Lst []),
|
||||||
|
metaList metaData
|
||||||
|
]
|
||||||
|
)
|
||||||
|
metaList :: MetaData -> XObj
|
||||||
|
metaList (MetaData m) =
|
||||||
|
makeX (Lst (map genPair (Map.toList m)))
|
||||||
|
where
|
||||||
|
genPair (s, x) = makeX (Lst [XObj (Str s) Nothing Nothing, x])
|
||||||
|
makeX o = XObj o Nothing Nothing
|
||||||
|
primitiveStructuredInfo _ ctx notName =
|
||||||
|
argumentErr ctx "structured-info" "a name" "first" notName
|
||||||
|
|
||||||
dynamicOrMacroWith :: Context -> (SymPath -> [XObj]) -> Ty -> String -> XObj -> IO (Context, Either EvalError XObj)
|
dynamicOrMacroWith :: Context -> (SymPath -> [XObj]) -> Ty -> String -> XObj -> IO (Context, Either EvalError XObj)
|
||||||
dynamicOrMacroWith ctx producer ty name body = do
|
dynamicOrMacroWith ctx producer ty name body = do
|
||||||
let qpath = qualifyPath ctx (SymPath [] name)
|
let qpath = qualifyPath ctx (SymPath [] name)
|
||||||
|
@ -297,6 +297,7 @@ dynamicModule =
|
|||||||
let f = makeUnaryPrim . spath
|
let f = makeUnaryPrim . spath
|
||||||
in [ f "quote" (\_ ctx x -> pure (ctx, Right x)) "quotes any value." "(quote x) ; where x is an actual symbol",
|
in [ f "quote" (\_ ctx x -> pure (ctx, Right x)) "quotes any value." "(quote x) ; where x is an actual symbol",
|
||||||
f "info" primitiveInfo "prints all information associated with a symbol." "(info mysymbol)",
|
f "info" primitiveInfo "prints all information associated with a symbol." "(info mysymbol)",
|
||||||
|
f "structured-info" primitiveStructuredInfo "gets all information associated with a symbol as a list of the form `(type|(), info|(), metadata)`." "(structured-info mysymbol)",
|
||||||
f "managed?" primitiveIsManaged "checks whether a type is managed by Carp by checking whether `delete` was implemented for it. For an explanation of memory management, you can reference [this document](https://carp-lang.github.io/carp-docs/Memory.html)." "(register-type Unmanaged \"void*\")\n(managed? Unmanaged) ; => false",
|
f "managed?" primitiveIsManaged "checks whether a type is managed by Carp by checking whether `delete` was implemented for it. For an explanation of memory management, you can reference [this document](https://carp-lang.github.io/carp-docs/Memory.html)." "(register-type Unmanaged \"void*\")\n(managed? Unmanaged) ; => false",
|
||||||
f "members" primitiveMembers "returns the members of a type as an array." "(members MyType)",
|
f "members" primitiveMembers "returns the members of a type as an array." "(members MyType)",
|
||||||
f "use" primitiveUse "uses a module, i.e. imports the symbols inside that module into the current module." "(use MyModule)",
|
f "use" primitiveUse "uses a module, i.e. imports the symbols inside that module into the current module." "(use MyModule)",
|
||||||
|
Loading…
Reference in New Issue
Block a user