Rename substitute to substitute-here, change stack effect, update some libraries to use it
parent
ee0536e649
commit
c4ac180c5a
|
@ -59,6 +59,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs"
|
||||||
{ $subsection diff }
|
{ $subsection diff }
|
||||||
{ $subsection remove-all }
|
{ $subsection remove-all }
|
||||||
{ $subsection substitute }
|
{ $subsection substitute }
|
||||||
|
{ $subsection substitute-here }
|
||||||
{ $see-also key? } ;
|
{ $see-also key? } ;
|
||||||
|
|
||||||
ARTICLE: "assocs-mutation" "Storing keys and values in assocs"
|
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." }
|
{ $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" } ;
|
{ $side-effects "assoc" } ;
|
||||||
|
|
||||||
HELP: substitute
|
HELP: substitute-here
|
||||||
{ $values { "assoc" assoc } { "seq" "a mutable sequence" } }
|
{ $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" } "." }
|
{ $errors "Throws an error if " { $snippet "assoc" } " contains values whose types are not permissible in " { $snippet "seq" } "." }
|
||||||
{ $side-effects "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
|
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" } }
|
{ $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." }
|
{ $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." }
|
||||||
|
|
|
@ -124,8 +124,14 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
||||||
: remove-all ( assoc seq -- subseq )
|
: remove-all ( assoc seq -- subseq )
|
||||||
swap [ key? not ] curry subset ;
|
swap [ key? not ] curry subset ;
|
||||||
|
|
||||||
: substitute ( assoc seq -- )
|
: (substitute)
|
||||||
swap [ dupd at* [ nip ] [ drop ] if ] curry change-each ;
|
[ 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 )
|
: cache ( key assoc quot -- value )
|
||||||
2over at [
|
2over at [
|
||||||
|
|
|
@ -504,7 +504,7 @@ M: loc lazy-store
|
||||||
: substitute-vregs ( values vregs -- )
|
: substitute-vregs ( values vregs -- )
|
||||||
[ vreg-substitution ] 2map
|
[ vreg-substitution ] 2map
|
||||||
[ substitute-vreg? ] assoc-subset >hashtable
|
[ substitute-vreg? ] assoc-subset >hashtable
|
||||||
[ swap substitute ] curry each-phantom ;
|
[ substitute-here ] curry each-phantom ;
|
||||||
|
|
||||||
: set-operand ( value var -- )
|
: set-operand ( value var -- )
|
||||||
>r dup constant? [ constant-value ] when r> set ;
|
>r dup constant? [ constant-value ] when r> set ;
|
||||||
|
|
|
@ -37,10 +37,10 @@ GENERIC: optimize-node* ( node -- node/t changed? )
|
||||||
over assoc-empty? [
|
over assoc-empty? [
|
||||||
2drop
|
2drop
|
||||||
] [
|
] [
|
||||||
2dup node-in-d substitute
|
2dup node-in-d substitute-here
|
||||||
2dup node-in-r substitute
|
2dup node-in-r substitute-here
|
||||||
2dup node-out-d substitute
|
2dup node-out-d substitute-here
|
||||||
node-out-r substitute
|
node-out-r substitute-here
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: perform-substitutions ( node -- )
|
: perform-substitutions ( node -- )
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
|
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: namespaces splitting sequences io.files kernel assocs
|
USING: namespaces sequences io.files kernel assocs words vocabs
|
||||||
words vocabs definitions parser continuations inspector debugger
|
definitions parser continuations inspector debugger io io.styles
|
||||||
io io.styles io.streams.lines hashtables sorting prettyprint
|
io.streams.lines hashtables sorting prettyprint source-files
|
||||||
source-files arrays combinators strings system math.parser
|
arrays combinators strings system math.parser compiler.errors
|
||||||
compiler.errors ;
|
splitting ;
|
||||||
IN: vocabs.loader
|
IN: vocabs.loader
|
||||||
|
|
||||||
SYMBOL: vocab-roots
|
SYMBOL: vocab-roots
|
||||||
|
@ -16,7 +16,7 @@ V{
|
||||||
} clone vocab-roots set-global
|
} clone vocab-roots set-global
|
||||||
|
|
||||||
: vocab-dir ( vocab -- dir )
|
: vocab-dir ( vocab -- dir )
|
||||||
vocab-name "." split "/" join ;
|
vocab-name { { CHAR: . CHAR: / } } substitute ;
|
||||||
|
|
||||||
: vocab-dir+ ( vocab str/f -- path )
|
: vocab-dir+ ( vocab str/f -- path )
|
||||||
>r vocab-name "." split r>
|
>r vocab-name "." split r>
|
||||||
|
|
|
@ -205,6 +205,3 @@ PRIVATE>
|
||||||
|
|
||||||
: attempt-each ( seq quot -- result )
|
: attempt-each ( seq quot -- result )
|
||||||
(each) iterate-prep (attempt-each-integer) ; inline
|
(each) iterate-prep (attempt-each-integer) ; inline
|
||||||
|
|
||||||
: replace ( seq old new -- newseq )
|
|
||||||
[ pick pick = [ 2nip ] [ 2drop ] if ] 2curry map ;
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.files io words alien kernel math.parser alien.syntax
|
USING: io.files io words alien kernel math.parser alien.syntax
|
||||||
io.launcher system assocs arrays sequences namespaces qualified
|
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: tools.disassembler
|
||||||
|
|
||||||
: in-file "gdb-in.txt" resource-path ;
|
: in-file "gdb-in.txt" resource-path ;
|
||||||
|
@ -31,7 +31,7 @@ M: pair make-disassemble-cmd
|
||||||
out-file file-lines ;
|
out-file file-lines ;
|
||||||
|
|
||||||
: tabs>spaces ( str -- str' )
|
: tabs>spaces ( str -- str' )
|
||||||
CHAR: \t CHAR: \s replace ;
|
{ { CHAR: \t CHAR: \s } } substitute ;
|
||||||
|
|
||||||
: disassemble ( word -- )
|
: disassemble ( word -- )
|
||||||
make-disassemble-cmd run-gdb
|
make-disassemble-cmd run-gdb
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
USING: assocs math kernel sequences sequences.lib io.files
|
USING: assocs math kernel sequences io.files hashtables
|
||||||
hashtables quotations splitting arrays math.parser
|
quotations splitting arrays math.parser combinators.lib hash2
|
||||||
combinators.lib hash2 byte-arrays words namespaces words
|
byte-arrays words namespaces words compiler.units parser ;
|
||||||
compiler.units parser ;
|
|
||||||
IN: unicode.data
|
IN: unicode.data
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
@ -68,7 +67,7 @@ IN: unicode.data
|
||||||
: process-combining ( data -- hash )
|
: process-combining ( data -- hash )
|
||||||
3 swap (process-data)
|
3 swap (process-data)
|
||||||
[ string>number ] assoc-map
|
[ string>number ] assoc-map
|
||||||
[ nip 0 = not ] assoc-subset
|
[ nip zero? not ] assoc-subset
|
||||||
>hashtable ;
|
>hashtable ;
|
||||||
|
|
||||||
: categories ( -- names )
|
: categories ( -- names )
|
||||||
|
@ -95,9 +94,9 @@ IN: unicode.data
|
||||||
[ dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ] map ;
|
[ dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ] map ;
|
||||||
|
|
||||||
: process-names ( data -- names-hash )
|
: process-names ( data -- names-hash )
|
||||||
1 swap (process-data)
|
1 swap (process-data) [
|
||||||
[ ascii-lower CHAR: \s CHAR: - replace swap ] assoc-map
|
ascii-lower { { CHAR: \s CHAR: - } } substitute swap
|
||||||
>hashtable ;
|
] assoc-map >hashtable ;
|
||||||
|
|
||||||
: multihex ( hexstring -- string )
|
: multihex ( hexstring -- string )
|
||||||
" " split [ hex> ] map [ ] subset ;
|
" " split [ hex> ] map [ ] subset ;
|
||||||
|
|
Loading…
Reference in New Issue