From 0b8f2e14707a95fb4e97340b0f2e4bcf4ef34070 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 29 Sep 2009 22:53:42 -0500 Subject: [PATCH] give pretty names to typed gensyms, and report them as subwords of the driver word --- extra/typed/typed.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/typed/typed.factor b/extra/typed/typed.factor index f9dbbad61a..3060adea54 100644 --- a/extra/typed/typed.factor +++ b/extra/typed/typed.factor @@ -1,6 +1,6 @@ ! (c)Joe Groff bsd license -USING: accessors combinators combinators.short-circuit -definitions effects fry hints kernel kernel.private namespaces +USING: accessors arrays combinators combinators.short-circuit +definitions effects fry hints math kernel kernel.private namespaces parser quotations see.private sequences words locals locals.definitions locals.parser ; IN: typed @@ -49,8 +49,11 @@ ERROR: output-mismatch-error < type-mismatch-error ; [ nip effect-in-types swap '[ _ declare @ ] ] [ effect-out-types dup typed-stack-effect? [ typed-outputs ] [ 2drop ] if ] 2bi ; +: typed-gensym ( parent-word -- word ) + name>> "( typed " " )" surround f ; + : define-typed-gensym ( word def effect -- gensym ) - [ 3drop gensym dup ] + [ 2drop typed-gensym dup ] [ [ swap ] dip typed-gensym-quot ] [ 2nip ] 3tri define-declared ; @@ -90,3 +93,4 @@ M: typed-lambda-word definer drop \ TYPED:: \ ; ; M: typed-word definition "typed-def" word-prop ; M: typed-word declarations. "typed-word" word-prop declarations. ; +M: typed-word subwords "typed-word" word-prop 1array ;