steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

give pretty names to typed gensyms, and report them as subwords of the driver word

db4
Joe Groff 2009-09-29 22:53:42 -05:00
parent 4ae9e71f5c
commit 0b8f2e1470
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/typed/typed.factor
View File

@ -1,6 +1,6 @@
! (c)Joe Groff bsd license ! (c)Joe Groff bsd license
USING: accessors combinators combinators.short-circuit USING: accessors arrays combinators combinators.short-circuit
definitions effects fry hints kernel kernel.private namespaces definitions effects fry hints math kernel kernel.private namespaces
parser quotations see.private sequences words parser quotations see.private sequences words
locals locals.definitions locals.parser ; locals locals.definitions locals.parser ;
IN: typed IN: typed
@ -49,8 +49,11 @@ ERROR: output-mismatch-error < type-mismatch-error ;
[ nip effect-in-types swap '[ _ declare @ ] ] [ nip effect-in-types swap '[ _ declare @ ] ]
[ effect-out-types dup typed-stack-effect? [ typed-outputs ] [ 2drop ] if ] 2bi ; [ effect-out-types dup typed-stack-effect? [ typed-outputs ] [ 2drop ] if ] 2bi ;
: typed-gensym ( parent-word -- word )
name>> "( typed " " )" surround f <word> ;
: define-typed-gensym ( word def effect -- gensym ) : define-typed-gensym ( word def effect -- gensym )
[ 3drop gensym dup ] [ 2drop typed-gensym dup ]
[ [ swap ] dip typed-gensym-quot ] [ [ swap ] dip typed-gensym-quot ]
[ 2nip ] 3tri define-declared ; [ 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 definition "typed-def" word-prop ;
M: typed-word declarations. "typed-word" word-prop declarations. ; M: typed-word declarations. "typed-word" word-prop declarations. ;
M: typed-word subwords "typed-word" word-prop 1array ;