Tweaking some declarations
parent
fd3f37c8e3
commit
adca3c8464
|
@ -13,7 +13,7 @@ GENERIC: set-fill
|
|||
: capacity ( seq -- n ) underlying length ; inline
|
||||
|
||||
: expand ( len seq -- )
|
||||
[ underlying resize ] keep set-underlying ;
|
||||
[ underlying resize ] keep set-underlying ; inline
|
||||
|
||||
: new-size ( n -- n ) 3 * dup 50 < [ drop 50 ] when ;
|
||||
|
||||
|
@ -22,7 +22,7 @@ GENERIC: set-fill
|
|||
>r 1+ r>
|
||||
2dup capacity > [ over new-size over expand ] when
|
||||
2dup set-fill
|
||||
] when 2drop ;
|
||||
] when 2drop ; inline
|
||||
|
||||
TUPLE: bounds-error index seq ;
|
||||
|
||||
|
@ -35,7 +35,8 @@ TUPLE: bounds-error index seq ;
|
|||
2dup bounds-check? [ bounds-error ] unless ; inline
|
||||
|
||||
: grow-length ( len seq -- )
|
||||
growable-check 2dup capacity > [ 2dup expand ] when set-fill ;
|
||||
growable-check 2dup capacity > [ 2dup expand ] when set-fill
|
||||
; inline
|
||||
|
||||
: clone-growable ( obj -- obj )
|
||||
(clone) dup underlying clone over set-underlying ;
|
||||
(clone) dup underlying clone over set-underlying ; inline
|
||||
|
|
|
@ -1,19 +1,23 @@
|
|||
! Copyright (C) 2003, 2005 Slava Pestov.
|
||||
! Copyright (C) 2003, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: kernel-internals
|
||||
USING: vectors ;
|
||||
|
||||
: namestack* ( -- ns ) 3 getenv { vector } declare ; inline
|
||||
|
||||
IN: namespaces
|
||||
USING: arrays hashtables kernel kernel-internals lists math
|
||||
sequences strings vectors words ;
|
||||
sequences strings words ;
|
||||
|
||||
: namestack* ( -- ns ) 3 getenv ; inline
|
||||
: namestack ( -- ns ) namestack* clone ; inline
|
||||
: set-namestack ( ns -- ) clone 3 setenv ; inline
|
||||
: namespace ( -- namespace ) namestack* peek ; inline
|
||||
: >n ( namespace -- n:namespace ) namestack* push ; inline
|
||||
: n> ( n:namespace -- namespace ) namestack* pop ; inline
|
||||
: ndrop ( n:namespace -- ) namestack* pop* ; inline
|
||||
: global ( -- g ) 4 getenv ; inline
|
||||
: set-namestack ( ns -- ) >vector 3 setenv ; inline
|
||||
: namespace ( -- namespace ) namestack* peek ;
|
||||
: >n ( namespace -- n:namespace ) namestack* push ;
|
||||
: n> ( n:namespace -- namespace ) namestack* pop ;
|
||||
: ndrop ( n:namespace -- ) namestack* pop* ;
|
||||
: global ( -- g ) 4 getenv { hashtable } declare ; inline
|
||||
: get ( variable -- value ) namestack* hash-stack ; flushable
|
||||
: set ( value variable -- ) namespace set-hash ;
|
||||
: set ( value variable -- ) namespace set-hash ; inline
|
||||
: on ( var -- ) t swap set ; inline
|
||||
: off ( var -- ) f swap set ; inline
|
||||
: get-global ( var -- value ) global hash ; inline
|
||||
|
|
|
@ -5,13 +5,13 @@ USING: errors generic kernel kernel-internals math
|
|||
sequences-internals strings vectors words ;
|
||||
|
||||
: first2 ( { x y } -- x y )
|
||||
1 swap bounds-check nip first2-unsafe ; inline
|
||||
1 swap bounds-check nip first2-unsafe ; flushable
|
||||
|
||||
: first3 ( { x y z } -- x y z )
|
||||
2 swap bounds-check nip first3-unsafe ; inline
|
||||
2 swap bounds-check nip first3-unsafe ; flushable
|
||||
|
||||
: first4 ( { x y z w } -- x y z w )
|
||||
3 swap bounds-check nip first4-unsafe ; inline
|
||||
3 swap bounds-check nip first4-unsafe ; flushable
|
||||
|
||||
M: object like drop ;
|
||||
|
||||
|
@ -93,10 +93,10 @@ M: object like drop ;
|
|||
: pop* ( sequence -- )
|
||||
[ length 1- ] keep
|
||||
[ 0 -rot set-nth ] 2keep
|
||||
set-length ; inline
|
||||
set-length ;
|
||||
|
||||
: pop ( sequence -- element )
|
||||
dup peek swap pop* ; inline
|
||||
dup peek swap pop* ;
|
||||
|
||||
M: object reverse-slice ( seq -- seq ) <reversed> ;
|
||||
|
||||
|
|
|
@ -12,7 +12,7 @@ GENERIC: like ( seq seq -- seq ) flushable
|
|||
GENERIC: reverse ( seq -- seq ) flushable
|
||||
GENERIC: reverse-slice ( seq -- seq ) flushable
|
||||
|
||||
: empty? ( seq -- ? ) length zero? ;
|
||||
: empty? ( seq -- ? ) length zero? ; inline
|
||||
|
||||
: first 0 swap nth ; inline
|
||||
: second 1 swap nth ; inline
|
||||
|
@ -20,7 +20,7 @@ GENERIC: reverse-slice ( seq -- seq ) flushable
|
|||
: fourth 3 swap nth ; inline
|
||||
|
||||
: push ( element sequence -- )
|
||||
dup length swap set-nth ; inline
|
||||
dup length swap set-nth ;
|
||||
|
||||
: ?push ( elt seq/f -- seq )
|
||||
[ 1 <vector> ] unless* [ push ] keep ;
|
||||
|
|
|
@ -65,7 +65,7 @@ M: #dispatch node>quot ( ? node -- )
|
|||
M: #return node>quot ( ? node -- )
|
||||
dup node-param unparse "#return " swap append comment, ;
|
||||
|
||||
M: object node>quot ( ? node -- ) dup class comment, ;
|
||||
M: object node>quot ( ? node -- ) dup class word-name comment, ;
|
||||
|
||||
: (dataflow>quot) ( ? node -- )
|
||||
dup [
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: compiler
|
||||
USING: arrays generic hashtables kernel math namespaces
|
||||
sequences words ;
|
||||
sequences vectors words ;
|
||||
|
||||
: make-specializer ( quot class picker -- quot )
|
||||
over \ object eq? [
|
||||
|
@ -33,9 +33,13 @@ sequences words ;
|
|||
{ array array } "specializer" set-word-prop
|
||||
] each
|
||||
|
||||
\ hash* { object hashtable } "specializer" set-word-prop
|
||||
\ remove-hash { object hashtable } "specializer" set-word-prop
|
||||
\ set-hash { object object hashtable } "specializer" set-word-prop
|
||||
{ hash* remove-hash set-hash } [
|
||||
{ hashtable } "specializer" set-word-prop
|
||||
] each
|
||||
|
||||
{ first first2 first3 first4 }
|
||||
[ { array } "specializer" set-word-prop ] each
|
||||
|
||||
{ peek pop* pop push } [
|
||||
{ vector } "specializer" set-word-prop
|
||||
] each
|
||||
|
|
|
@ -1,9 +1,13 @@
|
|||
! Copyright (C) 2003, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
! Copyright (C) 2003, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: kernel-internals
|
||||
USING: vectors ;
|
||||
|
||||
: catchstack* ( -- cs ) 6 getenv { vector } declare ; inline
|
||||
|
||||
IN: errors
|
||||
USING: kernel kernel-internals ;
|
||||
|
||||
: catchstack* ( -- cs ) 6 getenv ; inline
|
||||
: catchstack ( -- cs ) catchstack* clone ; inline
|
||||
: set-catchstack ( cs -- ) clone 6 setenv ; inline
|
||||
|
||||
|
|
Loading…
Reference in New Issue