Tweaking some declarations

slava 2006-05-02 10:05:58 +00:00
parent fd3f37c8e3
commit adca3c8464
7 changed files with 42 additions and 29 deletions

View File

@ -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

View File

@ -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

View File

@ -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> ;

View File

@ -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 ;

View File

@ -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 [

View File

@ -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

View File

@ -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