Bootstrap fixes, cleanups, better debugger in the UI

library/bootstrap/boot-stage1.factor

@@ -41,14 +41,13 @@ vectors words ;
         "/library/collections/growable.factor"
         "/library/collections/virtual-sequences.factor"
         "/library/collections/sequence-combinators.factor"
-        "/library/collections/sequences-epilogue.factor"
         "/library/collections/arrays.factor"
+        "/library/collections/sequences-epilogue.factor"
         "/library/collections/strings.factor"
         "/library/collections/sbuf.factor"
         "/library/collections/vectors.factor"
         "/library/collections/hashtables.factor"
         "/library/collections/namespaces.factor"
-        "/library/collections/sequence-eq.factor"
         "/library/collections/slicing.factor"
         "/library/collections/sequence-sort.factor"
         "/library/collections/flatten.factor"
@@ -195,6 +194,7 @@ vectors words ;
         "/library/ui/environment.factor"
         "/library/ui/listener.factor"
         "/library/ui/browser.factor"
+        "/library/ui/apropos.factor"
         "/library/ui/launchpad.factor"
         "/library/ui/presentations.factor"
 
@@ -211,7 +211,6 @@ vectors words ;
         "/library/collections/queues.facts"
         "/library/collections/sbuf.facts"
         "/library/collections/sequence-combinators.facts"
-        "/library/collections/sequence-eq.facts"
         "/library/collections/sequence-sort.facts"
         "/library/collections/sequences-epilogue.facts"
         "/library/collections/sequences.facts"

library/collections/namespaces.factor

@@ -62,6 +62,14 @@ IN: sequences
 : prune ( seq -- seq )
     [ [ dup set ] each ] make-hash hash-keys ;
 
+: concat ( seq -- seq )
+    dup empty? [ [ [ % ] each ] over first make ] unless ;
+    flushable
+
+: join ( seq glue -- seq )
+    [ swap [ % ] [ dup % ] interleave drop ] over make ;
+    flushable
+
 IN: kernel-internals
 
 : init-namespaces ( -- ) global 1array >vector set-namestack ;

library/collections/sbuf.factor

@@ -3,7 +3,6 @@
 IN: strings
 USING: kernel math strings sequences-internals sequences ;
 
-M: string resize resize-string ;
 M: sbuf set-length grow-length ;
 M: sbuf nth-unsafe underlying nth-unsafe ;
 M: sbuf nth bounds-check nth-unsafe ;

library/collections/sequence-combinators.factor

@@ -160,3 +160,15 @@ IN: sequences
     ] [
         drop swap >r over >r call dup r> r> set-nth
     ] if ; inline
+
+: copy-into-check ( start to from -- start to from )
+    pick over length + pick 2dup length >
+    [ set-length ] [ 2drop ] if ;
+
+: copy-into ( start to from -- )
+    copy-into-check dup length
+    [ >r pick r> + pick set-nth-unsafe ] 2each 2drop ;
+    inline
+
+: >sequence ( seq quot -- )
+    over >r >r length r> call dup 0 swap r> copy-into ; inline

library/collections/sequence-eq.factor

@@ -1,33 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: sequences
-USING: arrays kernel math sequences-internals strings
-vectors ;
-
-UNION: sequence array string sbuf vector quotation ;
-
-: sequence= ( seq seq -- ? )
-    2dup [ length ] 2apply = [
-        dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip
-    ] [
-        2drop f
-    ] if ;
-
-M: sequence = ( obj seq -- ? )
-    2dup eq? [
-        2drop t
-    ] [
-        over type over type eq? [ sequence= ] [ 2drop f ] if
-    ] if ;
-
-M: sequence hashcode ( seq -- n )
-    #! Poor
-    length ;
-
-M: string = ( obj str -- ? )
-    over string? [
-        over hashcode over hashcode number=
-        [ sequence= ] [ 2drop f ] if
-    ] [
-        2drop f
-    ] if ;

