diff --git a/collections/sequences/extras/extras.factor b/collections/sequences/extras/extras.factor index cafd9209f4..ad99419d0e 100644 --- a/collections/sequences/extras/extras.factor +++ b/collections/sequences/extras/extras.factor @@ -544,6 +544,15 @@ PRIVATE> [ drop first4-unsafe ] } case ; +! : ?head* ( seq n -- headseq ) from-end short head ; +! : ?tail* ( seq n -- tailseq ) from-end short tail ; +! : ?cut* ( seq n -- before after ) [ ?head* ] [ ?tail* ] 2bi ; + +! : ?head-slice* ( seq n -- slice ) from-end ?head-slice ; inline +! : ?tail-slice* ( seq n -- slice ) from-end ?tail-slice ; inline +! : ?head*-as ( seq n exemplar -- seq' ) [ ?head-slice* ] [ like ] bi* ; inline +! : ?tail*-as ( seq n exemplar -- seq' ) [ ?tail-slice* ] [ like ] bi* ; inline + : cut-when ( ... seq quot: ( ... elt -- ... ? ) -- ... before after ) [ find drop ] 2keep drop swap [ cut ] [ f over like ] if* ; inline diff --git a/core/math/ranges/ranges.factor b/core/math/ranges/ranges.factor index b1ad913aae..45c5a72a31 100644 --- a/core/math/ranges/ranges.factor +++ b/core/math/ranges/ranges.factor @@ -38,19 +38,19 @@ PRIVATE< : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline -: (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline +: (a,) ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline -: ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline +: (,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline PRIVATE> : [a,b] ( a b -- range ) twiddle ; inline -: (a,b] ( a b -- range ) twiddle (a, ; inline +: (a,b] ( a b -- range ) twiddle (a,) ; inline -: [a,b) ( a b -- range ) twiddle ,b) ; inline +: [a,b) ( a b -- range ) twiddle (,b) ; inline -: (a,b) ( a b -- range ) twiddle (a, ,b) ; inline +: (a,b) ( a b -- range ) twiddle (a,) (,b) ; inline : [0,b] ( b -- range ) 0 swap [a,b] ; inline diff --git a/core/modern/modern.factor b/core/modern/modern.factor index f46a6714fc..63caa2f350 100644 --- a/core/modern/modern.factor +++ b/core/modern/modern.factor @@ -162,14 +162,15 @@ M: array collapse-decorators drop f ] if ; -: delimiters-match? ( opening closing -- ? ) - [ - 1 cut* over empty? [ - nip matching-delimiter-string 1array - ] [ - matching-delimiter-string [ append ] [ nip ] 2bi 2array - ] if - ] dip '[ _ sequence= ] any? ; +ERROR: no-start-delimiter lexer opening ; +:: delimiters-match? ( lexer opening closing -- ? ) + opening empty? [ lexer opening closing no-start-delimiter ] when + + opening 1 cut* over empty? [ + nip matching-delimiter-string 1array + ] [ + matching-delimiter-string [ append ] [ nip ] 2bi 2array + ] if closing '[ _ sequence= ] any? ; ERROR: whitespace-expected-after n string ch ; @@ -423,7 +424,7 @@ ERROR: backslash-expects-whitespace slice ; ERROR: mismatched-terminator lexer slice ; : read-terminator ( lexer slice -- slice ) - 2dup [ peek-tag ] dip delimiters-match? [ + 2dup [ dup peek-tag ] dip delimiters-match? [ nip terminator-literal make-tag-class-literal ] [ mismatched-terminator @@ -483,21 +484,21 @@ MACRO: rules>call-lexer ( seq -- quot: ( lexer string -- literal ) ) CONSTANT: factor-lexing-rules { T{ line-comment-lexer { generator read-exclamation } { delimiter char: \! } } - T{ backtick-lexer { generator read-backtick } { delimiter char: ` } } + T{ backtick-lexer { generator read-backtick } { delimiter char: \` } } T{ backslash-lexer { generator read-backslash } { delimiter char: \\ } } T{ dquote-lexer { generator read-string } { delimiter char: \" } { escape char: \\ } } - T{ decorator-lexer { generator read-decorator } { delimiter char: @ } } + T{ decorator-lexer { generator read-decorator } { delimiter char: \@ } } T{ colon-lexer { generator read-colon } { delimiter char: \: } } - T{ less-than-lexer { generator read-less-than } { delimiter char: < } } + T{ less-than-lexer { generator read-less-than } { delimiter char: \< } } T{ matched-lexer { generator read-bracket } { delimiter char: \[ } } T{ matched-lexer { generator read-brace } { delimiter char: \{ } } T{ matched-lexer { generator read-paren } { delimiter char: \( } } - T{ terminator-lexer { generator read-terminator } { delimiter char: ; } } - T{ terminator-lexer { generator read-terminator } { delimiter char: ] } } - T{ terminator-lexer { generator read-terminator } { delimiter char: } } } - T{ terminator-lexer { generator read-terminator } { delimiter char: ) } } + T{ terminator-lexer { generator read-terminator } { delimiter char: \; } } + T{ terminator-lexer { generator read-terminator } { delimiter char: \] } } + T{ terminator-lexer { generator read-terminator } { delimiter char: \} } } + T{ terminator-lexer { generator read-terminator } { delimiter char: \) } } T{ whitespace-lexer { generator read-token-or-whitespace } { delimiter char: \s } } T{ whitespace-lexer { generator read-token-or-whitespace } { delimiter char: \r } } diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 91a8e7172a..11ac31057f 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -64,7 +64,7 @@ name>char-hook [ : unicode-escape ( str -- ch str' ) "{" ?head-slice [ - char: } over index cut-slice [ + char: \} over index cut-slice [ dup hex> [ nip ] [ diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 0f6de42078..ac727a2ae3 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -188,12 +188,12 @@ in: bootstrap.syntax ] define-core-syntax "DEFER:" [ - scan-token current-vocab create-word + scan-new-escaped [ fake-definition ] [ set-last-word ] [ undefined-def define ] tri ] define-core-syntax "defer:" [ - scan-token current-vocab create-word + scan-new-escaped [ fake-definition ] [ set-last-word ] [ undefined-def define ] tri ] define-core-syntax diff --git a/language/functors/functors.factor b/language/functors/functors.factor index 8ee6e2452e..47f9782775 100644 --- a/language/functors/functors.factor +++ b/language/functors/functors.factor @@ -134,7 +134,7 @@ FUNCTOR-SYNTAX: \ MACRO: \ define-macro suffix! ; FUNCTOR-SYNTAX: inline [ last-word make-inline ] append! ; -FUNCTOR-SYNTAX: @inline [ last-word make-inline ] append! ; +FUNCTOR-SYNTAX: \ @inline [ last-word make-inline ] append! ; FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ; @@ -154,7 +154,7 @@ SYNTAX: DEFINES-PRIVATE [ begin-private create-word-in end-private ] (INTERPOLAT SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; -defer: FUNCTOR; delimiter +defer: \ FUNCTOR> delimiter PRIVATE< @@ -185,4 +185,4 @@ PRIVATE< PRIVATE> -SYNTAX: \ FUNCTOR: (FUNCTOR:) define-declared ; +SYNTAX: \ FUNCTOR< (FUNCTOR:) define-declared ; diff --git a/language/interpolate/interpolate.factor b/language/interpolate/interpolate.factor index 3322ccd16a..9b8dfccce0 100644 --- a/language/interpolate/interpolate.factor +++ b/language/interpolate/interpolate.factor @@ -85,6 +85,6 @@ MACRO: interpolate-locals ( str -- quot ) : interpolate-locals>string ( str -- newstr ) [ interpolate-locals ] with-string-writer ; inline -SYNTAX: I[[ +SYNTAX: \ I[[ "]]" parse-multiline-string interpolate-locals-quot append! ; diff --git a/language/prettyprint/prettyprint.factor b/language/prettyprint/prettyprint.factor index cdc366de32..85249cd192 100644 --- a/language/prettyprint/prettyprint.factor +++ b/language/prettyprint/prettyprint.factor @@ -8,8 +8,8 @@ vocabs.prettyprint words ; in: prettyprint : with-use ( obj quot -- ) - t make-pprint (pprint-manifest - [ pprint-manifest) ] [ [ drop nl ] unless-empty ] bi + t make-pprint pprint-manifest-begin + [ pprint-manifest-end ] [ [ drop nl ] unless-empty ] bi do-pprint ; inline : with-in ( obj quot -- ) diff --git a/language/see/see.factor b/language/see/see.factor index 5c1c18efec..ddd7d75c40 100644 --- a/language/see/see.factor +++ b/language/see/see.factor @@ -126,7 +126,7 @@ M: word declarations. postpone\ flushable } [ declaration. ] with each ; -: pprint-; ( -- ) \ ; pprint-word ; +: pprint-semi ( -- ) \ ; pprint-word ; M: object see* [ @@ -143,12 +143,12 @@ GENERIC: see-class* ( word -- ) ; M: union-class see-class* ; + class-members pprint-elements pprint-semi block> ; M: intersection-class see-class* ; + class-participants pprint-elements pprint-semi block> ; M: mixin-class see-class* block> ; + pprint-semi block> block> ; M: singleton-class see-class* ( class -- ) \ singleton: pprint-word pprint-word ; @@ -211,7 +211,7 @@ M: tuple-class see-class* { [ pprint-word ] [ superclass. ] - [ pprint-; ] + [ pprint-semi ] [ tuple-declarations. ] } cleave block> ; @@ -222,7 +222,7 @@ M: builtin-class see-class* ] bi + [ ] bi block> ; : see-class ( class -- ) @@ -245,7 +245,7 @@ M: error-class see-class* { [ pprint-word ] [ superclass. ] - [ > pprint-slot-name ] each block> pprint-; ] + [ > pprint-slot-name ] each block> pprint-semi ] [ tuple-declarations. ] } cleave block> ; diff --git a/language/tuple-arrays/tuple-arrays.factor b/language/tuple-arrays/tuple-arrays.factor index 099f13031c..2b210cada8 100644 --- a/language/tuple-arrays/tuple-arrays.factor +++ b/language/tuple-arrays/tuple-arrays.factor @@ -34,7 +34,7 @@ MACRO: write-tuple ( class -- quot ) PRIVATE> -FUNCTOR: define-tuple-array ( CLASS -- ) +FUNCTOR< define-tuple-array ( CLASS -- ) CLASS IS ${CLASS} @@ -71,6 +71,6 @@ M: CLASS-array like drop dup CLASS-array? [ >CLASS-array ] unless ; inline INSTANCE: CLASS-array sequence ; -FUNCTOR; +FUNCTOR> SYNTAX: \ tuple-array: scan-word define-tuple-array ; diff --git a/language/vocabs/prettyprint/prettyprint.factor b/language/vocabs/prettyprint/prettyprint.factor index 3aaba88f7c..a96f6fbec6 100644 --- a/language/vocabs/prettyprint/prettyprint.factor +++ b/language/vocabs/prettyprint/prettyprint.factor @@ -68,7 +68,7 @@ M: rename pprint-qualified ( rename -- ) PRIVATE> -: (pprint-manifest ( manifest -- quots ) +: pprint-manifest-begin ( manifest -- quots ) [ [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ] [ qualified-vocabs>> filter-interesting [ '[ _ pprint-qualified ] , ] each ] @@ -76,11 +76,11 @@ PRIVATE> tri ] { } make ; -: pprint-manifest) ( quots -- ) +: pprint-manifest-end ( quots -- ) [ nl ] [ call( -- ) ] interleave ; : pprint-manifest ( manifest -- ) - (pprint-manifest pprint-manifest) ; + pprint-manifest-begin pprint-manifest-end ; CONSTANT: manifest-style H{ { page-color color: FactorLightTan }