Minor updates

diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor
index ea41dc54360a1e6e18b64c287edfcf625c15aeb4..61ebe744f8e45b2bb83ff4b024aa411f7020c1dc 100755 (executable)
--- a/basis/float-arrays/float-arrays.factor
+++ b/basis/float-arrays/float-arrays.factor
@@ -68,9 +68,10 @@ M: float-array >pprint-sequence ;
 USING: hints math.vectors arrays ;
 
 HINTS: vneg { float-array } { array } ;
-HINTS: v*n { float-array object } { array object } ;
-HINTS: v/n { float-array object } { array object } ;
-HINTS: n/v { object float-array } { object array } ;
+HINTS: v*n { float-array float } { array object } ;
+HINTS: n*v { float float-array } { array object } ;
+HINTS: v/n { float-array float } { array object } ;
+HINTS: n/v { float float-array } { object array } ;
 HINTS: v+ { float-array float-array } { array array } ;
 HINTS: v- { float-array float-array } { array array } ;
 HINTS: v* { float-array float-array } { array array } ;

diff --git a/basis/ui/gadgets/canvas/canvas.factor b/basis/ui/gadgets/canvas/canvas.factor
index cfc7c4cfd6e5596450adc38495b4d92fb58b9eee..ba5aeaf95b30d78b5331814a21a1591e04cbbc96 100644 (file)
--- a/basis/ui/gadgets/canvas/canvas.factor
+++ b/basis/ui/gadgets/canvas/canvas.factor
@@ -7,9 +7,8 @@ IN: ui.gadgets.canvas
 
 TUPLE: canvas < gadget dlist ;
 
-: <canvas> ( -- canvas )
-    canvas new-gadget
-    black solid-interior ;
+: new-canvas ( class -- canvas )
+    new-gadget black solid-interior ; inline
 
 : delete-canvas-dlist ( canvas -- )
     dup find-gl-context

diff --git a/basis/ui/gadgets/handler/handler.factor b/basis/ui/gadgets/handler/handler.factor
index bff03c7d9f1b672c569ae8e5665cd1a177b22037..1ad50630135cec6c5b8533abfc51971ff54de2ba 100644 (file)
--- a/basis/ui/gadgets/handler/handler.factor
+++ b/basis/ui/gadgets/handler/handler.factor
@@ -7,5 +7,5 @@ TUPLE: handler < wrapper table ;
 
 : <handler> ( child -- handler ) handler new-wrapper ;
 
-M: handler handle-gesture* ( gadget gesture delegate -- ? )
-   table>> at dup [ call f ] [ 2drop t ] if ;
\ No newline at end of file
+M: handler handle-gesture ( gesture gadget -- ? )
+   over table>> at dup [ call f ] [ 2drop t ] if ;
\ No newline at end of file

diff --git a/basis/units/units.factor b/basis/units/units.factor
index 251a4e9b473738cbe633141c375dfe98e965f8f8..fb93691f0a5906e4e79be65d3f3c39df2600914a 100755 (executable)
--- a/basis/units/units.factor
+++ b/basis/units/units.factor
@@ -33,7 +33,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
 \ <dimensioned> [ >dimensioned< ] define-inverse
 
 : dimensions ( dimensioned -- top bot )
-    { dimensioned-top dimensioned-bot } get-slots ;
+    [ top>> ] [ bot>> ] bi ;
 
 : check-dimensions ( d d -- )
     [ dimensions 2array ] bi@ =

diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor
index 7d7ec244fbcde15a239fdefd10187b005effd3c9..d22f339ed4151c2f7f9673971d1be6607fc9e810 100755 (executable)
--- a/extra/benchmark/raytracer/raytracer.factor
+++ b/extra/benchmark/raytracer/raytracer.factor
@@ -1,9 +1,9 @@
 ! Factor port of the raytracer benchmark from
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
 
-USING: float-arrays compiler generic io io.files kernel math
-math.functions math.vectors math.parser namespaces sequences
-sequences.private words io.encodings.binary ;
+USING: arrays accessors float-arrays io io.files
+io.encodings.binary kernel math math.functions math.vectors
+math.parser namespaces sequences sequences.private words ;
 IN: benchmark.raytracer
 
 ! parameters
@@ -23,32 +23,33 @@ IN: benchmark.raytracer
 
 : delta 1.4901161193847656E-8 ; inline
 
-TUPLE: ray orig dir ;
+TUPLE: ray { orig float-array read-only } { dir float-array read-only } ;
 
 C: <ray> ray
 
-TUPLE: hit normal lambda ;
+TUPLE: hit { normal float-array read-only } { lambda float read-only } ;
 
 C: <hit> hit
 
 GENERIC: intersect-scene ( hit ray scene -- hit )
 
