Minor indentation change, a typo.

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

diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm
index 1709d81..faa5815 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))
@@ -65,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))
@@ -93,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))
 
@@ -117,6 +147,14 @@
             dict)))
 
 
+;██████╗  █████╗ ██████╗ ███████╗███████╗██████╗
+;██╔══██╗██╔══██╗██╔══██╗██╔════╝██╔════╝██╔══██╗
+;██████╔╝███████║██████╔╝███████╗█████╗  ██████╔╝
+;██╔═══╝ ██╔══██║██╔══██╗╚════██║██╔══╝  ██╔══██╗
+;██║     ██║  ██║██║  ██║███████║███████╗██║  ██║
+;╚═╝     ╚═╝  ╚═╝╚═╝  ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
+;Parser
+
 (define (string-replace str from to)
   (string-intersperse (string-split str from #t) to))
 
@@ -162,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))
@@ -172,36 +218,48 @@
   (string-intersperse (map joy-term->string expr) " "))
 
 
+;██████╗ ███████╗███████╗██╗███╗   ██╗██╗████████╗██╗ ██████╗ ███╗   ██╗███████╗
+;██╔══██╗██╔════╝██╔════╝██║████╗  ██║██║╚══██╔══╝██║██╔═══██╗████╗  ██║██╔════╝
+;██║  ██║█████╗  █████╗  ██║██╔██╗ ██║██║   ██║   ██║██║   ██║██╔██╗ ██║███████╗
+;██║  ██║██╔══╝  ██╔══╝  ██║██║╚██╗██║██║   ██║   ██║██║   ██║██║╚██╗██║╚════██║
+;██████╔╝███████╗██║     ██║██║ ╚████║██║   ██║   ██║╚██████╔╝██║ ╚████║███████║
+;╚═════╝ ╚══════╝╚═╝     ╚═╝╚═╝  ╚═══╝╚═╝   ╚═╝   ╚═╝ ╚═════╝ ╚═╝  ╚═══╝╚══════╝
+;Definitions
+
 (define (initialize)
-  (load-defs (make-hash-table string=? string-hash)))
+  (load-defs! (make-hash-table string=? string-hash)))
 
-(define (load-defs dict)
-  (for-each (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))))
 
 
-(define (prompt) (display "joy? ") (read-line))
+;██████╗ ███████╗██████╗ ██╗
+;██╔══██╗██╔════╝██╔══██╗██║
+;██████╔╝█████╗  ██████╔╝██║
+;██╔══██╗██╔══╝  ██╔═══╝ ██║
+;██║  ██║███████╗██║     ███████╗
+;╚═╝  ╚═╝╚══════╝╚═╝     ╚══════╝
+;REPL
 
-(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 (prompt) (display "joy? ") (read-line))
 
-(define (main-loop)
+(define (main-loop stack0 dict0)
   (let ((text (prompt)))
-    (if (not (string=? text ""))
-      ((print (doit text)) (main-loop))
-      (else))))
+    (if (not (eof-object? text))
+      (receive (stack dict) (joy stack0 (text->expression text) dict0)
+        (print (joy-expression->string (reverse stack)))
+        (main-loop stack dict))
+      (print))))
+
+(define (joy-trace stack expression)
+  (print (conc (joy-expression->string (reverse stack)) " . " (joy-expression->string expression))))
 
-(main-loop)
+(main-loop '() (initialize))
 
 
 ;(display (doit "5 [] cons [4] concat first"))