]> gitweb.factorcode.org Git - factor.git/commitdiff
core: using fry in a few places to see how it works.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 19 Nov 2020 04:41:34 +0000 (20:41 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 19 Nov 2020 04:41:34 +0000 (20:41 -0800)
core/bootstrap/stage1.factor
core/continuations/continuations.factor
core/generic/single/single.factor
core/hash-sets/hash-sets.factor
core/sets/sets.factor

index 9151aae85506ae726e6d14e1a2023d24aa4347e7..df26a6cb556770dd75f3dac758dd11c65c403c14 100644 (file)
@@ -2,8 +2,7 @@
 ! 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
@@ -39,11 +38,6 @@ load-help? off
     "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 %
 
     [
index 577ae71aaf669451572db5439d032d70bc7cb419..12bb976a0aeeb7a41ec12322bb1ea938540ce6b0 100644 (file)
@@ -151,15 +151,13 @@ callback-error-hook [ [ die rethrow ] ] initialize
     [ 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
@@ -171,7 +169,7 @@ ERROR: attempt-all-error ;
         attempt-all-error
     ] [
         [
-            [ [ , f ] compose [ , drop t ] recover ] curry all?
+            '[ [ @ , f ] [ , drop t ] recover ] all?
         ] { } make last swap [ rethrow ] when
     ] if ; inline
 
index 4dec5b9d83debe2ba58b1e184bfdae055ab3d776..7d38b2c603516aadfd5bc438283ce6e94552451c 100644 (file)
@@ -41,14 +41,15 @@ HOOK: picker combination ( -- quot )
 
 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 )
@@ -59,7 +60,7 @@ M: single-combination next-method-quot*
     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 ! ! !
 
index aec8aa77f1994f100e1b96a2eeb8fbed33f08197..00b72ff75f32c312e327e9aa5dacabd76767cd59 100644 (file)
@@ -74,14 +74,14 @@ TUPLE: hash-set
     ] 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 [
@@ -147,18 +147,17 @@ INSTANCE: hash-set set
 <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>
@@ -213,7 +212,7 @@ M: f fast-set drop 0 <hash-set> ;
 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? ;
index 990b33d6f8058e95789ce7a093756df04eb865f4..a42cf6dfd854be2604ab360fce3ad38bf43937e3 100644 (file)
@@ -163,9 +163,9 @@ M: sequence clear-set
     ?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 ;