-TUPLE: sphere center radius ;
+TUPLE: sphere { center float-array read-only } { radius float read-only } ;
 
 C: <sphere> sphere
 
 : sphere-v ( sphere ray -- v )
-    swap sphere-center swap ray-orig v- ; inline
+    swap center>> swap orig>> v- ; inline
 
-: sphere-b ( ray v -- b ) swap ray-dir v. ; inline
+: sphere-b ( ray v -- b ) swap dir>> v. ; inline
 
 : sphere-disc ( sphere v b -- d )
-    sq swap norm-sq - swap sphere-radius sq + ; inline
+    sq swap norm-sq - swap radius>> sq + ; inline
 
 : -+ ( x y -- x-y x+y ) [ - ] 2keep + ; inline
 
 : sphere-b/d ( b d -- t )
-    -+ dup 0.0 < [ 2drop 1.0/0.0 ] [ >r [ 0.0 > ] keep r> ? ] if ; inline
+    -+ dup 0.0 <
+    [ 2drop 1.0/0.0 ] [ [ [ 0.0 > ] keep ] dip ? ] if ; inline
 
 : ray-sphere ( sphere ray -- t )
     2dup sphere-v tuck sphere-b [ sphere-disc ] keep
@@ -56,29 +57,31 @@ C: <sphere> sphere
     inline
 
 : sphere-n ( ray sphere l -- n )
-    pick ray-dir n*v swap sphere-center v- swap ray-orig v+ ;
+    pick dir>> n*v swap center>> v- swap orig>> v+ ;
     inline
 
 : if-ray-sphere ( hit ray sphere quot -- hit )
     #! quot: hit ray sphere l -- hit
-    >r pick hit-lambda >r 2dup swap ray-sphere dup r> >=
-    [ 3drop ] r> if ; inline
+    [
+        pick lambda>> [ 2dup swap ray-sphere dup ] dip >=
+        [ 3drop ]
+    ] dip if ; inline
 
 M: sphere intersect-scene ( hit ray sphere -- hit )
     [ [ sphere-n normalize ] keep <hit> nip ] if-ray-sphere ;
 
-TUPLE: group objs ;
+TUPLE: group < sphere { objs array read-only } ;
 
 : <group> ( objs bound -- group )
-    { set-group-objs set-delegate } group construct ;
+    [ center>> ] [ radius>> ] bi rot group boa ; inline
 
 : make-group ( bound quot -- )
-    swap >r { } make r> <group> ; inline
+    swap [ { } make ] dip <group> ; inline
 
 M: group intersect-scene ( hit ray group -- hit )
     [
         drop
-        group-objs [ >r tuck r> intersect-scene swap ] each
+        objs>> [ [ tuck ] dip intersect-scene swap ] each
         drop
     ] if-ray-sphere ;
 
@@ -88,30 +91,30 @@ M: group intersect-scene ( hit ray group -- hit )
     initial-hit -rot intersect-scene ; inline
 
 : ray-o ( ray hit -- o )
-    over ray-dir over hit-lambda v*n
-    swap hit-normal delta v*n v+
-    swap ray-orig v+ ; inline
+    over dir>> over lambda>> v*n
+    swap normal>> delta v*n v+
+    swap orig>> v+ ; inline
 
 : sray-intersect ( ray scene hit -- ray )
-    swap >r ray-o light vneg <ray> r> initial-intersect ; inline
+    swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline
 
-: ray-g ( hit -- g ) hit-normal light v. ; inline
+: ray-g ( hit -- g ) normal>> light v. ; inline
 
 : cast-ray ( ray scene -- g )
