From 944c543db7dadc028bcd8eb46b888d8126acfa97 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 26 Jun 2019 13:58:02 -0700
Subject: [PATCH] refac scriptish

---
 .../scriptish-demo/expander.rkt               | 48 +++++++++++--------
 .../scriptish-demo/grammar.rkt                | 24 ++++++++++
 beautiful-racket-demo/scriptish-demo/main.rkt | 26 ++++------
 .../scriptish-demo/parser.rkt                 | 24 ----------
 beautiful-racket-demo/scriptish-demo/test.rkt |  2 +
 5 files changed, 65 insertions(+), 59 deletions(-)
 create mode 100644 beautiful-racket-demo/scriptish-demo/grammar.rkt
 delete mode 100644 beautiful-racket-demo/scriptish-demo/parser.rkt

diff --git a/beautiful-racket-demo/scriptish-demo/expander.rkt b/beautiful-racket-demo/scriptish-demo/expander.rkt
index 80cbc84..4b25c1b 100644
--- a/beautiful-racket-demo/scriptish-demo/expander.rkt
+++ b/beautiful-racket-demo/scriptish-demo/expander.rkt
@@ -1,50 +1,60 @@
 #lang br/quicklang
 (require racket/stxparam)
-(provide (all-defined-out) (all-from-out br/quicklang))
+(provide (all-defined-out))
 
