effects: Add support for :type as standalone, unnamed types. ( :float -- ) pprints as ( _: float -- ), and ( :( a -- b ) -- ) works, etc. :union{ foo bar } pprints as object but could be improved if the effects parser uses the prettyprinter somehow.
Move ?execute-parsing to parser to avoid circularity.locals-and-roots
parent
7d66c331db
commit
3fa9ad91f6
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ] }
|
||||
|
|
|
@ -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? [
|
||||
|
|
Loading…
Reference in New Issue