mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +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 Emit
|
||||
import Env (addUsePath, contextEnv, insert, lookupBinderEverywhere, lookupEverywhere, lookupMeta, searchValueBinder)
|
||||
import EvalError
|
||||
import Infer
|
||||
import Info
|
||||
import Interfaces
|
||||
import Managed
|
||||
import qualified Map
|
||||
import qualified Meta
|
||||
import Obj
|
||||
import PrimitiveError
|
||||
@ -347,6 +349,48 @@ primitiveInfo _ ctx target@(XObj (Sym path@(SymPath _ name) _) _ _) =
|
||||
primitiveInfo _ ctx 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 ctx producer ty name body = do
|
||||
let qpath = qualifyPath ctx (SymPath [] name)
|
||||
|
@ -297,6 +297,7 @@ dynamicModule =
|
||||
let f = makeUnaryPrim . spath
|
||||
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 "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 "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)",
|
||||
|
Loading…
Reference in New Issue
Block a user