diff --git a/beautiful-racket-demo/scriptish-demo/expander.rkt b/beautiful-racket-demo/scriptish-demo/expander.rkt index f658696..0c13332 100644 --- a/beautiful-racket-demo/scriptish-demo/expander.rkt +++ b/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)) \ No newline at end of file +(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)]) \ No newline at end of file diff --git a/beautiful-racket-demo/scriptish-demo/grammar.rkt b/beautiful-racket-demo/scriptish-demo/grammar.rkt index 2ffa39a..2818775 100644 --- a/beautiful-racket-demo/scriptish-demo/grammar.rkt +++ b/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 \ 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 4bb1095..92e53c0 100644 --- a/beautiful-racket-demo/scriptish-demo/main.rkt +++ b/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")))