minor cleanups, new map-with and each-with words

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 9bec611f5f5f6da1f1c7d24913355809626aab45..7d89068abbfb9eb5e57c1f5c5ea4f217bb5ffcb7 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,10 +1,3 @@
-[error] AWT-EventQueue-0: java.lang.NullPointerException\r
-[error] AWT-EventQueue-0:  at org.gjt.sp.jedit.Buffer.markTokens(Buffer.java:2109)\r
-[error] AWT-EventQueue-0:  at factor.jedit.WordPreview.getWordAtCaret(WordPreview.java:95)\r
-[error] AWT-EventQueue-0:  at factor.jedit.WordPreview.showPreview(WordPreview.java:137)\r
-[error] AWT-EventQueue-0:  at factor.jedit.WordPreview.actionPerformed(WordPreview.java:79)\r
-[error] AWT-EventQueue-0:  at javax.swing.Timer.fireActionPerformed(Timer.java:271)\r
-\r
 + compiler:\r
 \r
 - optimize away dispatch\r
@@ -28,6 +21,7 @@
 \r
 + listener/plugin:\r
 \r
+- WordPreview calls markTokens() -> NPE\r
 - stream server can hang because of exception handler limitations\r
 - listener should be multithreaded\r
 - compile all, infer all commands\r
@@ -40,7 +34,6 @@
 \r
 + kernel:\r
 \r
-- after bootstrapping, classes hash is messed up\r
 - do partial objects cause problems?\r
 - profiler is inaccurate: wrong word on cs\r
 - better i/o scheduler\r
@@ -51,8 +44,6 @@
 \r
 + misc:\r
 \r
-- each-with map-with\r
-- step: print NEXT word to execute, not word that JUST executed\r
 - perhaps /i should work with all numbers\r
 - unit test weirdness: 2 lines appears at end\r
 - jedit ==> jedit-word, jedit takes a file name\r

diff --git a/library/assoc.factor b/library/assoc.factor
index cc6c66982c716fe64fedb16845b77ea90ec8bd3b..62bf6723b640a8c74aa979c47c5e0f88bf725e3f 100644 (file)
--- a/library/assoc.factor
+++ b/library/assoc.factor
@@ -70,12 +70,12 @@ USE: kernel
     #! corresponding quotation, the value is popped off the
     #! stack.
     swap [
-        over >r unswons rot assoc* dup [
+        unswons rot assoc* dup [
             cdr call
         ] [
             2drop
-        ] ifte r>
-    ] each drop ;
+        ] ifte
+    ] each-with ;
 
 : 2cons ( car1 car2 cdr1 cdr2 -- cons1 cons2 )
     rot swons >r cons r> ;

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 19a8e878754580cf7e5724149d3d1c001b068f13..47d3336909a900442a5de1584e5360d24f059ef8 100644 (file)
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -305,7 +305,7 @@ M: vector ' ( vector -- pointer )
         >r dup vector-length [
             f swap pick set-vector-nth
         ] times* r>
-        [ unswons pick set-hash ] each drop
+        [ unswons rot set-hash ] each-with
     ] cons cons
     boot-quot [ append ] change ;
 

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index ea17e4067cc01c33d2340c8aab24887e62589943..6dd9d8c76344b8474a793e67251c2273d54ab387 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -51,6 +51,8 @@ vocabularies get [
     "syntax" set
 ] bind
 
