demo details

beautiful-racket-demo/scriptish-demo/expander.rkt

@@ -1,17 +1,30 @@
 #lang br
 (require racket/stxparam)
 (provide (all-defined-out)
-         #%top-interaction #%top
+         #%top-interaction #%top #%app
          (rename-out [my-datum #%datum]))
 
 (define-macro top #'#%module-begin)
 
+(define-macro-cases ternary
+  [(_ EXPR) #'EXPR]
+  [(_ COND TRUE-EXPR FALSE-EXPR) #'(if COND TRUE-EXPR FALSE-EXPR)])
+
+(define-macro-cases logical-or
+  [(_ VAL) #'VAL]
+  [(_ L "||" R) #'(or L R)])
+
+(define-macro-cases logical-and
+  [(_ VAL) #'VAL]
+  [(_ L "&&" R) #'(and L R)])
+
 (define-macro (my-datum . VAL)
   (with-syntax ([NEW-VAL (let ([val (syntax->datum #'VAL)])
-                          (if (and (integer? val)
-                                   (inexact? val))
-                              (inexact->exact val)
-                              val))])
+                           (cond
+                             [(and (integer? val) (inexact? val))
+                              (inexact->exact val)]
+                             [(boolean? val) (if val "True" "False")]
+                             [else val]))])
     #'(#%datum . NEW-VAL)))
 
 (define-macro (var ID VAL) #'(define ID VAL))
@@ -42,7 +55,10 @@
     (λ (ARG ...)
       (let/cc return-cc
         (syntax-parameterize ([return (make-rename-transformer #'return-cc)])
-          STMT ... (void))))))
+          (void) STMT ...)))))
+
+(define-macro (defun ID (ARG ...) STMT ...)
+  #'(define ID (fun (ARG ...) STMT ...)))
 
 (define (resolve-deref base . keys)
   (for/fold ([val base])
@@ -61,26 +77,64 @@
 
 (define-macro app #'#%app)
 
-(define-macro-cases if
+(define-macro-cases if-else
   [(_ COND TSTMT ... "else" FSTMT ...) #'(cond
                                            [COND TSTMT ...]
                                            [else FSTMT ...])]
   [(_ COND STMT ...) #'(when COND STMT ...)])
 
-(define-macro-cases comparison
+(define-macro-cases equal-or-not
   [(_ VAL) #'VAL]
   [(_ L "==" R) #'(equal? L R)]
   [(_ L "!=" R) #'(not (equal? L R))])
 
+(define-macro-cases gt-or-lt
+  [(_ VAL) #'VAL]
+  [(_ L "<" R) #'(< L R)]
+  [(_ L "<=" R) #'(<= L R)]
+  [(_ L ">" R) #'(> L R)]
+  [(_ L ">=" R) #'(>= 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))
+(define (alert x) (displayln (format "ALERT! ~a" x)))
+
+#;(require racket/gui)
+#;(define (alert text)
+    (define dialog (instantiate dialog% ("Alert")))
+    (new message% [parent dialog] [label text])
+    (define panel (new horizontal-panel% [parent dialog]
+                       [alignment '(center center)]))
+    (new button% [parent panel] [label "Ok"]
+         [callback (lambda (button event)
+                     (send dialog show #f))])
+    (send dialog show #t))
+
+(define-macro-cases increment
+  [(_ ID) #'ID]
+  [(_ "++" ID) #'(let ()
+                   (set! ID (add1 ID))
+                   ID)]
+  [(_ "--" ID) #'(let ()
+                   (set! ID (sub1 ID))
+                   ID)]
+  [(_ ID "++") #'(begin0
+                   ID
+                   (set! ID (add1 ID)))]
+  [(_ ID "--") #'(begin0
+                   ID
+                   (set! ID (sub1 ID)))])
+
+
+(define-macro-cases reassignment
+  [(_ ID) #'ID]
+  [(_ ID "+=" EXPR) #'(let ()
+                        (set! ID (+ ID EXPR))
+                        ID)]
+  [(_ ID "-=" EXPR) #'(let ()
+                        (set! ID (- ID EXPR))
+                        ID)])

beautiful-racket-demo/scriptish-demo/grammar.rkt

@@ -1,25 +1,31 @@
 #lang brag
 
 top : @statement*
-statement : (var | expr | return) /";" | if | while
-var : /"var" id /"=" expr
-@expr : comparison
-comparison : [comparison ("!=" | "==")] add-or-sub
+statement : (var | expr | return | defun) /";" | if-else | while
+var : /"var" varname /"=" expr
+@expr : reassignment
+reassignment : ID [("+=" | "-=") expr] | ternary
+ternary : expr /"?" expr /":" expr | logical-or
+logical-or : [logical-or "||"] logical-and
+logical-and : [logical-and "&&"] equal-or-not
+equal-or-not : [equal-or-not ("!=" | "==")] gt-or-lt
+gt-or-lt : [gt-or-lt ("<" | "<=" | ">" | ">=")] add-or-sub
 add-or-sub : [add-or-sub ("+" | "-")] mult-or-div
 mult-or-div : [mult-or-div ("*" | "/")] value
-@value : id | NUMBER  | STRING | object
-       | fun | app | increment
-increment : id /"++"
+@value :  NUMBER  | STRING | object
+       | fun | app | increment | varname | /"(" expr /")"
+increment : ("++" | "--") varname | varname ("++" | "--")
 object : /"{" @kvs /"}"
 kvs : [kv (/"," kv)*]
 /kv : expr /":" expr
-fun : /"function" /"(" ids /")" @block
-/ids : [id (/"," id)*]
-@id : ID | deref
+defun : /"function" ID /"(" varnames /")" @block
+fun : /"function" /"(" varnames /")" @block
+/varnames : [varname (/"," varname)*]
+@varname : ID | deref
 deref : DEREF
 block : /"{" @statement* /"}"
 return : /"return" expr
-app : id /"(" @exprs /")"
+app : varname /"(" @exprs /")"
 exprs : [expr (/"," expr)*]
-if : /"if" /"(" expr /")" @block ["else" @block]
+if-else : /"if" /"(" expr /")" @block ["else" @block]
 while : /"while" /"(" expr /")" @block

beautiful-racket-demo/scriptish-demo/main.rkt

@@ -5,10 +5,14 @@
   (provide read-syntax))
 
 (define-lex-abbrev reserved-terms
-  (:or "var" "=" ";" "+" "*" "/"
-       "-" "{" "}" "'" "\""
-       ":" "," "(" ")" "//" "/*" "*/"
-       "if" "else" "while" "==" "!=" "function" "return" "++"))
+  (:or "var" "=" ";" "{" "}" "//" "/*" "*/"
+       "+" "*" "/" "-"
+       "'" "\""
+       ":" "," "(" ")" 
+       "if" "else" "while" "?"
+       "==" "!=" "<=" "<" ">=" ">" "&&" "||"
+       "function"
+       "return" "++" "--" "+=" "-="))
 
 (define-lex-abbrev digits (:+ (char-set "0123456789")))