Merge branch 'master' of git://factorcode.org/git/factor

core/classes/tuple/tuple.factor

@@ -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 )

core/inference/transforms/transforms.factor

@@ -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

core/prettyprint/prettyprint-tests.factor

@@ -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 ;
 

core/prettyprint/sections/sections.factor

@@ -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

core/sequences/sequences-docs.factor

@@ -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." } ;

core/sequences/sequences.factor

@@ -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> ;

core/splitting/splitting.factor

@@ -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

extra/help/lint/lint.factor

@@ -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

extra/html/parser/analyzer/analyzer.factor

@@ -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' )

extra/html/parser/utils/utils.factor

@@ -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? ;
 

extra/inverse/inverse.factor

@@ -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 )

extra/koszul/koszul.factor

@@ -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 )

extra/locals/locals.factor

@@ -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?

extra/mortar/mortar.factor

@@ -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
 

extra/multiline/multiline.factor

@@ -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

extra/porter-stemmer/porter-stemmer.factor

@@ -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 ;
 

extra/project-euler/002/002.factor

@@ -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 ;

extra/project-euler/059/059.factor

@@ -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>

extra/state-parser/state-parser-docs.factor

@@ -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" } ;

extra/tools/deploy/backend/backend.factor

@@ -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

extra/tuple-syntax/tuple-syntax.factor

@@ -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 )

extra/ui/gestures/gestures.factor

@@ -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+ ;

extra/xml/errors/errors-tests.factor

@@ -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>&nbsp;</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