+<namespace> classes set
+
 2 [
     [ "words" | "execute" ]
     [ "kernel" | "call" ]

diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index cdeecd9c08636fe2b6b44f91ea651a972c28fea8..9d39ef8e529954fa04479073bc601769bf56fba9 100644 (file)
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -150,8 +150,8 @@ SYMBOL: #target ( part of jump table )
 : dispatch-body ( end label/param -- )
     #! Output each branch, with a jump to the end label.
     [
-        uncons label, (linearize) dup #jump-label swons ,
-    ] each drop ;
+        uncons label, (linearize) #jump-label swons ,
+    ] each-with ;
 
 : check-dispatch ( vtable -- )
     length num-types = [

diff --git a/library/compiler/optimizer.factor b/library/compiler/optimizer.factor
index 549b81f85167bc77b0fd8bda822dfaf3bacf781b..7c196f2b38adfa335fda8bc1b254c87c91e9e64d 100644 (file)
--- a/library/compiler/optimizer.factor
+++ b/library/compiler/optimizer.factor
@@ -101,7 +101,7 @@ USE: prettyprint
 
 : (kill-nodes) ( literals dataflow -- )
     #! Append live nodes to currently constructing list.
-    [ dupd  "kill-node" [ nip , ] apply-dataflow ] each drop ;
+    [ "kill-node" [ nip , ] apply-dataflow ] each-with ;
 
 : kill-nodes ( literals dataflow -- dataflow )
     #! Remove literals and construct a list.

diff --git a/library/cons.factor b/library/cons.factor
index 86932e0f1f2c44de83a67fa560318dd049c2fb8a..b75c56abd13d738108fbf9eb690e5927424f50ae 100644 (file)
--- a/library/cons.factor
+++ b/library/cons.factor
@@ -98,9 +98,18 @@ PREDICATE: general-list list ( list -- ? )
 
 : each ( list quot -- )
     #! Push each element of a proper list in turn, and apply a
-    #! quotation with effect ( X -- ) to each element.
+    #! quotation with effect ( elt -- ) to each element.
     over [ (each) each ] [ 2drop ] ifte ; inline
 
+: with ( obj quot elt -- obj quot )
+    #! Utility word for each-with, map-with.
+    pick pick >r >r swap call r> r> ;
+
+: each-with ( obj list quot -- )
+    #! Push each element of a proper list in turn, and apply a
+    #! quotation with effect ( obj elt -- ) to each element.
+    swap [ with ] each 2drop ; inline
+
 : subset ( list quot -- list )
     #! Applies a quotation with effect ( X -- ? ) to each
     #! element of a list; all elements for which the quotation

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index 7891288a397139d1be977c29457b259b2072bdc1..2cbdd9c364a8aa474a358b0b2471e4e79d1b5e19 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -215,4 +215,4 @@ SYMBOL: object
     dup builtin-supertypes [ > ] sort
     classes get set-hash ;
 
-global [ classes get [ <namespace> classes set ] unless ] bind
+classes get [ <namespace> classes set ] unless

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index c584344102b112378de0d11240581297aa4f3285..e30e0310cf74a953ca13522b70e40e012db16c96 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -45,15 +45,15 @@ USE: prettyprint
 : computed-value-vector ( n -- vector )
     [ drop object <computed> ] vector-project ;
 
-: add-inputs ( count stack -- count stack )
+: add-inputs ( count stack -- stack )
     #! Add this many inputs to the given stack.
-    [ vector-length - dup ] keep
-    >r computed-value-vector dup r> vector-append ;
+    dup >r vector-length - computed-value-vector dup r>
+    vector-append ;
 
 : unify-lengths ( list -- list )
     #! Pad all vectors to the same length. If one vector is
     #! shorter, pad it with unknown results at the bottom.
-    dup longest-vector swap [ dupd add-inputs nip ] map nip ;
+    dup longest-vector swap [ add-inputs ] map-with ;
 
 : unify-results ( list -- value )
     #! If all values in list are equal, return the value.
@@ -67,7 +67,7 @@ USE: prettyprint
 : vector-transpose ( list -- vector )
     #! Turn a list of same-length vectors into a vector of lists.
     dup car vector-length [
-        over [ dupd vector-nth ] map nip
+        over [ vector-nth ] map-with
     ] vector-project nip ;
 
 : unify-stacks ( list -- stack )

diff --git a/library/io/files.factor b/library/io/files.factor
index 020aec84c6bf5217217dfee588ebcae31114aa5c..2519ad539284f6228c57ea193c5a01e4e7a6b0be 100644 (file)
--- a/library/io/files.factor
+++ b/library/io/files.factor
@@ -80,8 +80,7 @@ USE: unparser
 : file-link. ( dir name -- )
     tuck "/" swap cat3 dup "file-link" swons swap
     unparse file-actions <actions> "actions" swons
-    t "underline" swons
-    3list write-attr ;
+    2list write-attr ;
 
 : file. ( dir name -- )
     #! If "doc-root" set, create links relative to it.
@@ -91,11 +90,11 @@ USE: unparser
     #! If "doc-root" set, create links relative to it.
     dup directory [
         dup [ "." ".." ] contains? [
-            drop
+            2drop
         ] [
-            dupd file.
+            file.
         ] ifte
-    ] each drop ;
+    ] each-with ;
 
 : pwd cwd print ;
 : dir. cwd directory. ;

