diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index df008d52bd..b4417532b4 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -13,7 +13,7 @@ WHERE TUPLE: B { value T } ; -C: B +C: B ( T -- B ) ;FUNCTOR diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 58c9edaf0c..d69233b8d1 100644 --- a/basis/functors/functors.factor +++ b/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 - 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)) 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 ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e6b363c209..9e26a8caaa 100644 --- a/basis/locals/locals.factor +++ b/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 ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index d987e2c91d..3417d67e09 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -103,18 +103,19 @@ M: lambda-parser parse-quotation ( -- quotation ) "|" expect "|" parse-wbindings (parse-lambda) ?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" 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 diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 4869601588..f64c88388a 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -6,15 +6,16 @@ IN: macros > 1 ; +: real-macro-effect ( effect -- effect' ) + in>> 1 ; 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 ; diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor index 2c0cd357db..4e10fc3de4 100644 --- a/basis/memoize/memoize.factor +++ b/basis/memoize/memoize.factor @@ -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 ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index febcde5b25..98c92159ec 100644 --- a/basis/peg/peg.factor +++ b/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 diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 6e6812e25c..022bcba3b5 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -9,7 +9,6 @@ IN: bootstrap.syntax "!" "\"" "#!" - "(" "((" ":" ";" diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index 04dc42712c..2cc2e9f0a7 100644 --- a/core/effects/parser/parser.factor +++ b/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 { - { \ ( [ ")" parse-effect ] } - [ ] + scan { + { "(" [ ")" parse-effect ] } + { f [ ")" unexpected-eof ] } } case 2array ] when ] if @@ -28,4 +28,4 @@ ERROR: bad-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 diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1f4d377b27..62177ec0c7 100644 --- a/core/parser/parser.factor +++ b/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 ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 144b417f04..f352705e85 100755 --- a/core/sequences/sequences.factor +++ b/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' ) diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 47a45f6e4e..1cf627a1a9 100644 --- a/core/syntax/syntax.factor +++ b/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 diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 35feae34bb..e8783c0dbe 100644 --- a/core/vocabs/parser/parser.factor +++ b/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+) ; \ No newline at end of file diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index ed412ee445..869158bf72 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -19,9 +19,10 @@ M: descriptive-error summary [ recover ] 2curry ; PRIVATE> -: define-descriptive ( word def -- ) - [ "descriptive-definition" set-word-prop ] - [ dupd [descriptive] define ] 2bi ; +: define-descriptive ( word def effect -- ) + [ drop "descriptive-definition" set-word-prop ] + [ [ dupd [descriptive] ] dip define-declared ] + 3bi ; SYNTAX: DESCRIPTIVE: (:) define-descriptive ;