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.+)`.

core/Introspect.carp

@@ -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)))

src/Commands.hs

@@ -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

src/Concretize.hs

@@ -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

src/Interfaces.hs

@@ -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) ->

src/Obj.hs

@@ -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)
 

src/Primitives.hs

@@ -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)