70 lines
1.6 KiB
Plaintext
70 lines
1.6 KiB
Plaintext
(define-struct syntax (e scopes))
|
|
|
|
(define (identifier? s) (syntax:syntax? s))
|
|
|
|
(define (datum->syntax v)
|
|
(cond
|
|
((syntax:syntax? v) v)
|
|
((symbol? v) (syntax:make-syntax v []))
|
|
((list? v) (map datum->syntax v))
|
|
(else v)))
|
|
|
|
(define (syntax->datum s)
|
|
(cond
|
|
((syntax:syntax? s) (syntax:get-e s))
|
|
((list? s) (map syntax->datum s))
|
|
(else s)))
|
|
|
|
(defimpl stringify syntax:syntax?
|
|
((->string (lambda (v)
|
|
(++ "(syntax "
|
|
(->string (syntax:get-e v))
|
|
" "
|
|
(->string (syntax:get-scopes v))
|
|
")")))))
|
|
|
|
(write (->string (datum->syntax '(a b c))))
|
|
(write (->string (syntax->datum (datum->syntax '(a b c)))))
|
|
|
|
(define-struct scope (id))
|
|
|
|
(define ID 0)
|
|
|
|
(defimpl stringify scope:scope?
|
|
((->string (lambda (v)
|
|
(++ "(scope "
|
|
(->string (scope:get-id v))
|
|
")")))))
|
|
|
|
(define (scope:new-scope)
|
|
(begin
|
|
(set! ID (+ ID 1))
|
|
(scope:make-scope ID)))
|
|
|
|
(define (adjust-scope s sc op)
|
|
(cond
|
|
((syntax:syntax? s) (syntax:make-syntax (syntax:get-e s)
|
|
(op (syntax:get-scopes s) sc)))
|
|
((list? s) (map ($ (adjust-scope % sc op)) s))
|
|
(else s)))
|
|
|
|
(define (add-scope s sc)
|
|
(adjust-scope s sc ++))
|
|
|
|
(define (flip-scope s sc)
|
|
(adjust-scope s sc set-flip))
|
|
|
|
(define (set-flip s e)
|
|
(if (in? s e)
|
|
(filter ($ (/= (scope:get-id %) (scope:get-id e))) s)
|
|
(++ s e)))
|
|
|
|
(write (->string (add-scope (datum->syntax '(a b c)) (scope:new-scope))))
|
|
(let ((s (scope:new-scope)))
|
|
(write (->string (flip-scope (add-scope (datum->syntax 'a) s) s))))
|
|
|
|
(define all-bindings #{})
|
|
|
|
(define (add-binding! id binding)
|
|
(hash:set! all-bindings id binding))
|