library/collections/sequence-eq.facts

@@ -1,6 +0,0 @@
-IN: sequences
-USING: help kernel ;
-
-HELP: sequence= "( seq1 seq2 -- ? )"
-{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "?" "a boolean" } }
-{ $description "Tests if the two sequences have the same length and elements. This is weaker than " { $link = } ", since it does not ensure that the sequences are instances of the same class." } ;

library/collections/sequences-epilogue.factor

@@ -56,18 +56,6 @@ M: object like drop ;
 
 : delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ;
 
-: copy-into-check ( start to from -- start to from )
-    pick over length + pick 2dup length >
-    [ set-length ] [ 2drop ] if ;
-
-: copy-into ( start to from -- )
-    copy-into-check dup length
-    [ >r pick r> + pick set-nth-unsafe ] 2each 2drop ;
-    inline
-
-: >sequence ( seq quot -- )
-    over >r >r length r> call dup 0 swap r> copy-into ; inline
-
 : nappend ( to from -- )
     >r [ length ] keep r> copy-into ; inline
 
@@ -118,6 +106,9 @@ M: object like drop ;
         [ swap [ nth ] map-with ] map-with
     ] unless ; flushable
 
+: unpair ( seq -- firsts seconds )
+    flip dup empty? [ drop { } { } ] [ first2 ] if ;
+
 : exchange ( n n seq -- )
     pick over bounds-check 2drop 2dup bounds-check 2drop
     exchange-unsafe ;
@@ -125,10 +116,28 @@ M: object like drop ;
 : assoc ( key assoc -- value ) 
     [ first = ] find-with nip second ;
 
-: unclip ( seq -- rest first ) 1 over tail swap first ;
-
 : last/first ( seq -- pair ) dup peek swap first 2array ;
 
+: sequence= ( seq seq -- ? )
+    2dup [ length ] 2apply = [
+        dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip
+    ] [
+        2drop f
+    ] if ;
+
+UNION: sequence array string sbuf vector quotation ;
+
+M: sequence = ( obj seq -- ? )
+    2dup eq? [
+        2drop t
+    ] [
+        over type over type eq? [ sequence= ] [ 2drop f ] if
+    ] if ;
+
+M: sequence hashcode ( seq -- n )
+    #! Poor
+    length ;
+
 IN: kernel
 
 M: object <=>

library/collections/sequences-epilogue.facts

@@ -1,5 +1,5 @@
 IN: sequences
-USING: help ;
+USING: help kernel ;
 
 HELP: first2 "( seq -- first second )"
 { $values { "seq" "a sequence" } { "first" "the first element" } { "second" "the second element" } }
@@ -125,3 +125,7 @@ HELP: flip "( matrix -- newmatrix )"
 { $values { "matrix" "a sequence of equal-length sequences" } { "newmatrix" "a sequence of equal-length sequences" } }
 { $description "Transposes the matrix; that is, rows become columns and columns become rows." }
 { $examples { $example "{ { 1 2 3 } { 4 5 6 } } flip ." "{ { 1 4 } { 2 5 } { 3 6 } }" } } ;
+
+HELP: sequence= "( seq1 seq2 -- ? )"
+{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "?" "a boolean" } }
+{ $description "Tests if the two sequences have the same length and elements. This is weaker than " { $link = } ", since it does not ensure that the sequences are instances of the same class." } ;

library/collections/slicing.factor

@@ -103,13 +103,4 @@ strings vectors ;
     2dup mismatch dup -1 = [ drop 2dup min-length ] when
     tuck swap tail-slice >r swap tail-slice r> ;
 
-: unpair ( seq -- firsts seconds )
-    flip dup empty? [ drop { } { } ] [ first2 ] if ;
-
-: concat ( seq -- seq )
-    dup empty? [ [ [ % ] each ] over first make ] unless ;
-    flushable
-
-: join ( seq glue -- seq )
-    [ swap [ % ] [ dup % ] interleave drop ] over make ;
-    flushable
+: unclip ( seq -- rest first ) 1 over tail swap first ;

