]> gitweb.factorcode.org Git - factor.git/commitdiff
give pretty names to typed gensyms, and report them as subwords of the driver word
authorJoe Groff <arcata@gmail.com>
Wed, 30 Sep 2009 03:53:42 +0000 (22:53 -0500)
committerJoe Groff <arcata@gmail.com>
Wed, 30 Sep 2009 03:53:42 +0000 (22:53 -0500)
extra/typed/typed.factor

index f9dbbad61a16f08a55d1bed978387e0bc9449e30..3060adea5423e616753f91ece62d74a5bf701c22 100644 (file)
@@ -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 <word> ;
+
 : 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 ;