Put a bang on add-def.

[joypy/Thun.git] / implementations / scheme-chicken / joy.scm

diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm
index f747a38..27fc3a8 100644 (file)
--- a/implementations/scheme-chicken/joy.scm
+++ b/implementations/scheme-chicken/joy.scm
@@ -33,7 +33,17 @@
   (chicken-script (load "defs.scm"))
   (else))
 
+
+;██╗███╗   ██╗████████╗███████╗██████╗ ██████╗ ██████╗ ███████╗████████╗███████╗██████╗
+;██║████╗  ██║╚══██╔══╝██╔════╝██╔══██╗██╔══██╗██╔══██╗██╔════╝╚══██╔══╝██╔════╝██╔══██╗
+;██║██╔██╗ ██║   ██║   █████╗  ██████╔╝██████╔╝██████╔╝█████╗     ██║   █████╗  ██████╔╝
+;██║██║╚██╗██║   ██║   ██╔══╝  ██╔══██╗██╔═══╝ ██╔══██╗██╔══╝     ██║   ██╔══╝  ██╔══██╗
+;██║██║ ╚████║   ██║   ███████╗██║  ██║██║     ██║  ██║███████╗   ██║   ███████╗██║  ██║
+;╚═╝╚═╝  ╚═══╝   ╚═╝   ╚══════╝╚═╝  ╚═╝╚═╝     ╚═╝  ╚═╝╚══════╝   ╚═╝   ╚══════╝╚═╝  ╚═╝
+;Interpreter
+
 (define (joy stack expression dict)
+  ;(joy-trace stack expression)
   (if (null? expression)
     (values stack dict)
     (if (string? (car expression))
@@ -48,7 +58,14 @@
     ((is-it? "+") ((joy-func +) stack expression dict))
     ((is-it? "-") ((joy-func -) stack expression dict))
     ((is-it? "*") ((joy-func *) stack expression dict))
+    ((is-it? "/") ((joy-func quotient) stack expression dict))  ; but for negative divisor, no!?
+    ((is-it? "%") ((joy-func modulo) stack expression dict))
+
+    ((is-it? "add") ((joy-func +) stack expression dict))
+    ((is-it? "sub") ((joy-func -) stack expression dict))
     ((is-it? "mul") ((joy-func *) stack expression dict))
+    ((is-it? "div") ((joy-func quotient) stack expression dict))  ; but for negative divisor, no!?
+    ((is-it? "mod") ((joy-func modulo) stack expression dict))
 
     ((is-it? "<") ((joy-func <) stack expression dict))
     ((is-it? ">") ((joy-func >) stack expression dict))
@@ -58,6 +75,8 @@
     ((is-it? "<>") ((joy-func not-equal) stack expression dict))
     ((is-it? "!=") ((joy-func not-equal) stack expression dict))
 
+    ((is-it? "bool") (joy-bool stack expression dict))
+
     ((is-it? "dup") (values (cons (car stack) stack) expression dict))
     ((is-it? "pop") (values (cdr stack) expression dict))
     ((is-it? "stack") (values (cons stack stack) expression dict))
@@ -66,8 +85,8 @@
 
     ((is-it? "concat") ((joy-func append) stack expression dict))
     ((is-it? "cons") ((joy-func cons) stack expression dict))
-    ;((is-it? "first") ((joy-func not-equal) stack expression dict))
-    ;((is-it? "rest") ((joy-func not-equal) stack expression dict))
+    ((is-it? "first") (values (cons (caar stack) (cdr stack)) expression dict))
+    ((is-it? "rest")  (values (cons (cdar stack) (cdr stack)) expression dict))
 
     ((is-it? "i") (joy-i stack expression dict))
     ((is-it? "dip") (joy-dip stack expression dict))
@@ -86,6 +105,24 @@
     (values (cons (op (cadr stack) (car stack)) (cddr stack)) expression dict)))
 
 
+(define (joy-bool stack expression dict)
+  (values (cons (joy-bool-term (car stack)) (cdr stack)) expression dict))
+
+(define (joy-bool-term term)
+    (cond ((boolean? term) term)
+          ((number? term) (not-equal 0 term))
+          ((list? term) (not (null? term)))
+          (else #t)))
+
+
+; ██████╗ ██████╗ ███╗   ███╗██████╗ ██╗███╗   ██╗ █████╗ ████████╗ ██████╗ ██████╗ ███████╗
+;██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║████╗  ██║██╔══██╗╚══██╔══╝██╔═══██╗██╔══██╗██╔════╝
+;██║     ██║   ██║██╔████╔██║██████╔╝██║██╔██╗ ██║███████║   ██║   ██║   ██║██████╔╝███████╗
+;██║     ██║   ██║██║╚██╔╝██║██╔══██╗██║██║╚██╗██║██╔══██║   ██║   ██║   ██║██╔══██╗╚════██║
+;╚██████╗╚██████╔╝██║ ╚═╝ ██║██████╔╝██║██║ ╚████║██║  ██║   ██║   ╚██████╔╝██║  ██║███████║
+; ╚═════╝ ╚═════╝ ╚═╝     ╚═╝╚═════╝ ╚═╝╚═╝  ╚═══╝╚═╝  ╚═╝   ╚═╝    ╚═════╝ ╚═╝  ╚═╝╚══════╝
+;Combinators
+
 (define (joy-i stack expression dict)
   (values (cdr stack) (append (car stack) expression) dict))
 
@@ -110,6 +147,14 @@
             dict)))
 
 
+;██████╗  █████╗ ██████╗ ███████╗███████╗██████╗
+;██╔══██╗██╔══██╗██╔══██╗██╔════╝██╔════╝██╔══██╗
+;██████╔╝███████║██████╔╝███████╗█████╗  ██████╔╝
+;██╔═══╝ ██╔══██║██╔══██╗╚════██║██╔══╝  ██╔══██╗
+;██║     ██║  ██║██║  ██║███████║███████╗██║  ██║
+;╚═╝     ╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
+;Parser
+
 (define (string-replace str from to)
   (string-intersperse (string-split str from #t) to))
 
@@ -155,6 +200,14 @@
 (define (text->expression text) (parse (tokenize text)))
 
 
+;██████╗ ██████╗ ██╗███╗   ██╗████████╗███████╗██████╗
+;██╔══██╗██╔══██╗██║████╗  ██║╚══██╔══╝██╔════╝██╔══██╗
+;██████╔╝██████╔╝██║██╔██╗ ██║   ██║   █████╗  ██████╔╝
+;██╔═══╝ ██╔══██╗██║██║╚██╗██║   ██║   ██╔══╝  ██╔══██╗
+;██║     ██║  ██║██║██║ ╚████║   ██║   ███████╗██║  ██║
+;╚═╝     ╚═╝  ╚═╝╚═╝╚═╝  ╚═══╝   ╚═╝   ╚══════╝╚═╝  ╚═╝
+;Printer
+
 (define (joy-term->string term)
   (cond ((boolean? term) (if term "true" "false"))
         ((number? term) (->string term))
@@ -164,26 +217,61 @@
 (define (joy-expression->string expr)
   (string-intersperse (map joy-term->string expr) " "))
 
-(define (doit text)
-  (receive (stack _dict)
-    (joy '() (text->expression text) (initialize))
-    (joy-expression->string stack)))
 
+;██████╗ ███████╗███████╗██╗███╗   ██╗██╗████████╗██╗ ██████╗ ███╗   ██╗███████╗
+;██╔══██╗██╔════╝██╔════╝██║████╗  ██║██║╚══██╔══╝██║██╔═══██╗████╗  ██║██╔════╝
+;██║  ██║█████╗  █████╗  ██║██╔██╗ ██║██║   ██║   ██║██║   ██║██╔██╗ ██║███████╗
+;██║  ██║██╔══╝  ██╔══╝  ██║██║╚██╗██║██║   ██║   ██║██║   ██║██║╚██╗██║╚════██║
+;██████╔╝███████╗██║     ██║██║ ╚████║██║   ██║   ██║╚██████╔╝██║ ╚████║███████║
+;╚═════╝ ╚══════╝╚═╝     ╚═╝╚═╝  ╚═══╝╚═╝   ╚═╝   ╚═╝ ╚═════╝ ╚═╝  ╚═══╝╚══════╝
+;Definitions
 
 (define (initialize)
-  (load-defs (make-hash-table string=? string-hash)))
+  (load-defs! (make-hash-table string=? string-hash)))
 
-(define (load-defs dict)
-  (map (lambda (def) (add-def def dict)) (defs))  ;defs is defined in defs.scm
+(define (load-defs! dict)
+  (for-each (lambda (def) (add-def! def dict)) (defs))  ;defs is defined in defs.scm
   dict)
 
-(define (add-def def dict)
+(define (add-def! def dict)
   (let ((def_list (text->expression def)))
     (hash-table-set! dict (car def_list) (cdr def_list))))
 
-(display (doit "5 [] cons [4] concat"))
 
+;██████╗ ███████╗██████╗ ██╗
+;██╔══██╗██╔════╝██╔══██╗██║
+;██████╔╝█████╗  ██████╔╝██║
+;██╔══██╗██╔══╝  ██╔═══╝ ██║
+;██║  ██║███████╗██║     ███████╗
+;╚═╝  ╚═╝╚══════╝╚═╝     ╚══════╝
+;REPL
+
+(define (prompt) (display "joy? ") (read-line))
+
+(define DICTIONARY (initialize))
+(define STACK '())
+
+(define (doit text)
+  (receive (stack dict) (joy STACK (text->expression text) DICTIONARY)
+    (set! DICTIONARY dict)
+    (set! STACK stack)
+    (joy-expression->string (reverse stack))))
+
+(define (main-loop)
+  (let ((text (prompt)))
+    (if (not (string=? text ""))
+      ((print (doit text)) (main-loop))
+      (else))))
+
+
+(define (joy-trace stack expression)
+  (print (conc (joy-expression->string (reverse stack)) " . " (joy-expression->string expression))))
+
+(main-loop)
+
+
+;(display (doit "5 [] cons [4] concat first"))
 ;(display (doit "5 down_to_zero"))
 ;(display (doit "1 2 true [4 5 false] loop <"))
-(newline)
+;(newline)