From 079dea6e3c86a739d5d5b3d304f91343b7b6df97 Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 19 May 2006 02:20:23 +0000 Subject: [PATCH] Bootstrap fixes, cleanups, better debugger in the UI --- library/bootstrap/boot-stage1.factor | 5 +-- library/collections/namespaces.factor | 8 ++++ library/collections/sbuf.factor | 1 - .../collections/sequence-combinators.factor | 12 ++++++ library/collections/sequence-eq.factor | 33 ----------------- library/collections/sequence-eq.facts | 6 --- library/collections/sequences-epilogue.factor | 37 ++++++++++++------- library/collections/sequences-epilogue.facts | 6 ++- library/collections/slicing.factor | 11 +----- library/collections/strings.factor | 10 +++++ library/help/markup.factor | 2 +- library/help/syntax.factor | 2 +- library/syntax/see.facts | 4 -- library/tools/describe.factor | 2 +- library/tools/describe.facts | 4 ++ library/ui/browser.factor | 14 ++++++- 16 files changed, 80 insertions(+), 77 deletions(-) delete mode 100644 library/collections/sequence-eq.factor delete mode 100644 library/collections/sequence-eq.facts diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 4dafd01cad..219ad94025 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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" diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index 40dd75b119..10ee1092f1 100644 --- a/library/collections/namespaces.factor +++ b/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 ; diff --git a/library/collections/sbuf.factor b/library/collections/sbuf.factor index 2e6d5aebd8..a38759b16d 100644 --- a/library/collections/sbuf.factor +++ b/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 ; diff --git a/library/collections/sequence-combinators.factor b/library/collections/sequence-combinators.factor index 38ab00d584..3016a27a2f 100644 --- a/library/collections/sequence-combinators.factor +++ b/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 diff --git a/library/collections/sequence-eq.factor b/library/collections/sequence-eq.factor deleted file mode 100644 index 43412ebed0..0000000000 --- a/library/collections/sequence-eq.factor +++ /dev/null @@ -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 ; diff --git a/library/collections/sequence-eq.facts b/library/collections/sequence-eq.facts deleted file mode 100644 index d9634ed715..0000000000 --- a/library/collections/sequence-eq.facts +++ /dev/null @@ -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." } ; diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index c89f65c2a5..7cadcadae4 100644 --- a/library/collections/sequences-epilogue.factor +++ b/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 <=> diff --git a/library/collections/sequences-epilogue.facts b/library/collections/sequences-epilogue.facts index 1057e37c2e..5d7fde7e98 100644 --- a/library/collections/sequences-epilogue.facts +++ b/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." } ; diff --git a/library/collections/slicing.factor b/library/collections/slicing.factor index 64a103aec2..7838950751 100644 --- a/library/collections/slicing.factor +++ b/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 ; diff --git a/library/collections/strings.factor b/library/collections/strings.factor index 64f420fde9..d5ebf504fe 100644 --- a/library/collections/strings.factor +++ b/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? ; diff --git a/library/help/markup.factor b/library/help/markup.factor index 7843ee408e..6b7f3997d0 100644 --- a/library/help/markup.factor +++ b/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) ; diff --git a/library/help/syntax.factor b/library/help/syntax.factor index 1e13f73deb..9b60276ccd 100644 --- a/library/help/syntax.factor +++ b/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 diff --git a/library/syntax/see.facts b/library/syntax/see.facts index 0d0deaa923..5817873147 100644 --- a/library/syntax/see.facts +++ b/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" } "." } ; diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 32d39f6592..ca119b89bb 100644 --- a/library/tools/describe.factor +++ b/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. ; diff --git a/library/tools/describe.facts b/library/tools/describe.facts index 61aef3e41f..36db7c1370 100644 --- a/library/tools/describe.facts +++ b/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" } "." } ; diff --git a/library/ui/browser.factor b/library/ui/browser.factor index faf7254fd2..cb3ab9b4fe 100644 --- a/library/ui/browser.factor +++ b/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 -- )