From e4158d46fb0f2d7974eedb0dbef1e78428786e7d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 2 Sep 2009 12:13:47 -0500 Subject: [PATCH] coerce and check output types on typed words; set "input-classes" and "default-output-classes" props on typed words --- extra/typed/typed.factor | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/extra/typed/typed.factor b/extra/typed/typed.factor index 624d3e1e6c..f0a7946c79 100644 --- a/extra/typed/typed.factor +++ b/extra/typed/typed.factor @@ -33,7 +33,12 @@ ERROR: output-mismatch-error < type-mismatch-error ; [ output-mismatch-error ] 2curry ; : typed-outputs ( quot word types -- quot' ) - 2drop ; + { + [ 2drop ] + [ 2nip make-coercer ] + [ 2nip make-specializer ] + [ [ drop ] 2dip output-mismatch-quot ] + } 3cleave '[ @ @ @ _ unless ] ; ! defining typed words @@ -45,8 +50,12 @@ PREDICATE: typed < word "typed" word-prop ; [ effect-out-types dup typed-stack-effect? [ typed-outputs ] [ 2drop ] if ] 2bi ; : define-typed ( word def effect -- ) - [ [ 2drop ] [ typed-def ] [ 2nip ] 3tri define-declared ] - [ drop "typed" set-word-prop ] 3bi ; + { + [ [ 2drop ] [ typed-def ] [ 2nip ] 3tri define-declared ] + [ nip effect-in-types "input-classes" set-word-prop ] + [ nip effect-out-types "default-output-classes" set-word-prop ] + [ drop "typed" set-word-prop ] + } 3cleave ; SYNTAX: TYPED: (:) define-typed ;