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

fix parser so that it parses left to right

Browse Source
This commit is contained in:
jon 2010-04-22 15:07:48 -06:00 committed by Jon Rafkind
parent 72f83d19a9
commit 99e6eb5e9d
1 changed files with 29 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/honu/private/parse.rkt
View File

@ -93,7 +93,29 @@
#:literals (operator ...) #:literals (operator ...)
(pattern operator #:attr func reducer) (pattern operator #:attr func reducer)
...) ...)
(define-splicing-syntax-class (do-rest context left)
(pattern (~seq (~var op operator-class)
(~var right (next context))
(~var new-right (do-rest context ((attribute op.func) left #'right.result))))
#:with result (attribute new-right.result))
(pattern (~seq) #:with result left))
(define-splicing-syntax-class (name context) (define-splicing-syntax-class (name context)
(pattern (~seq (~var left (next context))
(~var rest (do-rest context #'left.result)))
#:with result
(attribute rest.result)))
#;
(define-splicing-syntax-class (name context)
(pattern (~seq (~var left (next context))
(~var op operator-class)
(~var right (name context)))
#:with result
(cond [(attribute right)
((attribute op.func) #'left.result #'right.result)]
[else
#'left.result]))
#;
(pattern (~seq (~var left (next context)) (pattern (~seq (~var left (next context))
(~optional (~seq (~var op operator-class) (~var right (name context))))) (~optional (~seq (~var op operator-class) (~var right (name context)))))
#:with result #:with result
@ -111,11 +133,10 @@
;; Where operators defined higher in the table have higher precedence. ;; Where operators defined higher in the table have higher precedence.
(define-syntax (infix-operators stx) (define-syntax (infix-operators stx)
(define (create-stuff names operator-stuff) (define (create-stuff names operator-stuff)
(define make (syntax-lambda (expression next-expression operator-stuff) (define make (syntax-lambda (expression next-expression (ops ...))
#; #;
(printf "Make infix ~a ~a\n" (syntax->datum #'expression) (syntax->datum #'next-expression)) (printf "Make infix ~a ~a\n" (syntax->datum #'expression) (syntax->datum #'next-expression))
(with-syntax ([(ops ...) #'operator-stuff]) #'(define-infix-operator expression next-expression ops ...)))
#'(define-infix-operator expression next-expression ops ...))))
(for/list ([name1 (drop-last names)] (for/list ([name1 (drop-last names)]
[name2 (cdr names)] [name2 (cdr names)]
[operator operator-stuff]) [operator operator-stuff])
@ -125,11 +146,11 @@
(with-syntax ([(name ...) (generate-temporaries #'(operator-stuff ...))]) (with-syntax ([(name ...) (generate-temporaries #'(operator-stuff ...))])
(with-syntax ([(result ...) (with-syntax ([(result ...)
(create-stuff (cons #'first (create-stuff (cons #'first
(append (append
(drop-last (syntax->list #'(name ...))) (drop-last (syntax->list #'(name ...)))
(list #'last))) (list #'last)))
(syntax->list #'(operator-stuff ...)))]) (syntax->list #'(operator-stuff ...)))])
#'(begin #'(begin
result ...)))])) result ...)))]))