From: Tim Vaughan <tgvaughan@gmail.com>
Date: Wed, 21 Jun 2017 03:14:53 +0000 (+1200)
Subject: Primitive procedure evaluation working.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=346e7741d328a4521e8673f1c0418d05d59a4439;p=scheme.forth.jl.git

Primitive procedure evaluation working.
---

diff --git a/src/goto.4th b/src/goto.4th
new file mode 100644
index 0000000..a2b5536
--- /dev/null
+++ b/src/goto.4th
@@ -0,0 +1,8 @@
+\ Words implementing GOTO
+\ These are required for tail call optimization.
+
+: goto ( cfa -- )
+    R> drop >body >R ;
+
+: goto-deferred ( cfa -- )
+    R> drop >body @ >body >R ;
diff --git a/src/scheme.4th b/src/scheme.4th
index 7a1a1dc..4d5e33b 100644
--- a/src/scheme.4th
+++ b/src/scheme.4th
@@ -1737,7 +1737,7 @@ hide env
 : evaluate-eproc ( eproc env --- res )
 
     >R >R
-    
+
     begin
         nil? invert
     while
@@ -1747,10 +1747,13 @@ hide env
     
     2drop \ get rid of null
 
-    R> R>
+    R> R> 2swap
 
     \ Final element of eproc list is primitive procedure
     drop \ dump type signifier
+
+    .s cr \ DEBUG
+
     goto \ jump straight to primitive procedure (executor)
 ;
 
@@ -1896,22 +1899,27 @@ hide env
 ;
 
 : evaluate-operand-eprocs ( env aprocs -- vals )
-    nil? invert if
-        2over 2over car evaluate-eproc ( env aprocs thisres )
-        -rot cdr recurse
+    nil? if
+        2swap 2drop
+    else
+        2over 2over car 2swap evaluate-eproc ( env aprocs thisval )
+        -2rot cdr recurse ( thisval restvals )
+        cons
+    then
 ;
 
 : application-executor ( operator-proc arg-procs env -- res )
     2rot 2over ( aprocs env fproc env )
     evaluate-eproc ( aprocs env proc )
-    2swap -2rot 2over 2swap ( proc env env aprocs )
-    evaluate-operand-eprocs ( proc env vals )
-    
-    2rot ( env vals proc )
+
+    -2rot 2swap ( proc env aprocs )
+    evaluate-operand-eprocs ( proc vals )
+
+    2swap ( vals proc )
     
     dup case
         primitive-proc-type of
-            2rot 2drop execute
+            drop execute
         endof
 
         compound-proc-type of
@@ -1936,7 +1944,7 @@ hide env
     2dup operator analyze
     2swap operands operand-eproc-list
 
-    ['] application-executor
+    ['] application-executor primitive-proc-type
     nil cons cons cons
 ;
 
@@ -1977,6 +1985,14 @@ hide env
         exit
     then
 
+    application? if
+        analyze-application
+        exit
+    then
+
+    
+    except-message: ." tried to analyze unknown expression type." recoverable-exception throw
+
 ; is analyze