Paste: [PATCH] basis/refs: add index-ref; tidy.

Author: mncharity
Mode: factor
Date: Wed, 1 Sep 2010 19:57:55
Plain Text |
Adds index-ref, a ref to the nth position in a sequence.
Reorders "ref" tests, code, and doc HELP and related-words, to a common order (that of the main doc page).  Nothing is otherwise changed, but for some -test section-header comments.

diff --git a/basis/refs/refs-docs.factor b/basis/refs/refs-docs.factor
index 8fe7797..1dab8b1 100644
--- a/basis/refs/refs-docs.factor
+++ b/basis/refs/refs-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Slava Pestov, 2009 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: boxes help.markup help.syntax kernel math namespaces assocs ;
+USING: assocs boxes help.markup help.syntax kernel math namespaces sequences ;
 IN: refs
 
 ARTICLE: "refs" "References"
@@ -20,6 +20,11 @@ ARTICLE: "refs-impls" "Reference implementations"
     obj-ref
     <obj-ref>
 }
+"References to sequence elements:"
+{ $subsections
+    index-ref
+    <index-ref>
+}
 "References to assoc keys:"
 { $subsections
     key-ref
@@ -67,7 +72,7 @@ ARTICLE: "box-refs" "Boxes as references"
 { $link "boxes" } " are elements of the " { $link ref } " mixin class, so any box may be used as a reference. Bear in mind that boxes will still throw an error if you call " { $link get-ref } " on an empty box." ;
 
 HELP: ref
-{ $class-description "A mixin class whose instances encapsulate a value which can be read, written, and deleted. Instantiable members of this class include:" { $link obj-ref } ", " { $link var-ref } ", " { $link global-var-ref } ", " { $link slot-ref } ", " { $link box } ", " { $link key-ref } ", and " { $link value-ref } "." } ;
+{ $class-description "A mixin class whose instances encapsulate a value which can be read, written, and deleted. Instantiable members of this class include: " { $link obj-ref } ", " { $link index-ref } ", " { $link key-ref } ", " { $link value-ref } ", " { $link var-ref } ", " { $link global-var-ref } ", " { $link slot-ref } ", and " { $link box } "." } ;
 
 HELP: delete-ref
 { $values { "ref" ref } }
@@ -88,6 +93,31 @@ HELP: <obj-ref>
 { $values { "obj" object } { "obj-ref" obj-ref } }
 { $description "Creates a reference which contains the value it references." } ;
 
+HELP: index-ref
+{ $class-description "Instances of this class identify the value at the nth position in a particular sequence. New key references are created by calling " { $link <index-ref> } "." } ;
+
+HELP: <index-ref>
+{ $values { "seq" sequence } { "n" integer } { "index-ref" index-ref } }
+{ $description "Creates a reference to the value at the nth position in the sequence." } ;
+
+HELP: key-ref
+{ $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link <key-ref> } "." } ;
+
+HELP: <key-ref>
+{ $values { "assoc" assoc } { "key" object } { "key-ref" key-ref } }
+{ $description "Creates a reference to a key stored in an assoc." } ;
+
+HELP: value-ref
+{ $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link <value-ref> } "." } ;
+
+HELP: <value-ref>
+{ $values { "assoc" assoc } { "key" object } { "value-ref" value-ref } }
+{ $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ;
+
+{ get-ref set-ref delete-ref set-ref* } related-words
+  
+{ <obj-ref> <index-ref> <key-ref> <value-ref> <var-ref> <global-var-ref> <slot-ref>  } related-words
+
 HELP: var-ref
 { $class-description "Instances of this class reference a variable as defined by the " { $vocab-link "namespaces" } " vocabulary. New variable references are created by calling " { $link <var-ref> } "." } ;
 
@@ -109,24 +139,6 @@ HELP: <slot-ref>
 { $values { "tuple" tuple } { "slot" integer } { "slot-ref" slot-ref } }
 { $description "Creates a reference to the value in a particular slot of the given tuple. The slot must be given as an integer, where the first user-defined slot is number 2. This is mostly just a proof of concept until we have a way of generating this slot number from a slot name." } ;
   
-HELP: key-ref
-{ $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link <key-ref> } "." } ;
-
-HELP: <key-ref>
-{ $values { "assoc" assoc } { "key" object } { "key-ref" key-ref } }
-{ $description "Creates a reference to a key stored in an assoc." } ;
-
-HELP: value-ref
-{ $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link <value-ref> } "." } ;
-
-HELP: <value-ref>
-{ $values { "assoc" assoc } { "key" object } { "value-ref" value-ref } }
-{ $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ;
-
-{ get-ref set-ref delete-ref set-ref* } related-words
-  
-{ <obj-ref> <var-ref> <global-var-ref> <slot-ref> <key-ref> <value-ref> } related-words
-
 HELP: set-ref*
 { $values { "ref" ref } { "obj" object } }
 { $description "Just like " { $link set-ref } ", but leave the ref on the stack." } ;
diff --git a/basis/refs/refs-tests.factor b/basis/refs/refs-tests.factor
index bf58aaf..63fbb88 100644
--- a/basis/refs/refs-tests.factor
+++ b/basis/refs/refs-tests.factor
@@ -1,17 +1,22 @@
 USING: boxes kernel namespaces refs tools.test ;
 IN: refs.tests
 
-! assoc-refs
-[ 3 ] [
-    H{ { "a" 3 } } "a" <value-ref> get-ref
-] unit-test
+SYMBOLS: lion giraffe elephant rabbit ;
 
-[ 4 ] [
-    4 H{ { "a" 3 } } clone "a" <value-ref>
-    [ set-ref ] keep
-    get-ref
+! obj-ref
+[ rabbit ] [ rabbit <obj-ref> get-ref ] unit-test
+[ rabbit ] [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
+[ rabbit ] [ rabbit <obj-ref> take ] unit-test
+[ rabbit f ] [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
+[ lion ] [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
+
+! index-ref
+{ 11 } [ { 10 11 12 } 1 <index-ref> get-ref ] unit-test
+{ V{ 10 21 12 } } [
+    V{ 10 11 12 } dup 21 swap 1 <index-ref> set-ref
 ] unit-test
 
+! key-ref
 [ "a" ] [
     H{ { "a" 3 } } "a" <key-ref> get-ref
 ] unit-test
@@ -23,16 +28,18 @@ IN: refs.tests
     ] keep
 ] unit-test
 
-SYMBOLS: lion giraffe elephant rabbit ;
+! value-ref
+[ 3 ] [
+    H{ { "a" 3 } } "a" <value-ref> get-ref
+] unit-test
 
-! obj-refs
-[ rabbit ] [ rabbit <obj-ref> get-ref ] unit-test
-[ rabbit ] [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
-[ rabbit ] [ rabbit <obj-ref> take ] unit-test
-[ rabbit f ] [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
-[ lion ] [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
+[ 4 ] [
+    4 H{ { "a" 3 } } clone "a" <value-ref>
+    [ set-ref ] keep
+    get-ref
+] unit-test
 
-! var-refs 
+! var-ref
 [ giraffe ] [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
 
 [ rabbit ]
diff --git a/basis/refs/refs.factor b/basis/refs/refs.factor
index 18b7490..bb97179 100644
--- a/basis/refs/refs.factor
+++ b/basis/refs/refs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, 2009 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs accessors boxes math namespaces ;
+USING: kernel assocs accessors boxes math namespaces sequences ;
 IN: refs
 
 MIXIN: ref
@@ -33,6 +33,29 @@ M: obj-ref get-ref obj>> ;
 M: obj-ref set-ref obj<< ;
 INSTANCE: obj-ref ref
 
+TUPLE: index-ref seq n ;
+C: <index-ref> index-ref
+: >index-ref< ( index-ref -- seq n ) [ seq>> ] [ n>> ] bi ; inline
+M: index-ref get-ref >index-ref< swap nth ;
+M: index-ref set-ref >index-ref< swap set-nth ;
+INSTANCE: index-ref ref
+
+TUPLE: assoc-ref assoc key ;
+: >assoc-ref< ( assoc-ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
+M: assoc-ref delete-ref ( assoc-ref -- ) >assoc-ref< delete-at ;
+
+TUPLE: key-ref < assoc-ref ;
+C: <key-ref> key-ref
+M: key-ref get-ref key>> ;
+M: key-ref set-ref >assoc-ref< rename-at ;
+INSTANCE: key-ref ref
+
+TUPLE: value-ref < assoc-ref ;
+C: <value-ref> value-ref
+M: value-ref get-ref >assoc-ref< at ;
+M: value-ref set-ref >assoc-ref< set-at ;
+INSTANCE: value-ref ref
+
 TUPLE: var-ref var ;
 C: <var-ref> var-ref
 M: var-ref get-ref var>> get ;
@@ -57,21 +80,3 @@ M: box get-ref box> ;
 M: box set-ref >box ;
 M: box delete-ref box> drop ;
 INSTANCE: box ref
-
-TUPLE: assoc-ref assoc key ;
-
-: >assoc-ref< ( assoc-ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
-
-M: assoc-ref delete-ref ( assoc-ref -- ) >assoc-ref< delete-at ;
-
-TUPLE: key-ref < assoc-ref ;
-C: <key-ref> key-ref
-M: key-ref get-ref key>> ;
-M: key-ref set-ref >assoc-ref< rename-at ;
-INSTANCE: key-ref ref
-
-TUPLE: value-ref < assoc-ref ;
-C: <value-ref> value-ref
-M: value-ref get-ref >assoc-ref< at ;
-M: value-ref set-ref >assoc-ref< set-at ;
-INSTANCE: value-ref ref

Annotation: posted for comment only

Author: mncharity
Mode: factor
Date: Wed, 1 Sep 2010 22:55:56
Plain Text |
This code was posted for comment only.  It's variously flawed, and not ready for primetime.

New Annotation

Summary:
Author:
Mode:
Body: