effects: Add support for :type as standalone, unnamed types. ( :float -- ) pprints...

Move ?execute-parsing to parser to avoid circularity.

diff --git a/core/effects/effects-tests.factor b/core/effects/effects-tests.factor
index 02ac4e26c8a6a0ab547320c78e1df238b0f2371c..068a597994915998bc9e696c36e199a086e2e688 100644 (file)
--- a/core/effects/effects-tests.factor
+++ b/core/effects/effects-tests.factor
@@ -1,5 +1,5 @@
 USING: accessors effects effects.parser eval kernel prettyprint
-sequences tools.test ;
+sequences tools.test math ;
 IN: effects.tests
 
 { t } [ { "a" } { "a" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
@@ -54,3 +54,7 @@ IN: effects.tests
 { ( -- x ) } [ ( c -- d ) curry-effect ] unit-test
 { ( -- x x ) } [ ( -- d ) curry-effect ] unit-test
 { ( x -- ) } [ ( a b -- ) curry-effect ] unit-test
+
+! test unnamed types
+{ ( _: fixnum -- _: float ) } [ ( :fixnum -- :float ) ] unit-test
+{ ( _: union{ fixnum bignum } -- ) } [ ( :union{ fixnum bignum } -- ) ] unit-test

diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor
index 398d4af5a14d7b61768ba6e62c8b9d7f65c5d137..46e635d289395a2f220a712b11de04c9b9c8407a 100644 (file)
--- a/core/effects/parser/parser.factor
+++ b/core/effects/parser/parser.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators continuations effects kernel
-lexer make namespaces parser sequences sets splitting
-vocabs.parser words ;
+USING: accessors arrays combinators continuations effects
+kernel lexer make namespaces parser sequences sets
+splitting vocabs.parser words ;
 IN: effects.parser
 
 DEFER: parse-effect
@@ -19,6 +19,7 @@ SYMBOL: effect-var
 : effect-opener? ( token -- token ? ) dup { f "(" "--" } member? ; inline
 : effect-closer? ( token -- token ? ) dup ")" sequence= ; inline
 : row-variable? ( token -- token' ? ) ".." ?head ; inline
+: standalone-type? ( token -- token' ? ) ":" ?head ; inline
 
 : parse-effect-var ( first? var name -- var )
     nip
@@ -27,6 +28,14 @@ SYMBOL: effect-var
 
 : parse-effect-value ( token -- value )
     ":" ?tail [ scan-object 2array ] when ;
+
+ERROR: bad-standalone-effect obj ;
+: parse-standalone-type ( obj -- var )
+    parse-datum
+    dup parsing-word? [
+        ?execute-parsing dup length 1 =
+        [ first ] [ bad-standalone-effect ] if
+    ] when "_" swap 2array ;
 PRIVATE>
 
 : parse-effect-token ( first? var end -- var more? )
@@ -35,7 +44,10 @@ PRIVATE>
         { [ effect-opener? ] [ bad-effect ] }
         { [ effect-closer? ] [ stack-effect-omits-dashes ] }
         { [ row-variable? ] [ parse-effect-var t ] }
-        [ [ drop ] 2dip parse-effect-value , t ]
+        [
+            [ drop ] 2dip standalone-type?
+            [ parse-standalone-type ] [ parse-effect-value ] if , t
+        ]
     } cond ;
 
 : parse-effect-tokens ( end -- var tokens )

diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor
index 77533de629cba040d88451aa701c3e885672da32..30a463ddbd8d290db0b3ea8c444153823210c735 100644 (file)
--- a/core/generic/parser/parser.factor
+++ b/core/generic/parser/parser.factor
@@ -40,10 +40,6 @@ ERROR: bad-method-effect ;
 : check-method-effect ( effect -- )
     last-word generic-effect method-effect= [ bad-method-effect ] unless ;
 
-: ?execute-parsing ( word/number -- seq )
-    dup parsing-word?
-    [ V{ } clone swap execute-parsing ] [ 1array ] if ;
-
 : parse-method-definition ( -- quot )
     scan-datum {
         { \ ( [ ")" parse-effect check-method-effect parse-definition ] }

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 5b581bce6111b1e98cf908168be06839932c3762..9369bbc17eb10420344671b8084542cd0311b62b 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -98,6 +98,10 @@ ERROR: staging-violation word ;
     dup changed-definitions get in? [ staging-violation ] when
     (execute-parsing) ;
 
+: ?execute-parsing ( word/number -- seq )
+    dup parsing-word?
+    [ V{ } clone swap execute-parsing ] [ 1array ] if ;
+
 : scan-object ( -- object )
     scan-datum
     dup parsing-word? [