]> gitweb.factorcode.org Git - factor.git/commitdiff
Change (:) to parse effect immediately, and remove ( parsing word
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 21 Mar 2009 08:17:35 +0000 (03:17 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 21 Mar 2009 08:17:35 +0000 (03:17 -0500)
14 files changed:
basis/functors/functors-tests.factor
basis/functors/functors.factor
basis/locals/locals.factor
basis/locals/parser/parser.factor
basis/macros/macros.factor
basis/memoize/memoize.factor
basis/peg/peg.factor
core/bootstrap/syntax.factor
core/effects/parser/parser.factor
core/parser/parser.factor
core/sequences/sequences.factor
core/syntax/syntax.factor
core/vocabs/parser/parser.factor
extra/descriptive/descriptive.factor

index df008d52bdc4e4754955f3918f0995120ad02bbd..b4417532b4f64fc3f7aa018766f16ee9460f5f52 100644 (file)
@@ -13,7 +13,7 @@ WHERE
 
 TUPLE: B { value T } ;
 
-C: <B> B
+C: <B> B ( T -- B )
 
 ;FUNCTOR
 
index 58c9edaf0c4c196bd89e2ffcb34fd7a820e35851..d69233b8d10cd7847b885bd07c7175f17842bfa3 100644 (file)
@@ -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
-    DEFINE* ;
+    "(" expect ")" parse-effect
+    [ [ [ boa ] curry ] over push-all ] dip parsed
+    \ define-declared* parsed ;
 
 SYNTAX: `:
-    effect off
     scan-param parsed
-    parse-definition*
-    DEFINE* ;
+    parse-declared*
+    \ 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 ;
index e6b363c209bc48de0be1dc4e6824328d3e9083d7..9e26a8caaa413c143e06563021286e57412b58de 100644 (file)
@@ -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 ;
 
index d987e2c91d42831447ecab0a0d7b39571768246d..3417d67e09e94e4ad230672556405d5f58adc331 100644 (file)
@@ -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 ]
-    [ rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] 2bi ; inline
+    [ nip "lambda" set-word-prop ]
+    [ 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 ;
\ No newline at end of file
index 48696015885846d8e910044de1891666e06ae543..f64c88388aa5fb84e0415d4f37170fa7a38c85ac 100644 (file)
@@ -6,15 +6,16 @@ IN: macros
 
 <PRIVATE
 
-: real-macro-effect ( word -- effect' )
-    stack-effect in>> 1 <effect> ;
+: real-macro-effect ( effect -- effect' )
+    in>> 1 <effect> ;
 
 PRIVATE>
 
-: define-macro ( word definition -- )
-    [ "macro" set-word-prop ]
-    [ over real-macro-effect memoize-quot [ call ] append define ]
-    2bi ;
+: define-macro ( word definition effect -- )
+    real-macro-effect
+    [ drop "macro" set-word-prop ]
+    [ [ memoize-quot [ call ] append ] keep define-declared ]
+    3bi ;
 
 SYNTAX: MACRO: (:) define-macro ;
 
index 2c0cd357db90f806b52afdf4724f543573609696..4e10fc3de4548e3afc165ad5b8b5a64c055cfb9f 100644 (file)
@@ -34,11 +34,10 @@ M: too-many-arguments summary
 
 PRIVATE>
 
-: define-memoized ( word quot -- )
-    [ H{ } clone ] dip
-    [ pick stack-effect make-memoizer define ]
-    [ nip "memo-quot" set-word-prop ]
-    [ drop "memoize" set-word-prop ]
+: define-memoized ( word quot effect -- )
+    [ drop "memo-quot" set-word-prop ]
+    [ 2drop H{ } clone "memoize" set-word-prop ]
+    [ [ [ dup "memoize" word-prop ] 2dip make-memoizer ] keep define-declared ]
     3tri ;
 
 SYNTAX: MEMO: (:) define-memoized ;
index febcde5b25869faef5b816f3d9f458ed14e495fd..98c92159ec6b0ac452e067b2d16e9dab38676a48 100644 (file)
@@ -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
index 6e6812e25c3ca3e1c098bc75bfc6f49530ed3489..022bcba3b5b2dddfa704d2460dd398f642911880 100644 (file)
@@ -9,7 +9,6 @@ IN: bootstrap.syntax
     "!"
     "\""
     "#!"
-    "("
     "(("
     ":"
     ";"
index 04dc42712ce027ff0d3648c7b6da12a7189f6afa..2cc2e9f0a7c717dc0bc693935957e9a8637f8563 100644 (file)
@@ -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 {
-                    { \ ( [ ")" parse-effect ] }
-                    [ ]
+                scan {
+                    { "(" [ ")" 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 ;
\ No newline at end of file
+    [ ")" parse-effect ] dip 2array over push-all ;
\ No newline at end of file
index 1f4d377b27ce599374cc7b72e2116dfa91eed77a..62177ec0c7c9ebe48c287ae5603e0399ca6e18ac 100644 (file)
@@ -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 ;
 
index 144b417f04b9a8d209ade4eb52c8b3d47adfeb0c..f352705e85698751916d02bb1b23ed236f2acb3d 100755 (executable)
@@ -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' )
index 47a45f6e4e38e5f9d4d03ab5a850abaa7e620f64..1cf627a1a99d5f3028b97a1fef8e6461d6a4abc7 100644 (file)
@@ -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
index 35feae34bbddfc73525836ac15bcf7a9c2c0d63f..e8783c0dbe1655fcadf5d7a141659fbd8ee0a87b 100644 (file)
@@ -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+) ;
\ No newline at end of file
index ed412ee445088e35f0eac8100460f4c811e5a14d..869158bf725cd30469c5bf6f5c857d5540011c83 100755 (executable)
@@ -19,9 +19,10 @@ M: descriptive-error summary
     [ recover ] 2curry ;\r
 PRIVATE>\r
 \r
-: define-descriptive ( word def -- )\r
-    [ "descriptive-definition" set-word-prop ]\r
-    [ dupd [descriptive] define ] 2bi ;\r
+: define-descriptive ( word def effect -- )\r
+    [ drop "descriptive-definition" set-word-prop ]\r
+    [ [ dupd [descriptive] ] dip define-declared ]\r
+    3bi ;\r
 \r
 SYNTAX: DESCRIPTIVE: (:) define-descriptive ;\r
 \r