1 ! Copyright (C) 2008, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators continuations effects
4 kernel lexer make namespaces parser sequences sets
5 splitting vocabs.parser words ;
11 ERROR: invalid-row-variable ;
12 ERROR: row-variable-can't-have-type ;
13 ERROR: stack-effect-omits-dashes ;
18 : end-token? ( end token -- token ? ) [ nip ] [ = ] 2bi ; inline
19 : effect-opener? ( token -- token ? ) dup { f "(" "--" } member? ; inline
20 : effect-closer? ( token -- token ? ) dup ")" sequence= ; inline
21 : row-variable? ( token -- token' ? ) ".." ?head ; inline
22 : standalone-type? ( token -- token' ? ) ":" ?head ; inline
24 : parse-effect-var ( first? var name -- var )
26 [ ":" ?tail [ row-variable-can't-have-type ] when ] curry
27 [ invalid-row-variable ] if ;
29 : parse-effect-value ( token -- value )
30 ":" ?tail [ scan-object 2array ] when ;
32 ERROR: bad-standalone-effect obj ;
33 : parse-standalone-type ( obj -- var )
36 ?execute-parsing dup length 1 =
37 [ first ] [ bad-standalone-effect ] if
38 ] when f swap 2array ;
41 : parse-effect-token ( first? var end -- var more? )
43 { [ end-token? ] [ drop nip f ] }
44 { [ effect-opener? ] [ bad-effect ] }
45 { [ effect-closer? ] [ stack-effect-omits-dashes ] }
46 { [ row-variable? ] [ parse-effect-var t ] }
49 [ parse-standalone-type ] [ parse-effect-value ] if , t
53 : parse-effect-tokens ( end -- var tokens )
55 [ t f ] dip [ parse-effect-token [ f ] 2dip ] curry [ ] while nip
58 : parse-effect ( end -- effect )
59 [ "--" parse-effect-tokens ] dip parse-effect-tokens
62 : scan-effect ( -- effect )
63 "(" expect ")" parse-effect ;
65 : parse-call-paren ( accum word -- accum )
66 [ ")" parse-effect ] dip 2array append! ;
68 CONSTANT: in-definition HS{ }
70 ERROR: can't-nest-definitions word ;
72 : set-in-definition ( -- )
73 manifest get current-vocab>> t or in-definition ?adjoin
74 [ last-word can't-nest-definitions ] unless ;
76 : unset-in-definition ( -- )
77 manifest get current-vocab>> t or in-definition delete ;
79 : with-definition ( quot -- )
80 [ set-in-definition ] prepose [ unset-in-definition ] finally ; inline
82 : (:) ( -- word def effect )