diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 649ef6c166..9ef2e45141 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -162,6 +162,6 @@ M: compound (uncrossref) over "infer" word-prop or [ drop ] [ - dup { "infer-effect" "base-case" "no-effect" } + dup { "infer-effect" "base-case" "no-effect" "terminates" } reset-props update-xt ] ifte ; diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 43aa7cdc0f..7b624043c0 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -2,8 +2,8 @@ ! See http://factor.sf.net/license.txt for BSD license. USING: alien assembler command-line compiler compiler-backend errors generic hashtables io io-internals kernel -kernel-internals lists math memory namespaces parser sequences -sequences-internals words ; +kernel-internals lists math memory namespaces optimizer parser +sequences sequences-internals words ; : pull-in ( ? list -- ) swap [ @@ -78,7 +78,8 @@ compile? [ { uncons 1+ 1- + <= > >= mod length nth-unsafe set-nth-unsafe - = string>number number>string scan (generate) + = string>number number>string scan solve-recursion + kill-set kill-node (generate) } [ compile ] each ] when diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 1491501f1c..39e609f420 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -167,8 +167,7 @@ M: f ' ( obj -- ptr ) 0 emit ; : word-error ( word msg -- ) - [ % dup word-vocabulary % " " % word-name % ] "" make - throw ; inline + [ % dup word-vocabulary % " " % word-name % ] "" make throw ; : transfer-word ( word -- word ) #! This is a hack. See doc/bootstrap.txt. diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 44dfa19f8b..d59f18a00c 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -156,7 +156,7 @@ IN: kernel #! Push the number of elements on the datastack. datastack length ; -: no-cond "cond fall-through" throw ; inline +: no-cond "cond fall-through" throw ; : cond ( conditions -- ) #! Conditions is a sequence of quotation pairs. diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index fae176e459..c0e13ef844 100644 --- a/library/collections/sequences.factor +++ b/library/collections/sequences.factor @@ -45,7 +45,7 @@ GENERIC: resize ( n seq -- seq ) TUPLE: bounds-error index seq ; -: bounds-error throw ; inline +: bounds-error throw ; : growable-check ( n seq -- fx seq ) >r >fixnum dup 0 fixnum< diff --git a/library/errors.factor b/library/errors.factor index 065294e8f3..a731a57d9d 100644 --- a/library/errors.factor +++ b/library/errors.factor @@ -11,7 +11,7 @@ USING: kernel-internals lists ; TUPLE: no-method object generic ; -: no-method ( object generic -- ) throw ; inline +: no-method ( object generic -- ) throw ; : catchstack ( -- cs ) 6 getenv ; : set-catchstack ( cs -- ) 6 setenv ; diff --git a/library/generic/math-combination.factor b/library/generic/math-combination.factor index 6b1f167bec..3a490bdf78 100644 --- a/library/generic/math-combination.factor +++ b/library/generic/math-combination.factor @@ -31,7 +31,7 @@ math namespaces sequences words ; TUPLE: no-math-method left right generic ; : no-math-method ( left right generic -- ) - 3dup throw ; inline + 3dup throw ; : applicable-method ( generic class -- quot ) over "methods" word-prop hash [ ] [ diff --git a/library/inference/branches.factor b/library/inference/branches.factor index 5e5e540a34..ab05588d10 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -83,8 +83,7 @@ namespaces parser prettyprint sequences strings vectors words ; ] make-hash ; : (infer-branches) ( branchlist -- list ) - [ infer-branch ] map dup unify-effects - unify-dataflow ; + [ infer-branch ] map dup unify-effects unify-dataflow ; : infer-branches ( branches node -- ) #! Recursive stack effect inference is done here. If one of diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor index 71e601cbd7..e84e797641 100644 --- a/library/inference/dataflow.factor +++ b/library/inference/dataflow.factor @@ -55,8 +55,8 @@ M: node = eq? ; : empty-node f { } { } { } { } ; : param-node ( label) { } { } { } { } ; -: in-d-node ( inputs) >r f r> { } { } { } ; -: out-d-node ( outputs) >r f { } r> { } { } ; +: in-node ( inputs) >r f r> { } { } { } ; +: out-node ( outputs) >r f { } r> { } { } ; : d-tail ( n -- list ) meta-d get tail* ; : r-tail ( n -- list ) meta-r get tail* ; @@ -69,7 +69,7 @@ C: #label make-node ; TUPLE: #entry ; C: #entry make-node ; -: #entry ( -- node ) meta-d get clone in-d-node <#entry> ; +: #entry ( -- node ) meta-d get clone in-node <#entry> ; TUPLE: #call ; C: #call make-node ; @@ -82,31 +82,35 @@ C: #call-label make-node ; TUPLE: #shuffle ; C: #shuffle make-node ; : #shuffle ( -- node ) empty-node <#shuffle> ; -: #push ( outputs -- node ) d-tail out-d-node <#shuffle> ; +: #push ( outputs -- node ) d-tail out-node <#shuffle> ; TUPLE: #values ; C: #values make-node ; -: #values ( -- node ) meta-d get clone in-d-node <#values> ; +: #values ( -- node ) meta-d get clone in-node <#values> ; TUPLE: #return ; C: #return make-node ; : #return ( label -- node ) #! The parameter is the label we are returning from, or if #! f, this is a top-level return. - meta-d get clone in-d-node <#return> + meta-d get clone in-node <#return> [ set-node-param ] keep ; TUPLE: #ifte ; C: #ifte make-node ; -: #ifte ( in -- node ) 1 d-tail in-d-node <#ifte> ; +: #ifte ( in -- node ) 1 d-tail in-node <#ifte> ; TUPLE: #dispatch ; C: #dispatch make-node ; -: #dispatch ( in -- node ) 1 d-tail in-d-node <#dispatch> ; +: #dispatch ( in -- node ) 1 d-tail in-node <#dispatch> ; TUPLE: #merge ; C: #merge make-node ; -: #merge ( -- node ) meta-d get clone out-d-node <#merge> ; +: #merge ( -- node ) meta-d get clone out-node <#merge> ; + +TUPLE: #terminate ; +C: #terminate make-node ; +: #terminate ( -- node ) empty-node <#terminate> ; : node-inputs ( d-count r-count node -- ) tuck @@ -169,10 +173,10 @@ SYMBOL: current-node ] ifte ; : drop-inputs ( node -- #shuffle ) - node-in-d clone in-d-node <#shuffle> ; + node-in-d clone in-node <#shuffle> ; : #drop ( n -- #shuffle ) - d-tail in-d-node <#shuffle> ; + d-tail in-node <#shuffle> ; : each-node ( node quot -- | quot: node -- ) over [ diff --git a/library/inference/inference.factor b/library/inference/inference.factor index ff072f8f33..ea00eaf2b9 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -15,7 +15,7 @@ TUPLE: inference-error message rstate data-stack call-stack ; : inference-error ( msg -- ) recursive-state get meta-d get meta-r get - throw ; inline + throw ; M: inference-error error. ( error -- ) "! Inference error:" print @@ -78,11 +78,11 @@ M: wrapper apply-object wrapped apply-literal ; : active? ( -- ? ) #! Is this branch not terminated? - d-in get meta-d get and ; + meta-d get meta-r get and ; : terminate ( -- ) #! Ignore this branch's stack effect. - meta-d off meta-r off d-in off ; + meta-d off meta-r off #terminate node, ; : infer-quot ( quot -- ) #! Recursive calls to this word are made for nested diff --git a/library/inference/words.factor b/library/inference/words.factor index 0911aa2f7b..672083c68e 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -41,15 +41,16 @@ hashtables parser prettyprint ; ] with-nesting ] with-recursive-state ; -: infer-compound ( word base-case -- effect ) +: infer-compound ( word base-case -- terminates? effect ) #! Infer a word's stack effect in a separate inferencer - #! instance. + #! instance. Outputs a boolean if the word terminates + #! control flow by throwing an exception or restoring a + #! continuation. [ inferring-base-case set recursive-state get init-inference - dup inline-block drop - effect - ] with-scope [ consume/produce ] keep ; + [ inline-block drop active? not effect ] keep + ] with-scope over consume/produce over [ terminate ] when ; GENERIC: apply-word @@ -60,7 +61,9 @@ M: object apply-word ( word -- ) M: compound apply-word ( word -- ) #! Infer a compound word's stack effect. [ - dup f infer-compound "infer-effect" set-word-prop + dup dup f infer-compound + >r "terminates" set-word-prop r> + "infer-effect" set-word-prop ] [ [ swap t "no-effect" set-word-prop rethrow ] when* ] catch ; @@ -73,7 +76,8 @@ M: compound apply-word ( word -- ) over "infer" word-prop [ swap first length ensure-values call drop ] [ - consume/produce + dupd consume/produce + "terminates" word-prop [ terminate ] when ] ifte* ] [ apply-word @@ -93,7 +97,7 @@ M: symbol apply-object ( word -- ) [ #call-label ] [ #call ] ?ifte r> over set-node-in-d node, ] [ - drop dup t infer-compound "base-case" set-word-prop + drop dup t infer-compound nip "base-case" set-word-prop ] ifte ; : base-case ( word label -- ) diff --git a/library/math/complex.factor b/library/math/complex.factor index 8b59571ab1..8a28e2a4a8 100644 --- a/library/math/complex.factor +++ b/library/math/complex.factor @@ -21,7 +21,7 @@ M: number = ( n n -- ? ) number= ; over real? over real? and [ (rect>) ] [ - "Complex number must have real components" throw drop + "Complex number must have real components" throw ] ifte ; inline : >rect ( x -- xr xi ) dup real swap imaginary ; inline diff --git a/library/math/integer.factor b/library/math/integer.factor index 9055bf53af..891bfba4f2 100644 --- a/library/math/integer.factor +++ b/library/math/integer.factor @@ -31,8 +31,7 @@ IN: math-internals : fraction> ( a b -- a/b ) dup 1 number= [ drop ] [ (fraction>) ] ifte ; inline -: division-by-zero ( x y -- ) - "Division by zero" throw drop ; inline +: division-by-zero ( x y -- ) "Division by zero" throw ; M: integer / ( x y -- x/y ) dup 0 number= [ diff --git a/library/math/parse-numbers.factor b/library/math/parse-numbers.factor index 2e92a3e14e..751061598e 100644 --- a/library/math/parse-numbers.factor +++ b/library/math/parse-numbers.factor @@ -6,7 +6,7 @@ strings ; ! Number parsing -: not-a-number "Not a number" throw ; inline +: not-a-number "Not a number" throw ; GENERIC: digit> ( ch -- n ) M: digit digit> CHAR: 0 - ; diff --git a/library/test/errors.factor b/library/test/errors.factor index 4183ec5ffa..33e124c686 100644 --- a/library/test/errors.factor +++ b/library/test/errors.factor @@ -1,5 +1,4 @@ IN: temporary -USING: memory ; USE: errors USE: kernel USE: namespaces @@ -7,6 +6,7 @@ USE: test USE: lists USE: parser USE: io +USE: memory [ f ] [ [ ] [ ] catch ] unit-test diff --git a/library/test/inference.factor b/library/test/inference.factor index 4ecfcd851f..fbf10d6b8e 100644 --- a/library/test/inference.factor +++ b/library/test/inference.factor @@ -1,6 +1,6 @@ IN: temporary -USING: arrays generic inference kernel lists math math-internals -namespaces parser sequences test vectors ; +USING: arrays errors generic inference kernel lists math +math-internals namespaces parser sequences test vectors ; [ << shuffle f { "a" } { } { "a" } { "a" } >> @@ -57,6 +57,14 @@ namespaces parser sequences test vectors ; [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] ifte call ] unit-test-fails +! Test inference of termination of control flow +: termination-test-1 + "foo" throw ; + +: termination-test-2 [ termination-test-1 ] [ 3 ] ifte ; + +[ @{ 1 1 }@ ] [ [ termination-test-2 ] infer ] unit-test + : infinite-loop infinite-loop ; : simple-recursion-1 diff --git a/library/unix/io.factor b/library/unix/io.factor index 88dc3c2c09..4c0f8069ca 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -74,7 +74,7 @@ M: port set-timeout ( timeout port -- ) : >port< dup port-handle swap delegate ; : pending-error ( port -- ) - dup port-error f rot set-port-error throw ; + dup port-error f rot set-port-error [ throw ] when* ; : report-error ( error port -- ) [ "Error on fd " % dup port-handle # ": " % swap % ] "" make diff --git a/native/error.c b/native/error.c index f3796b3af6..91262be345 100644 --- a/native/error.c +++ b/native/error.c @@ -50,9 +50,7 @@ void throw_error(CELL error, bool keep_stacks) void primitive_throw(void) { - CELL error = dpop(); - if(error != F) - throw_error(error,true); + throw_error(dpop(),true); } void primitive_die(void)