new accessors

extra/asn1/asn1.factor

@@ -3,7 +3,7 @@
 
 USING: arrays asn1.ldap assocs byte-arrays combinators
 continuations io io.binary io.streams.string kernel math
-math.parser namespaces pack strings sequences ;
+math.parser namespaces pack strings sequences accessors ;
 
 IN: asn1
 
@@ -48,16 +48,12 @@ SYMBOL: elements
 
 TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
 
-: <element> ( -- element ) element new ;
-
-: set-id ( -- boolean )
-    read1 dup elements get set-element-id ;
 
 : get-id ( -- id )
-    elements get element-id ;
+    elements get id>> ;
 
 : (set-tag) ( -- )
-    elements get element-id 31 bitand
+    elements get id>> 31 bitand
     dup elements get set-element-tag
     31 < [
         [ "unsupported tag encoding: #{" % 
@@ -81,14 +77,14 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
     ] unless elements get set-element-contentlength ;
 
 : set-newobj ( -- )
-    elements get element-contentlength read
+    elements get contentlength>> read
     elements get set-element-newobj ;
 
 : set-objtype ( syntax -- )
     builtin-syntax 2array [
-        elements get element-tagclass swap at
-        elements get element-encoding swap at
-        elements get element-tag
+        elements get tagclass>> swap at
+        elements get encoding>> swap at
+        elements get tag>>
         swap at [ 
             elements get set-element-objtype
         ] when*
@@ -99,7 +95,7 @@ DEFER: read-ber
 SYMBOL: end
 
 : (read-array) ( -- )
-    elements get element-id [
+    elements get id>> [
         elements get element-syntax read-ber
         dup end = [ drop ] [ , (read-array) ] if
     ] when ;
@@ -115,9 +111,13 @@ SYMBOL: end
         { "array" [ "" or [ read-array ] with-string-reader ] }
     } case ;
 
+: set-id ( -- boolean )
+    read1 dup elements get set-element-id ;
+
 : read-ber ( syntax -- object )
-    <element> elements set
-    elements get set-element-syntax
+    element new
+        swap >>syntax
+    elements set
     set-id [
         (set-tag)
         set-tagclass

extra/benchmark/fib4/fib4.factor

@@ -1,4 +1,4 @@
-USING: math kernel debugger ;
+USING: accessors math kernel debugger ;
 IN: benchmark.fib4
 
 TUPLE: box i ;
@@ -6,15 +6,15 @@ TUPLE: box i ;
 C: <box> box
 
 : tuple-fib ( m -- n )
-    dup box-i 1 <= [
+    dup i>> 1 <= [
         drop 1 <box>
     ] [
-        box-i 1- <box>
+        i>> 1- <box>
         dup tuple-fib
         swap
-        box-i 1- <box>
+        i>> 1- <box>
         tuple-fib
-        swap box-i swap box-i + <box>
+        swap i>> swap i>> + <box>
     ] if ;
 
 : fib-main ( -- ) T{ box f 34 } tuple-fib T{ box f 9227465 } assert= ;

extra/benchmark/typecheck1/typecheck1.factor

@@ -1,9 +1,9 @@
-USING: math kernel ;
+USING: math kernel accessors ;
 IN: benchmark.typecheck1
 
 TUPLE: hello n ;
 
-: foo ( obj -- obj n ) 0 100000000 [ over hello-n + ] times ;
+: foo ( obj -- obj n ) 0 100000000 [ over n>> + ] times ;
 
 : typecheck-main ( -- ) 0 hello boa foo 2drop ;
 

extra/regexp/regexp.factor

@@ -2,7 +2,7 @@ USING: arrays combinators kernel lists math math.parser
 namespaces parser lexer parser-combinators parser-combinators.simple
 promises quotations sequences combinators.lib strings math.order
 assocs prettyprint.backend memoize unicode.case unicode.categories
-combinators.short-circuit ;
+combinators.short-circuit accessors ;
 USE: io
 IN: regexp
 
@@ -277,7 +277,7 @@ TUPLE: regexp source parser ignore-case? ;
 
 : match-head ( string regexp -- end )
     do-ignore-case regexp-parser parse dup nil?
-    [ drop f ] [ car parse-result-unparsed slice-from ] if ;
+    [ drop f ] [ car parse-result-unparsed from>> ] if ;
 
 ! Literal syntax for regexps
 : parse-options ( string -- ? )