172 lines
5.0 KiB
Scheme
172 lines
5.0 KiB
Scheme
|
|
#lang scheme/base
|
|
(require parser-tools/lex
|
|
"deriv.ss")
|
|
(provide (all-defined-out))
|
|
|
|
(define-tokens basic-tokens
|
|
(start ; .
|
|
visit ; syntax
|
|
resolve ; identifier
|
|
next ; .
|
|
next-group ; .
|
|
enter-macro ; syntax
|
|
macro-pre-transform ; syntax
|
|
macro-post-transform ; syntax
|
|
exit-macro ; syntax
|
|
enter-prim ; syntax
|
|
exit-prim ; syntax
|
|
return ; syntax
|
|
enter-block ; syntaxes
|
|
block->list ; syntaxes
|
|
block->letrec ; syntax(es?)
|
|
splice ; syntaxes
|
|
enter-list ; syntaxes
|
|
exit-list ; syntaxes
|
|
enter-check ; syntax
|
|
exit-check ; syntax
|
|
phase-up ; .
|
|
module-body ; (list-of (cons syntax boolean))
|
|
... ; .
|
|
EOF ; .
|
|
syntax-error ; exn
|
|
lift-loop ; syntax
|
|
lift/let-loop ; syntax
|
|
module-lift-loop ; syntaxes
|
|
module-lift-end-loop ; syntaxes
|
|
lift ; (cons syntax id)
|
|
lift-statement ; syntax
|
|
enter-local ; syntax
|
|
local-pre ; syntax
|
|
local-post ; syntax
|
|
exit-local ; syntax
|
|
|
|
local-bind ; (list-of identifier)
|
|
enter-bind ; .
|
|
exit-bind ; .
|
|
opaque ; opaque-syntax
|
|
|
|
variable ; (cons identifier identifier)
|
|
tag ; syntax
|
|
|
|
rename-one ; syntax
|
|
rename-list ; (list-of syntax)
|
|
|
|
IMPOSSIBLE ; useful for error-handling clauses that have no NoError counterpart
|
|
))
|
|
|
|
(define-tokens renames-tokens
|
|
(renames-lambda ; (cons syntax syntax)
|
|
renames-case-lambda ; (cons syntax syntax)
|
|
renames-let ; (cons (listof syntax) syntax)
|
|
renames-letrec-syntaxes ; (cons (listof syntax) (cons (listof syntax) syntax))
|
|
renames-block ; (cons syntax syntax) ... different, contains both pre+post
|
|
))
|
|
|
|
;; Empty tokens
|
|
(define-tokens prim-tokens
|
|
(prim-module prim-#%module-begin
|
|
prim-define-syntaxes prim-define-values
|
|
prim-if prim-wcm prim-begin prim-begin0 prim-#%app prim-lambda
|
|
prim-case-lambda prim-let-values prim-let*-values prim-letrec-values
|
|
prim-letrec-syntaxes+values prim-#%datum prim-#%top prim-stop
|
|
prim-quote prim-quote-syntax prim-require prim-require-for-syntax
|
|
prim-require-for-template prim-provide
|
|
prim-set!
|
|
prim-expression
|
|
prim-varref
|
|
))
|
|
|
|
;; ** Signals to tokens
|
|
|
|
(define signal-mapping
|
|
`((EOF . EOF)
|
|
(error . ,token-syntax-error)
|
|
(0 . ,token-visit)
|
|
(1 . ,token-resolve)
|
|
(2 . ,token-return)
|
|
(3 . ,token-next)
|
|
(4 . ,token-enter-list)
|
|
(5 . ,token-exit-list)
|
|
(6 . ,token-enter-prim)
|
|
(7 . ,token-exit-prim)
|
|
(8 . ,token-enter-macro)
|
|
(9 . ,token-exit-macro)
|
|
(10 . ,token-enter-block)
|
|
(11 . ,token-splice)
|
|
(12 . ,token-block->list)
|
|
(13 . ,token-next-group)
|
|
(14 . ,token-block->letrec)
|
|
(16 . ,token-renames-let)
|
|
(17 . ,token-renames-lambda)
|
|
(18 . ,token-renames-case-lambda)
|
|
(19 . ,token-renames-letrec-syntaxes)
|
|
(20 . phase-up)
|
|
(21 . ,token-macro-pre-transform)
|
|
(22 . ,token-macro-post-transform)
|
|
(23 . ,token-module-body)
|
|
(24 . ,token-renames-block)
|
|
|
|
(100 . prim-stop)
|
|
(101 . prim-module)
|
|
(102 . prim-#%module-begin)
|
|
(103 . prim-define-syntaxes)
|
|
(104 . prim-define-values)
|
|
(105 . prim-if)
|
|
(106 . prim-wcm)
|
|
(107 . prim-begin)
|
|
(108 . prim-begin0)
|
|
(109 . prim-#%app)
|
|
(110 . prim-lambda)
|
|
(111 . prim-case-lambda)
|
|
(112 . prim-let-values)
|
|
(113 . prim-letrec-values)
|
|
(114 . prim-letrec-syntaxes+values)
|
|
(115 . prim-#%datum)
|
|
(116 . prim-#%top)
|
|
(117 . prim-quote)
|
|
(118 . prim-quote-syntax)
|
|
(119 . prim-require)
|
|
(120 . prim-require-for-syntax)
|
|
(121 . prim-require-for-template)
|
|
(122 . prim-provide)
|
|
(123 . prim-set!)
|
|
(124 . prim-let*-values)
|
|
(125 . ,token-variable)
|
|
(126 . ,token-enter-check)
|
|
(127 . ,token-exit-check)
|
|
(128 . ,token-lift-loop)
|
|
(129 . ,token-lift)
|
|
(130 . ,token-enter-local)
|
|
(131 . ,token-exit-local)
|
|
(132 . ,token-local-pre)
|
|
(133 . ,token-local-post)
|
|
(134 . ,token-lift-statement)
|
|
(135 . ,token-module-lift-end-loop)
|
|
(136 . ,token-lift/let-loop)
|
|
(137 . ,token-module-lift-loop)
|
|
(138 . prim-expression)
|
|
(141 . ,token-start)
|
|
(142 . ,token-tag)
|
|
(143 . ,token-local-bind)
|
|
(144 . ,token-enter-bind)
|
|
(145 . ,token-exit-bind)
|
|
(146 . ,token-opaque)
|
|
(147 . ,token-rename-list)
|
|
(148 . ,token-rename-one)
|
|
(149 . prim-varref)
|
|
))
|
|
|
|
(define (tokenize sig-n val pos)
|
|
(let ([p (assv sig-n signal-mapping)])
|
|
(if (pair? p)
|
|
(make-position-token
|
|
(cond [(procedure? (cdr p)) ((cdr p) val)]
|
|
[(symbol? (cdr p)) (cdr p)])
|
|
pos
|
|
pos)
|
|
(error 'tokenize "bad signal: ~s" sig-n))))
|
|
|
|
(define (signal->symbol sig-n)
|
|
(cdr (assv sig-n signal-mapping)))
|