From 21606409845e717c4760793e95326c25e4e95029 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Fri, 22 Jul 2016 20:24:23 +1200
Subject: [PATCH 1/1] Factored out application into apply.

---
 scheme-primitives.4th |  2 +-
 scheme.4th            | 23 ++++++++++++++++-------
 2 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/scheme-primitives.4th b/scheme-primitives.4th
index 9afc2c2..b347d8a 100644
--- a/scheme-primitives.4th
+++ b/scheme-primitives.4th
@@ -45,7 +45,7 @@
 :noname ( args -- boolobj )
     2dup 1 ensure-arg-count
 
-    car primitive-type istype? -rot 2drop boolean-type
+    car primitive-proc-type istype? -rot 2drop boolean-type
 ; make-primitive procedure?
 
 ( = Type conversions = )
diff --git a/scheme.4th b/scheme.4th
index 1e58af9..c69f0ec 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -911,6 +911,21 @@ defer eval
     then
 ;
 
+: apply ( proc args )
+        2swap dup case
+            primitive-proc-type of
+                drop execute
+            endof
+
+            compound-proc-type of
+                ." Compound procedures not yet implemented."
+            endof
+
+            bold fg red ." Object not applicable. Aboring." reset-term cr
+            abort
+        endcase
+;
+
 :noname ( obj env -- result )
     2swap
 
@@ -957,16 +972,10 @@ defer eval
     application? if
         2over 2over
         operator 2swap eval
-
-        primitive-proc-type istype? false = if
-            bold fg red ." Object not applicable. Aboring." reset-term cr
-            abort
-        then
-
         -2rot
         operands 2swap list-of-vals
 
-        2swap drop execute
+        apply
         exit
     then
 
-- 
2.20.1