From ed191ba289bdcd6c0aa2e1079e63e8069ca6965c Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Wed, 21 Jun 2017 10:59:02 +1200
Subject: [PATCH] Working on analyzer.

---
 README.md      |  8 ++---
 src/scheme.4th | 87 ++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 89 insertions(+), 6 deletions(-)

diff --git a/README.md b/README.md
index 0a861b9..8f7f12e 100644
--- a/README.md
+++ b/README.md
@@ -75,12 +75,12 @@ You'll then be greeted by the following prompt:
     ;; M-Eval input:
 
 At this point you can start entering Scheme commands... but be prepared to wait
-a while for the result.  After all, when evaluating commands in the MCE you are
+a while for each result.  After all, when evaluating commands in the MCE you are
 running a program in a Scheme interpreter running inside another Scheme
 interpreter which is itself running on a Forth system that is implemented atop
-the Julia numerical computing environment.  **That's three levels of
-abstraction more than a native Julia program experiences**, so some delay is to
-be expected!
+a virtual register machine running in the Julia numerical computing
+environment.  **That's four levels of abstraction more than a native Julia
+program experiences**, so some delay is to be expected!
 
 For instance, the following example from SICP defines and demonstrates a
 recursive list append procedure:
diff --git a/src/scheme.4th b/src/scheme.4th
index ec97f09..1a90ae3 100644
--- a/src/scheme.4th
+++ b/src/scheme.4th
@@ -11,6 +11,7 @@ include debugging.4th
 
 defer read
 defer expand
+defer analyze
 defer eval
 defer print
 
@@ -1726,6 +1727,88 @@ hide env
 
 \ }}}
 
+\ ---- Analyze ----
+
+: evaluate-eproc ( env eproc --- res )
+    begin
+        nil? invert
+    while
+        2dup car
+        2swap cdr
+    repeat
+    
+    2drop \ get rid of null
+
+    \ Final element of eproc list is primitive procedure
+    drop        \ dump type signifier
+    R> drop >body >R  \ GOTO primitive procedure (executor)
+;
+
+: self-evaluating-executor ( env exp -- exp )
+    2swap 2drop ;
+
+: analyze-self-evaluating ( exp --- eproc )
+    ['] self-evaluating-executor primitive-proc-type
+    nil cons cons
+;
+
+: quote-executor ( env exp -- exp )
+    2swap 2drop ;
+
+: analyze-quoted ( exp -- eproc )
+    quote-body
+
+    ['] quote-executor primitive-proc-type
+    nil cons cons
+;
+
+: variable-executor ( env var -- val )
+    2swap lookup-var ;
+
+: analyze-variable ( exp -- eproc )
+    ['] variable-executor primitive-proc-type
+    nil cons cons
+;
+
+: assignment-executor ( env var val-eproc -- ok )
+    2rot 2dup 2rot ( var env env val-eproc )
+    evaluate-eproc 2swap ( var val env )
+    set-var
+    ok-symbol ;
+
+: analyze-assignment ( exp -- eproc )
+    2dup assignment-var
+    2swap assignment-val analyze ( var val-eproc )
+
+    ['] assignment-executor primitive-proc-type
+    nil cons cons cons
+;
+
+:noname ( exp --- eproc )
+
+    self-evaluating? if
+        analyze-self-evaluating
+        exit
+    then
+
+    quote? if
+        analyze-quoted
+        exit
+    then
+    
+    variable? if
+        analyze-variable
+        exit
+    then
+
+    assignment? if
+        analyze-assignment
+        exit
+    then
+
+; is analyze
+
+
 \ ---- Macro Expansion ---- {{{
 
 ( Simply evaluates the given procedure with expbody as its argument. )
@@ -2110,7 +2193,7 @@ variable gc-stack-depth
 
     include scheme-primitives.4th
 
-    s" scheme-library.scm" load 2drop
+    \ s" scheme-library.scm" load 2drop
     
 \ }}}
 
@@ -2143,7 +2226,7 @@ variable gc-stack-depth
     enable-gc
 
     \ Display welcome message
-    welcome-symbol nil cons global-env obj@ eval 2drop
+    \ welcome-symbol nil cons global-env obj@ eval 2drop
 
     begin
         ['] repl-body catch
-- 
2.20.1