From: John Benediktsson Date: Thu, 19 Jul 2012 16:50:09 +0000 (-0700) Subject: using the new H{ } make. X-Git-Tag: 0.97~2860 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=559b5bfa5bec4e9f6ca8a90675f9dd0d2079f707 using the new H{ } make. --- diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index 57e5bc7e2b..742b0b6b75 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -58,7 +58,7 @@ IN: cocoa.subclassing ] [ class sel imp types add-method ] if* ; - + : redefine-objc-methods ( methods name -- ) dup class-exists? [ objc_getClass '[ [ _ ] dip (redefine-objc-method) ] each @@ -92,7 +92,7 @@ SYNTAX: CLASS: [ sift { "self" "selector" } prepend ] tri* ; : parse-method-body ( names -- quot ) - [ [ make-local ] map ] H{ } make-assoc + [ [ make-local ] map ] H{ } make (parse-lambda) ?rewrite-closures first ; SYNTAX: METHOD: diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 28682c91a8..fce6cf2f84 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -180,9 +180,9 @@ M: #push emit-node : make-input-map ( #shuffle -- assoc ) ! Assoc maps high-level IR values to stack locations. [ - [ in-d>> [ swap set ] each-index ] - [ in-r>> [ swap set ] each-index ] bi - ] H{ } make-assoc ; + [ in-d>> [ swap ,, ] each-index ] + [ in-r>> [ swap ,, ] each-index ] bi + ] H{ } make ; : make-output-seq ( values mapping input-map -- vregs ) '[ _ at _ at peek-loc ] map ; diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index fada25fd1e..b23546a74b 100644 --- a/basis/core-text/core-text.factor +++ b/basis/core-text/core-text.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays alien alien.c-types alien.data alien.syntax kernel destructors accessors fry words hashtables strings sequences -memoize assocs math math.order math.vectors math.rectangles +memoize assocs make math math.order math.vectors math.rectangles math.functions locals init namespaces combinators fonts colors cache core-foundation core-foundation.strings core-foundation.attributed-strings core-foundation.utilities @@ -41,9 +41,9 @@ ERROR: not-a-string object ; dup string? [ not-a-string ] unless ] 2dip [ - kCTForegroundColorAttributeName set - kCTFontAttributeName set - ] H{ } make-assoc &CFRelease + kCTForegroundColorAttributeName ,, + kCTFontAttributeName ,, + ] H{ } make &CFRelease CTLineCreateWithAttributedString ] with-destructors ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 39ce30c32d..1aea9fa7ed 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -147,23 +147,19 @@ DEFER: ;FUNCTOR delimiter : pop-functor-words ( -- ) functor-words unuse-words ; -: (parse-bindings) ( end -- ) - dup parse-binding dup [ - first2 [ make-local ] dip 2array , - (parse-bindings) - ] [ 2drop ] if ; +: (parse-bindings) ( end -- words ) + [ dup parse-binding dup ] + [ first2 [ make-local ] dip 2array ] + produce 2nip ; : with-bindings ( quot -- words assoc ) - '[ - in-lambda? on - _ H{ } make-assoc - ] { } make swap ; inline + in-lambda? on H{ } make ; inline : parse-bindings ( end -- words assoc ) [ - namespace use-words + building get use-words (parse-bindings) - namespace unuse-words + building get unuse-words ] with-bindings ; : parse-functor-body ( -- form ) diff --git a/basis/furnace/auth/providers/couchdb/couchdb.factor b/basis/furnace/auth/providers/couchdb/couchdb.factor index 96ac8232f9..841cf16dc2 100644 --- a/basis/furnace/auth/providers/couchdb/couchdb.factor +++ b/basis/furnace/auth/providers/couchdb/couchdb.factor @@ -117,7 +117,7 @@ TUPLE: couchdb-auth-provider username-view>> get-url swap >json "key" set-query-param ((get-user)) ; - + : strip-hash ( hash1 -- hash2 ) [ drop first CHAR: _ = not ] assoc-filter ; @@ -156,10 +156,10 @@ TUPLE: couchdb-auth-provider : (new-user) ( user -- user/f ) dup [ - [ username>> "username" set ] - [ email>> "email" set ] + [ username>> "username" ,, ] + [ email>> "email" ,, ] bi - ] H{ } make-assoc + ] H{ } make reserve-multiple [ user>user-hash >json @@ -203,22 +203,19 @@ PRIVATE> couchdb-auth-provider new swap >>username-view swap >>base-url ; M: couchdb-auth-provider get-user ( username provider -- user/f ) - [ - couchdb-auth-provider set + couchdb-auth-provider [ (get-user) [ user-hash>user ] [ f ] if* - ] with-scope ; + ] with-variable ; M: couchdb-auth-provider new-user ( user provider -- user/f ) - [ - couchdb-auth-provider set + couchdb-auth-provider [ dup (new-user) [ username>> couchdb-auth-provider get get-user ] [ drop f ] if - ] with-scope ; + ] with-variable ; M: couchdb-auth-provider update-user ( user provider -- ) - [ - couchdb-auth-provider set + couchdb-auth-provider [ [ username>> (get-user)/throw-on-no-user dup ] [ drop "_id" swap at get-url ] [ user>user-hash swapd @@ -226,4 +223,4 @@ M: couchdb-auth-provider update-user ( user provider -- ) unify-users >json swap couch-put drop ] tri - ] with-scope ; + ] with-variable ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index 861ffa5445..0bb47586c2 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators effects.parser +USING: accessors arrays assocs combinators effects.parser generic.parser kernel lexer locals.errors fry locals.rewrite.closures locals.types make namespaces parser quotations sequences splitting words vocabs.parser ; @@ -14,15 +14,15 @@ SYMBOL: in-lambda? : make-local ( name -- word ) "!" ?tail [ - dup dup name>> set + dup dup name>> ,, ] [ ] if - dup dup name>> set ; + dup dup name>> ,, ; : make-locals ( seq -- words assoc ) - [ [ make-local ] map ] H{ } make-assoc ; + [ [ make-local ] map ] H{ } make ; : parse-local-defs ( -- words assoc ) - [ "|" [ make-local ] map-tokens ] H{ } make-assoc ; + [ "|" [ make-local ] map-tokens ] H{ } make ; SINGLETON: lambda-parser @@ -36,7 +36,7 @@ SYMBOL: locals [ use-words @ ] [ unuse-words ] tri ] with-scope ; inline - + : (parse-lambda) ( assoc -- quot ) [ \ ] parse-until >quotation ] ((parse-lambda)) ; @@ -46,10 +46,14 @@ SYMBOL: locals ?rewrite-closures ; : parse-multi-def ( locals -- multi-def ) - [ ")" [ make-local ] map-tokens ] with-variables ; + [ [ ")" [ make-local ] map-tokens ] H{ } make ] dip + swap assoc-union! drop ; : parse-def ( name/paren locals -- def ) - over "(" = [ nip parse-multi-def ] [ [ make-local ] with-variables ] if ; + over "(" = + [ nip parse-multi-def ] + [ [ [ make-local ] H{ } make ] dip swap assoc-union! drop ] + if ; M: lambda-parser parse-quotation ( -- quotation ) H{ } clone (parse-lambda) ; diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 771ac5b19b..5edbf71434 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -7,7 +7,6 @@ io.encodings.ascii io.timeouts io.sockets io.sockets.secure io.crlf kernel logging sequences combinators splitting assocs strings math.order math.parser random system calendar summary calendar.format accessors sets hashtables base64 debugger classes prettyprint words ; -FROM: namespaces => set ; IN: smtp SYMBOL: smtp-domain @@ -194,18 +193,18 @@ ERROR: invalid-header-string string ; : email>headers ( email -- assoc ) [ - now timestamp>rfc822 "Date" set - message-id "Message-Id" set - "1.0" "MIME-Version" set - "base64" "Content-Transfer-Encoding" set + now timestamp>rfc822 "Date" ,, + message-id "Message-Id" ,, + "1.0" "MIME-Version" ,, + "base64" "Content-Transfer-Encoding" ,, { - [ from>> "From" set ] - [ to>> ", " join "To" set ] - [ cc>> ", " join [ "Cc" set ] unless-empty ] - [ subject>> "Subject" set ] - [ email-content-type "Content-Type" set ] + [ from>> "From" ,, ] + [ to>> ", " join "To" ,, ] + [ cc>> ", " join [ "Cc" ,, ] unless-empty ] + [ subject>> "Subject" ,, ] + [ email-content-type "Content-Type" ,, ] } cleave - ] { } make-assoc ; + ] H{ } make ; : (send-email) ( headers email -- ) [ diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor index 3f14aee59a..ab35070ac6 100644 --- a/basis/tools/deploy/macosx/macosx.factor +++ b/basis/tools/deploy/macosx/macosx.factor @@ -22,16 +22,16 @@ IN: tools.deploy.macosx : app-plist ( icon? executable bundle-name -- assoc ) [ - "6.0" "CFBundleInfoDictionaryVersion" set - "APPL" "CFBundlePackageType" set + "6.0" "CFBundleInfoDictionaryVersion" ,, + "APPL" "CFBundlePackageType" ,, - file-name "CFBundleName" set + file-name "CFBundleName" ,, - [ "CFBundleExecutable" set ] - [ "org.factor." prepend "CFBundleIdentifier" set ] bi + [ "CFBundleExecutable" ,, ] + [ "org.factor." prepend "CFBundleIdentifier" ,, ] bi - [ "Icon.icns" "CFBundleIconFile" set ] when - ] H{ } make-assoc ; + [ "Icon.icns" "CFBundleIconFile" ,, ] when + ] H{ } make ; : create-app-plist ( icon? executable bundle-name -- ) [ app-plist ] keep diff --git a/basis/ui/commands/commands.factor b/basis/ui/commands/commands.factor index cd2fa47616..1580f3fa13 100644 --- a/basis/ui/commands/commands.factor +++ b/basis/ui/commands/commands.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions kernel sequences strings -math assocs words generic namespaces make quotations -splitting ui.gestures unicode.case unicode.categories tr fry ; +math assocs words generic make quotations splitting +ui.gestures unicode.case unicode.categories tr fry ; IN: ui.commands SYMBOL: +nullary+ @@ -37,9 +37,9 @@ GENERIC: command-word ( command -- word ) [ commands>> [ drop ] assoc-filter - [ '[ _ invoke-command ] swap set ] assoc-each + [ '[ _ invoke-command ] swap ,, ] assoc-each ] each - ] H{ } make-assoc ; + ] H{ } make ; : update-gestures ( class -- ) dup command-gestures set-gestures ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 7274834a10..97f79115d0 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -4,7 +4,7 @@ USING: accessors arrays assocs calendar combinators locals source-files.errors colors.constants combinators.short-circuit compiler.units help.tips concurrency.flags concurrency.mailboxes continuations destructors documents documents.elements fry hashtables -help help.markup io io.styles kernel lexer listener math models sets +help help.markup io io.styles kernel lexer listener make math models sets models.delay models.arrow namespaces parser prettyprint quotations sequences strings threads vocabs vocabs.refresh vocabs.loader vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets @@ -103,9 +103,9 @@ M: input (print-input) M: word (print-input) "Command: " [ - "sans-serif" font-name set - bold font-style set - ] H{ } make-assoc format . ; + "sans-serif" font-name ,, + bold font-style ,, + ] H{ } make format . ; : print-input ( object interactor -- ) output>> [ (print-input) ] with-output-stream* ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index e9e61ce713..c85aca382e 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -6,7 +6,6 @@ math.parser math.order byte-arrays namespaces math.bitwise compiler.units parser io.encodings.ascii interval-maps ascii sets combinators locals math.ranges sorting make strings.parser io.encodings.utf8 memoize simple-flat-file ; -FROM: namespaces => set ; IN: unicode.data code-point : set-code-point ( seq -- ) 4 head [ multihex ] map first4 - swap first set ; + swap first ,, ; ! Extra properties : parse-properties ( -- {{[a,b],prop}} ) @@ -197,7 +196,7 @@ C: code-point : load-special-casing ( -- special-casing ) "vocab:unicode/data/SpecialCasing.txt" data [ length 5 = ] filter - [ [ set-code-point ] each ] H{ } make-assoc ; + [ [ set-code-point ] each ] H{ } make ; load-data { [ process-names name-map swap assoc-union! drop ] diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 3610360b6f..7979cf08dc 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs classes classes.private -combinators kernel math math.order namespaces sequences sorting -vectors words ; +combinators kernel make math math.order namespaces sequences +sorting vectors words ; FROM: classes => members ; RENAME: members sets => set-members IN: classes.algebra @@ -285,4 +285,4 @@ ERROR: topological-sort-failed ; ] if-empty ; : flatten-class ( class -- assoc ) - [ (flatten-class) ] H{ } make-assoc ; + [ (flatten-class) ] H{ } make ; diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor index bb4665ee16..c0bc609c13 100644 --- a/core/classes/builtin/builtin.factor +++ b/core/classes/builtin/builtin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes classes.algebra.private classes.private kernel -kernel.private namespaces sequences words ; +kernel.private make namespaces sequences words ; IN: classes.builtin SYMBOL: builtins @@ -21,7 +21,7 @@ M: builtin-class rank-class drop 0 ; M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ; -M: builtin-class (flatten-class) dup set ; +M: builtin-class (flatten-class) dup ,, ; M: builtin-class (classes-intersect?) eq? ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 617ddcc331..cc38c2a7f4 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -154,12 +154,12 @@ M: sequence implementors [ implementors ] gather ; : make-class-props ( superclass members participants metaclass -- assoc ) [ { - [ dup [ bootstrap-word ] when "superclass" set ] - [ [ bootstrap-word ] map "members" set ] - [ [ bootstrap-word ] map "participants" set ] - [ "metaclass" set ] + [ dup [ bootstrap-word ] when "superclass" ,, ] + [ [ bootstrap-word ] map "members" ,, ] + [ [ bootstrap-word ] map "participants" ,, ] + [ "metaclass" ,, ] } spread - ] H{ } make-assoc ; + ] H{ } make ; GENERIC: metaclass-changed ( use class -- ) diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor index 92f384ded1..32e0741323 100644 --- a/core/classes/intersection/intersection.factor +++ b/core/classes/intersection/intersection.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: words accessors sequences kernel assocs combinators classes classes.private classes.algebra classes.algebra.private -classes.builtin namespaces arrays math quotations ; +classes.builtin namespaces arrays math quotations make ; IN: classes.intersection PREDICATE: intersection-class < class @@ -48,7 +48,7 @@ M: anonymous-intersection (flatten-class) participants>> [ full-cover ] [ [ flatten-class keys ] [ intersect-flattened-classes ] map-reduce - [ dup set ] each + [ dup ,, ] each ] if-empty ; M: anonymous-intersection class-name diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index b338769706..dd7c63dea4 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -344,7 +344,7 @@ M: tuple-class rank-class drop 1 ; M: tuple-class instance? dup echelon-of layout-class-offset tuple-instance? ; -M: tuple-class (flatten-class) dup set ; +M: tuple-class (flatten-class) dup ,, ; M: tuple-class (classes-intersect?) { diff --git a/core/generic/generic.factor b/core/generic/generic.factor index e81212bf18..321016094f 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -4,7 +4,6 @@ USING: accessors arrays assocs classes classes.algebra classes.algebra.private classes.maybe classes.private combinators definitions kernel make namespaces sequences sets words ; -FROM: namespaces => set ; IN: generic ! Method combination protocol @@ -118,9 +117,9 @@ M: method crossref? : method-word-props ( class generic -- assoc ) [ - "method-generic" set - "method-class" set - ] H{ } make-assoc ; + "method-generic" ,, + "method-class" ,, + ] H{ } make ; : ( class generic -- method ) check-method diff --git a/extra/benchmark/partial-sums/partial-sums.factor b/extra/benchmark/partial-sums/partial-sums.factor index aa6098a434..8d78d8d4e8 100644 --- a/extra/benchmark/partial-sums/partial-sums.factor +++ b/extra/benchmark/partial-sums/partial-sums.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: math math.functions kernel io io.styles prettyprint -combinators hints fry namespaces sequences ; +USING: make math math.functions kernel io io.styles prettyprint +combinators hints fry sequences ; IN: benchmark.partial-sums ! Helper words @@ -24,17 +24,17 @@ IN: benchmark.partial-sums : partial-sums ( n -- results ) [ { - [ 2/3^k \ 2/3^k set ] - [ k^-0.5 \ k^-0.5 set ] - [ 1/k(k+1) \ 1/k(k+1) set ] - [ flint-hills \ flint-hills set ] - [ cookson-hills \ cookson-hills set ] - [ harmonic \ harmonic set ] - [ riemann-zeta \ riemann-zeta set ] - [ alternating-harmonic \ alternating-harmonic set ] - [ gregory \ gregory set ] + [ 2/3^k \ 2/3^k ,, ] + [ k^-0.5 \ k^-0.5 ,, ] + [ 1/k(k+1) \ 1/k(k+1) ,, ] + [ flint-hills \ flint-hills ,, ] + [ cookson-hills \ cookson-hills ,, ] + [ harmonic \ harmonic ,, ] + [ riemann-zeta \ riemann-zeta ,, ] + [ alternating-harmonic \ alternating-harmonic ,, ] + [ gregory \ gregory ,, ] } cleave - ] { } make-assoc ; + ] { } make ; HINTS: partial-sums fixnum ; diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor index 8d506cda28..f31aaba698 100644 --- a/extra/html/parser/parser.factor +++ b/extra/html/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays hashtables sequences.parser -html.parser.utils kernel namespaces sequences math +html.parser.utils kernel namespaces sequences make math unicode.case unicode.categories combinators.short-circuit quoting fry ; IN: html.parser @@ -94,11 +94,11 @@ SYMBOL: tagstack dup sequence-parse-end? [ drop ] [ - [ parse-key/value swap set ] [ (parse-attributes) ] bi + [ parse-key/value swap ,, ] [ (parse-attributes) ] bi ] if ; : parse-attributes ( sequence-parser -- hashtable ) - [ (parse-attributes) ] H{ } make-assoc ; + [ (parse-attributes) ] H{ } make ; : (parse-tag) ( string -- string' hashtable ) [ diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 331da4c90b..f0f3b99d16 100644 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -164,9 +164,9 @@ M: method-body crossref? : method-word-props ( specializer generic -- assoc ) [ - "multi-method-generic" set - "multi-method-specializer" set - ] H{ } make-assoc ; + "multi-method-generic" ,, + "multi-method-specializer" ,, + ] H{ } make ; : ( specializer generic -- word ) [ method-word-props ] 2keep diff --git a/extra/oauth/oauth.factor b/extra/oauth/oauth.factor index 3d9c2f7ed6..b0a358dcf0 100644 --- a/extra/oauth/oauth.factor +++ b/extra/oauth/oauth.factor @@ -40,17 +40,17 @@ nonce ; : make-token-params ( params quot -- assoc ) '[ - "1.0" "oauth_version" set - "HMAC-SHA1" "oauth_signature_method" set + "1.0" "oauth_version" ,, + "HMAC-SHA1" "oauth_signature_method" ,, _ [ - [ consumer-token>> key>> "oauth_consumer_key" set ] - [ timestamp>> "oauth_timestamp" set ] - [ nonce>> "oauth_nonce" set ] + [ consumer-token>> key>> "oauth_consumer_key" ,, ] + [ timestamp>> "oauth_timestamp" ,, ] + [ nonce>> "oauth_nonce" ,, ] tri ] bi - ] H{ } make-assoc ; inline + ] H{ } make ; inline :: sign-params ( url request-method consumer-token request-token params -- signed-params ) params sort-keys :> params @@ -90,7 +90,7 @@ TUPLE: request-token-params < token-params ; : make-request-token-params ( params -- assoc ) - [ callback-url>> "oauth_callback" set ] make-token-params ; + [ callback-url>> "oauth_callback" ,, ] make-token-params ; : ( url params -- request ) [ consumer-token>> f ] [ make-request-token-params ] bi @@ -110,8 +110,8 @@ TUPLE: access-token-params < token-params request-token verifier ; : make-access-token-params ( params -- assoc ) [ - [ request-token>> key>> "oauth_token" set ] - [ verifier>> "oauth_verifier" set ] + [ request-token>> key>> "oauth_token" ,, ] + [ verifier>> "oauth_verifier" ,, ] bi ] make-token-params ; @@ -143,8 +143,8 @@ TUPLE: oauth-request-params < token-params access-token ; params access-token>> params [ - access-token>> key>> "oauth_token" set - namespace request post-data>> assoc-union! drop + access-token>> key>> "oauth_token" ,, + request post-data>> %% ] make-token-params sign-params ;