diff --git a/library/lists.factor b/library/lists.factor
index 0f62920bb6a3f799737830b15e8416a00d4e4a4c..0fc947aa64e2186e634fa066ecb134f9d088bd2c 100644 (file)
--- a/library/lists.factor
+++ b/library/lists.factor
@@ -124,6 +124,12 @@ DEFER: tree-contains?
     #! ( X -- Y ) to each element into a new list.
     over [ (each) rot >r map r> swons ] [ drop ] ifte ; inline
 
+: map-with ( obj list quot -- )
+    #! Push each element of a proper list in turn, and collect
+    #! return values of applying a quotation with effect
+    #! ( obj elt -- obj ) to each element into a new list.
+    swap [ with rot ] map nip nip ; inline
+
 : remove ( obj list -- list )
     #! Remove all occurrences of the object from the list.
     [ dupd = not ] subset nip ;

diff --git a/library/test/image.factor b/library/test/image.factor
index ae3422f5587947510862b52690357d9b644ad1c1..5b79372b0a7d03fa9c7a75e564d6979fa7a96ef5 100644 (file)
--- a/library/test/image.factor
+++ b/library/test/image.factor
@@ -2,6 +2,10 @@ USE: test
 USE: image
 USE: namespaces
 USE: stdio
+USE: parser
+USE: kernel
+USE: generic
+USE: math
 
 [ "ab\0\0" ] [ 4 "ab" align-string ] unit-test
 
@@ -21,3 +25,10 @@ USE: stdio
 [
     [ image-magic write-big-endian-64 ] with-string
 ] unit-test
+
+[
+    boot-quot off
+    "/library/bootstrap/boot.factor" run-resource
+] with-image drop
+
+[ fixnum ] [ 4 class ] unit-test

diff --git a/library/test/lists/combinators.factor b/library/test/lists/combinators.factor
index d5a1dca4ad5e6f1b20dc66c818ec442f5e4b626e..54e4650b3f642a5f79428244c4b26e413af966f6 100644 (file)
--- a/library/test/lists/combinators.factor
+++ b/library/test/lists/combinators.factor
@@ -38,3 +38,5 @@ USE: strings
 [ t ] [ [ 1 ] [ ] some? >boolean ] unit-test
 [ t ] [ [ 1 2 3 ] [ 2 > ] some? >boolean ] unit-test
 [ f ] [ [ 1 2 3 ] [ 10 > ] some? ] unit-test
+
+[ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test

diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor
index 80eadbffb2297de3a8ca35666f34bb55e7ee0834..41f77a939f513150aec9856b1b8542f1c30eb74f 100644 (file)
--- a/library/tools/interpreter.factor
+++ b/library/tools/interpreter.factor
@@ -194,11 +194,11 @@ SYMBOL: meta-cf
 
 : step
     #! Step into current word.
-    [ next dup report do-1 ] not-done ;
+    [ meta-cf get . next do-1 ] not-done ;
 
 : into
     #! Step into current word.
-    [ next dup report do ] not-done ;
+    [ meta-cf get . next do ] not-done ;
 
 : walk-banner ( -- )
     "The following words control the single-stepper:" print

diff --git a/library/tools/jedit-wire.factor b/library/tools/jedit-wire.factor
index f75c1ff8dcb01f6a5276486daecdd62acd7f71eb..58daed042b1930d00d6946040e020204348c1c65 100644 (file)
--- a/library/tools/jedit-wire.factor
+++ b/library/tools/jedit-wire.factor
@@ -104,8 +104,8 @@ C: jedit-stream ( stream -- stream )
             "name"
             "stack-effect"
         ] [
-            dupd word-property
-        ] map nip
+            word-property
+        ] map-with
     ] when ;
 
 : completions ( str anywhere vocabs -- list )

diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor
index b89e32434de83a520102f4e5172e7d2fe1279a22..073d41fd86c27a3e193d200792509923877b832d 100644 (file)
--- a/library/tools/word-tools.factor
+++ b/library/tools/word-tools.factor
@@ -64,7 +64,7 @@ USE: math
 
 : usages. ( word -- )
     #! List all usages of a word in all vocabularies.
-    vocabs [ dupd usages-in-vocab. ] each drop ;
+    vocabs [ usages-in-vocab. ] each-with ;
 
 : vocab-apropos ( substring vocab -- list )
     #! Push a list of all words in a vocabulary whose names
@@ -86,7 +86,7 @@ USE: math
 
 : apropos. ( substring -- )
     #! List all words that contain a string.
-    vocabs [ dupd vocab-apropos. ] each drop ;
+    vocabs [ vocab-apropos. ] each-with ;
 
 : in. ( -- )
     #! Print the vocabulary where new words are added in