From: Tim Vaughan <tgvaughan@gmail.com>
Date: Wed, 13 Jul 2016 11:13:45 +0000 (+1200)
Subject: Implemented quote.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=c48d0766c23a3f5218e6fedf99250c727bf75dbc;p=scheme.forth.jl.git

Implemented quote.
---

diff --git a/scheme.4th b/scheme.4th
index 120edd2..4df51d0 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -50,6 +50,11 @@ variable nextfree
     cdr-type-cells + @
 ;
 
+: caar car car ;
+: cadr cdr car ;
+: cdar car cdr ;
+: cddr cdr cdr ;
+
 : nil 0 nil-type ;
 : nil? nil-type istype? ;
 
@@ -65,6 +70,9 @@ variable nextfree
 objvar symbol-table
 nil symbol-table setobj
 
+: objeq? ( obj obj -- bool )
+    rot = -rot = and ;
+
 \ ---- Pre-defined symbols ----
 
 : (create-symbol) ( addr n -- symbol-obj )
@@ -82,15 +90,21 @@ nil symbol-table setobj
 : create-symbol ( -- )
     bl word
     count
+
     (create-symbol)
     drop symbol-type
 
+    2dup
+
     symbol-table fetchobj
     cons
     symbol-table setobj
+
+    create swap , ,
+    does> dup @ swap 1+ @
 ;
 
-create-symbol quote
+create-symbol quote quote
 
 \ ---- Read ----
 
@@ -527,6 +541,11 @@ defer read
         exit
     then
 
+    nextchar [char] ' = if
+        inc-parse-idx
+        quote recurse nil cons cons exit
+    then
+
     eof? if
         bold fg blue ." Moriturus te saluto." reset-term ."  ok" cr
         quit
@@ -542,14 +561,39 @@ defer read
 \ ---- Eval ----
 
 : self-evaluating? ( obj -- obj bool )
-    true \ everything self-evaluating for now
+    boolean-type istype? if true exit then
+    number-type istype? if true exit then
+    character-type istype? if true exit then
+    string-type istype? if true exit then
+    nil-type istype? if true exit then
+
+    false
 ;
 
+: tagged-list? ( obj tag-obj -- obj bool )
+    2over 
+    pair-type istype? false = if
+        2drop 2drop false
+    else
+        car objeq?
+    then ;
+
+: quote? ( obj -- obj bool )
+    quote tagged-list?  ;
+
+: quote-body ( quote-obj -- quote-body-obj )
+    cadr ;
+    
 : eval
     self-evaluating? if
         exit
     then
 
+    quote? if
+        quote-body
+        exit
+    then
+
     bold fg red ." Error evaluating expression - unrecognized type. Aborting." reset-term cr
     abort
 ;