Initial commit
Some checks are pending
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (BC, stable) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (CS, stable) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (true, BC, current) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (true, CS, current) (push) Waiting to run
Some checks are pending
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (BC, stable) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (CS, stable) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (true, BC, current) (push) Waiting to run
CI / Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }}) (true, CS, current) (push) Waiting to run
This commit is contained in:
commit
da8298d864
16 changed files with 3710 additions and 0 deletions
29
.github/workflows/ci.yml
vendored
Normal file
29
.github/workflows/ci.yml
vendored
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
on: [push, pull_request]
|
||||
name: CI
|
||||
jobs:
|
||||
build:
|
||||
name: "Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
|
||||
runs-on: ubuntu-latest
|
||||
continue-on-error: ${{ matrix.experimental || false }}
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
racket-version: ["stable", "current"]
|
||||
racket-variant: ["BC", "CS"]
|
||||
include:
|
||||
- racket-version: current
|
||||
experimental: true
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
- uses: Bogdanp/setup-racket@v1.11
|
||||
with:
|
||||
architecture: x64
|
||||
distribution: full
|
||||
variant: ${{ matrix.racket-variant }}
|
||||
version: ${{ matrix.racket-version }}
|
||||
- name: Installing auto-rename and its dependencies
|
||||
run: raco pkg install --no-docs --auto --name auto-rename
|
||||
- name: Compiling auto-rename and building its docs
|
||||
run: raco setup --check-pkg-deps --unused-pkg-deps auto-rename
|
||||
- name: Testing auto-rename
|
||||
run: raco test -x -p auto-rename
|
||||
6
.gitignore
vendored
Normal file
6
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*~
|
||||
\#*
|
||||
.\#*
|
||||
.DS_Store
|
||||
compiled/
|
||||
/doc/
|
||||
13
LICENSE-APACHE
Normal file
13
LICENSE-APACHE
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Copyright 2025 eutro
|
||||
|
||||
Licensed under the Apache License, Version 2.0 (the "License");
|
||||
you may not use this file except in compliance with the License.
|
||||
You may obtain a copy of the License at
|
||||
|
||||
http://www.apache.org/licenses/LICENSE-2.0
|
||||
|
||||
Unless required by applicable law or agreed to in writing, software
|
||||
distributed under the License is distributed on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
See the License for the specific language governing permissions and
|
||||
limitations under the License.
|
||||
23
LICENSE-MIT
Normal file
23
LICENSE-MIT
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
auto-rename
|
||||
|
||||
MIT License
|
||||
|
||||
Copyright (c) 2025 eutro
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
4
README.md
Normal file
4
README.md
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
Auto Rename
|
||||
===========
|
||||
|
||||
A package for programmatic require and provide transformers.
|
||||
167
filters.rkt
Normal file
167
filters.rkt
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/contract
|
||||
racket/provide-transform
|
||||
racket/require-transform
|
||||
racket/sequence
|
||||
|
||||
syntax/parse/define
|
||||
(for-syntax racket/base))
|
||||
|
||||
(provide transform/filter transform/when
|
||||
transform/remove transform/unless
|
||||
transform/filter-raw
|
||||
transform/remove-raw
|
||||
transform/map transform/for
|
||||
transform/map-raw
|
||||
transform/append-map transform/for*
|
||||
transform/append-map-raw
|
||||
transform/matches
|
||||
transform/replace
|
||||
transform/disambiguate
|
||||
|
||||
im/export/c
|
||||
im/export-name
|
||||
im/export-map-name
|
||||
filter/c
|
||||
reducing-function/c
|
||||
transform/compose)
|
||||
|
||||
(define im/export/c (or/c import? export?))
|
||||
|
||||
(define (reducing-function/c in/c acc/c)
|
||||
(rename-contract
|
||||
(case->
|
||||
(in/c acc/c . -> . acc/c)
|
||||
(acc/c . -> . acc/c))
|
||||
(list 'reducing-function/c
|
||||
(contract-name in/c)
|
||||
(contract-name acc/c))))
|
||||
|
||||
(define filter/c
|
||||
(rename-contract
|
||||
(parametric->/c
|
||||
(Acc)
|
||||
(-> (reducing-function/c im/export/c Acc)
|
||||
(reducing-function/c im/export/c Acc)))
|
||||
'filter/c))
|
||||
|
||||
(define/contract transform/compose
|
||||
(filter/c ... . -> . filter/c)
|
||||
compose1)
|
||||
|
||||
(define/contract ((transform/filter-raw accept?) rf)
|
||||
((-> im/export/c any/c) . -> . filter/c)
|
||||
(case-lambda
|
||||
[(im/ex acc) (if (accept? im/ex) (rf im/ex acc) acc)]
|
||||
[(acc) acc]))
|
||||
|
||||
(define/contract (transform/remove-raw reject?)
|
||||
((-> im/export/c any/c) . -> . filter/c)
|
||||
(transform/filter-raw (λ (it) (not (reject? it)))))
|
||||
|
||||
(define/contract (transform/filter accept?)
|
||||
((-> string? any/c) . -> . filter/c)
|
||||
(transform/filter-raw (λ (it) (accept? (im/export-name it)))))
|
||||
|
||||
(define-syntax-parse-rule (transform/when name:id expr)
|
||||
;; using a function contract gives better errors than just any/c on
|
||||
;; expr does, in the case that expr returns multiple values
|
||||
#:with fun #'(λ (name) expr)
|
||||
#:declare fun (expr/c #'(-> string? any/c) #:name "when")
|
||||
(transform/filter fun.c))
|
||||
|
||||
(define/contract (transform/remove reject?)
|
||||
((-> string? any/c) . -> . filter/c)
|
||||
(transform/filter-raw (λ (it) (not (reject? (im/export-name it))))))
|
||||
|
||||
(define-syntax-parse-rule (transform/unless name:id expr)
|
||||
#:with fun #'(λ (name) expr)
|
||||
#:declare fun (expr/c #'(-> string? any/c) #:name "unless")
|
||||
(transform/remove fun.c))
|
||||
|
||||
(define/contract ((transform/map-raw func) rf)
|
||||
((-> im/export/c im/export/c) . -> . filter/c)
|
||||
(case-lambda
|
||||
[(im/ex acc) (rf (func im/ex) acc)]
|
||||
[(acc) acc]))
|
||||
|
||||
(define/contract (transform/map func)
|
||||
((-> string? string?) . -> . filter/c)
|
||||
(transform/map-raw (λ (it) (im/export-map-name it func))))
|
||||
|
||||
(define-syntax-parse-rule (transform/for name:id expr)
|
||||
#:with fun #'(λ (name) expr)
|
||||
#:declare fun (expr/c #'(-> string? string?) #:name "for")
|
||||
(transform/map fun.c))
|
||||
|
||||
(define/contract ((transform/append-map-raw func) rf)
|
||||
((-> im/export/c (sequence/c im/export/c)) . -> . filter/c)
|
||||
(case-lambda
|
||||
[(im/ex acc) (for/fold ([acc acc]) ([v (func im/ex)]) (rf v acc))]
|
||||
[(acc) acc]))
|
||||
|
||||
(define/contract (transform/append-map func)
|
||||
((-> string? (sequence/c string?)) . -> . filter/c)
|
||||
(transform/append-map-raw
|
||||
(λ (im/ex)
|
||||
(for*/list ([name (func (im/export-name im/ex))])
|
||||
(im/export-map-name im/ex (λ (_prev) name))))))
|
||||
|
||||
(define-syntax-parse-rule (transform/for* name:id expr)
|
||||
#:with fun #'(λ (name) expr)
|
||||
#:declare fun (expr/c #'(-> string? (sequence/c string?)) #:name "for*")
|
||||
(transform/append-map fun.c))
|
||||
|
||||
(define/contract (transform/matches pat)
|
||||
((or/c regexp? string?) . -> . filter/c)
|
||||
(transform/filter (λ (it) (regexp-match? pat it))))
|
||||
|
||||
(define/contract (transform/replace pat replacement)
|
||||
((or/c regexp? string?) (or/c string? (unconstrained-domain-> string?)) . -> . filter/c)
|
||||
(transform/map (λ (it) (regexp-replace* pat it replacement))))
|
||||
|
||||
(define/contract ((transform/disambiguate [n->str (λ (orig i) (format "~a-~a" orig i))]) rf)
|
||||
(() ((-> string? natural-number/c string?)) . ->* . filter/c)
|
||||
(define seen (make-hasheq))
|
||||
(case-lambda
|
||||
[(im/ex acc)
|
||||
(let loop ([im/ex im/ex])
|
||||
(define sym-name (string->symbol (im/export-name im/ex)))
|
||||
(hash-update! seen sym-name add1 0)
|
||||
(define conflicts (hash-ref seen sym-name))
|
||||
(cond
|
||||
[(= 1 conflicts) (rf im/ex acc)]
|
||||
[else
|
||||
(define (nth-name orig-name) (n->str orig-name conflicts))
|
||||
(loop (im/export-map-name im/ex nth-name))]))]
|
||||
[(acc) acc]))
|
||||
|
||||
(define (im/export-name x)
|
||||
(cond
|
||||
[(string? x) x]
|
||||
[else
|
||||
(im/export-name
|
||||
(cond
|
||||
[(import? x) (import-local-id x)]
|
||||
[(export? x) (export-out-id x)]
|
||||
[(identifier? x) (syntax-e x)]
|
||||
[(symbol? x) (symbol->string x)]
|
||||
[else (raise-argument-error 'im/export-name "(or/c symbol? identifier? import? export?)" x)]))]))
|
||||
|
||||
(define (im/export-map-name x string-func)
|
||||
(cond
|
||||
[(string? x)
|
||||
(define transformed (string-func x))
|
||||
(if (equal? x transformed) x transformed)]
|
||||
[else
|
||||
(define-values (x-> ->x)
|
||||
(cond
|
||||
[(symbol? x) (values symbol->string string->symbol)]
|
||||
[(identifier? x) (values syntax-e (λ (it) (datum->syntax x it x)))]
|
||||
[(import? x) (values import-local-id (λ (it) (struct-copy import x [local-id it])))]
|
||||
[(export? x) (values export-out-id (λ (it) (struct-copy export x [out-id it])))]
|
||||
[else (raise-argument-error 'transform "(or/c symbol? identifier? import? export?)" x)]))
|
||||
(define unwrapped (x-> x))
|
||||
(define transformed (im/export-map-name unwrapped string-func))
|
||||
(if (eq? transformed unwrapped) x (->x transformed))]))
|
||||
9
info.rkt
Normal file
9
info.rkt
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#lang info
|
||||
(define collection "auto-rename")
|
||||
(define deps '("base"))
|
||||
(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
|
||||
(define scribblings '(("scribblings/auto-rename.scrbl" ())))
|
||||
(define pkg-desc "Description Here")
|
||||
(define version "0.0")
|
||||
(define pkg-authors '(eutro))
|
||||
(define license '(Apache-2.0 OR MIT))
|
||||
1
language/.gitignore
vendored
Normal file
1
language/.gitignore
vendored
Normal file
|
|
@ -0,0 +1 @@
|
|||
*-words.*.tsv
|
||||
64
language/british-english.rkt
Normal file
64
language/british-english.rkt
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base racket/string)
|
||||
"../main.rkt")
|
||||
(provide for-british for-american)
|
||||
|
||||
(begin-for-syntax
|
||||
(require racket/runtime-path)
|
||||
|
||||
;; british_spellings.tsv was taken from
|
||||
;; https://github.com/hyperreality/American-British-English-Translator/blob/f8806121e58530f601b84ebb7302afc81b8b1461/data/british_spellings.json
|
||||
(define-runtime-path british-spellings-path "british_spellings.tsv")
|
||||
|
||||
(define tsv-data
|
||||
(call-with-input-file* british-spellings-path
|
||||
#:mode 'text
|
||||
(λ (ic)
|
||||
(for/list ([line (in-lines ic)])
|
||||
(apply cons (string-split line "\t"))))))
|
||||
|
||||
(define (flip-pair x) (cons (cdr x) (car x)))
|
||||
(define british->american-map (make-immutable-hash tsv-data))
|
||||
(define american->british-map (make-immutable-hash (map flip-pair tsv-data)))
|
||||
|
||||
;; TODO: introduce rule-based matcher rather than just consulting a table,
|
||||
;; to catch things like `dingor-frombilizer` -> `dingour-frombiliser`
|
||||
(define ((map-words table) name)
|
||||
(regexp-replace*
|
||||
#rx"[a-zA-Z]+" name
|
||||
(λ (word) (hash-ref table word word)))))
|
||||
|
||||
(define-syntax for-british
|
||||
(make-auto-rename-transformer
|
||||
(tx/map (map-words american->british-map))))
|
||||
(define-syntax for-american
|
||||
(make-auto-rename-transformer
|
||||
(tx/map (map-words british->american-map))))
|
||||
|
||||
(module+ test
|
||||
(module american racket/base
|
||||
(provide (all-defined-out))
|
||||
(define-values (color-red
|
||||
500-eons-ago
|
||||
emergency-breathalyzer
|
||||
galvanized-square-steel)
|
||||
(values 1 2 3 4)))
|
||||
|
||||
(module british racket/base
|
||||
(provide (all-defined-out))
|
||||
(define-values (cosy-defenceless-cottage
|
||||
fibre-glass-fishing-rod
|
||||
watercolour-fertiliser)
|
||||
(values 'a 'b 'c)))
|
||||
|
||||
(require (for-british 'american)
|
||||
(for-american 'british)
|
||||
rackunit)
|
||||
|
||||
(check-equal?
|
||||
(list colour-red 500-aeons-ago emergency-breathalyser galvanised-square-steel)
|
||||
(list 1 2 3 4))
|
||||
(check-equal?
|
||||
(list cozy-defenseless-cottage fiber-glass-fishing-rod watercolor-fertilizer)
|
||||
(list 'a 'b 'c)))
|
||||
1814
language/british_spellings.tsv
Normal file
1814
language/british_spellings.tsv
Normal file
File diff suppressed because it is too large
Load diff
38
language/generate.fish
Normal file
38
language/generate.fish
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
#!/usr/bin/env fish
|
||||
|
||||
: '
|
||||
;; Run these in a REPL
|
||||
(require auto-rename)
|
||||
(require (transform-in
|
||||
racket #:tx
|
||||
(lambda (rf)
|
||||
(define coll (mutable-set))
|
||||
(case-lambda
|
||||
[(im/ex acc)
|
||||
(for ([name (in-list (regexp-match* #rx"[A-Za-z]+" (im/export-name im/ex)))])
|
||||
(set-add! coll name))
|
||||
(rf im/ex acc)]
|
||||
[(acc)
|
||||
(with-output-to-file "stdlib-words.tsv"
|
||||
(lambda ()
|
||||
(displayln (string-join (sort (set->list coll) string<?) "\n"))))
|
||||
acc]))))
|
||||
'
|
||||
|
||||
set LANGS fr de hu
|
||||
|
||||
function atr_transl
|
||||
for lang in $LANGS
|
||||
awk '{print $1}' stdlib-words.tsv \
|
||||
| parallel --bar -N 5 -k -- trans -brief en:$lang \
|
||||
| string lower \
|
||||
| sed 's/ /-/g' \
|
||||
> stdlib-words.$lang.tsv
|
||||
end
|
||||
end
|
||||
|
||||
function atr_collate
|
||||
awk '{print $1}' stdlib-words.tsv > stdlib-words.en.tsv
|
||||
paste -d '\t' stdlib-words.en.tsv stdlib-words.$LANGS.tsv > stdlib-words.tsv
|
||||
rm stdlib-words.en.tsv
|
||||
end
|
||||
53
language/polyglot.rkt
Normal file
53
language/polyglot.rkt
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base racket/string)
|
||||
"../main.rkt")
|
||||
|
||||
(provide en-français
|
||||
auf-deutsch
|
||||
magyarul)
|
||||
|
||||
(begin-for-syntax
|
||||
(require racket/runtime-path)
|
||||
(define-logger polyglot)
|
||||
|
||||
(define-runtime-path table-path "stdlib-words.tsv")
|
||||
(define tsv-data
|
||||
(call-with-input-file* table-path
|
||||
#:mode 'text
|
||||
(λ (ic)
|
||||
(for/hash ([line (in-lines ic)])
|
||||
(define vals (string-split line "\t"))
|
||||
(values (car vals)
|
||||
(apply vector-immutable (cdr vals)))))))
|
||||
|
||||
(define ((map-words lang-code column) name)
|
||||
(cond
|
||||
[(string-prefix? name "#%") name]
|
||||
[else
|
||||
(define translated
|
||||
(regexp-replace*
|
||||
#rx"[a-zA-Z]+" name
|
||||
(λ (word)
|
||||
(define translated (hash-ref tsv-data word #f))
|
||||
(cond
|
||||
[translated
|
||||
(vector-ref translated column)]
|
||||
[else word]))))
|
||||
(log-polyglot-debug "~a -[~a]> ~a" name lang-code translated)
|
||||
translated])))
|
||||
|
||||
(define-syntax en-français
|
||||
(make-auto-rename-transformer
|
||||
(tx/map (map-words 'fr 0))
|
||||
(tx/disambiguate)))
|
||||
|
||||
(define-syntax auf-deutsch
|
||||
(make-auto-rename-transformer
|
||||
(tx/map (map-words 'de 1))
|
||||
(tx/disambiguate)))
|
||||
|
||||
(define-syntax magyarul
|
||||
(make-auto-rename-transformer
|
||||
(tx/map (map-words 'hu 2))
|
||||
(tx/disambiguate)))
|
||||
1034
language/stdlib-words.tsv
Normal file
1034
language/stdlib-words.tsv
Normal file
File diff suppressed because it is too large
Load diff
92
main.rkt
Normal file
92
main.rkt
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-syntax racket/base
|
||||
"reqprov-transformer.rkt"
|
||||
"filters.rkt")
|
||||
racket/require-syntax
|
||||
racket/provide-syntax)
|
||||
|
||||
(provide auto-rename-in/out auto-rename-in auto-rename-out
|
||||
transform-in/out transform-in transform-out
|
||||
|
||||
(for-syntax (all-from-out "reqprov-transformer.rkt"
|
||||
"filters.rkt")
|
||||
(auto-rename-out
|
||||
(all-from-out "filters.rkt")
|
||||
#:tx (transform/replace #rx"transform/" "tx/"))))
|
||||
|
||||
(define-syntax auto-rename-in/out (new-auto-rename-transformer values))
|
||||
(define-require-syntax (auto-rename-in stx)
|
||||
(syntax-case stx [] [(_ . tail) #`(auto-rename-in/out #:derived #,stx . tail)]))
|
||||
(define-provide-syntax (auto-rename-out stx)
|
||||
(syntax-case stx [] [(_ . tail) #`(auto-rename-in/out #:derived #,stx . tail)]))
|
||||
|
||||
(define-syntax transform-in/out (make-rename-transformer #'auto-rename-in/out))
|
||||
(define-syntax transform-in (make-rename-transformer #'auto-rename-in))
|
||||
(define-syntax transform-out (make-rename-transformer #'auto-rename-out))
|
||||
|
||||
(module+ test
|
||||
(define-syntax rust-in
|
||||
(make-auto-rename-transformer
|
||||
(transform/replace #rx"-" "🚀")
|
||||
(transform/replace #rx"\\?" "🤔")
|
||||
(transform/replace #rx"!" "💥")))
|
||||
|
||||
(require (rust-in rackunit racket/base))
|
||||
|
||||
(module mod racket/base
|
||||
(require (submod ".." "..") (for-syntax racket/base racket/string))
|
||||
(provide (transform-out abc #:tx (transform/map string-upcase))
|
||||
(transform-out ABC #:tx (transform/for x (string-downcase x)))
|
||||
(transform-out |def ghi| #:tx (transform/append-map string-split))
|
||||
(transform-out jKl #:tx (transform/for* it (list (string-downcase it) (string-upcase it))))
|
||||
(rename-out [pqr-1 pqr])
|
||||
(transform-out mno1 pqr #:tx (transform/filter (λ (it) (equal? it "mno1"))))
|
||||
(transform-out mno2 pqr #:tx (transform/when it (equal? it "mno2")))
|
||||
(transform-out mno3 pqr #:tx (transform/remove (λ (it) (equal? it "pqr"))))
|
||||
(transform-out mno4 pqr #:tx (transform/unless it (equal? it "pqr")))
|
||||
(transform-out stu1 stu2 stu3 pqr #:tx (transform/matches #rx"stu.")))
|
||||
(define-values (abc ABC |def ghi| jKl mno1 mno2 mno3 mno4 pqr pqr-1 stu1 stu2 stu3)
|
||||
(apply values '(abc ABC d/g jKl mno1 mno2 mno3 mno4 pqr pqr-1 stu1 stu2 stu3))))
|
||||
(require 'mod)
|
||||
|
||||
(check🚀eq🤔 ABC 'abc)
|
||||
(check🚀eq🤔 abc 'ABC)
|
||||
(check🚀eq🤔 def 'd/g)
|
||||
(check🚀eq🤔 ghi 'd/g)
|
||||
(check🚀eq🤔 jkl 'jKl)
|
||||
(check🚀eq🤔 JKL 'jKl)
|
||||
(check🚀equal🤔 (list mno1 mno2 mno3 mno4 pqr)
|
||||
'( mno1 mno2 mno3 mno4 pqr-1))
|
||||
(check🚀equal🤔 (list stu1 stu2 stu3)
|
||||
'( stu1 stu2 stu3))
|
||||
|
||||
(check🚀equal🤔
|
||||
(let ([x 5]) (set💥 x 8) x)
|
||||
8)
|
||||
|
||||
(module english racket/base
|
||||
(require (for-syntax "reqprov-transformer.rkt"
|
||||
"filters.rkt"
|
||||
racket/base))
|
||||
(provide for-british)
|
||||
(define-syntax for-british
|
||||
(make-auto-rename-transformer
|
||||
(transform/replace #rx"([yi])ze" "\\1se")
|
||||
(transform/replace #rx"center" "centre")
|
||||
(transform/replace #rx"defense" "defence")
|
||||
(transform/replace #rx"or$" "our"))))
|
||||
|
||||
(module american🇺🇸🦅 racket/base
|
||||
(provide (all-defined-out))
|
||||
(define-values (analyze center defense labor organize)
|
||||
(values 1 2 3 4 5)))
|
||||
(module british🇬🇧🫖 racket/base
|
||||
(require (submod ".." english) (submod ".." american🇺🇸🦅))
|
||||
(provide (for-british (all-from-out (submod ".." american🇺🇸🦅)))))
|
||||
|
||||
(require 'british🇬🇧🫖)
|
||||
(check🚀not🚀exn (λ () (list analyse centre defence labour)))
|
||||
|
||||
;
|
||||
)
|
||||
110
reqprov-transformer.rkt
Normal file
110
reqprov-transformer.rkt
Normal file
|
|
@ -0,0 +1,110 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "filters.rkt"
|
||||
racket/require-transform
|
||||
racket/provide-transform
|
||||
|
||||
racket/list
|
||||
racket/base
|
||||
racket/sequence
|
||||
racket/syntax
|
||||
syntax/parse
|
||||
racket/contract)
|
||||
|
||||
(provide (struct-out auto-rename-transformer)
|
||||
make-auto-rename-transformer)
|
||||
|
||||
(define (apply-transforms xform im/exports)
|
||||
(define rf
|
||||
(xform
|
||||
(case-lambda
|
||||
[(im/ex acc) (cons im/ex acc)]
|
||||
[(acc) (reverse acc)])))
|
||||
(rf (foldl rf null im/exports)))
|
||||
|
||||
(define (call-wrapping-syntax-errors f . stxes)
|
||||
(define (wrap-err it)
|
||||
(writeln stxes)
|
||||
(exn:fail:syntax (exn-message it) (exn-continuation-marks it) stxes))
|
||||
|
||||
(call-with-continuation-barrier
|
||||
(λ ()
|
||||
(with-handlers ([exn:fail? (λ (it) (raise (wrap-err it)))])
|
||||
(f)))))
|
||||
|
||||
(define (eval-transforms transform-stxes im/exports
|
||||
#:orig-stx orig-stx
|
||||
#:orig-exprs orig-transform-stxes
|
||||
#:precompose [extra-transforms values])
|
||||
(define transforms
|
||||
(apply
|
||||
compose1
|
||||
extra-transforms
|
||||
(for/list ([tf (in-syntax transform-stxes)]
|
||||
[tf-stx (in-syntax orig-transform-stxes)])
|
||||
(call-wrapping-syntax-errors
|
||||
(λ () (syntax-local-eval tf))
|
||||
orig-stx tf-stx))))
|
||||
(call-wrapping-syntax-errors
|
||||
(λ () (apply-transforms transforms im/exports))
|
||||
orig-stx))
|
||||
|
||||
(define-splicing-syntax-class transformers
|
||||
#:attributes {[transformers 1] [orig-transformers 1]}
|
||||
[pattern {~optional {~seq {~and {~or #:tx #:transform} kw} txs ...}}
|
||||
#:declare txs (expr/c #'filter/c
|
||||
#:phase (add1 (syntax-local-phase-level))
|
||||
#:name (format "~a" (syntax-e #'kw)))
|
||||
#:with (orig-transformers ...) #'({~? {~@ txs ...}})
|
||||
#:with (transformers ...) #'({~? {~@ txs.c ...}})])
|
||||
|
||||
(define (extract-derived stx)
|
||||
(syntax-parse stx
|
||||
[(func #:derived orig-stx . tail)
|
||||
(values
|
||||
#'orig-stx
|
||||
(syntax/loc #'orig-stx (func . tail)))]
|
||||
[_ (values stx stx)]))
|
||||
|
||||
(define ((auto-rename-require-transform obj) stx)
|
||||
(define-values (orig-stx stx*) (extract-derived stx))
|
||||
(syntax-parse stx*
|
||||
#:context orig-stx
|
||||
[(_ {~describe #:opaque "require sub-form" form:expr}
|
||||
...+
|
||||
tx:transformers)
|
||||
(define-values (imports sources)
|
||||
(for/lists (i s #:result (values (append* i) (append* s)))
|
||||
([it (in-syntax #'(form ...))])
|
||||
(expand-import it)))
|
||||
(values (eval-transforms #'(tx.transformers ...) imports
|
||||
#:orig-stx orig-stx
|
||||
#:orig-exprs #'(tx.orig-transformers ...)
|
||||
#:precompose (auto-rename-transformer-builtins obj))
|
||||
sources)]))
|
||||
|
||||
(define ((auto-rename-provide-transform obj) stx modes)
|
||||
(define-values (orig-stx stx*) (extract-derived stx))
|
||||
(syntax-parse stx*
|
||||
#:context orig-stx
|
||||
[(_ {~describe #:opaque "provide sub-form" form:expr}
|
||||
...+
|
||||
tx:transformers)
|
||||
(define exports
|
||||
(append*
|
||||
(for/list ([it (in-syntax #'(form ...))])
|
||||
(expand-export it modes))))
|
||||
(eval-transforms #'(tx.transformers ...)
|
||||
exports
|
||||
#:orig-stx orig-stx
|
||||
#:orig-exprs #'(tx.orig-transformers ...)
|
||||
#:precompose (auto-rename-transformer-builtins obj))]))
|
||||
|
||||
(struct auto-rename-transformer (builtins)
|
||||
#:extra-constructor-name new-auto-rename-transformer
|
||||
#:property prop:require-transformer auto-rename-require-transform
|
||||
#:property prop:provide-transformer auto-rename-provide-transform)
|
||||
|
||||
(define/contract (make-auto-rename-transformer . transforms)
|
||||
(filter/c ... . -> . auto-rename-transformer?)
|
||||
(new-auto-rename-transformer (apply compose1 transforms)))
|
||||
253
scribblings/auto-rename.scrbl
Normal file
253
scribblings/auto-rename.scrbl
Normal file
|
|
@ -0,0 +1,253 @@
|
|||
#lang scribble/manual
|
||||
|
||||
@(require (for-label auto-rename
|
||||
racket/base
|
||||
racket/sequence
|
||||
racket/contract
|
||||
racket/provide-transform
|
||||
racket/require-transform)
|
||||
scribble/example)
|
||||
|
||||
@(define make-evaluator
|
||||
(make-eval-factory (list 'racket 'auto-rename)))
|
||||
|
||||
@title{Auto Rename Transformers}
|
||||
@author{eutro}
|
||||
|
||||
@defmodule[auto-rename]
|
||||
|
||||
A package for programmatic @racket[require] and @racket[provide] filters and renamings.
|
||||
|
||||
@(examples
|
||||
#:eval (make-evaluator)
|
||||
#:once
|
||||
#:label "Example:"
|
||||
|
||||
(eval:no-prompt
|
||||
(module fancy-lib racket
|
||||
(provide (all-defined-out))
|
||||
(struct fancy (x y z) #:transparent))
|
||||
code:blank)
|
||||
|
||||
(require (transform-in
|
||||
'fancy-lib
|
||||
#:transform (transform/replace "fancy" "not-so-fancy")))
|
||||
(not-so-fancy 1 2 3)
|
||||
struct:not-so-fancy)
|
||||
|
||||
@deftogether[[(defform (auto-rename-in require-spec ...+ #:transform transform ...))
|
||||
(defform (auto-rename-out provide-spec ...+ #:transform transform ...))
|
||||
(defform (auto-rename-in/out spec ...+ #:transform transform ...)
|
||||
#:contracts ([transform filter/c]))]]{
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "require transformer"]{Require}
|
||||
and @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "provide transformer"]{provide}
|
||||
transformers which apply the given @racket[transform]s to all the imports and exports from the @racket[spec]s.
|
||||
}
|
||||
|
||||
@deftogether[[(defform (transform-in require-spec ...+ #:transform transforms ...))
|
||||
(defform (transform-out provide-spec ...+ #:transform transforms ...))
|
||||
(defform (transform-in/out spec ...+ #:transform transforms ...))]]{
|
||||
Aliases for @racket[auto-rename-in], @racket[auto-rename-out] and @racket[auto-rename-in/out].
|
||||
}
|
||||
|
||||
@section{Transformers}
|
||||
|
||||
@defmodule[auto-rename/filters]
|
||||
|
||||
These bindings are provided by both @racket[auto-rename] and @racket[auto-rename/filters].
|
||||
@racket[auto-rename] additionally provides these bindings with @racket[tx/] replacing @racket[transformer/].
|
||||
|
||||
@defproc[(transform/filter [accept? (-> string? any/c)]) filter/c]{
|
||||
Include only imports/exports for which @racket[accept?] produces a true value.
|
||||
}
|
||||
@defform[(transform/when x accept?-expr)]{
|
||||
Equivalent to @racket[(transform/filter (λ (x) accept?-expr))].
|
||||
}
|
||||
|
||||
@defproc[(transform/remove [reject? (-> string? any/c)]) filter/c]{
|
||||
Exclude any imports/exports for which @racket[reject?] produces a true value.
|
||||
}
|
||||
@defform[(transform/unless x reject?-expr)]{
|
||||
Equivalent to @racket[(transform/remove (λ (x) reject?-expr))].
|
||||
}
|
||||
|
||||
@defproc[(transform/map [renamer (-> string? string?)]) filter/c]{
|
||||
Change the name of any imports/exports to the result of applying @racket[renamer] to the original name.
|
||||
}
|
||||
@defform[(transform/for x name-expr)]{
|
||||
Equivalent to @racket[(transform/map (λ (x) name-expr))].
|
||||
}
|
||||
|
||||
@defproc[(transform/append-map [renamer (-> string? (sequence/c string?))]) filter/c]{
|
||||
Change the name of any imports/exports to the results of applying @racket[renamer] to the original name.
|
||||
That is, the binding is imported/exported under every name that @racket[renamer] returns, or no names at all
|
||||
if the returned sequence is empty.
|
||||
}
|
||||
@defform[(transform/for* x names-expr)]{
|
||||
Equivalent to @racket[(transform/append-map (λ (x) names-expr))].
|
||||
}
|
||||
|
||||
@defproc[(transform/matches [pattern (or/c string? regexp?)]) filter/c]{
|
||||
Include only imports/exports whose name matches @racket[pattern].
|
||||
Equivalent to @racket[(transform/when name (regexp-match? pattern name))].
|
||||
}
|
||||
|
||||
@defproc[(transform/replace [pattern (or/c string? regexp?)]
|
||||
[replacement (or/c string? (string? string? ... . -> . string?))])
|
||||
filter/c]{
|
||||
Replace all occurrences of @racket[pattern] in import/export names with @racket[replacement],
|
||||
as if by @racket[regexp-replace*].
|
||||
|
||||
Equivalent to @racket[(transform/for name (regexp-replace* pattern name replacement))].
|
||||
}
|
||||
|
||||
@section{Miscellaneous Definitions}
|
||||
|
||||
@deftogether[(@defthing[filter/c
|
||||
contract?
|
||||
#:value (-> (reducing-function/c im/export/c A)
|
||||
(reducing-function/c im/export/c A))]
|
||||
@defproc[(reducing-function/c [input/c contract?] [accumulator/c contract?])
|
||||
contract?
|
||||
#:value (case->
|
||||
(input/c accumulator/c . -> . accumulator/c)
|
||||
(accumulator/c . -> . accumulator/c))])]{
|
||||
A @deftech{filter} is a composable function which transforms streams of
|
||||
imports/exports. @racketmodname[auto-rename] uses filters to modify
|
||||
the sequence of imports/exports that @racket[auto-rename-in/out] produce.
|
||||
Typically one would use the @racket[transform/xyz] functions available in
|
||||
@racketmodname[auto-rename/filters] to construct these, rather than
|
||||
writing them by hand.
|
||||
|
||||
A @deftech{reducing function} is a type of procedure which accumulates inputs
|
||||
into an accumulator. @racketmodname[auto-rename] uses reducing functions
|
||||
to transform a sequence of imports/exports into the list of imports/exports
|
||||
produced by @racket[auto-rename-in/out]. Typically, one does not see reducing
|
||||
functions unless they are writing a @tech{filter} by hand.
|
||||
|
||||
Specifically @racket[(reducing-function/c in/c acc/c)] is a contract
|
||||
for a procedure @racket[rf] suitable for the expression
|
||||
@racket[(rf (foldl rf acc ins))], where @racket[acc] and @racket[ins] conform to
|
||||
@racket[acc/c] and @racket[(listof in/c)] respectively, and a @tech{filter}
|
||||
is a function which maps an import/export @tech{reducing function} to a new import/export
|
||||
reducing function, which may rename, remove, duplicate, or otherwise modify the
|
||||
stream of imports/exports that the original reducing function receives, but
|
||||
may not observe or modify the accumulator.
|
||||
|
||||
@(examples
|
||||
#:eval (make-evaluator)
|
||||
#:once #:no-prompt
|
||||
#:label "Some illustrative, but not terribly useful, examples:"
|
||||
|
||||
(code:line
|
||||
(code:comment "A transformer which drops all imports/exports.")
|
||||
(define (transform/none rf)
|
||||
(case-lambda
|
||||
[(im/ex acc) acc]
|
||||
[(acc) acc])))
|
||||
|
||||
(code:line
|
||||
code:blank
|
||||
(code:comment "A transformer which drops imports randomly.")
|
||||
(define (transform/drop-randomly rf)
|
||||
(case-lambda
|
||||
[(im/ex acc)
|
||||
(if (zero? (random 2))
|
||||
acc
|
||||
(rf im/ex acc))]
|
||||
[(acc) acc])))
|
||||
)
|
||||
}
|
||||
|
||||
@defthing[im/export/c contract? #:value (or/c import? export?)]{
|
||||
A import or an export.
|
||||
}
|
||||
|
||||
@defproc[(im/export-name [im/ex im/export/c]) string?]{
|
||||
Get the name of an import/export.
|
||||
}
|
||||
|
||||
@defproc[(im/export-map-name [im/ex im/export/c] [proc (-> string? string?)]) im/export/c]{
|
||||
Return a copy of @racket[im/ex] with its name transformed by @racket[proc].
|
||||
}
|
||||
|
||||
@defproc[(transform/compose [transform filter/c] ...) filter/c]{
|
||||
Compose the given @racket[transform]s.
|
||||
The effects of the transformations are performed left to right.
|
||||
}
|
||||
|
||||
@section{Internationalisation Support}
|
||||
|
||||
Bindings detailed in this section are experimental, and may not be
|
||||
up to the same quality as those exported by @racketmodname[auto-rename].
|
||||
I make no backwards-compatibility guarantees.
|
||||
|
||||
@subsection{British and American English}
|
||||
|
||||
@defmodule[auto-rename/language/british-english]
|
||||
|
||||
This module provides require/provide transformers for
|
||||
importing and exporting bindings with British English spelling.
|
||||
|
||||
@(examples
|
||||
#:eval (make-evaluator)
|
||||
#:once
|
||||
(require auto-rename/language/british-english
|
||||
(for-british racket))
|
||||
(normalise-arity 1)
|
||||
(rationalise 1/4 1/10)
|
||||
(eval:error
|
||||
(parameterise ([error-print-width 5])
|
||||
(car (expt 10 1024))))
|
||||
(string-normalise-spaces " foo bar baz \r\n\t"))
|
||||
|
||||
@defform[(for-british spec ...+)]{
|
||||
A @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "require transformer"]{require}
|
||||
and @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "provide transformer"]{provide}
|
||||
transformer which renames identifiers using American English spellings to use British English spellings instead.
|
||||
}
|
||||
|
||||
@defform[(for-american spec ...+)]{
|
||||
A @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "require transformer"]{require}
|
||||
and @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "provide transformer"]{provide}
|
||||
transformer which renames identifiers using British English spellings to use American English spellings instead.
|
||||
}
|
||||
|
||||
@subsection{Other languages}
|
||||
|
||||
@defmodule[auto-rename/language/polyglot]
|
||||
|
||||
This module provides require/provide transformers
|
||||
for importing and exporting bindings in languages like French, German
|
||||
and Hungarian. Due to the automated and word-based nature of these
|
||||
translations they may not be very good, but they are predictable.
|
||||
Sometimes.
|
||||
|
||||
@(examples
|
||||
#:eval (make-evaluator)
|
||||
#:once
|
||||
|
||||
(require auto-rename/language/polyglot)
|
||||
(require (en-français racket/base))
|
||||
(pour ([x (dans-gamme 5)])
|
||||
(affichage x))
|
||||
|
||||
(exiger (auf-deutsch racket/base))
|
||||
(für ([x (in-reichweite 5)])
|
||||
(schreiben x))
|
||||
|
||||
(erfordern (magyarul racket/base))
|
||||
(-ra ([x (-ben-hatótávolság 5)])
|
||||
(írás x)))
|
||||
|
||||
@deftogether[[(defform (en-français spec ...+))
|
||||
(defform (auf-deutsch spec ...+))
|
||||
(defform (magyarul spec ...+))]]{
|
||||
@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "require transformer"]{Require}
|
||||
and @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key "provide transformer"]{provide}
|
||||
transformers which renames identifiers to be in the corresponding language.
|
||||
|
||||
This works by splitting each identifier into tokens of (English) alphabet
|
||||
characters, and applying pre-defined translations (if any) to each token
|
||||
individually.
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue