Bug fixes

library/bootstrap/boot-stage1.factor

@@ -275,6 +275,7 @@ vectors words ;
         "/library/tools/annotations.facts"
         "/library/tools/debugger.facts"
         "/library/tools/describe.facts"
+        "/library/tools/inspector.facts"
         "/library/tools/listener.facts"
         "/library/tools/memory.facts"
         "/library/tools/walker.facts"

library/collections/sequences-epilogue.factor

@@ -156,8 +156,4 @@ M: object <=>
 : cond ( conditions -- )
     [ first call ] find nip dup [ second call ] [ no-cond ] if ;
 
-: with-datastack ( stack word -- stack )
-    datastack >r >r >vector set-datastack r> execute
-    datastack r> [ push ] keep set-datastack 2nip ;
-
 : unix? os { "freebsd" "linux" "macosx" "solaris" } member? ;

library/collections/sequences-epilogue.facts

@@ -85,7 +85,7 @@ HELP: >resizable "( seq -- newseq )"
 { $description "Outputs a new, mutable resizable sequence having the same elements as " { $snippet "seq" } "." } ;
 
 HELP: immutable "( seq quot -- newseq )"
-{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( seq -- )" } { "newseq" "a sequence" } }
+{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( seq -- )" } } { "newseq" "a sequence" } }
 { $description "A utility combinator transforming a word which modifies its input sequence into a word which returns a new output sequence. "
 $terpri
 "A mutable, resizable copy of " { $snippet "seq" } " is made, then the quotation is called to modify this copy and consume it. Finally, the copy is converted into a sequence of the same type as the original." }
@@ -164,12 +164,12 @@ HELP: exchange "( m n seq -- )"
 { $description "Exchanges the " { $snippet "m" } "th and " { $snippet "n" } "th elements of " { $snippet "seq" } "." } ;
 
 HELP: assoc "( key assoc -- value )"
-{ $values { "key" "an object" } { "assoc" "a sequence of pairs" } { "value" "the associated value, or " { $link f } }
+{ $values { "key" "an object" } { "assoc" "a sequence of pairs" } { "value" "the associated value, or " { $link f } } }
 { $description "Searches for a pair whose first element is equal to the key and outputs the second element of the pair. Keys are compared for equality using " { $link = } ". Outputs " { $link f } " if no matching key is found." }
 { $see-also rassoc } ;
 
 HELP: rassoc "( value assoc -- key )"
-{ $values { "value" "an object" } { "assoc" "a sequence of pairs" } { "key" "the associated key, or " { $link f } }
+{ $values { "value" "an object" } { "assoc" "a sequence of pairs" } { "key" "the associated key, or " { $link f } } }
 { $description "Searches for a pair whose second element is equal to the value and outputs the first element of the pair. Values are compared for equality using " { $link = } ". Outputs " { $link f } " if no matching value is found." } 
 { $see-also rassoc } ;
 
@@ -197,13 +197,6 @@ HELP: cond "( assoc -- )"
 }
 { $errors "Throws an error if the first quotation in every pair yields " { $link f } "." } ;
 
-HELP: with-datastack "( stack word -- newstack )"
-{ $values { "stack" "a sequence" } { "word" "a word" } { "newstack" "a sequence" } }
-{ $description "Executes " { $snippet "word" } " with the given data stack contents, and outputs the new data stack after the word returns. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
-{ $examples
-    { $example "{ 3 7 } \ + with-datastack ." "V{ 10 }" }
-} ;
-
 HELP: unix? "( -- ? )"
 { $values { "?" "a boolean" } }
 { $description "Tests if Factor is running on a Unix-like system. While this is a rather vague notion, one can use it to make certain assumptions about system calls and file structure which are not valid on Windows." } ;

library/collections/vectors.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: vectors
 USING: arrays errors generic kernel kernel-internals math
-math-internals sequences sequences-internals ;
+math-internals sequences sequences-internals words ;
 
 M: vector set-length ( len vec -- )
     grow-length ;
@@ -27,3 +27,9 @@ M: vector like
     drop dup vector? [
         dup array? [ array>vector ] [ >vector ] if
     ] unless ;
+
+IN: kernel
+
+: with-datastack ( stack word -- stack )
+    datastack >r >r >vector set-datastack r> execute
+    datastack r> [ push ] keep set-datastack 2nip ;

library/collections/vectors.facts

@@ -1,4 +1,4 @@
-USING: arrays help strings vectors ;
+USING: arrays help kernel strings vectors ;
 
 HELP: <vector> "( n -- vector )"
 { $values { "n" "a positive integer specifying initial capacity" } { "vector" "a new vector" } }
@@ -8,3 +8,10 @@ HELP: <vector> "( n -- vector )"
 HELP: >vector "( seq -- vector )"
 { $values { "seq" "a sequence" } { "vector" "a new vector" } }
 { $description "Outputs a freshly-allocated vector with the same elements as a given sequence." } ;
+
+HELP: with-datastack "( stack word -- newstack )"
+{ $values { "stack" "a sequence" } { "word" "a word" } { "newstack" "a sequence" } }
+{ $description "Executes " { $snippet "word" } " with the given data stack contents, and outputs the new data stack after the word returns. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
+{ $examples
+    { $example "{ 3 7 } \ + with-datastack ." "V{ 10 }" }
+} ;

library/collections/virtual-sequences.factor

@@ -8,6 +8,8 @@ TUPLE: reversed seq ;
 
 : reversed@ reversed-seq [ length swap - 1- ] keep ; inline
 
+M: reversed length ( seq -- n ) reversed-seq length ;
+
 M: reversed nth ( n seq -- elt ) reversed@ nth ;
 
 M: reversed nth-unsafe ( n seq -- elt ) reversed@ nth-unsafe ;

library/kernel.facts

@@ -28,22 +28,30 @@ HELP: r> "( r: x -- x )" $shuffle ;
 
 HELP: datastack "( -- ds )"
 { $values { "ds" "a vector" } }
-{ $description "Outputs the a vector containing a copy of the datastack contents right before the call to this word, with the top of the stack at the end of the vector." } ;
+{ $description "Outputs the a vector containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the vector." } ;
 
 HELP: set-datastack "( ds -- )"
 { $values { "ds" "a vector" } }
-{ $description "Replaces the datastack contents with a copy of a vector. The end of the vector becomes the top of the stack." } ;
+{ $description "Replaces the data stack contents with a copy of a vector. The end of the vector becomes the top of the stack." } ;
+
+HELP: retainstack "( -- rs )"
+{ $values { "rs" "a vector" } }
+{ $description "Outputs the a vector containing a copy of the retain stack contents right before the call to this word, with the top of the stack at the end of the vector." } ;
+
+HELP: set-retainstack "( rs -- )"
+{ $values { "rs" "a vector" } }
+{ $description "Replaces the retain stack contents with a copy of a vector. The end of the vector becomes the top of the stack." } ;
 
 HELP: callstack "( -- cs )"
 { $values { "cs" "a vector" } }
-{ $description "Outputs the a vector containing a copy of the callstack contents right before the call to this word, with the top of the stack at the end of the vector. The call frame of the caller word is " { $emphasis "not" } " included." } ;
+{ $description "Outputs the a vector containing a copy of the call stack contents right before the call to this word, with the top of the stack at the end of the vector. The call frame of the caller word is " { $emphasis "not" } " included." } ;
 
 HELP: set-callstack "( cs -- )"
 { $values { "cs" "a vector" } }
-{ $description "Replaces the callstack contents with a copy of a vector. The end of the vector becomes the top of the stack. The current quotation continues executing. The new callstack takes effect when the current quotation returns, resulting in a callframe being popped." } ;
+{ $description "Replaces the call stack contents with a copy of a vector. The end of the vector becomes the top of the stack. The current quotation continues executing. The new callstack takes effect when the current quotation returns, resulting in a callframe being popped." } ;
 
 HELP: clear "( -- )"
-{ $description "Clears the datastack." } ;
+{ $description "Clears the data stack." } ;
 
 HELP: hashcode "( obj -- n )"
 { $values { "obj" "an object" } { "n" "a fixnum" } }

library/syntax/early-parser.factor

@@ -14,7 +14,7 @@ SYMBOL: line-text
 SYMBOL: column
 
 : check-vocab ( name -- vocab )
-    dup vocab [ "No such vocabulary" throw ] unless* ;
+    vocab [ "No such vocabulary" throw ] unless* ;
 
 : use+ ( string -- ) check-vocab use get push ;
 

library/tools/annotations.facts

@@ -20,9 +20,4 @@ HELP: break-on "( word quot -- )"
 
 HELP: profile "( word -- )"
 { $values { "word" "a word" } }
-{ $description "Changes a word definition so that the total runtime is added to a variable keyed by the word in the global namespace." }
-{ $examples
-    { $example 
-        ": foo 1000000 [ drop ] each ;\n\\ foo profile\n\\ foo get ." "931"
-    }
-} ;
+{ $description "Changes a word definition so the variable named by the word in the global namespace is incremented every time the word is executed." } ;

library/tools/debugger.factor

@@ -160,9 +160,6 @@ DEFER: :cc
     ":get ( var -- value ) accesses variables at time of error" print
     flush ;
 
-: flush-error-handler ( -- )
-    [ "Error in default error handler!" print ] when ;
-
 : print-error ( error -- )
     [
         dup error.

library/tools/debugger.facts

@@ -1,23 +1,34 @@
 USING: errors help ;
 
 HELP: error f
-{ $description "Global variable holding most-recently thrown error." }
+{ $description "Global variable holding most recently thrown error." }
 { $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
 
 HELP: error-continuation f
-{ $description "Global variable holding current continuation of most-recently thrown error." }
+{ $description "Global variable holding current continuation of most recently thrown error." }
+{ $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
+
+HELP: restarts f
+{ $description "Global variable holding the set of possible restarts for the most recently thrown error." }
 { $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
 
 HELP: :s "( -- )"
-{ $description "Prints the datastack at the time of the most recent error. Used for interactive debugging." } ;
+{ $description "Prints the data stack at the time of the most recent error. Used for interactive debugging." } ;
 
 HELP: :r "( -- )"
-{ $description "Prints the callstack at the time of the most recent error. Used for interactive debugging." } ;
+{ $description "Prints the retain stack at the time of the most recent error. Used for interactive debugging." } ;
+
+HELP: :c "( -- )"
+{ $description "Prints the call stack at the time of the most recent error. Used for interactive debugging." } ;
 
 HELP: :get "( variable -- value )"
 { $values { "variable" "an object" } { "value" "the value, or f" } }
 { $description "Looks up the value of a variable at the time of the most recent error." } ;
 
+HELP: :res "( n -- )"
+{ $values { "n" "a non-negative integer" } }
+{ $description "Continues executing the " { $snippet "n" } "th restart." } ;
+
 HELP: error. "( error -- )"
 { $values { "error" "an error" } }
 { $contract "Print an error to the default stream." } ;

library/tools/describe.facts

@@ -1,5 +1,5 @@
 IN: inspector
-USING: help io prettyprint words ;
+USING: help io kernel prettyprint words ;
 
 HELP: summary "( object -- string )"
 { $values { "object" "an object" } { "string" "a string" } }
@@ -42,8 +42,9 @@ HELP: stack. "( seq -- )"
 { $description "Prints an outliner listing elements of a sequence in reverse order. Elements are coverted to strings using " { $link unparse-short } "." }
 { $notes "This word is used in the implementation of " { $link .s } " and " { $link .r } "." } ;
 
-HELP: .s "( -- )"
-{ $description "Displays the contents of the data stack, with the top of the stack printed first." } ;
+HELP: callstack. "( seq -- )"
+{ $values { "seq" "a sequence" } }
+{ $description "Displays a sequence output by " { $link callstack } " in a nice way, by highlighting the current execution point in every call frame." } ;
 
 HELP: .r "( -- )"
 { $description "Displays the contents of the return stack, with the top of the stack printed first." } ;

library/tools/inspector.factor

@@ -4,7 +4,6 @@ IN: inspector
 USING: arrays generic io kernel listener memory namespaces
 prettyprint sequences words ;
 
-! Interactive inspector
 SYMBOL: inspector-slots
 
 : sheet-numbers ( sheet -- sheet )

library/tools/inspector.facts

@@ -0,0 +1,36 @@
+IN: inspector
+USING: errors help ;
+
+HELP: inspector-slots f
+{ $description "If the inspector is running, this variable holds slot values for the object being inspected." }
+{ $see-also go } ;
+
+HELP: inspector-stack f
+{ $description "If the inspector is running, this variable holds previously-inspected objects." }
+{ $see-also go up } ;
+
+HELP: inspecting "( -- obj )"
+{ $description "If the inspector is running, outputs the object currently being inspected." } ;
+
+HELP: inspector "( obj -- )"
+{ $values { "obj" "an object" } }
+{ $description "Starts a new inspector and prints a brief help message. If an inspector is already running, this starts a nested inspector. An alternative word that reuses the current inspector instance is " { $link inspect } "." }
+{ $see-also go up inspecting } ;
+
+HELP: inspect "( obj -- )"
+{ $values { "obj" "an object" } }
+{ $description "If an inspector is already running, displays the slots of the object in the current inspector. If an inspector is not running, starts a new inspector." }
+{ $see-also go up inspecting } ;
+
+HELP: go "( n -- )"
+{ $values { "n" "a non-negative integer" } }
+{ $description "Inspects the " { $snippet "n" } "th slot of the current object. Use " { $link up } " to return." } ;
+
+HELP: up "( -- )"
+{ $description "Returns to the previously-inspected object." } ;
+
+HELP: :error "( -- )"
+{ $description "Opens an inspector with the most recently thrown error." } ;
+
+HELP: :cc "( -- )"
+{ $description "Opens an inspector with the continuation reified at the time of the most recently thrown error." } ;

library/tools/interpreter.factor

@@ -100,7 +100,7 @@ M: object do ( object -- ) do-1 ;
 
 ! The interpreter loses object identity of the name and catch
 ! stacks -- they are copied after each step -- so we execute
-! them atomically and don't allow stepping into these words
+! these atomically and don't allow stepping into these words
 \ >n [ \ >n host-word ] "meta-word" set-word-prop
 \ n> [ \ n> host-word ] "meta-word" set-word-prop
 \ >c [ \ >c host-word ] "meta-word" set-word-prop

library/tools/memory.factor

@@ -5,7 +5,7 @@ USING: arrays errors generic hashtables io kernel
 kernel-internals math namespaces parser prettyprint
 sequences strings vectors words ;
 
-: full-gc ( -- ) generations 1 - gc ;
+: full-gc ( -- ) generations 1- gc ;
 
 ! Printing an overview of heap usage.
 

library/tools/memory.facts

@@ -1,5 +1,26 @@
 IN: memory
-USING: help ;
+USING: help test ;
+
+HELP: address "( obj -- n )"
+{ $values { "obj" "an object" } { "n" "a memory address" } }
+{ $description "Outputs the address where " { $snippet "obj" } " is located in memory. Objects can be moved around by the GC and there is almost never any reason for user code to need to know object addresses." } ;
+
+HELP: gc "( n -- )"
+{ $values { "n" "a positive integer" } }
+{ $description "Collects all generations up to and including the " { $snippet "n" } "th generation. The nursery where new objects are allocated is generation 0, and tenured space is generation " { $snippet "g-1" } " where " { $snippet "g" } " is the value output by " { $link generations } "." } ;
+
+HELP: gc-time "( -- n )"
+{ $values { "n" "a timestamp in milliseconds" } }
+{ $description "Outputs the total time spent in garbage collection during this Factor session." }
+{ $examples "This word is used by " { $link time } " to measure the time spent in garbage collection during the execution of a quotation." } ;
+
+HELP: room "( -- code-free code-total cards semi generations )"
+{ $values { "code-free" "bytes free in the code heap" } { "code-total" "total bytes in the code heap" } { "cards" "number of bytes reserved for card marking" } { "semi" "number of bytes reserved for tenured semi-space" } { "generations" "array of free/total bytes pairs" } }
+{ $description "Queries the runtime for memory usage information. To see this in a human-readable form, call " { $link room. } " instead." } ;
+
+HELP: size "( obj -- n )"
+{ $values { "obj" "an object" } { "n" "a size in bytes" } }
+{ $description "Outputs the size of the object in memory, in bytes. Tagged immediate objects such as fixnums and " { $link f } " will yield a size of 0." } ;
 
 HELP: full-gc "( -- )"
 { $description "Performs a full garbage collection." } ;
@@ -7,6 +28,21 @@ HELP: full-gc "( -- )"
 HELP: room. "( -- )"
 { $description "Prints an overview of memory usage broken down by generation and zone." } ;
 
+HELP: begin-scan "( -- )"
+{ $description "Moves all objects to tenured space, disables the garbage collector, and resets the heap scan pointer to point at the first object in the heap. The " { $link next-object } " word can then be called to advance the heap scan pointer and return successive objects."
+$terpri
+"This word must always be paired with a call to " { $link end-scan } "." }
+{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
+
+HELP: next-object "( -- obj )"
+{ $description "Outputs the object at the heap scan pointer, and then advances the heap scan pointer. If the end of the heap has been reached, outputs " { $link f } ". This is unambiguous since the " { $link f } " object is tagged immediate and not actually stored in the heap." }
+{ $errors "Throws an error if called outside a " { $link begin-scan } "/" { $link end-scan } " pair." }
+{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
+
+HELP: end-scan "( -- )"
+{ $description "Finishes a heap iteration by re-enabling the garbage collector. This word must always be paired with a call to " { $link begin-scan } "." }
+{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
+
 HELP: each-object "( quot -- )"
 { $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } }
 { $description "Applies a quotation to each object in the heap. The garbage collector is switched off while this combinator runs, so the given quotation must not allocate too much memory." }

library/tools/walker.facts

@@ -6,9 +6,13 @@ HELP: &s "( -- )"
 { $notes "This is analogous to " { $link .s } "." } ;
 
 HELP: &r "( -- )"
-{ $description "Prints the single stepper return stack and the currently executing quotation." }
+{ $description "Prints the single stepper retain stack." }
 { $notes "This is analogous to " { $link .r } "." } ;
 
+HELP: &c "( -- )"
+{ $description "Prints the single stepper call stack and the currently executing quotation." }
+{ $notes "This is analogous to " { $link .c } "." } ;
+
 HELP: &get "( var -- value )"
 { $values { "var" "an object" } { "value" "an object" } }
 { $description "Looks up a variable value in the single stepper name stack." } ;
@@ -28,4 +32,4 @@ HELP: end-walk "( -- )"
 { $description "Continue normal execution of the single-stepped quotation." } ;
 
 HELP: walk "( quot -- )"
-{ $description "Spawn a new listener, customized for single-stepping through a quotation using the " { $link step } " and " { $link into } " words. The state of the single stepper stacks can be displayed using " { $link &s } " and " { $link &r } ", while variable values can be inspected with " { $link &get  } "." } ;
+{ $description "Spawn a new listener, customized for single-stepping through a quotation using the " { $link step } " and " { $link into } " words. The state of the single stepper stacks can be displayed using " { $link &s } ", " { $link &r } " and " { $link &c } ", while variable values can be inspected with " { $link &get  } "." } ;

library/ui/cocoa/menu-bar.factor

@@ -145,6 +145,10 @@ DEFER: described-menu
         { {
             "Help"
             { "Factor Documentation" handbook-window "?" }
+            { }
             { "Help Index" articles-window "" }
+            { "Types" types-window "" }
+            { "Classes" classes-window "" }
+            { "Primitives" primitives-window "" }
         } }
     } described-menu set-main-menu ;

library/ui/gadgets/panes.factor

@@ -69,7 +69,6 @@ C: pane ( -- pane )
 M: pane gadget-gestures
     pane-input [
         H{
-            { T{ button-down } [ pane-input click-editor ] }
             { T{ key-down f f "RETURN" } [ pane-commit ] }
             { T{ key-down f f "UP" } [ pane-input [ history-prev ] with-editor ] }
             { T{ key-down f f "DOWN" } [ pane-input [ history-next ] with-editor ] }

library/ui/tools/launchpad.factor

@@ -3,8 +3,9 @@
 IN: gadgets-launchpad
 USING: gadgets gadgets-apropos gadgets-borders gadgets-browser
 gadgets-buttons gadgets-labels gadgets-listener gadgets-panes
-gadgets-presentations gadgets-scrolling gadgets-theme help
-inspector io kernel memory namespaces prettyprint sequences ;
+gadgets-presentations gadgets-scrolling gadgets-theme generic
+help inspector io kernel memory namespaces prettyprint sequences
+words ;
 
 : <launchpad> ( menu -- )
     [ first2 >r <label> [ drop ] r> append <bevel-button> ] map
@@ -23,6 +24,18 @@ inspector io kernel memory namespaces prettyprint sequences ;
 : articles-window ( -- )
     [ articles. ] "Help index" pane-window ;
 
+: types-window ( -- )
+    [ builtins get [ help ] word-outliner ]
+    "Types" pane-window ;
+
+: classes-window ( -- )
+    [ classes [ help ] word-outliner ]
+    "Types" pane-window ;
+
+: primitives-window ( -- )
+    [ all-words [ primitive? ] subset [ help ] word-outliner ]
+    "Primitives" pane-window ;
+
 : apropos-window ( -- )
     <apropos-gadget> open-window ;
 
@@ -37,6 +50,9 @@ inspector io kernel memory namespaces prettyprint sequences ;
         { "Browser" [ f browser-window ] }
         { "Apropos" [ apropos-window ] }
         { "Globals" [ globals-window ] }
+        { "Types" [ types-window ] }
+        { "Classes" [ classes-window ] }
+        { "Primitives" [ primitives-window ] }
         { "Memory" [ memory-window ] }
         { "Save image" [ save ] }
         { "Exit" [ 0 exit ] }

library/words.facts

@@ -1,4 +1,4 @@
-USING: help kernel parser words ;
+USING: help inspector kernel parser words ;
 
 HELP: execute "( word -- )"
 { $values { "word" "a word" } }