Change (:) to parse effect immediately, and remove ( parsing word

basis/functors/functors-tests.factor

@@ -13,7 +13,7 @@ WHERE
 
 TUPLE: B { value T } ;
 
-C: <B> B
+C: <B> B ( T -- B )
 
 ;FUNCTOR
 

basis/functors/functors.factor

@@ -14,9 +14,9 @@ IN: functors
 
 : scan-param ( -- obj ) scan-object literalize ;
 
-: define* ( word def effect -- ) pick set-word define-declared ;
+: define* ( word def -- ) over set-word define ;
 
-: define-syntax* ( word def -- ) over set-word define-syntax ;
+: define-declared* ( word def effect -- ) pick set-word define-declared ;
 
 TUPLE: fake-quotation seq ;
 
@@ -41,7 +41,12 @@ M: object fake-quotations> ;
 : parse-definition* ( accum -- accum )
     parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
 
-: DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
+: parse-declared* ( accum -- accum )
+    "(" expect ")" parse-effect
+    [ parse-definition* ] dip
+    parsed ;
+
+: DEFINE* ( accum -- accum ) \ define-declared* parsed ;
 
 SYNTAX: `TUPLE:
     scan-param parsed
@@ -57,31 +62,28 @@ SYNTAX: `TUPLE:
     \ define-tuple-class parsed ;
 
 SYNTAX: `M:
-    effect off
     scan-param parsed
     scan-param parsed
     \ create-method-in parsed
     parse-definition*
-    DEFINE* ;
+    \ define* parsed ;
 
 SYNTAX: `C:
-    effect off
     scan-param parsed
     scan-param parsed
-    [ [ boa ] curry ] over push-all
+    "(" expect ")" parse-effect
-    DEFINE* ;
+    [ [ [ boa ] curry ] over push-all ] dip parsed
+    \ define-declared* parsed ;
 
 SYNTAX: `:
-    effect off
     scan-param parsed
-    parse-definition*
+    parse-declared*
-    DEFINE* ;
+    \ define-declared* parsed ;
 
 SYNTAX: `SYNTAX:
-    effect off
     scan-param parsed
     parse-definition*
-    \ define-syntax* parsed ;
+    \ define-syntax parsed ;
 
 SYNTAX: `INSTANCE:
     scan-param parsed
@@ -90,9 +92,6 @@ SYNTAX: `INSTANCE:
 
 SYNTAX: `inline [ word make-inline ] over push-all ;
 
-SYNTAX: `(
-    ")" parse-effect effect set ;
-
 : (INTERPOLATE) ( accum quot -- accum )
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
@@ -118,7 +117,6 @@ DEFER: ;FUNCTOR delimiter
         { "INSTANCE:" POSTPONE: `INSTANCE: }
         { "SYNTAX:" POSTPONE: `SYNTAX: }
         { "inline" POSTPONE: `inline }
-        { "(" POSTPONE: `( }
     } ;
 
 : push-functor-words ( -- )
@@ -133,9 +131,9 @@ DEFER: ;FUNCTOR delimiter
     [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) <let*> 1quotation
     pop-functor-words ;
 
-: (FUNCTOR:) ( -- word def )
+: (FUNCTOR:) ( -- word def effect )
     CREATE-WORD [ parse-functor-body ] parse-locals-definition ;
 
 PRIVATE>
 
-SYNTAX: FUNCTOR: (FUNCTOR:) define ;
+SYNTAX: FUNCTOR: (FUNCTOR:) define-declared ;

basis/locals/locals.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer macros memoize parser sequences vocabs
 vocabs.loader words kernel namespaces locals.parser locals.types
@@ -17,7 +17,7 @@ SYNTAX: [let* parse-let* over push-all ;
 
 SYNTAX: [wlet parse-wlet over push-all ;
 
-SYNTAX: :: (::) define ;
+SYNTAX: :: (::) define-declared ;
 
 SYNTAX: M:: (M::) define ;
 

basis/locals/parser/parser.factor

@@ -103,18 +103,19 @@ M: lambda-parser parse-quotation ( -- quotation )
     "|" expect "|" parse-wbindings
     (parse-lambda) <wlet> ?rewrite-closures ;
 
-: parse-locals ( -- vars assoc )
+: parse-locals ( -- effect vars assoc )
     "(" expect ")" parse-effect
-    word [ over "declared-effect" set-word-prop ] when*
+    dup
     in>> [ dup pair? [ first ] when ] map make-locals ;
 
-: parse-locals-definition ( word reader -- word quot )
+: parse-locals-definition ( word reader -- word quot effect )
     [ parse-locals ] dip
     ((parse-lambda)) <lambda>
-    [ "lambda" set-word-prop ]
+    [ nip "lambda" set-word-prop ]
-    [ rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] 2bi ; inline
+    [ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ]
+    [ drop nip ] 3tri ; inline
 
-: (::) ( -- word def )
+: (::) ( -- word def effect )
     CREATE-WORD
     [ parse-definition ]
     parse-locals-definition ;
@@ -123,5 +124,5 @@ M: lambda-parser parse-quotation ( -- quotation )
     CREATE-METHOD
     [
         [ parse-definition ] 
-        parse-locals-definition
+        parse-locals-definition drop
     ] with-method-definition ;

basis/macros/macros.factor

@@ -6,15 +6,16 @@ IN: macros
 
 <PRIVATE
 
-: real-macro-effect ( word -- effect' )
+: real-macro-effect ( effect -- effect' )
-    stack-effect in>> 1 <effect> ;
+    in>> 1 <effect> ;
 
 PRIVATE>
 
-: define-macro ( word definition -- )
+: define-macro ( word definition effect -- )
-    [ "macro" set-word-prop ]
+    real-macro-effect
-    [ over real-macro-effect memoize-quot [ call ] append define ]
+    [ drop "macro" set-word-prop ]
-    2bi ;
+    [ [ memoize-quot [ call ] append ] keep define-declared ]
+    3bi ;
 
 SYNTAX: MACRO: (:) define-macro ;
 

basis/memoize/memoize.factor

@@ -34,11 +34,10 @@ M: too-many-arguments summary
 
 PRIVATE>
 
-: define-memoized ( word quot -- )
+: define-memoized ( word quot effect -- )
-    [ H{ } clone ] dip
+    [ drop "memo-quot" set-word-prop ]
-    [ pick stack-effect make-memoizer define ]
+    [ 2drop H{ } clone "memoize" set-word-prop ]
-    [ nip "memo-quot" set-word-prop ]
+    [ [ [ dup "memoize" word-prop ] 2dip make-memoizer ] keep define-declared ]
-    [ drop "memoize" set-word-prop ]
     3tri ;
 
 SYNTAX: MEMO: (:) define-memoized ;

basis/peg/peg.factor

@@ -618,7 +618,7 @@ ERROR: parse-failed input word ;
 
 SYNTAX: PEG:
   (:)
-  [let | def [ ] word [ ] |
+  [let | effect [ ] def [ ] word [ ] |
     [
       [
         [let | compiled-def [ def call compile ] |
@@ -626,7 +626,7 @@ SYNTAX: PEG:
             dup compiled-def compiled-parse
             [ ast>> ] [ word parse-failed ] ?if
           ]
-          word swap define
+          word swap effect define-declared
         ]
       ] with-compilation-unit
     ] over push-all

core/bootstrap/syntax.factor

@@ -9,7 +9,6 @@ IN: bootstrap.syntax
     "!"
     "\""
     "#!"
-    "("
     "(("
     ":"
     ";"

core/effects/parser/parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer sets sequences kernel splitting effects
-combinators arrays parser ;
+combinators arrays ;
 IN: effects.parser
 
 DEFER: parse-effect
@@ -12,9 +12,9 @@ ERROR: bad-effect ;
     scan [ nip ] [ = ] 2bi [ drop f ] [
         dup { f "(" "((" } member? [ bad-effect ] [
             ":" ?tail [
-                scan-word {
+                scan {
-                    { \ ( [ ")" parse-effect ] }
+                    { "(" [ ")" parse-effect ] }
-                    [ ]
+                    { f [ ")" unexpected-eof ] }
                 } case 2array
             ] when
         ] if
@@ -28,4 +28,4 @@ ERROR: bad-effect ;
     [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
 
 : parse-call( ( accum word -- accum )
-    [ ")" parse-effect parsed ] dip parsed ;
+    [ ")" parse-effect ] dip 2array over push-all ;

core/parser/parser.factor

@@ -4,7 +4,7 @@ USING: arrays definitions generic assocs kernel math namespaces
 sequences strings vectors words words.symbol quotations io combinators
 sorting splitting math.parser effects continuations io.files vocabs
 io.encodings.utf8 source-files classes hashtables compiler.errors
-compiler.units accessors sets lexer vocabs.parser slots ;
+compiler.units accessors sets lexer vocabs.parser effects.parser slots ;
 IN: parser
 
 : location ( -- loc )
@@ -132,7 +132,10 @@ M: f parse-quotation \ ] parse-until >quotation ;
 : parse-definition ( -- quot )
     \ ; parse-until >quotation ;
 
-: (:) ( -- word def ) CREATE-WORD parse-definition ;
+: (:) ( -- word def effect )
+    CREATE-WORD
+    "(" expect ")" parse-effect
+    parse-definition swap ;
 
 ERROR: bad-number ;
 

core/sequences/sequences.factor

@@ -176,7 +176,7 @@ PRIVATE>
     3 swap bounds-check nip first4-unsafe ; flushable
 
 : ?nth ( n seq -- elt/f )
-    2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; flushable
+    2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; inline
 
 MIXIN: virtual-sequence
 GENERIC: virtual-seq ( seq -- seq' )

core/syntax/syntax.factor

@@ -111,7 +111,7 @@ IN: bootstrap.syntax
     "delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax
 
     "SYNTAX:" [
-        (:) define-syntax
+        CREATE-WORD parse-definition define-syntax
     ] define-core-syntax
 
     "SYMBOL:" [
@@ -142,7 +142,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     ":" [
-        (:) define
+        (:) define-declared
     ] define-core-syntax
 
     "GENERIC:" [
@@ -220,11 +220,6 @@ IN: bootstrap.syntax
         scan-object forget
     ] define-core-syntax
 
-    "(" [
-        ")" parse-effect
-        word dup [ set-stack-effect ] [ 2drop ] if
-    ] define-core-syntax
-
     "((" [
         "))" parse-effect parsed
     ] define-core-syntax

core/vocabs/parser/parser.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Daniel Ehrenberg, Bruno Deferrari,
+! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs hashtables kernel namespaces sequences
@@ -56,4 +56,4 @@ SYMBOL: in
     dup string? [ "Vocabulary name must be a string" throw ] unless ;
 
 : set-in ( name -- )
-    check-vocab-string dup in set create-vocab (use+) ;
+    check-vocab-string dup in set create-vocab (use+) ;

extra/descriptive/descriptive.factor

@@ -19,9 +19,10 @@ M: descriptive-error summary
     [ recover ] 2curry ;
 PRIVATE>
 
-: define-descriptive ( word def -- )
+: define-descriptive ( word def effect -- )
-    [ "descriptive-definition" set-word-prop ]
+    [ drop "descriptive-definition" set-word-prop ]
-    [ dupd [descriptive] define ] 2bi ;
+    [ [ dupd [descriptive] ] dip define-declared ]
+    3bi ;
 
 SYNTAX: DESCRIPTIVE: (:) define-descriptive ;