-    2dup initial-intersect dup hit-lambda 1.0/0.0 = [
+    2dup initial-intersect dup lambda>> 1.0/0.0 = [
         3drop 0.0
     ] [
-        dup ray-g >r sray-intersect hit-lambda 1.0/0.0 =
-        [ r> neg ] [ r> drop 0.0 ] if
+        [ sray-intersect lambda>> 1.0/0.0 = ] keep swap
+        [ ray-g neg ] [ drop 0.0 ] if
     ] if ; inline
 
 : create-center ( c r d -- c2 )
-    >r 3.0 12.0 sqrt / * r> n*v v+ ; inline
+    [ 3.0 12.0 sqrt / * ] dip n*v v+ ; inline
 
 DEFER: create ( level c r -- scene )
 
 : create-step ( level c r d -- scene )
-    over >r create-center r> 2.0 / >r >r 1 - r> r> create ;
+    over [ create-center ] dip 2.0 / [ 1 - ] 2dip create ;
 
 : create-offsets ( quot -- )
     {
@@ -126,7 +129,7 @@ DEFER: create ( level c r -- scene )
 : create-group ( level c r -- scene )
     2dup create-bound [
         2dup <sphere> ,
-        [ >r 3dup r> create-step , ] create-offsets 3drop
+        [ [ 3dup ] dip create-step , ] create-offsets 3drop
     ] make-group ;
 
 : create ( level c r -- scene )
@@ -140,7 +143,7 @@ DEFER: create ( level c r -- scene )
 
 : ray-grid ( point ss-grid -- ray-grid )
     [
-        [ v+ normalize { 0.0 0.0 -4.0 } swap <ray> ] with map
+        [ v+ normalize F{ 0.0 0.0 -4.0 } swap <ray> ] with map
     ] with map ;
 
 : ray-pixel ( scene point -- n )
@@ -164,7 +167,7 @@ DEFER: create ( level c r -- scene )
     pixel-grid [ [ ray-pixel ] with map ] with map ;
 
 : run ( -- string )
-    levels { 0.0 -1.0 0.0 } 1.0 create ray-trace [
+    levels F{ 0.0 -1.0 0.0 } 1.0 create ray-trace [
         size size pgm-header
         [ [ oversampling sq / pgm-pixel ] each ] each
     ] B{ } make ;

diff --git a/extra/gesture-logger/gesture-logger.factor b/extra/gesture-logger/gesture-logger.factor
index 7b1fac8fcd62019668c8aeb86c4c70b416ccb4bf..b990de03fc652ab567defdbbe81e66181c85051d 100644 (file)
--- a/extra/gesture-logger/gesture-logger.factor
+++ b/extra/gesture-logger/gesture-logger.factor
@@ -13,7 +13,7 @@ TUPLE: gesture-logger < gadget stream ;
     { 100 100 } >>dim
     black solid-interior ;
 
-M: gesture-logger handle-gesture*
+M: gesture-logger handle-gesture
     over T{ button-down } = [ dup request-focus ] when
     stream>> [ . ] with-output-stream*
     t ;

diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index 5c775681067a934c770735d0410f1b2d174a4157..edcf0c7d26889fa6459493cbe3734c34f4549473 100755 (executable)
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -226,17 +226,6 @@ DEFER: _
 
 \ new 1 [ ?wrapped empty-inverse ] define-pop-inverse
 
-: writer>reader ( word -- word' )
-    [ "writing" word-prop "slots" word-prop ] keep
-    [ swap slot-spec-writer = ] curry find nip slot-spec-reader ;
-
-: construct-inverse ( class setters -- quot )
-    >r deconstruct-pred r>
-    [ writer>reader ] map [ get-slots ] curry
-    compose ;
-
-\ construct 2 [ >r ?wrapped r> construct-inverse ] define-pop-inverse
-
 ! More useful inverse-based combinators
 
 : recover-fail ( try fail -- )

diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor
index 15ef21d64e2df71b53b61093a2495b89b5ede32a..e14a46a967cb4a51bd6058bee593ab11ebd3cf32 100755 (executable)
--- a/extra/key-caps/key-caps.factor
+++ b/extra/key-caps/key-caps.factor
@@ -168,7 +168,7 @@ M: key-caps-gadget graft*
 M: key-caps-gadget ungraft*
     alarm>> [ cancel-alarm ] when* ;
 
-M: key-caps-gadget handle-gesture*
+M: key-caps-gadget handle-gesture
     drop [ key-down? ] [ key-up? ] bi or not ;
 
 : key-caps ( -- )

diff --git a/extra/lcd/lcd.factor b/extra/lcd/lcd.factor
index b0d5060b4a50c6bf1bc8404fbe39310f660e16d1..d1646a408990f9628ec87b6e69aabf0907975c9b 100755 (executable)
--- a/extra/lcd/lcd.factor
+++ b/extra/lcd/lcd.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel math io calendar calendar.format
-calendar.model arrays models models.filter namespaces ui.gadgets
-ui.gadgets.labels ui.gadgets.theme ui ;
+USING: accessors sequences kernel math io calendar grouping
+calendar.format calendar.model arrays models models.filter
+namespaces ui.gadgets ui.gadgets.labels ui.gadgets.theme ui ;
 IN: lcd
 
 : lcd-digit ( row digit -- str )
@@ -11,7 +11,7 @@ IN: lcd
         " | |  |   _| _| |_| |_  |_    | |_| |_|  *  "
         " |_|  |  |_  _|   |  _| |_|   | |_|   |  *  "
         "                                            "
-    } nth >r 4 * dup 4 + r> subseq ;
+    } nth 4 <groups> nth ;
 
 : lcd-row ( num row -- string )
     [ swap lcd-digit ] curry { } map-as concat ;
@@ -20,9 +20,8 @@ IN: lcd
     4 [ lcd-row ] with map "\n" join ;
 
 : hh:mm:ss ( timestamp -- string )
-    {
-        timestamp-hour timestamp-minute timestamp-second
-    } get-slots >fixnum 3array [ pad-00 ] map ":" join ;
+    [ hour>> ] [ minute>> ] [ second>> >fixnum ] tri
+    3array [ pad-00 ] map ":" join ;
 
 : <time-display> ( timestamp -- gadget )
     [ hh:mm:ss lcd ] <filter> <label-control>

diff --git a/extra/math/blas/matrices/matrices.factor b/extra/math/blas/matrices/matrices.factor
index c07dfca76dcee1e3a5c6e6c5fd06b10ae5a521e9..c8e55c4ec0c54e91cce4bbbf2ee6c87aefde79f0 100755 (executable)
--- a/extra/math/blas/matrices/matrices.factor
+++ b/extra/math/blas/matrices/matrices.factor
@@ -194,9 +194,9 @@ METHOD: n*M.M+n*M-in-place { number double-complex-blas-matrix double-complex-bl
 syntax:M: blas-matrix-base clone
     [ 
         [
-            { data>> ld>> cols>> element-type } get-slots
-            heap-size * * memory>byte-array
-        ] [ { ld>> rows>> cols>> transpose>> } get-slots ] bi
+            { [ data>> ] [ ld>> ] [ cols>> ] [ element-type heap-size ] } cleave
+            * * memory>byte-array
+        ] [ { [ ld>> ] [ rows>> ] [ cols>> ] [ transpose>> ] } cleave ] bi
     ] keep (blas-matrix-like) ;
 
 ! XXX try rounding stride to next 128 bit bound for better vectorizin'
@@ -296,7 +296,7 @@ syntax:M: blas-matrix-rowcol-sequence nth-unsafe
     recip swap n*M ; inline
 
 : Mtranspose ( matrix -- matrix^T )
-    [ { data>> ld>> rows>> cols>> transpose>> } get-slots not ] keep (blas-matrix-like) ;
+    [ { [ data>> ] [ ld>> ] [ rows>> ] [ cols>> ] [ transpose>> not ] } cleave ] keep (blas-matrix-like) ;
 
 syntax:M: blas-matrix-base equal?
     {

diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor
index 389dabc0f6c0bfd25af734325fae53eda31f5185..07f7b74265dd04cf779c33e59b121b4f1df7d89a 100644 (file)
--- a/extra/maze/maze.factor
+++ b/extra/maze/maze.factor
@@ -49,10 +49,9 @@ SYMBOL: visited
     { 0 0 } dup vertex (draw-maze)
     glEnd ;
 
-TUPLE: maze ;
+TUPLE: maze < canvas ;
 
-: <maze> ( -- gadget )
-    <canvas> { set-delegate } maze construct ;
+: <maze> ( -- gadget ) maze new-canvas ;
 
 : n ( gadget -- n ) rect-dim first2 min line-width /i ;
 

diff --git a/extra/processing/gadget/gadget.factor b/extra/processing/gadget/gadget.factor
index 4621bab85545c9946627023a3ea915d6ab2f5157..c1a4c77703d2932fed81b88d2e28aa888dde7f0b 100644 (file)
--- a/extra/processing/gadget/gadget.factor
+++ b/extra/processing/gadget/gadget.factor
@@ -26,8 +26,8 @@ SYMBOL: key-value
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-M: processing-gadget handle-gesture* ( gadget gesture delegate -- ? )
-   rot drop swap         ! delegate gesture
+M: processing-gadget handle-gesture ( gesture gadget -- ? )
+   swap
    {
      {
        [ dup key-down? ]

diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor
index ff88abad612d25c6b105fa54fa7a315fd3792421..4a361210463fe252b9d6bf25ed87b4096aa1baf3 100755 (executable)
--- a/extra/reports/noise/noise.factor
+++ b/extra/reports/noise/noise.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.\r
+! See http://factorcode.org/license.txt for BSD license.\r
 USING: accessors assocs math kernel shuffle generalizations\r
 words quotations arrays combinators sequences math.vectors\r
 io.styles prettyprint vocabs sorting io generic locals.private\r
@@ -92,11 +94,11 @@ M: word noise badness 1 2array ;
 \r
 M: wrapper noise wrapped>> noise ;\r
 \r
-M: let noise let-body noise ;\r
+M: let noise body>> noise ;\r
 \r
-M: wlet noise wlet-body noise ;\r
+M: wlet noise body>> noise ;\r
 \r
-M: lambda noise lambda-body noise ;\r
+M: lambda noise body>> noise ;\r
 \r
 M: object noise drop { 0 0 } ;\r
 \r