adding procedure? procedure

fitzgen · Feb 1, 2010 · df60f74 · df60f74
1 parent 162cbeb
commit df60f74
Showing 1 changed file with 13 additions and 0 deletions.
diff --git a/scheme.adb b/scheme.adb
@@ -559,6 +559,16 @@ procedure Scheme is
       end if;
    end;
 
+   function Is_Procedure_Proc (Arguments : Access_Object) return Access_Object is
+      Obj : Access_Object := Car(Arguments);
+   begin
+      if Is_Primitive_Proc(Obj) then
+         return True_Singleton;
+      else
+         return False_Singleton;
+      end if;
+   end;
+
    function Is_Pair_Proc (Arguments : Access_Object) return Access_Object is
       Obj : Access_Object := Car(Arguments);
    begin
@@ -647,6 +657,9 @@ procedure Scheme is
       Define_Variable(Make_Symbol(To_Unbounded_String("pair?")),
                       Make_Primitive_Proc(Is_Pair_Proc'access),
                       The_Global_Environment);
+      Define_Variable(Make_Symbol(To_Unbounded_String("procedure?")),
+                      Make_Primitive_Proc(Is_Procedure_Proc'access),
+                      The_Global_Environment);
    end;
 
    -- READ ----------------------------------------------------------------