From d04b47ebe34766e33aa9025572a1fcdf9393e9e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Sep 2005 05:12:16 +0000 Subject: [PATCH] getting more words to infer --- library/compiler/compiler.factor | 2 +- library/compiler/generator.factor | 4 ++-- library/errors.factor | 17 ++++++++++++--- library/httpd/http-common.factor | 2 +- library/inference/known-words.factor | 2 ++ library/inference/words.factor | 4 ++-- library/io/stdio.factor | 5 +++-- library/io/string-streams.factor | 3 ++- library/syntax/parse-errors.factor | 2 +- library/syntax/prettyprint.factor | 8 +++---- library/tools/debugger.factor | 32 +++++++++++++--------------- library/tools/inspector.factor | 10 ++++----- library/tools/memory.factor | 4 +++- 13 files changed, 55 insertions(+), 40 deletions(-) diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index ab6987bf1c..181e9c609b 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -26,7 +26,7 @@ words ; "compile" get [ word compile ] when ; parsing : try-compile ( word -- ) - [ compile ] catch [ error. drop ] when* ; + [ compile ] [ error. drop ] recover ; : compile-all ( -- ) [ try-compile ] each-word ; diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index 14620edf8c..596eded3bb 100644 --- a/library/compiler/generator.factor +++ b/library/compiler/generator.factor @@ -36,10 +36,10 @@ SYMBOL: previous-offset [ compiled-offset previous-offset set (generate) - ] catch [ + ] [ previous-offset get set-compiled-offset rethrow - ] when* ; + ] recover ; ! A few VOPs have trivial generators. diff --git a/library/errors.factor b/library/errors.factor index 17459726d8..a9da25ef0b 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -28,14 +28,25 @@ TUPLE: no-method object generic ; : rethrow ( error -- ) #! Use rethrow when passing an error on from a catch block. - catchstack empty? [ die ] [ c> continue-with ] ifte ; + catchstack empty? [ + die "Can't happen" throw + ] [ + c> continue-with + ] ifte ; : cleanup ( try cleanup -- | try: -- | cleanup: -- ) #! Call the try quotation. If an exception is thrown in the #! dynamic extent of the quotation, restore the datastack #! and run the cleanup quotation. Then throw the error to #! the next outermost catch handler. - >r [ call ] catch r> swap slip - [ nip rethrow ] when* ; inline + >r [ dup slip ] catch nip r> + swap slip [ rethrow ] when* ; inline + +: recover ( try recovery -- | try: -- | recovery: -- ) + #! Call the try quotation. If an exception is thrown in the + #! dynamic extent of the quotation, restore the datastack, + #! push the exception on the datastack, and call the + #! recovery quotation. + >r catch r> when* ; inline GENERIC: error. ( error -- ) diff --git a/library/httpd/http-common.factor b/library/httpd/http-common.factor index 0763cac30d..55420f54d0 100644 --- a/library/httpd/http-common.factor +++ b/library/httpd/http-common.factor @@ -24,7 +24,7 @@ io strings ; ] each ] "" make ; -: catch-hex> ( str -- n ) +: catch-hex> ( str -- n/f ) #! Push f if string is not a valid hex literal. [ hex> ] catch [ drop f ] when ; diff --git a/library/inference/known-words.factor b/library/inference/known-words.factor index 9a8f28ec7f..181d04c07e 100644 --- a/library/inference/known-words.factor +++ b/library/inference/known-words.factor @@ -524,3 +524,5 @@ prettyprint ; \ set-c-stack [ "set-c-stack cannot be compiled (yet)" throw ] "infer" set-word-prop + +\ flush-icache [ [ ] [ ] ] "infer-effect" set-word-prop diff --git a/library/inference/words.factor b/library/inference/words.factor index a086afa573..18370125d0 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -64,9 +64,9 @@ M: compound apply-word ( word -- ) dup dup f infer-compound >r "terminates" set-word-prop r> "infer-effect" set-word-prop - ] catch [ + ] [ swap t "no-effect" set-word-prop rethrow - ] when* ; + ] recover ; : apply-default ( word -- ) dup "no-effect" word-prop [ diff --git a/library/io/stdio.factor b/library/io/stdio.factor index 34c55b582d..c2a74b2626 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -19,11 +19,12 @@ USING: errors generic kernel lists namespaces strings styles ; : with-stream ( stream quot -- ) #! Close the stream no matter what happens. - [ swap stdio set [ close ] cleanup ] with-scope ; + [ swap stdio set [ close ] cleanup ] with-scope ; inline : with-stream* ( stream quot -- ) #! Close the stream if there is an error. - [ swap stdio set catch [ close rethrow ] when* ] with-scope ; + [ swap stdio set [ close rethrow ] recover ] with-scope ; + inline : contents ( stream -- string ) #! Read the entire stream into a string. diff --git a/library/io/string-streams.factor b/library/io/string-streams.factor index 19831463e4..c2bc69ae30 100644 --- a/library/io/string-streams.factor +++ b/library/io/string-streams.factor @@ -12,6 +12,7 @@ M: sbuf stream-finish drop ; : string-out ( quot -- str ) [ 512 stdio set call stdio get >string ] with-scope ; + inline ! Reversed string buffers support the stream input protocol. M: sbuf stream-read1 ( sbuf -- char/f ) @@ -29,4 +30,4 @@ M: sbuf stream-read ( count sbuf -- string ) >sbuf ; : string-in ( str quot -- ) - [ swap stdio set call ] with-scope ; + [ swap stdio set call ] with-scope ; inline diff --git a/library/syntax/parse-errors.factor b/library/syntax/parse-errors.factor index d0ff816035..8b89f7a7a5 100644 --- a/library/syntax/parse-errors.factor +++ b/library/syntax/parse-errors.factor @@ -9,4 +9,4 @@ TUPLE: parse-error file line col text ; file get line-number get "col" get "line" get [ set-delegate ] keep throw ; -: with-parser ( quot -- ) catch [ parse-error ] when* ; +: with-parser ( quot -- ) [ parse-error ] recover ; diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index 3322fdbdcf..59e963fe97 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -226,9 +226,9 @@ M: string pprint* ( str -- str ) "\"" pprint-string ; M: sbuf pprint* ( str -- str ) "SBUF\" " pprint-string ; M: word pprint* ( word -- ) - dup "pprint-before-hook" word-prop call + dup "pprint-open" word-prop [ ] when ; M: f pprint* drop "f" f text ; @@ -349,12 +349,12 @@ M: wrapper pprint* ( wrapper -- ) : define-open #! The word will be pretty-printed as a block opener. #! Examples are [ { {{ [[ << and so on. - [ > and so on. - [ block> ] "pprint-before-hook" set-word-prop ; + t "pprint-close" set-word-prop ; { { POSTPONE: [ POSTPONE: ] } diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index f4dfdb99a6..ac7b492d0c 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -47,24 +47,22 @@ parser prettyprint sequences io strings vectors words ; PREDICATE: cons kernel-error ( obj -- ? ) car kernel-error = ; -M: f error. ( f -- ) drop ; - M: kernel-error error. ( error -- ) #! Kernel errors are indexed by integers. cdr uncons car swap { - expired-error. - io-error. - undefined-word-error. - type-check-error. - float-format-error. - signal-error. - negative-array-size-error. - c-string-error. - ffi-error. - heap-scan-error. - undefined-symbol-error. - user-interrupt. - } nth execute ; + [ expired-error. ] + [ io-error. ] + [ undefined-word-error. ] + [ type-check-error. ] + [ float-format-error. ] + [ signal-error. ] + [ negative-array-size-error. ] + [ c-string-error. ] + [ ffi-error. ] + [ heap-scan-error. ] + [ undefined-symbol-error. ] + [ user-interrupt. ] + } dispatch ; M: no-method error. ( error -- ) "No suitable method." print @@ -116,12 +114,12 @@ M: object error. ( error -- ) . ; : print-error ( error -- ) #! Print the error. - [ error. ] catch flush-error-handler ; + [ dup error. ] catch nip flush-error-handler ; : try ( quot -- ) #! Execute a quotation, and if it throws an error, print it #! and return to the caller. - catch [ print-error debug-help ] when* ; + [ print-error debug-help ] recover ; : save-error ( error ds rs ns cs -- ) #! Save the stacks and parser state for post-mortem diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index 3cbdd365c9..6dd12d2b91 100644 --- a/library/tools/inspector.factor +++ b/library/tools/inspector.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: inspector -USING: arrays generic hashtables io kernel listener -lists math memory namespaces prettyprint sequences +USING: arrays generic hashtables io kernel kernel-internals +listener lists math memory namespaces prettyprint sequences strings styles test vectors words ; GENERIC: sheet ( obj -- sheet ) M: object sheet ( obj -- sheet ) dup class "slots" word-prop - [ second ] map - tuck [ execute ] map-with + dup [ second ] map -rot + [ first slot ] map-with 2array ; M: list sheet 1array ; @@ -23,7 +23,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2array ; : format-column ( list -- list ) [ unparse-short ] map - [ 0 [ length ] reduce ] keep + [ 0 [ length max ] reduce ] keep [ swap CHAR: \s pad-right ] map-with ; : sheet-numbers ( sheet -- sheet ) diff --git a/library/tools/memory.factor b/library/tools/memory.factor index 022e75df40..5f3024ff97 100644 --- a/library/tools/memory.factor +++ b/library/tools/memory.factor @@ -44,12 +44,14 @@ sequences strings unparser vectors words ; : each-object ( quot -- ) #! Applies the quotation to each object in the image. - [ begin-scan (each-object) ] [ end-scan ] cleanup ; inline + [ begin-scan [ (each-object) ] keep ] + [ end-scan ] cleanup drop ; inline : instances ( quot -- list ) #! Return a list of all object that return true when the #! quotation is applied to them. [ [ [ swap call ] 2keep rot ?, ] each-object drop ] [ ] make ; + inline G: each-slot ( obj quot -- ) [ over ] standard-combination ; inline