library/collections/strings.factor

@@ -4,6 +4,14 @@ IN: strings
 USING: generic kernel kernel-internals math sequences
 sequences-internals ;
 
+M: string = ( obj str -- ? )
+    over string? [
+        over hashcode over hashcode number=
+        [ sequence= ] [ 2drop f ] if
+    ] [
+        2drop f
+    ] if ;
+
 M: string hashcode
     dup string-hashcode [ ] [
         dup rehash-string string-hashcode
@@ -21,6 +29,8 @@ M: string set-nth-unsafe
 
 M: string clone (clone) ;
 
+M: string resize resize-string ;
+
 ! Characters
 PREDICATE: integer blank     " \t\n\r" member? ;
 PREDICATE: integer letter    CHAR: a CHAR: z between? ;

library/help/markup.factor

@@ -133,7 +133,7 @@ DEFER: help
 
 : $subtopic ( object -- )
     [
-        uncons* ($subtopic) [
+        unclip swap ($subtopic) [
             subtopic-style [ print-element ] with-style
         ] write-outliner
     ] ($block) ;

library/help/syntax.factor

@@ -5,7 +5,7 @@ USING: arrays help kernel parser sequences syntax words ;
 
 : HELP:
     scan-word bootstrap-word dup [
-        >array uncons* >r "stack-effect" set-word-prop r>
+        >array unclip swap >r "stack-effect" set-word-prop r>
         "help" set-word-prop
     ] f ; parsing
 

library/syntax/see.facts

@@ -57,7 +57,3 @@ $prettyprinting-note ;
 HELP: see "( word -- )"
 { $values { "word" "a word" } }
 { $description "Prettyprints the definition of a word." } ;
-
-HELP: apropos "( substr -- )"
-{ $values { "substr" "a string" } }
-{ $description "Lists all words whose name contains " { $snippet "substr" } "." } ;

library/tools/describe.factor

@@ -120,7 +120,7 @@ DEFER: describe
     ] with-scope ;
 
 : callstack. ( seq -- seq )
-    3 swap group [ first2 print-callframe ] each ;
+    3 swap group [ first2 callframe. ] each ;
 
 : .c callstack callstack. ;
 

library/tools/describe.facts

@@ -58,3 +58,7 @@ HELP: .s "( -- )"
 
 HELP: .r "( -- )"
 { $description "Displays the contents of the return stack, with the top of the stack printed first." } ;
+
+HELP: apropos "( substr -- )"
+{ $values { "substr" "a string" } }
+{ $description "Lists all words whose name contains " { $snippet "substr" } "." } ;

library/ui/browser.factor

@@ -11,8 +11,9 @@ SYMBOL: components
 H{ } clone components set-global
 
 : get-components ( class -- assoc )
-    components get-global hash [ { } ] unless*
-    { "Slots" [ describe ] } add ;
+    components get-global hash [
+        { "Slots" [ describe ] }
+    ] unless* ;
 
 {
     { "Definition" [ help ] }
@@ -21,6 +22,7 @@ H{ } clone components set-global
     { "Links in" [ links-in. ] }
     { "Links out" [ links-out. ] }
     { "Vocabulary" [ word-vocabulary words. ] }
+    { "Properties" [ word-props describe ] }
 } \ word components get-global set-hash
 
 {
@@ -29,6 +31,14 @@ H{ } clone components set-global
     { "Links out" [ links-out. ] }
 } \ link components get-global set-hash
 
+{
+    { "Call stack" [ continuation-call callstack. ] }
+    { "Data stack" [ continuation-data stack. ] }
+    { "Retain stack" [ continuation-retain stack. ] }
+    { "Name stack" [ continuation-name stack. ] }
+    { "Catch stack" [ continuation-catch stack. ] }
+} \ continuation components get-global set-hash
+
 TUPLE: book page pages ;
 
 : show-page ( key book -- )