diff --git a/beautiful-racket-demo/basic-demo/expander.rkt b/beautiful-racket-demo/basic-demo/expander.rkt index e1473d8..43ffc02 100644 --- a/beautiful-racket-demo/basic-demo/expander.rkt +++ b/beautiful-racket-demo/basic-demo/expander.rkt @@ -3,9 +3,11 @@ (matching-identifiers-out #rx"^b-" (all-defined-out))) (define-macro (b-module-begin (b-program LINE ...)) - (with-pattern ([(LINE-NUM ...) - (filter-stx-prop 'b-line-number (stx-flatten #'(LINE ...)))] - [(LINE-ID ...) (prefix-ids "line-" #'(LINE-NUM ...))]) + (with-pattern + ([(LINE-NUM ...) + (filter-stx-prop 'b-line-number + (stx-flatten #'(LINE ...)))] + [(LINE-ID ...) (prefix-ids "line-" #'(LINE-NUM ...))]) #'(#%module-begin LINE ... (define line-table @@ -13,9 +15,10 @@ (run line-table)))) (define-macro (b-line LINE-NUMBER STATEMENT ...) - (with-pattern ([LINE-NUMBER-ID (prefix-id "line-" #'LINE-NUMBER - #:source #'LINE-NUMBER)] - [ORIG-LOC caller-stx]) + (with-pattern + ([LINE-NUMBER-ID (prefix-id "line-" #'LINE-NUMBER + #:source #'LINE-NUMBER)] + [ORIG-LOC caller-stx]) (syntax/loc caller-stx (define (LINE-NUMBER-ID #:srcloc? [srcloc #f]) (if srcloc @@ -31,24 +34,28 @@ (struct $program-end-signal ()) (define (b-end) (raise ($program-end-signal))) -(struct $change-line-signal (num)) +(struct $change-line-signal (val)) (define (b-goto expr) (raise ($change-line-signal expr))) (define-exn line-not-found exn:fail) (define (run line-table) - (define line-vec (list->vector (sort (hash-keys line-table) <))) + (define line-vec + (list->vector (sort (hash-keys line-table) <))) (with-handlers ([$program-end-signal? void]) (for/fold ([line-idx 0]) ([i (in-naturals)]) (unless (< line-idx (vector-length line-vec)) (b-end)) (define line-num (vector-ref line-vec line-idx)) (define line-proc (hash-ref line-table line-num)) - (with-handlers ([$change-line-signal? - (λ (cls) - (or - (and (exact-positive-integer? ($change-line-signal-num cls)) - (vector-member ($change-line-signal-num cls) line-vec)) - (raise-line-not-found (line-proc #:srcloc? #t))))]) + (with-handlers + ([$change-line-signal? + (λ (cls) + (define clsv ($change-line-signal-val cls)) + (or + (and (exact-positive-integer? clsv) + (vector-member clsv line-vec)) + (raise-line-not-found + (line-proc #:srcloc? #t))))]) (line-proc) (add1 line-idx))))) diff --git a/beautiful-racket-demo/basic-demo/lexer.rkt b/beautiful-racket-demo/basic-demo/lexer.rkt new file mode 100644 index 0000000..6ce1bf2 --- /dev/null +++ b/beautiful-racket-demo/basic-demo/lexer.rkt @@ -0,0 +1,21 @@ +#lang br +(require brag/support racket/contract) + +(define basic-lexer + (lexer-srcloc + [(eof) eof] + [whitespace (token lexeme #:skip? #t)] + [(from/to "rem" "\n") (token 'REM lexeme)] + [(:or "print" "goto" "end" "+" ":") lexeme] + [(:+ numeric) (token 'INTEGER (string->number lexeme))] + [(:or (:seq (:+ numeric) ".") + (:seq (:* numeric) "." (:+ numeric))) + (token 'DECIMAL (string->number lexeme))] + [(from/to "\"" "\"") + (token 'STRING (trim-ends "\"" lexeme "\""))])) + +(provide + (contract-out + [basic-lexer + (input-port? . -> . + (or/c eof-object? string? srcloc-token?))])) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo/main.rkt b/beautiful-racket-demo/basic-demo/main.rkt index fafa851..b77a60a 100644 --- a/beautiful-racket-demo/basic-demo/main.rkt +++ b/beautiful-racket-demo/basic-demo/main.rkt @@ -1,15 +1,16 @@ #lang br/quicklang -(require "parser.rkt" "tokenizer.rkt" brag/support) +(require "parser.rkt" "tokenizer.rkt") (module+ reader (provide read-syntax)) (define (read-syntax path port) - (define-values (line col pos) (port-next-location port)) - (define port+newline (input-port-append #f port (open-input-string "\n"))) + (define-values (pline pcol ppos) (port-next-location port)) + (define port+newline + (input-port-append #f port (open-input-string "\n"))) (port-count-lines! port+newline) - (set-port-next-location! port+newline line col pos) - (with-handlers ([exn:fail:parsing? (λ (exn) (displayln "Sorry!") (raise exn))]) - (define parse-tree (parse path (make-tokenizer port+newline))) - (strip-bindings - #`(module basic-mod basic-demo/expander - #,parse-tree)))) \ No newline at end of file + (set-port-next-location! port+newline pline pcol ppos) + (define parse-tree + (parse path (make-tokenizer port+newline path))) + (strip-bindings + #`(module basic-mod basic-demo/expander + #,parse-tree))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo/sample.rkt b/beautiful-racket-demo/basic-demo/sample.rkt index 174d944..3f01722 100644 --- a/beautiful-racket-demo/basic-demo/sample.rkt +++ b/beautiful-racket-demo/basic-demo/sample.rkt @@ -1,8 +1,8 @@ #lang basic-demo -30 rem print "statement ignored" -40 end +30 rem print "ignored" 50 print "never gets here" -60 print "two" : print 1.2 + 1.8 +40 end +60 print "three" : print 2 + 2 70 goto 11 + 10.5 + 8.5 10 print "one" 20 print : goto 60 : end \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo/tokenizer.rkt b/beautiful-racket-demo/basic-demo/tokenizer.rkt index d4834d3..cb8cd04 100644 --- a/beautiful-racket-demo/basic-demo/tokenizer.rkt +++ b/beautiful-racket-demo/basic-demo/tokenizer.rkt @@ -1,20 +1,14 @@ #lang br -(require brag/support) -(provide (all-defined-out)) +(require "lexer.rkt" brag/support racket/contract) -(define basic-lexer - (lexer-srcloc - [(eof) eof] - [whitespace (token lexeme #:skip? #t)] - [(from/to "rem" "\n") (token 'REM lexeme)] - [(:or "print" "goto" "end" "+" ":") lexeme] - [(:+ numeric) (token 'INTEGER (string->number lexeme))] - [(:or (:seq (:+ numeric) ".") - (:seq (:* numeric) "." (:+ numeric))) - (token 'DECIMAL (string->number lexeme))] - [(from/to "\"" "\"") (token 'STRING (trim-ends "\"" lexeme "\""))])) - -(define (make-tokenizer ip) +(define (make-tokenizer ip [path #f]) (port-count-lines! ip) + (file-path path) (define (next-token) (basic-lexer ip)) - next-token) \ No newline at end of file + next-token) + +(provide + (contract-out + [make-tokenizer + ((input-port?) (path?) . ->* . + (-> (or/c eof-object? string? srcloc-token?)))])) \ No newline at end of file