mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

make `parse` et al work on brag REPL

Browse Source
pull/6/head
Matthew Butterick 6 years ago
parent 7b9538c054
commit 3d6588fc47
2 changed files with 44 additions and 25 deletions
Show Stats Download Patch File Download Diff File

44
brag/brag/codegen/codegen.rkt
Unescape Escape View File

@ -18,19 +18,19 @@
;; Generates the body of the module. ;; Generates the body of the module.
;; FIXME: abstract this so we can just call (rules ...) without ;; FIXME: abstract this so we can just call (rules ...) without
;; generating the whole module body. ;; generating the whole module body.
(define (rules-codegen stx (define (rules-codegen rules-stx
#:parser-provider-module [parser-provider-module 'br-parser-tools/yacc] #:parser-provider-module [parser-provider-module 'br-parser-tools/yacc]
#:parser-provider-form [parser-provider-form 'parser]) #:parser-provider-form [parser-provider-form 'parser])
(syntax-case stx () (syntax-case rules-stx ()
[(_ r ...) [(_ RULE ...)
(begin (begin
;; (listof stx) ;; (listof stx)
(define rules (syntax->list #'(r ...))) (define rules (syntax->list #'(RULE ...)))
(when (empty? rules) (when (empty? rules)
(raise-syntax-error 'brag (raise-syntax-error 'brag
(format "The grammar does not appear to have any rules") (format "The grammar does not appear to have any rules")
stx)) rules-stx))
(check-all-rules-defined! rules) (check-all-rules-defined! rules)
(check-all-rules-no-duplicates! rules) (check-all-rules-no-duplicates! rules)
@ -83,8 +83,13 @@
implicit-token-types)] implicit-token-types)]
[generated-grammar #`(grammar #,@generated-rule-codes)] [generated-grammar #`(grammar #,@generated-rule-codes)]
[parser-module parser-provider-module] [parser-module parser-provider-module]
[parser-form parser-provider-form]) [parser-form parser-provider-form]
(quasisyntax/loc stx [PARSE (syntax-local-introduce (or (syntax-property rules-stx 'parse) (error 'no-parse-id-prop)))]
[PARSE-TO-DATUM (syntax-local-introduce (or (syntax-property rules-stx 'parse-to-datum) (error 'no-parse-to-datum-id-prop)))]
[PARSE-TREE (syntax-local-introduce (or (syntax-property rules-stx 'parse-tree) (error 'no-parse-tree-id-prop)))]
[MAKE-RULE-PARSER (syntax-local-introduce (or (syntax-property rules-stx 'make-rule-parser) (error 'no-make-rule-parser-id-prop)))]
[ALL-TOKEN-TYPES (syntax-local-introduce (or (syntax-property rules-stx 'all-token-types) (error 'no-all-token-types-id-prop)))])
(quasisyntax/loc rules-stx
(begin (begin
(require br-parser-tools/lex (require br-parser-tools/lex
parser-module parser-module
@ -94,9 +99,11 @@
racket/set racket/set
(for-syntax syntax/parse racket/base)) (for-syntax syntax/parse racket/base))
(provide parse (provide PARSE
make-rule-parser PARSE-TO-DATUM
all-token-types PARSE-TREE
MAKE-RULE-PARSER
ALL-TOKEN-TYPES
#;current-source #;current-source
#;current-parser-error-handler #;current-parser-error-handler
#;current-tokenizer-error-handler #;current-tokenizer-error-handler
@ -106,7 +113,7 @@
(define-tokens enumerated-tokens (token-type ...)) (define-tokens enumerated-tokens (token-type ...))
;; all-token-types lists all the tokens (except for EOF) ;; all-token-types lists all the tokens (except for EOF)
(define all-token-types (define ALL-TOKEN-TYPES
(set-remove (set 'token-type ...) 'EOF)) (set-remove (set 'token-type ...) 'EOF))
;; For internal use by the permissive tokenizer only: ;; For internal use by the permissive tokenizer only:
@ -123,7 +130,7 @@
... ...
[(eof) (token eof)])) [(eof) (token eof)]))
(define-syntax (make-rule-parser stx-2) (define-syntax (MAKE-RULE-PARSER stx-2)
(syntax-parse stx-2 (syntax-parse stx-2
[(_ start-rule:id) [(_ start-rule:id)
(begin (begin
@ -137,7 +144,7 @@
(format "Rule ~a is not defined in the grammar" (syntax-e #'start-rule)) (format "Rule ~a is not defined in the grammar" (syntax-e #'start-rule))
stx-2)) stx-2))
(define recolored-start-rule (datum->syntax (syntax #,stx) (syntax-e #'start-rule))) (define recolored-start-rule (datum->syntax (syntax #,rules-stx) (syntax-e #'start-rule)))
#`(let ([THE-GRAMMAR (parser-form (tokens enumerated-tokens) #`(let ([THE-GRAMMAR (parser-form (tokens enumerated-tokens)
(src-pos) (src-pos)
(start #,recolored-start-rule) (start #,recolored-start-rule)
@ -151,20 +158,19 @@
(THE-GRAMMAR next-token)] (THE-GRAMMAR next-token)]
[(source tokenizer) [(source tokenizer)
(parameterize ([current-source source]) (parameterize ([current-source source])
(parse tokenizer))]) (PARSE tokenizer))])
(string->symbol (format "~a-rule-parser" 'start-rule)))))])) (string->symbol (format "~a-rule-parser" 'start-rule)))))]))
(define parse (make-rule-parser start-id)) (define PARSE (procedure-rename (MAKE-RULE-PARSER start-id) 'parse))
(provide parse-to-datum parse-tree)
(define (parse-to-datum x) (define (PARSE-TO-DATUM x)
(let loop ([x (syntax->datum (parse x))]) (let loop ([x (syntax->datum (PARSE x))])
(cond (cond
[(list? x) (map loop x)] [(list? x) (map loop x)]
[(char? x) (string x)] [(char? x) (string x)]
[else x]))) [else x])))
(define parse-tree parse-to-datum)))))])) (define PARSE-TREE PARSE-TO-DATUM)))))]))
;; Given a flattened rule, returns a syntax for the code that ;; Given a flattened rule, returns a syntax for the code that

25
brag/brag/codegen/sexp-based-lang.rkt
Unescape Escape View File

@ -84,13 +84,26 @@
(require (for-syntax racket/base (require (for-syntax racket/base
"codegen.rkt")) "codegen.rkt"
syntax/strip-context))
(provide rules (provide rules
(rename-out [#%plain-module-begin #%module-begin]) (rename-out [my-module-begin #%module-begin])
#%top-interaction) #%top-interaction #%top #%app #%datum)
(define-syntax (rules stx)
(define-syntax (my-module-begin module-stx)
(syntax-case module-stx ()
[(_ RULES-STX)
(with-syntax ([RULES-STX (for/fold ([stx #'RULES-STX])
([id (in-list '(parse parse-to-datum parse-tree make-rule-parser all-token-types))])
(syntax-property stx id (syntax-local-introduce (replace-context module-stx (datum->syntax #f id)))))])
#`(#%module-begin
RULES-STX
(provide (all-defined-out))))]))
(define-syntax (rules rules-stx)
(rules-codegen #:parser-provider-module 'brag/cfg-parser/cfg-parser ;; 'br-parser-tools/yacc (rules-codegen #:parser-provider-module 'brag/cfg-parser/cfg-parser ;; 'br-parser-tools/yacc
#:parser-provider-form 'cfg-parser ;; 'parser #:parser-provider-form 'cfg-parser ;; 'parser
stx)) rules-stx))

Write Preview
Loading…
Cancel
Save