]> gitweb.factorcode.org Git - factor.git/blob - basis/fixups/fixups.factor
Rename and add sorting words
[factor.git] / basis / fixups / fixups.factor
1 ! Copyright (C) 2021 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs classes.tuple continuations kernel sequences
4 slots.private vocabs vocabs.parser ;
5 IN: fixups
6
7 CONSTANT: vocab-renames {
8     { "math.intervals" { "intervals" "0.99" } }
9     { "math.ranges" { "ranges" "0.99" } }
10     { "sorting.slots" { "sorting.specification" "0.99" } }
11 }
12
13 CONSTANT: word-renames {
14     { "32bit?" { "layouts:32-bit?" "0.99" } }
15     { "64bit?" { "layouts:64-bit?" "0.99" } }
16     { "lines" { "io:read-lines" "0.99" } }
17     { "words" { "splitting:split-words" "0.99" } }
18     { "contents" { "io:read-contents" "0.99" } }
19     { "exists?" { "io.files:file-exists?" "0.99" } }
20     { "string-lines" { "splitting:split-lines" "0.99" } }
21     { "[-inf,a)" { "math.intervals:[-inf,b)" "0.99" } }
22     { "[-inf,a]" { "math.intervals:[-inf,b]" "0.99" } }
23     { "(a,b)" { "ranges:(a..b)" "0.99" } }
24     { "(a,b]" { "ranges:(a..b]" "0.99" } }
25     { "[a,b)" { "ranges:[a..b)" "0.99" } }
26     { "[a,b]" { "ranges:[a..b]" "0.99" } }
27     { "[0,b)" { "ranges:[0..b)" "0.99" } }
28     { "[0,b]" { "ranges:[0..b]" "0.99" } }
29     { "[1,b)" { "ranges:[1..b)" "0.99" } }
30     { "[1,b]" { "ranges:[1..b]" "0.99" } }
31     { "assoc-combine" { "assocs:assoc-union-all" "0.99" } }
32     { "assoc-refine" { "assocs:assoc-intersect-all" "0.99" } }
33     { "assoc-merge" { "assocs.extras:assoc-collect" "0.99" } }
34     { "assoc-merge!" { "assocs.extras:assoc-collect!" "0.99" } }
35     { "peek-from" { "modern.html:peek1-from" "0.99" } }
36     { "in?" { "interval-sets:interval-in?" "0.99" } }
37     { "substitute" { "regexp.classes:(substitute)" "0.99" } }
38     { "combine" { "sets:union-all" "0.99" } }
39     { "refine" { "sets:intersect-all" "0.99" } }
40     { "read-json-objects" { "json:read-json" "0.99" } }
41     { "init-namespaces" { "namespaces:init-namestack" "0.99" } }
42     { "iota" { "sequences:<iota>" ".98" } }
43     { "git-checkout-existing-branch" { "git-checkout-existing" "0.99" } }
44     { "git-checkout-existing-branch*" { "git-checkout-existing*" "0.99" } }
45     { "tags" { "chloe-tags" "0.99" } }
46     { "(each)" { "sequence-operator" "0.99" } }
47     { "(each-integer)" { "each-integer-from" "0.99" } }
48     { "(find-integer)" { "find-integer-from" "0.99" } }
49     { "(all-integers?)" { "all-integers-from?" "0.99" } }
50     { "short" { "index-or-length" "0.99" } }
51     { "map-integers" { "map-integers-as" "0.99" } }
52     { "deep-subseq?" { "deep-subseq-of?" "0.99" } }
53     { "overtomorrow" { "overmorrow" "0.99" } }
54     { "INITIALIZE:" { "INITIALIZED-SYMBOL:" "0.99" } }
55     { "natural-sort" { "sort" "0.99" } }
56     { "sort-by-with" { "sort-with-spec-by" "0.99" } }
57     { "sort-keys-by" { "sort-keys-with-spec" "0.99" } }
58     { "sort-values-by" { "sort-values-with-spec" "0.99" } }
59     { "compare-slots" { "compare-with-spec" "0.99" } }
60     { "natural-sort!" { "sort!" "0.99" } }
61     { "natural-bubble-sort!" { "bubble-sort!" "0.99" } }
62 }
63
64 : compute-assoc-fixups ( continuation name assoc -- seq )
65     swap '[ drop _ = ] assoc-filter [
66         drop { }
67     ] [
68         swap '[
69             first2 dupd first2
70             " in Factor " glue " renamed to " glue "Fixup: " prepend
71             swap drop no-op-restart
72             _ <restart>
73         ] map
74     ] if-empty ;
75
76 GENERIC: compute-fixups ( continuation error -- seq )
77
78 M: object compute-fixups
79     "error" over ?offset-of-slot
80     [ slot compute-fixups ] [ 2drop { } ] if* ;
81
82 M: f compute-fixups 2drop { } ;
83
84 M: no-vocab compute-fixups
85     [ name>> vocab-renames compute-assoc-fixups ] [ drop { } ] if* ;
86
87 M: no-word-error compute-fixups
88     [ name>> word-renames compute-assoc-fixups ] [ drop { } ] if* ;