diff --git a/br-bf/bf-test-sexp.rkt b/br-bf/bf-test-sexp.rkt index 017dc21..f298200 100644 --- a/br-bf/bf-test-sexp.rkt +++ b/br-bf/bf-test-sexp.rkt @@ -1,2 +1,2 @@ #lang s-exp br-bf -(bf-program (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op (loop "[" (op ">") (op "+") (op "+") (op "+") (op "+") (op "+") (op "<") (op "-") "]")) (op ">") (op ".")) \ No newline at end of file +(bf-program (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (loop "[" (op ">") (op "+") (op "+") (op "+") (op "+") (op "+") (op "<") (op "-") "]") (op ">") (op ".")) \ No newline at end of file diff --git a/br-bf/main.rkt b/br-bf/main.rkt index ac0b7c8..0ed8e15 100644 --- a/br-bf/main.rkt +++ b/br-bf/main.rkt @@ -20,30 +20,30 @@ (for-each println (map syntax->datum result)) result)) -(define #'(bf-program ...) - #'(begin ...)) - -(define #'(op ) - (syntax-case #'(op ) () - [(op ">") #'(move-pointer 1)] - [(op "<") #'(move-pointer -1)] - [(op "+") #'(set-pointer-byte! (add1 (pointer-byte)))] - [(op "-") #'(set-pointer-byte! (sub1 (pointer-byte)))] - [(op ".") #'(write-byte (pointer-byte))] - [(op ",") #'(set-pointer-byte! (read-byte))] - [else #'])) ; must therefore be a loop - -(define #'(loop "[" ... "]") - #'(until (zero? (pointer-byte)) - ...)) - -(define bf-vector (make-vector 10 0)) +(define #'(bf-program ...) + #'(begin ...)) + +(define-cases #'op + [#'(_ ">") #'(move-pointer 1)] + [#'(_ "<") #'(move-pointer -1)] + [#'(_ "+") #'(set-pointer-byte! (add1 (get-pointer-byte)))] + [#'(_ "-") #'(set-pointer-byte! (sub1 (get-pointer-byte)))] + [#'(_ ".") #'(write-byte (get-pointer-byte))] + [#'(_ ",") #'(set-pointer-byte! (read-byte))]) + +(define-cases f + [(_ arg) (add1 arg)] + [(_ arg1 arg2) (+ arg1 arg2)]) + +(define #'(loop "[" ... "]") + #'(until (zero? (get-pointer-byte)) + ...)) + +(define bf-vector (make-vector 1000 0)) (define bf-pointer 0) -(define (pointer-byte) (vector-ref bf-vector bf-pointer)) +(define (get-pointer-byte) (vector-ref bf-vector bf-pointer)) (define (set-pointer-byte! val) (vector-set! bf-vector bf-pointer val)) - -(define (move-pointer how-far) - (set! bf-pointer (+ bf-pointer how-far))) +(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far))) (define (dump) (displayln "") diff --git a/br-bf/parser.rkt b/br-bf/parser.rkt index bc22ffa..ab562b4 100644 --- a/br-bf/parser.rkt +++ b/br-bf/parser.rkt @@ -2,6 +2,19 @@ ;; use uppercase TOKEN-IDENTIFIERS for classes of tokens ;; too numerous to indicate individually ;; (e.g., numbers, strings) -bf-program : op* -op : ">" | "<" | "+" | "-" | "." | "," | loop -loop : "[" op* "]" \ No newline at end of file + +bf-program : (op | loop)* +op : ">" | "<" | "+" | "-" | "." | "," +loop : "[" (op | loop)* "]" + + +;; Alternate ways of specifying grammar +;; bf-program : op* +;; op : ">" | "<" | "+" | "-" | "." | "," | loop +;; loop : "[" op* "]" + +;; bf-program : expr* +;; expr : op | loop +;; op : ">" | "<" | "+" | "-" | "." | "," +;; loop : "[" bf-program "]" + diff --git a/br/define.rkt b/br/define.rkt index c68484c..6458a07 100644 --- a/br/define.rkt +++ b/br/define.rkt @@ -75,3 +75,38 @@ #'(zam x x))) (foo 42)) 84) ;; todo: error from define not trapped by check-exn #;(check-exn exn:fail:syntax? (λ _ (br:define (#'times stx stx2) #'*)))) + + +;; todo: support `else` case +(define-syntax (br:define-cases stx) + (syntax-parse stx + #:literals (syntax) + ; (define-cases #'foo [#'(_ arg) #'(+ arg arg)] [#'(_ 42 bar) #'42] ...) + [(_ (syntax top-id) [(syntax (_ pat-arg ... . rest-arg)) body ...] ...) + #'(define-syntax top-id (λ (stx) + (define result + (syntax-case stx () + [(_ pat-arg ... . rest-arg) body ...] ...)) + (if (not (syntax? result)) + (datum->syntax stx result) + result)))] + + [(_ top-id [(_ pat-arg ... . rest-arg) body ...] ...) + #'(define top-id + (case-lambda + [(pat-arg ... . rest-arg) body ...] ...))])) + +(module+ test + (br:define-cases #'op + [#'(_ "+") #''got-plus] + [#'(_ arg) #''got-something-else]) + + (check-equal? (op "+") 'got-plus) + (check-equal? (op 42) 'got-something-else) + + (br:define-cases f + [(_ arg) (add1 arg)] + [(_ arg1 arg2) (+ arg1 arg2)]) + + (check-equal? (f 42) 43) + (check-equal? (f 42 5) 47)) \ No newline at end of file