]> gitweb.factorcode.org Git - factor.git/commitdiff
slots: remove uses of "[ ] make".
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 20 Nov 2020 00:52:37 +0000 (16:52 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 20 Nov 2020 00:52:37 +0000 (16:52 -0800)
core/slots/slots.factor

index edcdff92ee4020fd3792cf4bace9520d255b3ad1..c0812b5d127a49fc5689661a82fa822b8d9790fc 100644 (file)
@@ -1,11 +1,10 @@
 ! Copyright (C) 2005, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-! IN: alien DEFER: pinned-alien DEFER: <bad-alien> ! for bootstrap
 USING: accessors alien arrays assocs byte-arrays classes
 classes.algebra classes.algebra.private classes.maybe
 combinators generic generic.standard hashtables kernel
-kernel.private make math quotations sequences sequences.private
-slots.private strings words ;
+kernel.private math quotations sequences sequences.private
+strings words ;
 IN: slots
 
 <PRIVATE
@@ -37,12 +36,9 @@ PREDICATE: writer-method < method "writing" word-prop >boolean ;
 GENERIC#: reader-quot 1 ( class slot-spec -- quot )
 
 M: object reader-quot
-    nip [
-        dup offset>> ,
-        \ slot ,
-        dup class>> object bootstrap-word eq?
-        [ drop ] [ class>> 1array , \ declare , ] if
-    ] [ ] make ;
+    nip [ offset>> [ slot ] curry ] [ class>> ] bi
+    dup object bootstrap-word eq?
+    [ drop ] [ 1array [ declare ] curry compose ] if ;
 
 : reader-word ( name -- word )
     ">>" append "accessors" create-word
@@ -81,12 +77,8 @@ M: class instance-check-quot
     } cond ;
 
 M: object instance-check-quot
-    [
-        \ dup ,
-        [ predicate-def % ]
-        [ [ bad-slot-value ] curry , ] bi
-        \ unless ,
-    ] [ ] make ;
+    [ predicate-def [ dup ] prepose ] keep
+    [ bad-slot-value ] curry [ unless ] curry compose ;
 
 GENERIC#: writer-quot 1 ( class slot-spec -- quot )
 
@@ -117,7 +109,7 @@ M: object writer-quot
 
 : define-setter ( name -- )
     dup setter-word dup deferred? [
-        [ \ over , swap writer-word , ] [ ] make
+        swap writer-word 1quotation [ over ] prepose
         ( object value -- object ) define-inline
     ] [ 2drop ] if ;
 
@@ -126,12 +118,10 @@ M: object writer-quot
 
 : define-changer ( name -- )
     dup changer-word dup deferred? [
-        [
-            \ over ,
-            over reader-word 1quotation
-            [ dip call ] curry [ ] like [ dip swap ] curry %
-            swap setter-word ,
-        ] [ ] make ( object quot -- object ) define-inline
+        over reader-word 1quotation
+        [ dip call ] curry [ dip swap ] curry [ over ] prepose
+        rot setter-word 1quotation compose
+        ( object quot -- object ) define-inline
     ] [ 2drop ] if ;
 
 : define-slot-methods ( class slot-spec -- )