! See http://factorcode.org/license.txt for BSD license.
USING: assocs bootstrap.image.private hash-sets hashtables init
io io.files kernel kernel.private make memory namespaces parser
-parser.notes sequences system vocabs vocabs.hierarchy
-vocabs.loader ;
+parser.notes sequences system vocabs vocabs.loader ;
IN: bootstrap.stage1
"Bootstrap stage 1..." print flush
"locals.fry" require
"locals.macros" require
-! "resource:core" disk-vocabs-in-root
-! [ vocab-prefix? ] reject
-! [ vocab-name "test" swap subseq? ] reject
-! require-all
-
"vocab:bootstrap/layouts.factor" parse-file %
[
[ drop ] recover ; inline
: ignore-error ( quot check: ( error -- ? ) -- )
- [ dup ] prepose [ [ drop ] [ rethrow ] if ] compose
- recover ; inline
+ '[ dup @ [ drop ] [ rethrow ] if ] recover ; inline
: ignore-error/f ( quot check: ( error -- ? ) -- )
- [ dup ] prepose [ [ drop f ] [ rethrow ] if ] compose
- recover ; inline
+ '[ dup @ [ drop f ] [ rethrow ] if ] recover ; inline
: cleanup ( try cleanup-always cleanup-error -- )
- [ compose [ dip rethrow ] curry recover ] [ drop ] 2bi call ; inline
+ [ '[ [ @ @ ] dip rethrow ] recover ] [ drop ] 2bi call ; inline
: finally ( try cleanup-always -- )
[ ] cleanup ; inline
attempt-all-error
] [
[
- [ [ , f ] compose [ , drop t ] recover ] curry all?
+ '[ [ @ , f ] [ , drop t ] recover ] all?
] { } make last swap [ rethrow ] when
] if ; inline
M: single-combination next-method-quot*
[
- 2dup next-method dup [
+ 2dup next-method [
[
- pick predicate-def %
+ [ picker % ] 3dip
+ [ dup predicate-def % ] 2dip
1quotation ,
[ inconsistent-next-method ] 2curry ,
\ if ,
- ] [ ] make picker prepend
- ] [ 3drop f ] if
+ ] [ ] make
+ ] [ 2drop f ] if*
] with-combination ;
: method-for-object ( obj word -- method )
bi or ;
M: single-combination make-default-method
- [ [ picker ] dip [ no-method ] curry append ] with-combination ;
+ [ [ picker ] dip '[ @ _ no-method ] ] with-combination ;
! ! ! Build an engine ! ! !
] if ; inline
: (rehash) ( seq hash -- )
- [ (adjoin) drop ] curry each ; inline
+ '[ _ (adjoin) drop ] each ; inline
: hash-large? ( hash -- ? )
[ count>> 1 fixnum+fast 3 fixnum*fast ]
[ array>> length>> 1 fixnum-shift-fast ] bi fixnum>= ; inline
: each-member ( ... array quot: ( ... elt -- ... ) -- ... )
- [ if ] curry [ dup tombstone? [ drop ] ] prepose each ; inline
+ '[ dup tombstone? [ drop ] _ if ] each ; inline
: grow-hash ( hash -- )
{ hash-set } declare [
<PRIVATE
: and-tombstones ( quot: ( elt -- ? ) -- quot: ( elt -- ? ) )
- [ if ] curry [ dup tombstone? [ drop t ] ] prepose ; inline
+ '[ dup tombstone? [ drop t ] _ if ] ; inline
: not-tombstones ( quot: ( elt -- ? ) -- quot: ( elt -- ? ) )
- [ if ] curry [ dup tombstone? [ drop f ] ] prepose ; inline
+ '[ dup tombstone? [ drop f ] _ if ] ; inline
: array/tester ( hash-set1 hash-set2 -- array quot )
- [ array>> ] dip [ in? ] curry ; inline
+ [ array>> ] dip '[ _ in? ] ; inline
: filter-members ( hash-set array quot: ( elt -- ? ) -- accum )
- [ dup ] prepose rot cardinality <vector> [
- [ push-unsafe ] curry [ [ drop ] if ] curry
- compose each
+ rot cardinality <vector> [
+ '[ dup @ [ _ push-unsafe ] [ drop ] if ] each
] keep ; inline
PRIVATE>
M: sequence fast-set >hash-set ;
M: sequence duplicates
- dup length <hash-set> [ ?adjoin ] curry reject ;
+ dup length <hash-set> '[ _ ?adjoin ] reject ;
M: sequence all-unique?
- dup length <hash-set> [ ?adjoin ] curry all? ;
+ dup length <hash-set> '[ _ ?adjoin ] all? ;
?members over adjoin-all ;
: diff! ( set1 set2 -- set1 )
- dupd sequence/tester [ dup ] prepose pick
- [ delete ] curry [ [ drop ] if ] curry compose each ;
+ dupd sequence/tester pick
+ '[ dup @ [ _ delete ] [ drop ] if ] each ;
: intersect! ( set1 set2 -- set1 )
- dupd sequence/tester [ dup ] prepose [ not ] compose pick
- [ delete ] curry [ [ drop ] if ] curry compose each ;
+ dupd sequence/tester pick
+ '[ dup @ [ drop ] [ _ delete ] if ] each ;