diff --git a/hygiene.zp b/hygiene.zp new file mode 100644 index 0000000..b8e325b --- /dev/null +++ b/hygiene.zp @@ -0,0 +1,69 @@ +(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))