suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

kaboom

Browse Source
This commit is contained in:
Matthew Butterick 2016-04-19 23:20:37 -07:00
parent cca2376b9b
commit b410e97b8f
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
beautiful-racket/br/demo/basic/expander.rkt
View File

@ -3,14 +3,21 @@
(rename-out [basic-module-begin #%module-begin]) (rename-out [basic-module-begin #%module-begin])
(rename-out [basic-top #%top]) (rename-out [basic-top #%top])
(all-defined-out)) (all-defined-out))
(require (for-syntax racket/syntax racket/list)) (require (for-syntax racket/syntax racket/list br/datum))
(define-for-syntax alphasyms (for/list ([i (in-string "ABCDEFGHIJKLMNOPQRSTUVWXYZ")])
(string->symbol (format "~a" i))))
(define-for-syntax stringsyms (map (λ(s) (format-datum "~a$" s)) alphasyms))
(define-syntax (basic-module-begin stx) (define-syntax (basic-module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ PARSE-TREE ...) [(_ PARSE-TREE ...)
(with-syntax ([(VARNAME ...) (map (λ(c) (format-id stx "~a" (integer->char c))) (range 65 91))]) (with-syntax ([(VARNAME ...) (datum->syntax stx alphasyms)]
[(STRINGVARNAME ...) (datum->syntax stx stringsyms)])
#'(#%module-begin #'(#%module-begin
(define VARNAME 0) ... (define VARNAME 0) ...
(define STRINGVARNAME "") ...
(provide VARNAME ... STRINGVARNAME ...)
(println (quote PARSE-TREE ...)) (println (quote PARSE-TREE ...))
PARSE-TREE ...))])) PARSE-TREE ...))]))
@ -38,8 +45,7 @@
idx))) idx)))
(add1 line-idx))))) (add1 line-idx)))))
(define-cases #'cr-line (define #'(cr-line ARG ...) #'(begin ARG ...))
[#'(_ ARG ...) #'(begin ARG ...)])
(define #'(line NUMBER STATEMENT ...) (define #'(line NUMBER STATEMENT ...)
#'(cons NUMBER (λ _ STATEMENT ...))) #'(cons NUMBER (λ _ STATEMENT ...)))

10
beautiful-racket/br/demo/basic/sinewave.bas
View File

@ -1,8 +1,6 @@
#lang br/demo/basic #lang br/demo/basic
1 A = 2
10 PRINT 2 + 3 * 10 + 1 10 PRINT A < 2
12 C$ = "string thing"
20 PRINT 6 * 7 / 8 15 PRINT A;: PRINT C$

2
beautiful-racket/br/demo/basic/tokenizer.rkt
View File

@ -27,7 +27,7 @@
[(union ";" "=" "(" ")") lexeme] [(union ";" "=" "(" ")") lexeme]
[(union "+" "-" "*" "/" [(union "+" "-" "*" "/"
"<=" ">=" "<>" "><" "<" ">" "=" ) (string->symbol lexeme)] "<=" ">=" "<>" "><" "<" ">" "=" ) (string->symbol lexeme)]
[(:seq (repetition 1 +inf.0 upper-case)) (token 'ID (string->symbol lexeme))] [(:seq (repetition 1 +inf.0 upper-case) (:? "$")) (token 'ID (string->symbol lexeme))]
[upper-case (token 'UPPERCASE (string->symbol lexeme))] [upper-case (token 'UPPERCASE (string->symbol lexeme))]
[whitespace (token 'WHITESPACE lexeme #:skip? #t)] [whitespace (token 'WHITESPACE lexeme #:skip? #t)]
[(:seq "\"" (complement (:: any-string "\"" any-string)) "\"") (token 'STRING (string-trim lexeme "\""))] [(:seq "\"" (complement (:: any-string "\"" any-string)) "\"") (token 'STRING (string-trim lexeme "\""))]