diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index 2eabe9b0bc..ed82532d0c 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -59,6 +59,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" { $subsection diff } { $subsection remove-all } { $subsection substitute } +{ $subsection substitute-here } { $see-also key? } ; ARTICLE: "assocs-mutation" "Storing keys and values in assocs" @@ -266,12 +267,16 @@ HELP: remove-all { $notes "The values of the keys in the assoc are disregarded, so this word is usually used for set-theoretic calculations where the assoc in question either has dummy sentinels as values, or the values equal the keys." } { $side-effects "assoc" } ; -HELP: substitute +HELP: substitute-here { $values { "assoc" assoc } { "seq" "a mutable sequence" } } -{ $description "Replaces elements of " { $snippet "seq" } " which appear in as keys in " { $snippet "assoc" } " with the corresponding values, acting as the identity on all other elements." } +{ $description "Replaces elements of " { $snippet "seq" } " which appear as keys in " { $snippet "assoc" } " with the corresponding values, acting as the identity on all other elements." } { $errors "Throws an error if " { $snippet "assoc" } " contains values whose types are not permissible in " { $snippet "seq" } "." } { $side-effects "seq" } ; +HELP: substitute +{ $values { "assoc" assoc } { "seq" sequence } { "seq" sequence } } +{ $description "Creates a new sequence where elements of " { $snippet "seq" } " which appear as keys in " { $snippet "assoc" } " are replaced by the corresponding values, and all other elements are unchanged." } ; + HELP: cache { $values { "key" "a key" } { "assoc" assoc } { "quot" "a quotation with stack effect " { $snippet "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } } { $description "If the key is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the key/value pair into the assoc." } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index d8cf01e1bd..ff0938e001 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -124,8 +124,14 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : remove-all ( assoc seq -- subseq ) swap [ key? not ] curry subset ; -: substitute ( assoc seq -- ) - swap [ dupd at* [ nip ] [ drop ] if ] curry change-each ; +: (substitute) + [ dupd at* [ nip ] [ drop ] if ] curry ; inline + +: substitute-here ( seq assoc -- ) + (substitute) change-each ; + +: substitute ( seq assoc -- newseq ) + (substitute) map ; : cache ( key assoc quot -- value ) 2over at [ diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor old mode 100644 new mode 100755 index 8dc9bd606f..307e3a99f1 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -504,7 +504,7 @@ M: loc lazy-store : substitute-vregs ( values vregs -- ) [ vreg-substitution ] 2map [ substitute-vreg? ] assoc-subset >hashtable - [ swap substitute ] curry each-phantom ; + [ substitute-here ] curry each-phantom ; : set-operand ( value var -- ) >r dup constant? [ constant-value ] when r> set ; diff --git a/core/optimizer/backend/backend.factor b/core/optimizer/backend/backend.factor index 3fe3a3e25f..d13df9e70c 100755 --- a/core/optimizer/backend/backend.factor +++ b/core/optimizer/backend/backend.factor @@ -37,10 +37,10 @@ GENERIC: optimize-node* ( node -- node/t changed? ) over assoc-empty? [ 2drop ] [ - 2dup node-in-d substitute - 2dup node-in-r substitute - 2dup node-out-d substitute - node-out-r substitute + 2dup node-in-d substitute-here + 2dup node-in-r substitute-here + 2dup node-out-d substitute-here + node-out-r substitute-here ] if ; : perform-substitutions ( node -- ) diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 5e8a5630b2..a05cd2fa8c 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: namespaces splitting sequences io.files kernel assocs -words vocabs definitions parser continuations inspector debugger -io io.styles io.streams.lines hashtables sorting prettyprint -source-files arrays combinators strings system math.parser -compiler.errors ; +USING: namespaces sequences io.files kernel assocs words vocabs +definitions parser continuations inspector debugger io io.styles +io.streams.lines hashtables sorting prettyprint source-files +arrays combinators strings system math.parser compiler.errors +splitting ; IN: vocabs.loader SYMBOL: vocab-roots @@ -16,7 +16,7 @@ V{ } clone vocab-roots set-global : vocab-dir ( vocab -- dir ) - vocab-name "." split "/" join ; + vocab-name { { CHAR: . CHAR: / } } substitute ; : vocab-dir+ ( vocab str/f -- path ) >r vocab-name "." split r> diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 4c0ea04f24..1beec90b75 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -205,6 +205,3 @@ PRIVATE> : attempt-each ( seq quot -- result ) (each) iterate-prep (attempt-each-integer) ; inline - -: replace ( seq old new -- newseq ) - [ pick pick = [ 2nip ] [ 2drop ] if ] 2curry map ; diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 16ea58ac70..8fe3b9bdf0 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io words alien kernel math.parser alien.syntax io.launcher system assocs arrays sequences namespaces qualified -system math sequences.lib windows.kernel32 generator.fixup ; +system math windows.kernel32 generator.fixup ; IN: tools.disassembler : in-file "gdb-in.txt" resource-path ; @@ -31,7 +31,7 @@ M: pair make-disassemble-cmd out-file file-lines ; : tabs>spaces ( str -- str' ) - CHAR: \t CHAR: \s replace ; + { { CHAR: \t CHAR: \s } } substitute ; : disassemble ( word -- ) make-disassemble-cmd run-gdb diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor old mode 100644 new mode 100755 index 419d3bcefd..c3998a6132 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -1,7 +1,6 @@ -USING: assocs math kernel sequences sequences.lib io.files -hashtables quotations splitting arrays math.parser -combinators.lib hash2 byte-arrays words namespaces words -compiler.units parser ; +USING: assocs math kernel sequences io.files hashtables +quotations splitting arrays math.parser combinators.lib hash2 +byte-arrays words namespaces words compiler.units parser ; IN: unicode.data << @@ -68,7 +67,7 @@ IN: unicode.data : process-combining ( data -- hash ) 3 swap (process-data) [ string>number ] assoc-map - [ nip 0 = not ] assoc-subset + [ nip zero? not ] assoc-subset >hashtable ; : categories ( -- names ) @@ -95,9 +94,9 @@ IN: unicode.data [ dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ] map ; : process-names ( data -- names-hash ) - 1 swap (process-data) - [ ascii-lower CHAR: \s CHAR: - replace swap ] assoc-map - >hashtable ; + 1 swap (process-data) [ + ascii-lower { { CHAR: \s CHAR: - } } substitute swap + ] assoc-map >hashtable ; : multihex ( hexstring -- string ) " " split [ hex> ] map [ ] subset ;