From 177f0bbb09e52ed7a098e4e88c9113f8f9014fc3 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Tue, 18 Jun 2019 11:50:02 -0700
Subject: [PATCH] scriptish demo

---
 .../scriptish-demo/expander.rkt               |  59 ++++++++++
 .../scriptish-demo/grammar.rkt                |  24 +++++
 beautiful-racket-demo/scriptish-demo/info.rkt |   4 +
 .../scriptish-demo/less-rackety.rkt           | 102 ++++++++++++++++++
 beautiful-racket-demo/scriptish-demo/main.rkt |  33 ++++++
 .../scriptish-demo/rackety.rkt                |  64 +++++++++++
 .../scriptish-demo/sexped.rkt                 |  30 ++++++
 beautiful-racket-demo/scriptish-demo/test.rkt |  32 ++++++
 8 files changed, 348 insertions(+)
 create mode 100644 beautiful-racket-demo/scriptish-demo/expander.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/grammar.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/info.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/less-rackety.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/main.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/rackety.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/sexped.rkt
 create mode 100644 beautiful-racket-demo/scriptish-demo/test.rkt

diff --git a/beautiful-racket-demo/scriptish-demo/expander.rkt b/beautiful-racket-demo/scriptish-demo/expander.rkt
new file mode 100644
index 0000000..b75cc7c
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/expander.rkt
@@ -0,0 +1,59 @@
+#lang br/quicklang
+(require racket/stxparam)
+(provide (all-defined-out) (all-from-out br/quicklang))
+
+(define-macro top #'begin)
+
+(define-macro (assignment ID VAL) #'(define ID VAL))
+
+(define (add/concat . xs)
+  (cond
+    [(andmap number? xs) (apply + xs)]
+    [(ormap string? xs) (string-join (map ~a xs) "")]))
+  
+(define-macro-cases sumlike
+  [(_ VAL) #'VAL]
+  [(_ . VALS) #'(add/concat . VALS)])
+
+(define-macro (object (K V) ...)
+  #'(make-hash (list (cons K V) ...)))
+
+(define-macro (func-def (ARG ...) STMT ...)
+  #'(λ (ARG ...)
+      (let/cc return-cc
+        (syntax-parameterize ([return (make-rename-transformer #'return-cc)])
+          STMT ... (void)))))
+
+(define-syntax-parameter return
+  (λ (stx) (error 'not-parameterized)))
+
+(define-macro (dotted-id (BASE KEY ...))
+  #'(for/fold ([val BASE])
+              ([key (in-list (list 'KEY ...))])
+      (cond
+        [(hash-ref val key #f)]
+        [(hash-ref val (symbol->string key) #f)]
+        [else (error 'dotted-failure)])))
+
+(define-macro func-app #'#%app)
+
+(define-macro (if COND . STMTS)
+  #'(when COND . STMTS))
+
+(define-macro-cases comparison
+  [(_ VAL) #'VAL]
+  [(_ L == R) #'(equal? L R)]
+  [(_ L != R) #'(not (equal? L R))])
+
+(define-macro (while COND STMT ...)
+  #'(let loop ()
+      (when COND
+        STMT ...
+        (loop))))
+
+(define alert displayln)
+
+(define-macro (increment ID)
+  #'(let ()
+      (set! ID (add1 ID))
+      ID))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/grammar.rkt b/beautiful-racket-demo/scriptish-demo/grammar.rkt
new file mode 100644
index 0000000..a1ed89f
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/grammar.rkt
@@ -0,0 +1,24 @@
+#lang brag
+
+top : @statement*
+statement : (assignment | expr | return) /";" | if | while
+assignment : /"var" id /"=" expr
+@expr : comparison
+comparison : [comparison ("!=" | "==")] sumlike
+sumlike : [@sumlike /"+"] value 
+@value : id | INTEGER  | STRING | object
+       | func-def | func-app | increment
+increment : id /"++"
+object : /"{" @kvs /"}"
+kvs : [kv (/"," kv)*]
+/kv : expr /":" expr
+func-def : /"function" /"(" ids /")" @block
+/ids : [id (/"," id)*]
+@id : ID | dotted-id
+dotted-id : DOTTED-ID
+block : /"{" @statement* /"}"
+return : /"return" expr
+func-app : id /"(" @exprs /")"
+exprs : [expr (/"," expr)*]
+if : /"if" /"(" expr /")" @block
+while : /"while" /"(" expr /")" @block
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/info.rkt b/beautiful-racket-demo/scriptish-demo/info.rkt
new file mode 100644
index 0000000..ebe1cda
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/info.rkt
@@ -0,0 +1,4 @@
+#lang info
+
+(define compile-omit-paths '("less-rackety.rkt"))
+(define test-omit-paths '("less-rackety.rkt"))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/less-rackety.rkt b/beautiful-racket-demo/scriptish-demo/less-rackety.rkt
new file mode 100644
index 0000000..a2cfb3d
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/less-rackety.rkt
@@ -0,0 +1,102 @@
+#lang s-exp javascriptlike-demo
+;;
+;;var x = 42;
+;(define x 42)
+
+(var x 42)
+
+;;var s = "string";
+;(define s "string")
+
+(var s "string")
+
+;;
+;;x + x;
+;(define (add/concat . xs)
+;  (cond
+;    [(andmap number? xs) (apply + xs)]
+;    [(ormap string? xs) (string-join (map ~a xs) "")]))
+;(add/concat x x)
+
+(sumlike x x)
+
+;;s + x;
+;(add/concat s x)
+
+(sumlike s x)
+
+
+;;
+;;var thing = {
+;;    'foo' : 42,
+;;
+;;    'bar' : function(x) {
+;;        return x + 15;
+;;    }
+;;};
+
+;
+;(define thing (hash
+;               "foo" 42
+;               "bar" (λ (x) (let/ec return (return (add/concat x 15)) (void)))))
+;
+
+
+(object thing ("foo" 42) ("bar" (func (x) (return (sumlike x 15)))))
+
+;;thing.foo
+;;thing.bar
+;;thing.bar(3)
+
+;
+;(hash-ref thing "foo")
+;(hash-ref thing "bar")
+;(#%app (hash-ref thing "bar") 3)
+
+
+(dot thing "foo")
+(dot thing "bar")
+(func-app (dot thing "bar") 3)
+
+;
+;;
+;;if ( thing.foo == 42 ) {
+;;    console.log("The correct answer is " + thing.foo);
+;;}
+;
+;(when (equal? (hash-ref thing "foo") 42)
+;  (displayln (add/concat "The correct answer is " (hash-ref thing "foo"))))
+
+
+(object console ("log" (func (str) (pretty-print str))))
+
+(if (comparison (dot thing "foo") "==" 42)
+  (func-app (dot console "log") (sumlike "The correct answer is " (dot thing "foo"))))
+
+;
+;;var idx = 0;
+;;while ( idx != 50 ) {
+;;    if ( thing.bar(idx) == 35 ) {
+;;       alert("Calamity at " + idx + "!");
+;;    }
+;;    idx++;
+;;}
+;
+;(define (alert str)
+;  (displayln "*********")
+;  (displayln str)
+;  (displayln "*********"))
+;
+;(define idx 0)
+;(let loop ()
+;  (when (not (equal? idx 50))
+;    (when (equal? (#%app (hash-ref thing "bar") idx) 35)
+;      (alert (add/concat "Calamity at " idx "!")))
+;    (set! idx (add1 idx))
+;    (loop)))
+
+(var idx 0)
+(while (comparison idx "!=" 50)
+       (if (comparison (func-app (dot thing "bar") idx) "==" 35)
+           (alert (sumlike "Calamity at " idx "!")))
+       (increment idx))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/main.rkt b/beautiful-racket-demo/scriptish-demo/main.rkt
new file mode 100644
index 0000000..e35555a
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/main.rkt
@@ -0,0 +1,33 @@
+#lang br/quicklang
+(require "grammar.rkt" brag/support)
+
+(module+ reader
+  (provide read-syntax))
+
+(define-lex-abbrev reserved-terms
+  (:or "var" "=" ";" "+" "{" "}" "'" "\""
+       ":" "," "(" ")" "//" "/*" "*/"
+       "if" "while" "==" "!=" "function" "return" "++"))
+
+(define tokenize
+  (lexer
+   [(:or (from/stop-before "//" "\n")
+         (from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
+   [reserved-terms (token lexeme (string->symbol lexeme))]
+   [(:+ (:- (:or alphabetic punctuation) "." reserved-terms))
+    (token 'ID (string->symbol lexeme))]
+   [(:+ (:- (:or alphabetic punctuation) reserved-terms))
+    (token 'DOTTED-ID (map string->symbol (string-split lexeme ".")))]
+   [(:+ (char-set "0123456789"))
+    (token 'INTEGER (string->number lexeme))]
+   [(:or (from/to "\"" "\"") (from/to "'" "'"))
+    (token 'STRING (string-trim lexeme (substring lexeme 0 1)))]
+   [whitespace (token 'WHITE #:skip? #t)]
+   [any-char lexeme]))
+
+(define (read-syntax src ip)
+  (define parse-tree (parse (λ () (tokenize ip))))
+  (strip-context
+   (with-syntax ([PT parse-tree])
+     #'(module you-win scriptish-demo/expander
+         PT))))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/rackety.rkt b/beautiful-racket-demo/scriptish-demo/rackety.rkt
new file mode 100644
index 0000000..4a0ae72
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/rackety.rkt
@@ -0,0 +1,64 @@
+#lang br
+;
+;var x = 42;
+(define x 42)
+;var s = "string";
+(define s "string")
+;
+;x + x;
+(define (add/concat . xs)
+  (cond
+    [(andmap number? xs) (apply + xs)]
+    [(ormap string? xs) (string-join (map ~a xs) "")]))
+(add/concat x x)
+;s + x;
+(add/concat s x)
+;
+;var thing = {
+;    'foo' : 42,
+;
+;    'bar' : function(x) {
+;        return x + 15;
+;    }
+;};
+
+(define thing (hash
+               "foo" 42
+               "bar" (λ (x) (let/ec return (return (add/concat x 15)) (void)))))
+
+;thing.foo
+;thing.bar
+;thing.bar(3)
+
+(hash-ref thing "foo")
+(hash-ref thing "bar")
+(#%app (hash-ref thing "bar") 3)
+
+;
+;if ( thing.foo == 42 ) {
+;    console.log("The correct answer is " + thing.foo);
+;}
+
+(when (equal? (hash-ref thing "foo") 42)
+  (displayln (add/concat "The correct answer is " (hash-ref thing "foo")))) 
+
+;var idx = 0;
+;while ( idx != 50 ) {
+;    if ( thing.bar(idx) == 35 ) {
+;       alert("Calamity at " + idx + "!");
+;    }
+;    idx++;
+;}
+
+(define (alert str)
+  (displayln "*********")
+  (displayln str)
+  (displayln "*********"))
+
+(define idx 0)
+(let loop ()
+  (when (not (equal? idx 50))
+    (when (equal? (#%app (hash-ref thing "bar") idx) 35)
+      (alert (add/concat "Calamity at " idx "!")))
+    (set! idx (add1 idx))
+    (loop)))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/sexped.rkt b/beautiful-racket-demo/scriptish-demo/sexped.rkt
new file mode 100644
index 0000000..d2f37b8
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/sexped.rkt
@@ -0,0 +1,30 @@
+#lang s-exp javascriptlike-demo/expander
+
+(assignment x 42)
+(assignment s "string")
+
+(sumlike x x)
+(sumlike s x)
+
+(assignment thing (object
+                   ("foo" 42)
+        
+                   ("bar" (func-def (x)
+                                (return (sumlike x 15))))))
+
+
+
+(dotted-id (thing foo))
+(dotted-id (thing bar))
+(func-app (dotted-id (thing bar)) 3)
+
+(assignment console (object ("log" (func-def (str) (displayln str))))) ; simulates global console (don't put in parse tree)
+(if (comparison (dotted-id (thing foo)) == 42)
+    (func-app (dotted-id (console log)) (sumlike "The correct answer is " (dotted-id (thing foo)))))
+
+
+(assignment idx 0)
+(while (comparison idx != 50)
+       (if (comparison (func-app (dotted-id (thing bar)) idx) == 35)
+           (alert (sumlike "Calamity at " idx "!")))
+       (increment idx))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/test.rkt b/beautiful-racket-demo/scriptish-demo/test.rkt
new file mode 100644
index 0000000..8daa65c
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/test.rkt
@@ -0,0 +1,32 @@
+#lang scriptish-demo
+
+var x = 42;
+var s = "string";
+
+x + x; // prints 84
+s + x; // prints "string42"
+
+var thing = {
+    "foo" : 42,
+    'bar' : function(x) {
+        return x + 15;
+    }
+};
+
+thing.foo; // prints 42
+thing.bar; // prints #<procedure:...>
+thing.bar(3); // prints 18
+
+if ( thing.foo == 42 ) {
+    // prints "The correct answer is 42"
+    alert("The correct answer is " + thing.foo);
+}
+
+var idx = 0;
+while ( idx != 50 ) {
+    if ( thing.bar(idx) == 35 ) {
+       // prints "Calamity at 20!"
+       alert("Calamity at " + idx + "!"); 
+    }
+    idx++;
+}