over push -> suffix!, over push-all -> append!
parent
bd13e018dd
commit
93de179c2f
|
@ -37,7 +37,7 @@ ERROR: no-such-symbol name library ;
|
|||
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
|
||||
|
||||
SYNTAX: &:
|
||||
scan "c-library" get '[ _ _ address-of ] over push-all ;
|
||||
scan "c-library" get '[ _ _ address-of ] append! ;
|
||||
|
||||
: global-quot ( type word -- quot )
|
||||
name>> "c-library" get '[ _ _ address-of 0 ]
|
||||
|
|
|
@ -350,7 +350,7 @@ PRIVATE>
|
|||
: parse-struct-slots ( slots -- slots' more? )
|
||||
scan {
|
||||
{ ";" [ f ] }
|
||||
{ "{" [ parse-struct-slot over push t ] }
|
||||
{ "{" [ parse-struct-slot suffix! t ] }
|
||||
{ f [ unexpected-eof ] }
|
||||
[ invalid-struct-slot ]
|
||||
} case ;
|
||||
|
@ -378,7 +378,7 @@ SYNTAX: S@
|
|||
|
||||
: parse-struct-slot` ( accum -- accum )
|
||||
scan-string-param scan-c-type` \ } parse-until
|
||||
[ <struct-slot-spec> over push ] 3curry over push-all ;
|
||||
[ <struct-slot-spec> suffix! ] 3curry append! ;
|
||||
|
||||
: parse-struct-slots` ( accum -- accum more? )
|
||||
scan {
|
||||
|
@ -390,9 +390,9 @@ PRIVATE>
|
|||
|
||||
FUNCTOR-SYNTAX: STRUCT:
|
||||
scan-param suffix!
|
||||
[ 8 <vector> ] over push-all
|
||||
[ 8 <vector> ] append!
|
||||
[ parse-struct-slots` ] [ ] while
|
||||
[ >array define-struct-class ] over push-all ;
|
||||
[ >array define-struct-class ] append! ;
|
||||
|
||||
USING: vocabs vocabs.loader ;
|
||||
|
||||
|
|
|
@ -53,4 +53,4 @@ M: callable deep-fry
|
|||
|
||||
M: object deep-fry , ;
|
||||
|
||||
SYNTAX: '[ parse-quotation fry over push-all ;
|
||||
SYNTAX: '[ parse-quotation fry append! ;
|
||||
|
|
|
@ -43,7 +43,7 @@ M: object (fake-quotations>) , ;
|
|||
|
||||
: parse-definition* ( accum -- accum )
|
||||
parse-definition >fake-quotations suffix!
|
||||
[ fake-quotations> first ] over push-all ;
|
||||
[ fake-quotations> first ] append! ;
|
||||
|
||||
: parse-declared* ( accum -- accum )
|
||||
complete-effect
|
||||
|
@ -74,7 +74,7 @@ FUNCTOR-SYNTAX: MIXIN:
|
|||
FUNCTOR-SYNTAX: M:
|
||||
scan-param suffix!
|
||||
scan-param suffix!
|
||||
[ create-method-in dup method-body set ] over push-all
|
||||
[ create-method-in dup method-body set ] append!
|
||||
parse-definition*
|
||||
\ define* suffix! ;
|
||||
|
||||
|
@ -82,7 +82,7 @@ FUNCTOR-SYNTAX: C:
|
|||
scan-param suffix!
|
||||
scan-param suffix!
|
||||
complete-effect
|
||||
[ [ [ boa ] curry ] over push-all ] dip suffix!
|
||||
[ [ [ boa ] curry ] append! ] dip suffix!
|
||||
\ define-declared* suffix! ;
|
||||
|
||||
FUNCTOR-SYNTAX: :
|
||||
|
@ -114,7 +114,7 @@ FUNCTOR-SYNTAX: MACRO:
|
|||
parse-declared*
|
||||
\ define-macro suffix! ;
|
||||
|
||||
FUNCTOR-SYNTAX: inline [ word make-inline ] over push-all ;
|
||||
FUNCTOR-SYNTAX: inline [ word make-inline ] append! ;
|
||||
|
||||
FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ;
|
||||
|
||||
|
|
|
@ -40,4 +40,4 @@ MACRO: interpolate ( string -- )
|
|||
|
||||
SYNTAX: I[
|
||||
"]I" parse-multiline-string
|
||||
interpolate-locals over push-all ;
|
||||
interpolate-locals append! ;
|
||||
|
|
|
@ -53,7 +53,7 @@ M: input-port stream-read-partial ( max stream -- byte-array/f )
|
|||
: read-loop ( count port accum -- )
|
||||
pick over length - dup 0 > [
|
||||
pick read-step dup [
|
||||
over push-all read-loop
|
||||
append! read-loop
|
||||
] [
|
||||
2drop 2drop
|
||||
] if
|
||||
|
@ -78,7 +78,7 @@ M: input-port stream-read
|
|||
|
||||
: read-until-loop ( seps port buf -- separator/f )
|
||||
2over read-until-step over [
|
||||
[ over push-all ] dip dup [
|
||||
[ append! ] dip dup [
|
||||
[ 3drop ] dip
|
||||
] [
|
||||
drop read-until-loop
|
||||
|
|
|
@ -9,13 +9,13 @@ SYNTAX: :>
|
|||
scan locals get [ :>-outside-lambda-error ] unless*
|
||||
[ make-local ] bind <def> suffix! ;
|
||||
|
||||
SYNTAX: [| parse-lambda over push-all ;
|
||||
SYNTAX: [| parse-lambda append! ;
|
||||
|
||||
SYNTAX: [let parse-let over push-all ;
|
||||
SYNTAX: [let parse-let append! ;
|
||||
|
||||
SYNTAX: [let* parse-let* over push-all ;
|
||||
SYNTAX: [let* parse-let* append! ;
|
||||
|
||||
SYNTAX: [wlet parse-wlet over push-all ;
|
||||
SYNTAX: [wlet parse-wlet append! ;
|
||||
|
||||
SYNTAX: :: (::) define-declared ;
|
||||
|
||||
|
|
|
@ -40,7 +40,7 @@ M: just-parser (compile) ( parser -- quot )
|
|||
<PRIVATE
|
||||
|
||||
: flatten-vectors ( pair -- vector )
|
||||
first2 over push-all ;
|
||||
first2 append! ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -634,7 +634,7 @@ SYNTAX: PEG:
|
|||
word swap effect define-declared
|
||||
]
|
||||
] with-compilation-unit
|
||||
] over push-all
|
||||
] append!
|
||||
] ;
|
||||
|
||||
USING: vocabs vocabs.loader ;
|
||||
|
|
|
@ -19,7 +19,7 @@ M: object random-bytes* ( n tuple -- byte-array )
|
|||
[ pick '[ _ random-32* 4 >le _ push-all ] times ]
|
||||
[
|
||||
over zero?
|
||||
[ 2drop ] [ random-32* 4 >le swap head over push-all ] if
|
||||
[ 2drop ] [ random-32* 4 >le swap head append! ] if
|
||||
] bi-curry bi* ;
|
||||
|
||||
M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ;
|
||||
|
|
|
@ -43,7 +43,7 @@ MEMO: standard-rule-set ( id -- ruleset )
|
|||
|
||||
: ?push-all ( seq1 seq2 -- seq1+seq2 )
|
||||
[
|
||||
over [ [ V{ } like ] dip over push-all ] [ nip ] if
|
||||
over [ [ V{ } like ] dip append! ] [ nip ] if
|
||||
] when* ;
|
||||
|
||||
: rule-set-no-word-sep* ( ruleset -- str )
|
||||
|
|
|
@ -35,4 +35,4 @@ ERROR: stack-effect-omits-dashes effect ;
|
|||
"(" expect ")" parse-effect ;
|
||||
|
||||
: parse-call( ( accum word -- accum )
|
||||
[ ")" parse-effect ] dip 2array over push-all ;
|
||||
[ ")" parse-effect ] dip 2array append! ;
|
||||
|
|
|
@ -741,7 +741,7 @@ PRIVATE>
|
|||
: concat-as ( seq exemplar -- newseq )
|
||||
swap [ { } ] [
|
||||
[ sum-lengths over new-resizable ] keep
|
||||
[ over push-all ] each
|
||||
[ append! ] each
|
||||
] if-empty swap like ;
|
||||
|
||||
: concat ( seq -- newseq )
|
||||
|
|
|
@ -4,10 +4,10 @@ SYMBOL: |
|
|||
|
||||
! Selective Binding
|
||||
: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ;
|
||||
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
|
||||
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with append! ;
|
||||
! Common ones
|
||||
SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
|
||||
SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with append! ;
|
||||
|
||||
! Namespace Binding
|
||||
: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ;
|
||||
SYNTAX: NS[ parse-quotation bind-to-namespace over push-all ;
|
||||
SYNTAX: NS[ parse-quotation bind-to-namespace append! ;
|
||||
|
|
|
@ -13,4 +13,4 @@ SYNTAX: FONT: \ ; parse-until {
|
|||
[ [ italic = ] find nip [ >>italic? ] install ]
|
||||
[ [ bold = ] find nip [ >>bold? ] install ]
|
||||
[ [ fontname? ] find nip [ >>name* ] install ]
|
||||
} cleave 4array concat '[ dup font>> @ drop ] over push-all ;
|
||||
} cleave 4array concat '[ dup font>> @ drop ] append! ;
|
||||
|
|
|
@ -8,6 +8,6 @@ IN: fries
|
|||
[ unclip-last [ [ spin 1array glue ] reduce-r ] 2curry ]
|
||||
[ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
|
||||
|
||||
SYNTAX: i" parse-string rest "_" str-fry over push-all ;
|
||||
SYNTAX: i{ \ } parse-until >array { _ } gen-fry over push-all ;
|
||||
SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry over push-all ;
|
||||
SYNTAX: i" parse-string rest "_" str-fry append! ;
|
||||
SYNTAX: i{ \ } parse-until >array { _ } gen-fry append! ;
|
||||
SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry append! ;
|
||||
|
|
|
@ -107,7 +107,7 @@ UNIFORM-TUPLE: loading-uniforms
|
|||
[
|
||||
numbers {
|
||||
{ [ dup length 5 = ] [ <bunny-vertex> pick push ] }
|
||||
{ [ dup first 3 = ] [ rest over push-all ] }
|
||||
{ [ dup first 3 = ] [ rest append! ] }
|
||||
[ drop ]
|
||||
} cond
|
||||
] each-line-tokens ; inline
|
||||
|
|
|
@ -93,4 +93,4 @@ PRIVATE>
|
|||
|
||||
SYNTAX: [infix|
|
||||
"|" parse-bindings "infix]" parse-infix-locals <let>
|
||||
?rewrite-closures over push-all ;
|
||||
?rewrite-closures append! ;
|
||||
|
|
|
@ -24,7 +24,7 @@ IN: project-euler.017
|
|||
! --------
|
||||
|
||||
: euler017 ( -- answer )
|
||||
1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
|
||||
1000 [1,b] SBUF" " clone [ number>text append! ] reduce [ Letter? ] count ;
|
||||
|
||||
! [ euler017 ] 100 ave-time
|
||||
! 15 ms ave run time - 1.71 SD (100 trials)
|
||||
|
|
|
@ -39,7 +39,7 @@ IN: project-euler.038
|
|||
pick length 8 > [
|
||||
2drop 10 digits>integer
|
||||
] [
|
||||
[ * number>digits over push-all ] 2keep 1 + (concat-product)
|
||||
[ * number>digits append! ] 2keep 1 + (concat-product)
|
||||
] if ;
|
||||
|
||||
: concat-product ( n -- m )
|
||||
|
|
|
@ -28,7 +28,7 @@ IN: project-euler.040
|
|||
|
||||
: (concat-upto) ( n limit str -- str )
|
||||
2dup length > [
|
||||
pick number>string over push-all rot 1 + -rot (concat-upto)
|
||||
pick number>string append! [ 1 + ] 2dip (concat-upto)
|
||||
] [
|
||||
2nip
|
||||
] if ;
|
||||
|
|
|
@ -59,9 +59,9 @@ M: model-field model-changed 2dup model*>> =
|
|||
: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
|
||||
|
||||
: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
|
||||
SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry over push-all ;
|
||||
SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry append! ;
|
||||
|
||||
SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
|
||||
SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry append! ;
|
||||
|
||||
GENERIC: output-model ( gadget -- model )
|
||||
M: gadget output-model model>> ;
|
||||
|
|
|
@ -26,8 +26,8 @@ DEFER: with-interface
|
|||
: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
|
||||
templates get spin '[ [ _ templates set _ , @ ] with-interface ] ] when* ;
|
||||
|
||||
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
|
||||
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
|
||||
SYNTAX: ,% scan string>number [ <layout> , ] curry append! ;
|
||||
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] append! ;
|
||||
|
||||
GENERIC: -> ( uiitem -- model )
|
||||
M: gadget -> dup , output-model ;
|
||||
|
@ -55,7 +55,7 @@ M: model -> dup , ;
|
|||
ERROR: not-in-template word ;
|
||||
SYNTAX: $ CREATE-WORD dup
|
||||
[ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
|
||||
[ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi over push-all ;
|
||||
[ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi append! ;
|
||||
|
||||
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
|
||||
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
|
||||
|
|
Loading…
Reference in New Issue