Clean up kernel vocab

db4
Slava Pestov 2009-02-06 05:12:30 -06:00
parent dd9cf39467
commit aed691dab3
1 changed files with 33 additions and 33 deletions

View File

@ -138,39 +138,6 @@ DEFER: if
: 2tri@ ( u v w y x z quot -- )
dup dup 2tri* ; inline
! Object protocol
GENERIC: hashcode* ( depth obj -- code )
M: object hashcode* 2drop 0 ;
M: f hashcode* 2drop 31337 ;
: hashcode ( obj -- code ) 3 swap hashcode* ; inline
GENERIC: equal? ( obj1 obj2 -- ? )
M: object equal? 2drop f ;
TUPLE: identity-tuple ;
M: identity-tuple equal? 2drop f ;
: = ( obj1 obj2 -- ? )
2dup eq? [ 2drop t ] [
2dup both-fixnums? [ 2drop f ] [ equal? ] if
] if ; inline
GENERIC: clone ( obj -- cloned )
M: object clone ;
M: callstack clone (clone) ;
! Tuple construction
GENERIC: new ( class -- tuple )
GENERIC: boa ( ... class -- tuple )
! Quotation building
: 2curry ( obj1 obj2 quot -- curry )
curry curry ; inline
@ -238,6 +205,39 @@ PRIVATE>
: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
[ [ not ] compose ] 2dip while ; inline
! Object protocol
GENERIC: hashcode* ( depth obj -- code )
M: object hashcode* 2drop 0 ;
M: f hashcode* 2drop 31337 ;
: hashcode ( obj -- code ) 3 swap hashcode* ; inline
GENERIC: equal? ( obj1 obj2 -- ? )
M: object equal? 2drop f ;
TUPLE: identity-tuple ;
M: identity-tuple equal? 2drop f ;
: = ( obj1 obj2 -- ? )
2dup eq? [ 2drop t ] [
2dup both-fixnums? [ 2drop f ] [ equal? ] if
] if ; inline
GENERIC: clone ( obj -- cloned )
M: object clone ;
M: callstack clone (clone) ;
! Tuple construction
GENERIC: new ( class -- tuple )
GENERIC: boa ( ... class -- tuple )
! Error handling -- defined early so that other files can
! throw errors before continuations are loaded
: throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;