factor: fix minor syntax problems. add some commented out sequences code that i wish worked.
need to rename ?tail to ?trim-taillocals-and-roots
parent
6d47257a6a
commit
6308848d19
|
@ -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
|
||||
|
|
|
@ -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 <range> ; inline
|
||||
|
||||
: (a,b] ( a b -- range ) twiddle (a, <range> ; inline
|
||||
: (a,b] ( a b -- range ) twiddle (a,) <range> ; inline
|
||||
|
||||
: [a,b) ( a b -- range ) twiddle ,b) <range> ; inline
|
||||
: [a,b) ( a b -- range ) twiddle (,b) <range> ; inline
|
||||
|
||||
: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; inline
|
||||
: (a,b) ( a b -- range ) twiddle (a,) (,b) <range> ; inline
|
||||
|
||||
: [0,b] ( b -- range ) 0 swap [a,b] ; inline
|
||||
|
||||
|
|
|
@ -162,14 +162,15 @@ M: array collapse-decorators
|
|||
drop f
|
||||
] if ;
|
||||
|
||||
: delimiters-match? ( opening closing -- ? )
|
||||
[
|
||||
1 cut* over empty? [
|
||||
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
|
||||
] dip '[ _ sequence= ] any? ;
|
||||
] 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 } }
|
||||
|
|
|
@ -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
|
||||
] [
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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! ;
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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*
|
||||
<colon \ UNION: pprint-word
|
||||
dup pprint-word
|
||||
class-members pprint-elements pprint-; block> ;
|
||||
class-members pprint-elements pprint-semi block> ;
|
||||
|
||||
M: intersection-class see-class*
|
||||
<colon \ INTERSECTION: pprint-word
|
||||
dup pprint-word
|
||||
class-participants pprint-elements pprint-; block> ;
|
||||
class-participants pprint-elements pprint-semi block> ;
|
||||
|
||||
M: mixin-class see-class*
|
||||
<block \ mixin: pprint-word
|
||||
|
@ -165,7 +165,7 @@ M: predicate-class see-class*
|
|||
dup superclass-of pprint-word
|
||||
<block
|
||||
"predicate-definition" word-prop pprint-elements
|
||||
pprint-; block> 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. ]
|
||||
[ <block "slots" word-prop [ pprint-slot ] each block> pprint-; ]
|
||||
[ <block "slots" word-prop [ pprint-slot ] each block> pprint-semi ]
|
||||
[ tuple-declarations. ]
|
||||
} cleave
|
||||
block> ;
|
||||
|
@ -222,7 +222,7 @@ M: builtin-class see-class*
|
|||
<block
|
||||
\ BUILTIN: pprint-word
|
||||
[ pprint-word ]
|
||||
[ <block "slots" word-prop [ pprint-slot ] each pprint-; block> ] bi
|
||||
[ <block "slots" word-prop [ pprint-slot ] each pprint-semi block> ] bi
|
||||
block> ;
|
||||
|
||||
: see-class ( class -- )
|
||||
|
@ -245,7 +245,7 @@ M: error-class see-class*
|
|||
{
|
||||
[ pprint-word ]
|
||||
[ superclass. ]
|
||||
[ <block "slots" word-prop [ name>> pprint-slot-name ] each block> pprint-; ]
|
||||
[ <block "slots" word-prop [ name>> pprint-slot-name ] each block> pprint-semi ]
|
||||
[ tuple-declarations. ]
|
||||
} cleave
|
||||
block> ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 }
|
||||
|
|
Loading…
Reference in New Issue