mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Support introspection on external functions
Like the previous two commits, this commit extends support for reflection to yet another type, externally registered functions, allowing us to support calls such as `(arity Int.+)`.
This commit is contained in:
parent
33a7f51c7b
commit
14a3d9b5ab
@ -34,6 +34,14 @@
|
||||
false
|
||||
(Dynamic.= (Symbol.from "primitive") (car s)))))
|
||||
|
||||
(doc external?
|
||||
"Is this binding external?")
|
||||
(defndynamic external? [binding]
|
||||
(let [s (s-expr binding)]
|
||||
(if (empty? s)
|
||||
false
|
||||
(Dynamic.= (Symbol.from "external") (car s)))))
|
||||
|
||||
(doc variable?
|
||||
"Is this binding a variable?")
|
||||
(defndynamic variable? [binding]
|
||||
@ -81,6 +89,10 @@
|
||||
(if (empty? s)
|
||||
0
|
||||
(cond
|
||||
(Introspect.external? binding)
|
||||
(if (list? (caddr s))
|
||||
(length (car (cdaddr s)))
|
||||
0)
|
||||
(Introspect.command? binding) (length (caddr s))
|
||||
(Introspect.primitive? binding) (length (caddr s))
|
||||
(Introspect.interface? binding) (length (car (cdaddr s)))
|
||||
|
@ -954,4 +954,5 @@ toSymbols (XObj (Interface _ _) i t) = (XObj (Sym (SymPath [] "definterface") Sy
|
||||
toSymbols (XObj Macro i t) = (XObj (Sym (SymPath [] "defmacro") Symbol) i t)
|
||||
toSymbols (XObj (Command _) i t) = (XObj (Sym (SymPath [] "command") Symbol) i t)
|
||||
toSymbols (XObj (Primitive _) i t) = (XObj (Sym (SymPath [] "primitive") Symbol) i t)
|
||||
toSymbols (XObj (External _) i t) = (XObj (Sym (SymPath [] "external") Symbol) i t)
|
||||
toSymbols x = x
|
||||
|
@ -554,6 +554,13 @@ concretizeDefinition allowAmbiguity typeEnv globalEnv visitedDefinitions definit
|
||||
XObj (Lst (XObj (Deftemplate (TemplateCreator templateCreator)) _ _ : _)) _ _ ->
|
||||
let template = templateCreator typeEnv globalEnv
|
||||
in Right (instantiateTemplate newPath concreteType template)
|
||||
XObj (Lst [XObj (External _) _ _, _, _]) _ _ ->
|
||||
if name == "NULL"
|
||||
then Right (definition, []) -- A hack to make all versions of NULL have the same name
|
||||
else let withNewPath = setPath definition newPath
|
||||
withNewType = withNewPath { ty = Just concreteType }
|
||||
in Right (withNewType, [])
|
||||
-- TODO: This old form shouldn't be necessary, but somehow, some External xobjs are still registered without a ty xobj position.
|
||||
XObj (Lst [XObj (External _) _ _, _]) _ _ ->
|
||||
if name == "NULL"
|
||||
then Right (definition, []) -- A hack to make all versions of NULL have the same name
|
||||
|
@ -63,7 +63,7 @@ registerInInterface ctx xobj interface =
|
||||
-- Global variables can also be part of an interface
|
||||
registerInInterfaceIfNeeded ctx path interface t
|
||||
-- So can externals!
|
||||
XObj (Lst [XObj (External _) _ _, XObj (Sym path _) _ _]) _ (Just t) ->
|
||||
XObj (Lst [XObj (External _) _ _, XObj (Sym path _) _ _, _]) _ (Just t) ->
|
||||
registerInInterfaceIfNeeded ctx path interface t
|
||||
-- And instantiated/auto-derived type functions! (e.g. Pair.a)
|
||||
XObj (Lst [XObj (Instantiate _) _ _, XObj (Sym path _) _ _]) _ (Just t) ->
|
||||
|
@ -252,8 +252,8 @@ getPath x = SymPath [] (pretty x)
|
||||
setPath :: XObj -> SymPath -> XObj
|
||||
setPath (XObj (Lst (defn@(XObj (Defn _) _ _) : XObj (Sym _ _) si st : rest)) i t) newPath =
|
||||
XObj (Lst (defn : XObj (Sym newPath Symbol) si st : rest)) i t
|
||||
setPath (XObj (Lst [extr@(XObj (External _) _ _), XObj (Sym _ _) si st]) i t) newPath =
|
||||
XObj (Lst [extr, XObj (Sym newPath Symbol) si st]) i t
|
||||
setPath (XObj (Lst [extr@(XObj (External _) _ _), XObj (Sym _ _) si st, ty]) i t) newPath =
|
||||
XObj (Lst [extr, XObj (Sym newPath Symbol) si st, ty]) i t
|
||||
setPath x _ =
|
||||
error ("Can't set path on " ++ show x)
|
||||
|
||||
|
@ -449,8 +449,10 @@ registerInternal ctx name ty override =
|
||||
"'") (info ty)
|
||||
-- TODO: Retroactively register in interface if implements metadata is present.
|
||||
validType t = let path = SymPath pathStrings name
|
||||
registration = XObj (Lst [XObj (External override) Nothing Nothing,
|
||||
XObj (Sym path Symbol) Nothing Nothing]) (info ty) (Just t)
|
||||
registration = XObj (Lst [XObj (External override) Nothing Nothing
|
||||
,XObj (Sym path Symbol) Nothing Nothing
|
||||
,ty
|
||||
]) (info ty) (Just t)
|
||||
meta = existingMeta globalEnv registration
|
||||
env' = envInsertAt globalEnv path (Binder meta registration)
|
||||
in (ctx { contextGlobalEnv = env' }, dynamicNil)
|
||||
|
Loading…
Reference in New Issue
Block a user