diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 39599d6d83..a196e416de 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -9,9 +9,6 @@ IN: alien.parser SYMBOL: current-library -: parse-c-type-name ( name -- word ) - dup search [ ] [ no-word ] ?if ; - DEFER: (parse-c-type) ERROR: bad-array-type ; @@ -26,8 +23,8 @@ ERROR: bad-array-type ; { { [ "*" ?tail ] [ (parse-c-type) ] } { [ CHAR: ] over member? ] [ parse-array-type ] } - { [ dup search ] [ parse-c-type-name ] } - [ dup search [ ] [ no-word ] ?if ] + { [ dup search ] [ parse-word ] } + [ parse-word ] } cond ; : c-array? ( c-type -- ? ) diff --git a/basis/bitstreams/bitstreams.factor b/basis/bitstreams/bitstreams.factor index 5581e47056..12f75dc6ee 100644 --- a/basis/bitstreams/bitstreams.factor +++ b/basis/bitstreams/bitstreams.factor @@ -49,7 +49,7 @@ TUPLE: lsb0-bit-writer < bit-writer ; : new-bit-writer ( class -- bs ) new BV{ } clone >>bytes - 0 0 >>widthed ; inline + zero-widthed >>widthed ; inline : ( -- bs ) msb0-bit-writer new-bit-writer ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 2d2fe2314f..45fbf31a0f 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -131,8 +131,7 @@ ERROR: no-defined-persistent object ; : ensure-tables ( classes -- ) [ ensure-table ] each ; : insert-tuple ( tuple -- ) - dup class ensure-defined-persistent - db-columns find-primary-key db-assigned-id-spec? + dup class ensure-defined-persistent db-assigned? [ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ; : update-tuple ( tuple -- ) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index 30116e3fc5..1ad81ad3ee 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -38,8 +38,7 @@ SYMBOL: IGNORE ERROR: no-slot ; : offset-of-slot ( string tuple -- n ) - class superclasses [ "slots" word-prop ] map concat - slot-named dup [ no-slot ] unless offset>> ; + class all-slots slot-named dup [ no-slot ] unless offset>> ; : get-slot-named ( name tuple -- value ) [ nip ] [ offset-of-slot ] 2bi slot ; diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 7e16c1c218..8c97cddfb0 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -16,7 +16,7 @@ M: no-edit-hook summary SYMBOL: edit-hook : available-editors ( -- seq ) - "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ; + "editors" child-vocab-names ; : editor-restarts ( -- alist ) available-editors diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 439c50b144..d54587caf2 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -102,9 +102,7 @@ DEFER: (parse-paragraph) ] [ drop "" like 1list ] if* ] if-empty ; -: ( string -- state ) string-lines ; : look ( state i -- char ) swap first ?nth ; -: take-line ( state -- state' line ) unclip-slice ; : take-lines ( state char -- state' lines ) dupd '[ ?first _ = not ] find drop @@ -136,7 +134,7 @@ DEFER: (parse-paragraph) [ trim= parse-paragraph ] dip boa ; inline : parse-heading ( state -- state' heading ) - take-line dup count= { + unclip-slice dup count= { { 0 [ make-paragraph ] } { 1 [ heading1 make-heading ] } { 2 [ heading2 make-heading ] } @@ -168,7 +166,7 @@ DEFER: (parse-paragraph) ] map table boa ; : parse-line ( state -- state' item ) - take-line dup "___" = + unclip-slice dup "___" = [ drop line new ] [ make-paragraph ] if ; : parse-list ( state char class -- state' list ) @@ -185,12 +183,12 @@ DEFER: (parse-paragraph) : parse-code ( state -- state' item ) dup 1 look CHAR: [ = - [ take-line make-paragraph ] [ + [ unclip-slice make-paragraph ] [ dup "{" take-until [ [ nip rest ] dip "}]" take-until [ code boa ] dip swap - ] [ drop take-line make-paragraph ] if* + ] [ drop unclip-slice make-paragraph ] if* ] if ; : parse-item ( state -- state' item ) @@ -202,11 +200,11 @@ DEFER: (parse-paragraph) { CHAR: # [ parse-ol ] } { CHAR: [ [ parse-code ] } { f [ rest-slice f ] } - [ drop take-line make-paragraph ] + [ drop unclip-slice make-paragraph ] } case ; : parse-farkup ( string -- farkup ) - [ dup empty? not ] [ parse-item ] produce nip sift ; + string-lines [ dup empty? not ] [ parse-item ] produce nip sift ; CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');" diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 8e1364b495..b3ebaa4749 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -127,7 +127,7 @@ FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ; PRIVATE> -SYNTAX: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; +SYNTAX: IS [ parse-word ] (INTERPOLATE) ; SYNTAX: DEFERS [ current-vocab create ] (INTERPOLATE) ; diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 0521951574..ddcde5a1ac 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -26,7 +26,7 @@ log-level [ DEBUG ] initialize ERROR: undefined-log-level ; : log-level<=> ( log-level log-level -- ? ) - [ log-levels at* [ undefined-log-level ] unless ] bi@ <=> ; + [ log-levels at* [ undefined-log-level ] unless ] compare ; : log? ( log-level -- ? ) log-level get log-level<=> +lt+ = not ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index e0c5350ed1..4511c9d235 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -22,9 +22,9 @@ SYMBOL: error-stack : (merge-errors) ( a b -- c ) { - { [ over position>> not ] [ nip ] } - { [ dup position>> not ] [ drop ] } - [ 2dup [ position>> ] bi@ <=> { + { [ over position>> not ] [ nip ] } + { [ dup position>> not ] [ drop ] } + [ 2dup [ position>> ] compare { { +lt+ [ nip ] } { +gt+ [ drop ] } { +eq+ [ messages>> over messages>> union [ position>> ] dip ] } diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index fe31a49265..88fae781ea 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -28,8 +28,7 @@ TUPLE: entry title url description date ; [ rfc822>timestamp ] [ drop rfc3339>timestamp ] recover ; : rss1.0-entry ( tag -- entry ) - entry new - swap { + swap { [ "title" tag-named children>string >>title ] [ "link" tag-named children>string >url >>url ] [ "description" tag-named children>string >>description ] @@ -41,16 +40,14 @@ TUPLE: entry title url description date ; } cleave ; : rss1.0 ( xml -- feed ) - feed new - swap [ + swap [ "channel" tag-named [ "title" tag-named children>string >>title ] [ "link" tag-named children>string >url >>url ] bi ] [ "item" tags-named [ rss1.0-entry ] map set-entries ] bi ; : rss2.0-entry ( tag -- entry ) - entry new - swap { + swap { [ "title" tag-named children>string >>title ] [ { "link" "guid" } any-tag-named children>string >url >>url ] [ { "description" "encoded" } any-tag-named children>string >>description ] @@ -61,9 +58,8 @@ TUPLE: entry title url description date ; } cleave ; : rss2.0 ( xml -- feed ) - feed new - swap - "channel" tag-named + swap + "channel" tag-named [ "title" tag-named children>string >>title ] [ "link" tag-named children>string >url >>url ] [ "item" tags-named [ rss2.0-entry ] map set-entries ] @@ -75,8 +71,7 @@ TUPLE: entry title url description date ; dup [ "href" attr >url ] when ; : atom1.0-entry ( tag -- entry ) - entry new - swap { + swap { [ "title" tag-named children>string >>title ] [ atom-entry-link >>url ] [ diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index 45287a60c6..a440ccff9c 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2006, 2010 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: kernel continuations sequences math namespaces make sets -math.parser math.ranges assocs regexp unicode.categories arrays -hashtables words classes quotations xmode.catalog unicode.case ; +USING: arrays assocs classes continuations hashtables kernel +make math math.functions math.parser math.ranges namespaces +quotations regexp sequences sets unicode.case unicode.categories +words xmode.catalog ; IN: validators : v-checkbox ( str -- ? ) >lower "on" = ; : v-default ( str def -- str/def ) - [ drop empty? not ] 2keep ? ; + [ drop empty? not ] most ; : v-required ( str -- str ) dup empty? [ "required" throw ] when ; @@ -94,7 +95,7 @@ IN: validators : luhn? ( str -- ? ) string>digits [ odd? [ 2 * 10 /mod + ] when ] map-index - sum 10 mod 0 = ; + sum 10 divisor? ; : v-credit-card ( str -- n ) "- " without diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor index 8caaf78403..ad755003cb 100644 --- a/core/lexer/lexer.factor +++ b/core/lexer/lexer.factor @@ -26,7 +26,7 @@ TUPLE: lexer-parsing-word word line line-text column ; ] [ parsing-words>> push ] bi ; : pop-parsing-word ( -- ) - lexer get parsing-words>> pop drop ; + lexer get parsing-words>> pop* ; : new-lexer ( text class -- lexer ) new diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 2cfdbf1080..3778031c4d 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -77,8 +77,7 @@ M: bad-stack-effect summary [ = ] dip 1 = and ; : find-and-check ( args argcount string -- quot ) - dup search [ ] [ no-word ] ?if - [ nip ] [ check-word ] 2bi + parse-word [ nip ] [ check-word ] 2bi [ 1quotation compose ] [ bad-stack-effect ] if ; : arguments-codegen ( seq -- quot ) diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index ce1708f9bf..85d2e9b639 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -36,6 +36,7 @@ CONSTANT: trivial-defs [ . ] [ new ] [ get ] + [ "" ] [ t ] [ f ] [ { } ] [ drop t ] [ drop f ] [ 2drop t ] [ 2drop f ] diff --git a/extra/pair-methods/pair-methods.factor b/extra/pair-methods/pair-methods.factor index 28a1182cf2..3971c3e1a2 100644 --- a/extra/pair-methods/pair-methods.factor +++ b/extra/pair-methods/pair-methods.factor @@ -26,7 +26,7 @@ ERROR: no-pair-method a b generic ; : pair-generic-definition ( word -- def ) [ sorted-pair-methods [ first2 pair-method-cond ] map ] [ [ no-pair-method ] curry suffix ] bi 1quotation - [ 2dup [ class ] bi@ <=> +gt+ eq? ?swap ] [ cond ] surround ; + [ 2dup [ class ] compare +gt+ eq? ?swap ] [ cond ] surround ; : make-pair-generic ( word -- ) dup pair-generic-definition define ; diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor index 9b61a95823..8cbb92a2dd 100644 --- a/extra/poker/poker.factor +++ b/extra/poker/poker.factor @@ -215,7 +215,7 @@ ERROR: no-card card deck ; sampled 2 cut :> ( hole2 community2 ) hole1 community community2 3append :> hand1 hole2 community community2 3append :> hand2 - hand1 hand2 [ best-holdem-hand 2array ] bi@ <=> +lt+ = + hand1 hand2 [ best-holdem-hand 2array ] compare +lt+ = ] count ; :: compare-holdem-hands ( holes deck n -- seq ) diff --git a/extra/semantic-versioning/semantic-versioning.factor b/extra/semantic-versioning/semantic-versioning.factor index 86973688cb..f7bf382d5d 100644 --- a/extra/semantic-versioning/semantic-versioning.factor +++ b/extra/semantic-versioning/semantic-versioning.factor @@ -13,7 +13,7 @@ IN: semantic-versioning : version<=> ( version1 version2 -- <=> ) [ split-version ] bi@ drop-prefix 2dup [ length 0 = ] either? - [ [ length ] bi@ >=< ] [ [ first ] bi@ <=> ] if ; + [ [ length ] bi@ >=< ] [ [ first ] compare ] if ; : version< ( version1 version2 -- ? ) version<=> +lt+ = ;