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

unstable/syntax: added format-id

Browse Source 
svn: r16629

original commit: daba183b087e841b4ad7d4e96b8383e784392b4b
This commit is contained in:
Ryan Culpepper 2009-11-09 02:33:43 +00:00
parent 442ab704e5
commit acd8a766f0
1 changed files with 14 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/macro-debugger/model/yacc-interrupted.ss
View File

@ -1,7 +1,8 @@
#lang scheme/base #lang scheme/base
(require (for-syntax scheme/base) (require (for-syntax scheme/base
(for-syntax mzlib/etc) mzlib/etc
unstable/syntax)
"yacc-ext.ss") "yacc-ext.ss")
(provide ! ? !! (provide ! ? !!
define-production-splitter define-production-splitter
@ -50,26 +51,18 @@
(raise-syntax-error 'split "bad grammar option or alternate" #'other)]) (raise-syntax-error 'split "bad grammar option or alternate" #'other)])
(values options (reverse alts))))) (values options (reverse alts)))))
(define-for-syntax (symbol+ . args)
(define (norm x)
(cond [(identifier? x) (norm (syntax-e x))]
[(string? x) x]
[(number? x) (number->string x)]
[(symbol? x) (symbol->string x)]))
(string->symbol (apply string-append (map norm args))))
(define-for-syntax (I symbol) (define-for-syntax (I symbol)
(syntax-local-introduce (syntax-local-introduce
(syntax-local-get-shadower (datum->syntax #f symbol)))) (syntax-local-get-shadower (datum->syntax #f symbol))))
(define-for-syntax ($name n) (define-for-syntax ($name n)
(I (symbol+ '$ n))) (I (format-symbol "$~a" n)))
(define-for-syntax (interrupted-name s) (define-for-syntax (interrupted-name id)
(I (symbol+ s '/Interrupted))) (I (format-symbol "~a/Interrupted" (syntax-e id))))
(define-for-syntax (skipped-name s) (define-for-syntax (skipped-name id)
(I (symbol+ s '/Skipped))) (I (format-symbol "~a/Skipped" (syntax-e id))))
(define-for-syntax (elaborate-skipped-tail head tail position args mk-action) (define-for-syntax (elaborate-skipped-tail head tail position args mk-action)
(define-values (new-tail new-arguments) (define-values (new-tail new-arguments)
@ -149,7 +142,7 @@
[((? NT) . parts-rest) [((? NT) . parts-rest)
(cons (cons
;; NT is interrupted ;; NT is interrupted
(elaborate-skipped-tail (I (symbol+ #'NT '/Interrupted)) (elaborate-skipped-tail (interrupted-name #'NT)
#'parts-rest #'parts-rest
(add1 position) (add1 position)
(cons ($name position) args) (cons ($name position) args)
@ -163,7 +156,7 @@
(define-for-syntax (generate-action-name nt pos) (define-for-syntax (generate-action-name nt pos)
(syntax-local-get-shadower (syntax-local-get-shadower
(datum->syntax #f (symbol+ 'action-for- nt '/ pos)))) (format-id #f "action-for-~a/~a" (syntax-e nt) pos)))
(define-for-syntax ((make-rewrite-alt+def nt args-spec) alt pos) (define-for-syntax ((make-rewrite-alt+def nt args-spec) alt pos)
(define pattern (car alt)) (define pattern (car alt))
@ -265,8 +258,8 @@
interrupted-alternates] interrupted-alternates]
[skip-spec (assq '#:skipped options)] [skip-spec (assq '#:skipped options)]
[args-spec (assq '#:args options)] [args-spec (assq '#:args options)]
[name/Skipped (I (symbol+ #'name '/Skipped))] [name/Skipped (skipped-name #'name)]
[name/Interrupted (I (symbol+ #'name '/Interrupted))] [name/Interrupted (interrupted-name #'name)]
[%action ((syntax-local-certifier) #'%action)]) [%action ((syntax-local-certifier) #'%action)])
#`(begin #`(begin
(definitions #,@action-definitions) (definitions #,@action-definitions)
@ -284,11 +277,11 @@
#'(begin)] #'(begin)]
[(skipped-token-values name . more) [(skipped-token-values name . more)
(identifier? #'name) (identifier? #'name)
(with-syntax ([name/Skipped (I (symbol+ #'name '/Skipped))]) (with-syntax ([name/Skipped (skipped-name #'name)])
#'(begin (productions (name/Skipped [() #f])) #'(begin (productions (name/Skipped [() #f]))
(skipped-token-values . more)))] (skipped-token-values . more)))]
[(skipped-token-values (name value) . more) [(skipped-token-values (name value) . more)
(with-syntax ([name/Skipped (I (symbol+ #'name '/Skipped))]) (with-syntax ([name/Skipped (skipped-name #'name)])
#'(begin (productions (name/Skipped [() value])) #'(begin (productions (name/Skipped [() value]))
(skipped-token-values . more)))])) (skipped-token-values . more)))]))