utils.rkt (1731B)
1 #lang racket/base 2 3 (require racket/base 4 racket/contract 5 racket/string) 6 7 (provide gen-id 8 gen-id/check) 9 10 ;; Utilities 11 ;; _____________________________________________________________________________ 12 13 ;; Escapes the identifier, so that it does not contain the separator character 14 (define/contract (escape-symbol sym separator escape) 15 (-> symbol? char? char? string?) 16 (let () 17 (define s1 (symbol->string sym)) 18 (define s2 (string-replace s1 19 (format "~a" escape) 20 (format "~a~a" escape escape))) 21 (define s3 (string-replace s1 22 (format "~a" separator) 23 (format "~a~a" escape separator))) 24 s3)) 25 26 ;; Generates a single-meaning identifier from `id` and `meaning`, possibly 27 ;; escaping some characters in `meaning` to remove ambiguities. 28 (define/contract (gen-id id meaning) 29 (-> identifier? symbol? identifier?) 30 (let () 31 (define s (format " polysemy ~a ~a " 32 (escape-symbol meaning #\space #\\) 33 (symbol->string (syntax-e id)))) 34 (datum->syntax id (string->symbol s) id id))) 35 36 (define/contract (gen-id/check id meaning) 37 (-> identifier? symbol? identifier?) 38 (unless (syntax-local-value (gen-id id '| safeguard |) (λ () #f)) 39 (raise-syntax-error 40 'polysemy 41 (format 42 (string-append 43 ;; TODO: check guidelines for error messages. 44 "the safeguard for ~a was not found." 45 " Usually, this means that only-in, rename-in or rename-out were used" 46 " instead of their poly-rename-in, poly-only-in, or poly-out" 47 " counterparts.") 48 (syntax-e id)) 49 id)) 50 (gen-id id meaning))