Merge branch 'master' of git://factorcode.org/git/factor
commit
a6ab5c3a47
core
classes/tuple
inference/transforms
prettyprint
splitting
extra
help/lint
html/parser
analyzer
utils
inverse
koszul
locals
mortar
multiline
porter-stemmer
project-euler
002
059
state-parser
tools/deploy/backend
tuple-syntax
ui/gestures
xml/errors
|
@ -102,7 +102,7 @@ ERROR: bad-superclass class ;
|
|||
dup tuple-predicate-quot define-predicate ;
|
||||
|
||||
: superclass-size ( class -- n )
|
||||
superclasses butlast-slice
|
||||
superclasses but-last-slice
|
||||
[ slot-names length ] map sum ;
|
||||
|
||||
: generate-tuple-slots ( class slots -- slot-specs )
|
||||
|
|
|
@ -32,7 +32,7 @@ IN: inference.transforms
|
|||
drop [ no-case ]
|
||||
] [
|
||||
dup peek quotation? [
|
||||
dup peek swap butlast
|
||||
dup peek swap but-last
|
||||
] [
|
||||
[ no-case ] swap
|
||||
] if case>quot
|
||||
|
|
|
@ -114,7 +114,7 @@ unit-test
|
|||
[ parse-fresh drop ] with-compilation-unit
|
||||
[
|
||||
"prettyprint.tests" lookup see
|
||||
] with-string-writer "\n" split butlast
|
||||
] with-string-writer "\n" split but-last
|
||||
] keep =
|
||||
] with-scope ;
|
||||
|
||||
|
|
|
@ -284,7 +284,7 @@ M: colon unindent-first-line? drop t ;
|
|||
|
||||
! Long section layout algorithm
|
||||
: chop-break ( seq -- seq )
|
||||
dup peek line-break? [ butlast-slice chop-break ] when ;
|
||||
dup peek line-break? [ but-last-slice chop-break ] when ;
|
||||
|
||||
SYMBOL: prev
|
||||
SYMBOL: next
|
||||
|
|
|
@ -92,7 +92,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
|
|||
{ $subsection subseq }
|
||||
{ $subsection head }
|
||||
{ $subsection tail }
|
||||
{ $subsection butlast }
|
||||
{ $subsection but-last }
|
||||
{ $subsection rest }
|
||||
{ $subsection head* }
|
||||
{ $subsection tail* }
|
||||
|
@ -107,7 +107,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
|
|||
{ $subsection <slice> }
|
||||
{ $subsection head-slice }
|
||||
{ $subsection tail-slice }
|
||||
{ $subsection butlast-slice }
|
||||
{ $subsection but-last-slice }
|
||||
{ $subsection rest-slice }
|
||||
{ $subsection head-slice* }
|
||||
{ $subsection tail-slice* }
|
||||
|
@ -838,7 +838,7 @@ HELP: tail-slice
|
|||
{ $description "Outputs a virtual sequence sharing storage with all elements from the " { $snippet "n" } "th index until the end of the input sequence." }
|
||||
{ $errors "Throws an error if the index is out of bounds." } ;
|
||||
|
||||
HELP: butlast-slice
|
||||
HELP: but-last-slice
|
||||
{ $values { "seq" sequence } { "slice" "a slice" } }
|
||||
{ $description "Outputs a virtual sequence sharing storage with all but the last element of the input sequence." }
|
||||
{ $errors "Throws an error on an empty sequence." } ;
|
||||
|
@ -869,7 +869,7 @@ HELP: tail
|
|||
{ $description "Outputs a new sequence consisting of the input sequence with the first n items removed." }
|
||||
{ $errors "Throws an error if the index is out of bounds." } ;
|
||||
|
||||
HELP: butlast
|
||||
HELP: but-last
|
||||
{ $values { "seq" sequence } { "headseq" "a new sequence" } }
|
||||
{ $description "Outputs a new sequence consisting of the input sequence with the last item removed." }
|
||||
{ $errors "Throws an error on an empty sequence." } ;
|
||||
|
|
|
@ -216,7 +216,7 @@ M: slice length dup slice-to swap slice-from - ;
|
|||
|
||||
: tail-slice* ( seq n -- slice ) from-end tail-slice ;
|
||||
|
||||
: butlast-slice ( seq -- slice ) 1 head-slice* ;
|
||||
: but-last-slice ( seq -- slice ) 1 head-slice* ;
|
||||
|
||||
INSTANCE: slice virtual-sequence
|
||||
|
||||
|
@ -265,7 +265,7 @@ PRIVATE>
|
|||
|
||||
: tail* ( seq n -- tailseq ) from-end tail ;
|
||||
|
||||
: butlast ( seq -- headseq ) 1 head* ;
|
||||
: but-last ( seq -- headseq ) 1 head* ;
|
||||
|
||||
: copy ( src i dst -- )
|
||||
pick length >r 3dup check-copy spin 0 r>
|
||||
|
@ -675,13 +675,13 @@ PRIVATE>
|
|||
[ rest ] [ first ] bi ;
|
||||
|
||||
: unclip-last ( seq -- butfirst last )
|
||||
[ butlast ] [ peek ] bi ;
|
||||
[ but-last ] [ peek ] bi ;
|
||||
|
||||
: unclip-slice ( seq -- rest first )
|
||||
[ rest-slice ] [ first ] bi ;
|
||||
|
||||
: unclip-last-slice ( seq -- butfirst last )
|
||||
[ butlast-slice ] [ peek ] bi ;
|
||||
[ but-last-slice ] [ peek ] bi ;
|
||||
|
||||
: <flat-slice> ( seq -- slice )
|
||||
dup slice? [ { } like ] when 0 over length rot <slice> ;
|
||||
|
|
|
@ -104,7 +104,7 @@ M: sliced-clumps nth group@ <slice> ;
|
|||
1array
|
||||
] [
|
||||
"\n" split [
|
||||
butlast-slice [
|
||||
but-last-slice [
|
||||
"\r" ?tail drop "\r" split
|
||||
] map
|
||||
] keep peek "\r" split suffix concat
|
||||
|
|
|
@ -10,7 +10,7 @@ IN: help.lint
|
|||
|
||||
: check-example ( element -- )
|
||||
rest [
|
||||
butlast "\n" join 1vector
|
||||
but-last "\n" join 1vector
|
||||
[
|
||||
use [ clone ] change
|
||||
[ eval>string ] with-datastack
|
||||
|
|
|
@ -99,7 +99,7 @@ IN: html.parser.analyzer
|
|||
|
||||
: find-between ( i/f tag/f vector -- vector )
|
||||
find-between* dup length 3 >= [
|
||||
[ rest-slice butlast-slice ] keep like
|
||||
[ rest-slice but-last-slice ] keep like
|
||||
] when ;
|
||||
|
||||
: find-between-first ( string vector -- vector' )
|
||||
|
|
|
@ -36,7 +36,7 @@ IN: html.parser.utils
|
|||
dup quoted? [ quote ] unless ;
|
||||
|
||||
: unquote ( str -- newstr )
|
||||
dup quoted? [ butlast-slice rest-slice >string ] when ;
|
||||
dup quoted? [ but-last-slice rest-slice >string ] when ;
|
||||
|
||||
: quote? ( ch -- ? ) "'\"" member? ;
|
||||
|
||||
|
|
|
@ -197,7 +197,7 @@ DEFER: _
|
|||
|
||||
\ prefix [ unclip ] define-inverse
|
||||
\ unclip [ prefix ] define-inverse
|
||||
\ suffix [ dup butlast swap peek ] define-inverse
|
||||
\ suffix [ dup but-last swap peek ] define-inverse
|
||||
|
||||
! Constructor inverse
|
||||
: deconstruct-pred ( class -- quot )
|
||||
|
|
|
@ -184,7 +184,7 @@ DEFER: (d)
|
|||
[ length ] keep [ (graded-ker/im-d) ] curry map ;
|
||||
|
||||
: graded-betti ( generators -- seq )
|
||||
basis graded graded-ker/im-d flip first2 butlast 0 prefix v- ;
|
||||
basis graded graded-ker/im-d flip first2 but-last 0 prefix v- ;
|
||||
|
||||
! Bi-graded for two-step complexes
|
||||
: (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank )
|
||||
|
|
|
@ -101,7 +101,7 @@ UNION: special local quote local-word local-reader local-writer ;
|
|||
] if ;
|
||||
|
||||
: point-free-body ( quot args -- newquot )
|
||||
>r butlast-slice r> [ localize ] curry map concat ;
|
||||
>r but-last-slice r> [ localize ] curry map concat ;
|
||||
|
||||
: point-free-end ( quot args -- newquot )
|
||||
over peek special?
|
||||
|
|
|
@ -122,7 +122,7 @@ over class-class-methods assoc-stack call ;
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: send-message-next ( object message -- )
|
||||
over object-class class-methods butlast assoc-stack call ;
|
||||
over object-class class-methods but-last assoc-stack call ;
|
||||
|
||||
: <-~ scan parsed \ send-message-next parsed ; parsing
|
||||
|
||||
|
|
|
@ -14,7 +14,7 @@ IN: multiline
|
|||
] [ ";" unexpected-eof ] if* ;
|
||||
|
||||
: parse-here ( -- str )
|
||||
[ (parse-here) ] "" make butlast
|
||||
[ (parse-here) ] "" make but-last
|
||||
lexer get next-line ;
|
||||
|
||||
: STRING:
|
||||
|
@ -34,7 +34,7 @@ IN: multiline
|
|||
[
|
||||
lexer get lexer-column swap (parse-multiline-string)
|
||||
lexer get set-lexer-column
|
||||
] "" make rest butlast ;
|
||||
] "" make rest but-last ;
|
||||
|
||||
: <"
|
||||
"\">" parse-multiline-string parsed ; parsing
|
||||
|
|
|
@ -93,7 +93,7 @@ USING: kernel math parser sequences combinators splitting ;
|
|||
{ [ "iz" ?tail ] [ "ize" append ] }
|
||||
{
|
||||
[ dup length 1- over double-consonant? ]
|
||||
[ dup "lsz" last-is? [ butlast-slice ] unless ]
|
||||
[ dup "lsz" last-is? [ but-last-slice ] unless ]
|
||||
}
|
||||
{
|
||||
[ t ]
|
||||
|
@ -120,7 +120,7 @@ USING: kernel math parser sequences combinators splitting ;
|
|||
} cond ;
|
||||
|
||||
: step1c ( str -- newstr )
|
||||
dup butlast-slice stem-vowel? [
|
||||
dup but-last-slice stem-vowel? [
|
||||
"y" ?tail [ "i" append ] when
|
||||
] when ;
|
||||
|
||||
|
@ -196,18 +196,18 @@ USING: kernel math parser sequences combinators splitting ;
|
|||
: remove-e? ( str -- ? )
|
||||
dup consonant-seq dup 1 >
|
||||
[ 2drop t ]
|
||||
[ 1 = [ butlast-slice cvc? not ] [ drop f ] if ] if ;
|
||||
[ 1 = [ but-last-slice cvc? not ] [ drop f ] if ] if ;
|
||||
|
||||
: remove-e ( str -- newstr )
|
||||
dup peek CHAR: e = [
|
||||
dup remove-e? [ butlast-slice ] when
|
||||
dup remove-e? [ but-last-slice ] when
|
||||
] when ;
|
||||
|
||||
: ll->l ( str -- newstr )
|
||||
{
|
||||
{ [ dup peek CHAR: l = not ] [ ] }
|
||||
{ [ dup length 1- over double-consonant? not ] [ ] }
|
||||
{ [ dup consonant-seq 1 > ] [ butlast-slice ] }
|
||||
{ [ dup consonant-seq 1 > ] [ but-last-slice ] }
|
||||
[ ]
|
||||
} cond ;
|
||||
|
||||
|
|
|
@ -41,7 +41,7 @@ PRIVATE>
|
|||
|
||||
: fib-upto* ( n -- seq )
|
||||
0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip
|
||||
butlast-slice { 0 1 } prepend ;
|
||||
but-last-slice { 0 1 } prepend ;
|
||||
|
||||
: euler002a ( -- answer )
|
||||
1000000 fib-upto* [ even? ] filter sum ;
|
||||
|
|
|
@ -78,7 +78,7 @@ INSTANCE: rollover immutable-sequence
|
|||
frequency-analysis sort-values keys peek ;
|
||||
|
||||
: crack-key ( seq key-length -- key )
|
||||
[ " " decrypt ] dip group butlast-slice
|
||||
[ " " decrypt ] dip group but-last-slice
|
||||
flip [ most-frequent ] map ;
|
||||
|
||||
PRIVATE>
|
||||
|
|
|
@ -69,4 +69,4 @@ HELP: next
|
|||
{ $description "originally written as " { $code "spot inc" } ", code that would no longer run, this word moves the state of the XML parser to the next place in the source file, keeping track of appropriate debugging information." } ;
|
||||
|
||||
HELP: parsing-error
|
||||
{ $class-description "class to which parsing errors delegate, containing information about which line and column the error occured on, and what the line was. Contains three slots, line, an integer, column, another integer, and line-str, a string" } ;
|
||||
{ $class-description "class from which parsing errors inherit, containing information about which line and column the error occured on, and what the line was. Contains three slots, line, an integer, column, another integer, and line-str, a string" } ;
|
||||
|
|
|
@ -63,11 +63,11 @@ DEFER: ?make-staging-image
|
|||
dup empty? [
|
||||
"-i=" my-boot-image-name append ,
|
||||
] [
|
||||
dup butlast ?make-staging-image
|
||||
dup but-last ?make-staging-image
|
||||
|
||||
"-resource-path=" "" resource-path append ,
|
||||
|
||||
"-i=" over butlast staging-image-name append ,
|
||||
"-i=" over but-last staging-image-name append ,
|
||||
|
||||
"-run=tools.deploy.restage" ,
|
||||
] if
|
||||
|
|
|
@ -7,7 +7,7 @@ IN: tuple-syntax
|
|||
|
||||
: parse-slot-writer ( tuple -- slot# )
|
||||
scan dup "}" = [ 2drop f ] [
|
||||
butlast swap object-slots slot-named slot-spec-offset
|
||||
but-last swap object-slots slot-named slot-spec-offset
|
||||
] if ;
|
||||
|
||||
: parse-slots ( accum tuple -- accum tuple )
|
||||
|
|
|
@ -54,7 +54,7 @@ TUPLE: zoom-in-action ; C: <zoom-in-action> zoom-in-action
|
|||
TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
|
||||
|
||||
: generalize-gesture ( gesture -- newgesture )
|
||||
tuple>array butlast >tuple ;
|
||||
tuple>array but-last >tuple ;
|
||||
|
||||
! Modifiers
|
||||
SYMBOLS: C+ A+ M+ S+ ;
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
USING: continuations xml xml.errors tools.test kernel arrays xml.data state-parser quotations ;
|
||||
IN: xml.errors.tests
|
||||
|
||||
: xml-error-test ( expected-error xml-string -- )
|
||||
[ string>xml ] curry swap [ = ] curry must-fail-with ;
|
||||
|
||||
T{ no-entity f 1 10 "nbsp" } "<x> </x>" xml-error-test
|
||||
T{ mismatched f 1 8 T{ name f "" "x" "" } T{ name f "" "y" "" }
|
||||
} "<x></y>" xml-error-test
|
||||
T{ unclosed f 1 4 V{ T{ name f "" "x" "" } } } "<x>" xml-error-test
|
||||
T{ nonexist-ns f 1 5 "x" } "<x:y/>" xml-error-test
|
||||
T{ unopened f 1 5 } "</x>" xml-error-test
|
||||
T{ not-yes/no f 1 41 "maybe" } "<?xml version='1.0' standalone='maybe'?><x/>" xml-error-test
|
||||
T{ extra-attrs f 1 32 V{ T{ name f "" "foo" f } }
|
||||
} "<?xml version='1.1' foo='bar'?><x/>" xml-error-test
|
||||
T{ bad-version f 1 28 "5 million" } "<?xml version='5 million'?><x/>" xml-error-test
|
||||
T{ notags f 1 0 } "" xml-error-test
|
||||
T{ multitags } "<x/><y/>" xml-error-test
|
||||
T{ bad-prolog f 1 26 T{ prolog f "1.0" "UTF-8" f }
|
||||
} "<x/><?xml version='1.0'?>" xml-error-test
|
||||
T{ capitalized-prolog f 1 6 "XmL" } "<?XmL version='1.0'?><x/>"
|
||||
xml-error-test
|
||||
T{ pre/post-content f "x" t } "x<y/>" xml-error-test
|
||||
T{ versionless-prolog f 1 8 } "<?xml?><x/>" xml-error-test
|
||||
T{ bad-instruction f 1 11 T{ instruction f "xsl" }
|
||||
} "<x><?xsl?></x>" xml-error-test
|
||||
T{ bad-directive f 1 15 T{ directive f "DOCTYPE" }
|
||||
} "<x/><!DOCTYPE>" xml-error-test
|
Loading…
Reference in New Issue