diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index 7b46aa87de..3509deb2fb 100644 --- a/extra/asn1/asn1.factor +++ b/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 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 ) - elements set - elements get set-element-syntax + element new + swap >>syntax + elements set set-id [ (set-tag) set-tagclass diff --git a/extra/benchmark/fib4/fib4.factor b/extra/benchmark/fib4/fib4.factor index 7cf756e11f..580be0d0ec 100644 --- a/extra/benchmark/fib4/fib4.factor +++ b/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 : tuple-fib ( m -- n ) - dup box-i 1 <= [ + dup i>> 1 <= [ drop 1 ] [ - box-i 1- + i>> 1- dup tuple-fib swap - box-i 1- + i>> 1- tuple-fib - swap box-i swap box-i + + swap i>> swap i>> + ] if ; : fib-main ( -- ) T{ box f 34 } tuple-fib T{ box f 9227465 } assert= ; diff --git a/extra/benchmark/typecheck1/typecheck1.factor b/extra/benchmark/typecheck1/typecheck1.factor index 434094a2a3..5ffe96292b 100644 --- a/extra/benchmark/typecheck1/typecheck1.factor +++ b/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 ; diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index c329977875..1bd81d46ea 100755 --- a/extra/regexp/regexp.factor +++ b/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 -- ? )