-(define-macro top #'begin)
+(define-macro top #'#%module-begin)
 
-(define-macro (assignment ID VAL) #'(define ID VAL))
+(define-macro (var 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
+(define-macro-cases add-or-sub
   [(_ VAL) #'VAL]
   [(_ . VALS) #'(add/concat . VALS)])
 
 (define-macro (object (K V) ...)
   #'(make-hash (list (cons K V) ...)))
 
-(define-macro (func-def (ARG ...) STMT ...)
+(define-syntax-parameter return
+  (λ (stx) (error 'not-parameterized)))
+
+(define-macro (fun (ARG ...) STMT ...)
   (syntax/loc caller-stx
     (λ (ARG ...)
       (let/cc return-cc
         (syntax-parameterize ([return (make-rename-transformer #'return-cc)])
           STMT ... (void))))))
 
-(define-syntax-parameter return
-  (λ (stx) (error 'not-parameterized)))
+(define (resolve-deref base . keys)
+  (for/fold ([val base])
+            ([key (in-list keys)])
+    (cond
+      [(and
+        (hash? val)
+        (cond
+          [(hash-ref val key #f)]
+          [(hash-ref val (symbol->string key) #f)]
+          [else #f]))]
+      [else (error 'deref-failure)])))
 
-(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 (deref (BASE KEY ...))
+  #'(resolve-deref BASE 'KEY ...))
 
-(define-macro func-app #'#%app)
+(define-macro app #'#%app)
 
-(define-macro (if COND . STMTS)
-  #'(when COND . STMTS))
+(define-macro-cases if
+  [(_ COND TSTMT ... "else" FSTMT ...) #'(cond
+                                           [COND TSTMT ...]
+                                           [else FSTMT ...])]
+  [(_ COND STMT ...) #'(when COND STMT ...)])
 
 (define-macro-cases comparison
   [(_ VAL) #'VAL]
-  [(_ L == R) #'(equal? L R)]
-  [(_ L != R) #'(not (equal? L R))])
+  [(_ L "==" R) #'(equal? L R)]
+  [(_ L "!=" R) #'(not (equal? L R))])
 
 (define-macro (while COND STMT ...)
   #'(let loop ()
diff --git a/beautiful-racket-demo/scriptish-demo/grammar.rkt b/beautiful-racket-demo/scriptish-demo/grammar.rkt
new file mode 100644
index 0000000..251e641
--- /dev/null
+++ b/beautiful-racket-demo/scriptish-demo/grammar.rkt
@@ -0,0 +1,24 @@
+#lang brag
+
+top : @statement*
+statement : (var | expr | return) /";" | if | while
+var : /"var" id /"=" expr
+@expr : comparison
+comparison : [comparison ("!=" | "==")] add-or-sub
+add-or-sub : [@add-or-sub /"+"] value 
+@value : id | INTEGER  | STRING | object
+       | fun | app | increment
+increment : id /"++"
+object : /"{" @kvs /"}"
+kvs : [kv (/"," kv)*]
+/kv : expr /":" expr
+fun : /"function" /"(" ids /")" @block
+/ids : [id (/"," id)*]
+@id : ID | deref
+deref : DEREF
+block : /"{" @statement* /"}"
+return : /"return" expr
+app : id /"(" @exprs /")"
+exprs : [expr (/"," expr)*]
+if : /"if" /"(" expr /")" @block ["else" @block]
+while : /"while" /"(" expr /")" @block
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/main.rkt b/beautiful-racket-demo/scriptish-demo/main.rkt
index d2bf265..f6b0377 100644
--- a/beautiful-racket-demo/scriptish-demo/main.rkt
+++ b/beautiful-racket-demo/scriptish-demo/main.rkt
@@ -1,5 +1,5 @@
 #lang br/quicklang
-(require "parser.rkt" brag/support)
+(require "grammar.rkt" brag/support)
 
 (module+ reader
   (provide read-syntax))
@@ -7,35 +7,29 @@
 (define-lex-abbrev reserved-terms
   (:or "var" "=" ";" "+" "{" "}" "'" "\""
        ":" "," "(" ")" "//" "/*" "*/"
-       "if" "while" "==" "!=" "function" "return" "++"))
+       "if" "else" "while" "==" "!=" "function" "return" "++"))
 
-(define scriptish-lexer
+(define tokenize-1
   (lexer-srcloc
    [(:or (from/stop-before "//" "\n")
          (from/to "/*" "*/")) (token 'COMMENT #:skip? #t)]
-   [reserved-terms (token lexeme (string->symbol lexeme))]
+   [reserved-terms 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 ".")))]
+    (token 'DEREF (map string->symbol (string-split lexeme ".")))]
    [(:+ (char-set "0123456789"))
     (token 'INTEGER (string->number lexeme))]
    [(:or (from/to "\"" "\"") (from/to "'" "'"))
-    (let ()
-    (token 'STRING (string-trim lexeme (substring lexeme 0 1))))]
+    (token 'STRING (string-trim lexeme (substring lexeme 0 1)))]
    [whitespace (token 'WHITE #:skip? #t)]
    [any-char lexeme]))
 
-(define (make-tokenizer ip [src #f])
-  (port-count-lines! ip)
-  (lexer-file-path src)
-  (define (next-token) (scriptish-lexer ip))
-  next-token)
-
 (define (read-syntax src ip)
-  (println src)
-  (define parse-tree (parse src (make-tokenizer ip src)))
-  (strip-context
+  (port-count-lines! ip)
+  (lexer-file-path ip)
+  (define parse-tree (parse src (λ () (tokenize-1 ip))))
+  (strip-bindings
    (with-syntax ([PT parse-tree])
      #'(module scriptish-mod scriptish-demo/expander
          PT))))
\ No newline at end of file
diff --git a/beautiful-racket-demo/scriptish-demo/parser.rkt b/beautiful-racket-demo/scriptish-demo/parser.rkt
deleted file mode 100644
index a1ed89f..0000000
--- a/beautiful-racket-demo/scriptish-demo/parser.rkt
+++ /dev/null
@@ -1,24 +0,0 @@
-#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/test.rkt b/beautiful-racket-demo/scriptish-demo/test.rkt
index e36655c..ea9942f 100644
--- a/beautiful-racket-demo/scriptish-demo/test.rkt
+++ b/beautiful-racket-demo/scriptish-demo/test.rkt
@@ -20,6 +20,8 @@ thing.bar(3); // prints 18
 if ( thing.foo == 42 ) {
     // prints "The correct answer is 42"
     alert("The correct answer is " + thing.foo);
+} else {
+    alert("Nope");
 }
 
 var idx = 0;