diff --git a/doc/handbook/math.facts b/doc/handbook/math.facts index 25663002d2..08cc2d7848 100644 --- a/doc/handbook/math.facts +++ b/doc/handbook/math.facts @@ -74,8 +74,7 @@ ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic" { $subsection shift } { $subsection log2 } { $subsection power-of-2? } -{ $subsection next-power-of-2 } -{ $subsection each-bit } ; +{ $subsection next-power-of-2 } ; ARTICLE: "random-numbers" "Generating random integers" { $subsection (random-int) } diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index f7d0785518..c901de6349 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -187,7 +187,7 @@ M: f ' ( obj -- ptr ) : transfer-word ( word -- word ) #! This is a hack. See doc/bootstrap.txt. - dup target-word [ ] [ dup "Missing DEFER: " word-error ] ?if ; + dup target-word [ ] [ "Missing DEFER: " word-error ] ?if ; : pooled-object ( object -- ptr ) objects get hash ; diff --git a/library/continuations.factor b/library/continuations.factor index 3871ea988e..b05917b487 100644 --- a/library/continuations.factor +++ b/library/continuations.factor @@ -17,7 +17,7 @@ USING: namespaces sequences ; TUPLE: continuation data retain call name catch ; : continuation ( -- interp ) - datastack retainstack callstack dup pop* dup pop* + datastack retainstack callstack dup pop* dup pop* dup pop* namestack catchstack ; inline : >continuation< ( continuation -- data retain call name catch ) diff --git a/library/errors.factor b/library/errors.factor index eded938bbf..f943e86db8 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -3,10 +3,6 @@ IN: errors USING: kernel kernel-internals sequences ; -TUPLE: no-method object generic ; - -: no-method ( object generic -- ) throw ; - : >c ( continuation -- ) catchstack* push ; : c> ( -- continuation ) catchstack* pop ; diff --git a/library/errors.facts b/library/errors.facts index 4ca88c008f..77e3d2c484 100644 --- a/library/errors.facts +++ b/library/errors.facts @@ -1,9 +1,5 @@ USING: errors help kernel ; -HELP: no-method "( object generic -- )" -{ $values { "object" "an object" } { "generic" "a generic word" } } -{ $description "Throws an error indicating that " { $snippet "object" } " does not respond to the " { $snippet "generic" } " word." } ; - HELP: >c "( continuation -- )" { $values { "continuation" "a continuation" } } { $description "Pushes an exception handler continuation on the catch stack. The continuation must have been reified by " { $link callcc1 } "." } ; diff --git a/library/generic/generic.facts b/library/generic/generic.facts index 8564fc7ffd..568ea858c3 100644 --- a/library/generic/generic.facts +++ b/library/generic/generic.facts @@ -1,4 +1,4 @@ -USING: generic help kernel ; +USING: generic help kernel kernel-internals ; HELP: typemap f { $description "Global variable. Hashtable mapping unions to class words." } diff --git a/library/generic/standard-combination.factor b/library/generic/standard-combination.factor index 7c8ba47bac..8231dfb9ac 100644 --- a/library/generic/standard-combination.factor +++ b/library/generic/standard-combination.factor @@ -1,6 +1,8 @@ -IN: generic +! Copyright (C) 2005, 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: arrays errors hashtables kernel kernel-internals math namespaces sequences vectors words ; +IN: generic : picker ( dispatch# -- quot ) { [ dup ] [ over ] [ pick ] } nth ; @@ -8,6 +10,10 @@ math namespaces sequences vectors words ; : unpicker ( dispatch# -- quot ) { [ nip ] [ >r nip r> swap ] [ >r >r nip r> r> -rot ] } nth ; +TUPLE: no-method object generic ; + +: no-method ( object generic -- ) throw ; + : error-method ( dispatch# word -- method ) >r picker r> [ no-method ] curry append ; diff --git a/library/generic/standard-combination.facts b/library/generic/standard-combination.facts index fc70f30d9d..f4722c1019 100644 --- a/library/generic/standard-combination.facts +++ b/library/generic/standard-combination.facts @@ -1,5 +1,9 @@ USING: generic help sequences ; +HELP: no-method "( object generic -- )" +{ $values { "object" "an object" } { "generic" "a generic word" } } +{ $description "Throws an error indicating that " { $snippet "object" } " does not respond to the " { $snippet "generic" } " word." } ; + HELP: standard-combination "( word dispatch# -- quot )" { $values { "word" "a generic word" } { "dispatch#" "a dispatch position" } { "quot" "a new quotation" } } { $description diff --git a/library/math/pow.facts b/library/math/pow.facts index c6655e822c..b1c19791a9 100644 --- a/library/math/pow.facts +++ b/library/math/pow.facts @@ -17,10 +17,6 @@ HELP: ^ "( x y -- z )" { $description "Raises " { $snippet "x" } " to the power of " { $snippet "y" } ". If " { $snippet "y" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } { $errors "Throws an error if " { $snippet "x" } " and " { $snippet "y" } " are both integer 0." } ; -HELP: each-bit "( n quot -- )" -{ $values { "n" "an integer" } { "quot" "a quotation with stack effect " { $snippet "( 0/1 -- )" } } } -{ $description "Applies the quotation to each bit of the input, ranging from least significant to most significant." } ; - HELP: power-of-2? "( n -- ? )" { $values { "n" "an integer" } { "?" "a boolean" } } { $description "Tests if " { $snippet "n" } " is a power of 2." } ; diff --git a/library/quotations.factor b/library/quotations.factor index b410b9f9f7..ae9d867156 100644 --- a/library/quotations.factor +++ b/library/quotations.factor @@ -30,5 +30,7 @@ M: wrapper literalize ; : curry ( obj quot -- quot ) >r literalize unit r> append ; +: curry-each ( seq quot -- seq ) [ swap curry ] map-with ; + : alist>quot ( default alist -- quot ) [ [ first2 swap % , , \ if , ] [ ] make ] each ; diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index d865d1fb62..d1c17befc0 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -21,6 +21,11 @@ SYMBOL: length-limit SYMBOL: line-limit SYMBOL: string-limit +! Special trick to highlight a word in a quotation +SYMBOL: hilite-quotation +SYMBOL: hilite-index +SYMBOL: hilite-now? + global [ 4 tab-size set 64 margin set @@ -158,11 +163,8 @@ GENERIC: pprint* ( obj -- ) : word-style ( word -- style ) [ dup presented set - parsing? [ - bold font-style - ] [ - { 0 0 0.3 1 } foreground - ] if set + parsing? [ bold font-style set ] when + hilite-now? get [ { 0.9 0.9 0.9 1 } background set ] when ] make-hash ; : pprint-word ( obj -- ) @@ -243,10 +245,16 @@ M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ; : pprint-element ( object -- ) dup parsing? [ \ POSTPONE: pprint-word ] when pprint* ; +: pprint-hilite ( object n -- ) + hilite-index get = hilite-now? set + pprint-element hilite-now? off ; + : pprint-elements ( seq -- ) - length-limit? >r - [ pprint-element ] each - r> [ "..." plain-text ] when ; + length-limit? >r dup hilite-quotation get eq? [ + dup length [ pprint-hilite ] 2each + ] [ + [ pprint-element ] each + ] if r> [ "..." plain-text ] when ; : pprint-sequence ( seq start end -- ) swap pprint* swap pprint-elements pprint* ; diff --git a/library/syntax/see.factor b/library/syntax/see.factor index 77c8588d93..74ab044be5 100644 --- a/library/syntax/see.factor +++ b/library/syntax/see.factor @@ -119,7 +119,3 @@ M: word class. drop ; methods. newline ] with-pprint ; - -: apropos ( substring -- ) - all-words completions natural-sort - [ [ synopsis ] keep simple-object terpri ] each ; diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 6cfa543942..a9449ae65a 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -90,23 +90,31 @@ DEFER: describe : describe ( object -- ) dup summary print sheet sheet. ; -: sequence-outliner ( seq quot -- | quot: obj -- ) - swap [ - [ unparse-short ] keep rot dupd curry - simple-outliner terpri - ] each-with ; +: sequence-outliner ( strings objects quot -- ) + over curry-each 3array flip + [ first3 simple-outliner terpri ] each ; -: words. ( vocab -- ) - words natural-sort [ (help) ] sequence-outliner ; +: unparse-outliner ( seq quot -- | quot: obj -- ) + >r [ [ unparse-short ] map ] keep r> sequence-outliner ; -: vocabs. ( -- ) vocabs [ words. ] sequence-outliner ; +: word-outliner ( seq quot -- ) + >r natural-sort [ [ synopsis ] map ] keep + r> sequence-outliner ; -: usage. ( word -- ) usage [ usage. ] sequence-outliner ; +: words. ( vocab -- ) words [ (help) ] unparse-outliner ; -: uses. ( word -- ) uses [ uses. ] sequence-outliner ; +: vocabs. ( -- ) vocabs [ words. ] unparse-outliner ; + +: usage. ( word -- ) usage [ usage. ] word-outliner ; + +: uses. ( word -- ) uses [ uses. ] word-outliner ; : stack. ( seq -- seq ) >array describe ; : .s datastack stack. ; : .r retainstack stack. ; : .c callstack stack. ; + +: apropos ( substring -- ) + all-words completions natural-sort + [ (help) ] word-outliner ; diff --git a/native/run.c b/native/run.c index 64df781c3e..91f88a4f8e 100644 --- a/native/run.c +++ b/native/run.c @@ -42,8 +42,6 @@ void handle_error(void) else fix_stacks(); - callframe_scan = callframe_end = 0; - dpush(thrown_error); /* Notify any 'catch' blocks */ call(userenv[BREAK_ENV]);