From a58c654361ffe6ce3b26f2d6a7fd063264a570b3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 03:00:10 -0500 Subject: [PATCH 1/5] More store cleanups --- extra/store/store.factor | 28 +++++++++++--------------- extra/webapps/pastebin/pastebin.factor | 19 +++++++++-------- 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/extra/store/store.factor b/extra/store/store.factor index 38c1d3a906..639b6d3fab 100644 --- a/extra/store/store.factor +++ b/extra/store/store.factor @@ -8,30 +8,26 @@ TUPLE: store path data ; C: store : save-store ( store -- ) - [ store-data ] keep store-path [ - [ - dup - [ >r drop [ get ] keep r> set-at ] curry assoc-each - ] keep serialize - ] with-stream ; + get-global dup store-data swap store-path + [ serialize ] with-stream ; : load-store ( path -- store ) dup exists? [ - dup [ - deserialize - ] with-stream + dup [ deserialize ] with-stream ] [ H{ } clone ] if ; -: store-variable ( default variable store -- ) - store-data 2dup at* [ - rot set-global 2drop - ] [ - drop >r 2dup set-global r> set-at - ] if ; - : define-store ( path id -- ) over >r [ >r resource-path load-store r> set-global ] 2curry r> add-init-hook ; + +: get-persistent ( key store -- value ) + get-global store-data at ; + +: set-persistent ( value key store -- ) + get-global [ store-data set-at ] keep save-store ; + +: init-persistent ( value key store -- ) + 2dup get-persistent [ 3drop ] [ set-persistent ] if ; diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index d49863b12a..7ea98b8ba1 100755 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -10,9 +10,9 @@ TUPLE: pastebin pastes ; ! Persistence SYMBOL: store + "pastebin.store" store define-store - pastebin store get store-variable -: save-pastebin-store ( -- ) store get-global save-store ; + pastebin store init-persistent TUPLE: paste summary author channel mode contents date @@ -25,8 +25,11 @@ TUPLE: annotation summary author mode contents ; C: annotation +: get-pastebin ( -- pastebin ) + pastebin store get-persistent ; + : get-paste ( n -- paste ) - pastebin get pastebin-pastes nth ; + get-pastebin pastebin-pastes nth ; : show-paste ( n -- ) serving-html @@ -46,7 +49,7 @@ C: annotation [ [ show-paste ] "show-paste-quot" set [ new-paste ] "new-paste-quot" set - pastebin get "paste-list" render-component + get-pastebin "paste-list" render-component ] with-html-stream ; \ paste-list { } define-action @@ -55,7 +58,7 @@ C: annotation paste-n number>string [ show-paste ] curry quot-link ; : paste-feed ( -- entries ) - pastebin get pastebin-pastes [ + get-pastebin pastebin-pastes [ { paste-summary paste-link @@ -77,8 +80,8 @@ C: annotation : submit-paste ( summary author channel mode contents -- ) [ - \ pastebin get-global add-paste - save-pastebin-store + pastebin store get-persistent add-paste + store save-store ] keep paste-link permanent-redirect ; \ submit-paste { @@ -92,7 +95,7 @@ C: annotation : annotate-paste ( n summary author mode contents -- ) swap get-paste paste-annotations push - save-pastebin-store ; + store save-store ; \ annotate-paste { { "n" v-required v-number } From 5e8bfb3d6e99ce5ae007b2faf6d81d8e5fc71cd3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 03:01:39 -0500 Subject: [PATCH 2/5] Fix extra/faq USING: --- extra/faq/faq.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index 703d542131..481fbeb59f 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: xml kernel sequences xml.utilities combinators.lib -math xml.data arrays assocs xml.generator namespaces math.parser ; +math xml.data arrays assocs xml.generator xml.writer namespaces +math.parser io ; IN: faq : find-after ( seq quot -- elem after ) From 9cd0b6437ce6fff8e9f43fc8e96d1217d80d0d9a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 03:05:15 -0500 Subject: [PATCH 3/5] Another FAQ fix --- extra/faq/faq.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index 481fbeb59f..9f39b33dc6 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -111,4 +111,4 @@ C: faq ] make-xml ; : read-write-faq ( xml-stream -- ) - [ read-xml ] with-stream xml>faq faq>html write-xml ; + read-xml xml>faq faq>html write-xml ; From 2059f6e9a4f84be404b639e9304af7530948c182 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 03:35:40 -0500 Subject: [PATCH 4/5] fix objective-c mode load --- extra/xmode/catalog/catalog.factor | 49 ++++++++++++++++++------------ 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index d880ca3789..e48b18b2ad 100644 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -1,6 +1,6 @@ USING: xmode.loader xmode.utilities xmode.rules namespaces strings splitting assocs sequences kernel io.files xml memoize -words globs ; +words globs combinators ; IN: xmode.catalog TUPLE: mode file file-name-glob first-line-glob ; @@ -40,18 +40,15 @@ MEMO: (load-mode) ( name -- rule-sets ) "extra/xmode/modes/" swap append resource-path parse-mode ; -DEFER: load-mode - SYMBOL: rule-sets -: get-rule-set ( name -- rules ) - dup string? [ - "::" split1 [ swap load-mode ] [ rule-sets get ] if* at - ] when ; +: get-rule-set ( name -- rule-sets rules ) + "::" split1 [ swap (load-mode) ] [ rule-sets get ] if* + tuck at ; : resolve-delegate ( rule -- ) - dup rule-delegate dup - [ get-rule-set swap set-rule-delegate ] [ 2drop ] if ; + dup rule-delegate dup string? + [ get-rule-set nip swap set-rule-delegate ] [ 2drop ] if ; : each-rule ( rule-set quot -- ) >r rule-set-rules values concat r> each ; inline @@ -71,24 +68,36 @@ SYMBOL: rule-sets : resolve-imports ( ruleset -- ) dup rule-set-imports [ - get-rule-set - dup resolve-delegates - 2dup import-keywords - import-rules + get-rule-set dup [ + swap rule-sets [ + 2dup import-keywords + import-rules + ] with-variable + ] [ + 3drop + ] if ] curry* each ; : finalize-rule-set ( ruleset -- ) - dup rule-set-finalized? [ drop ] [ - t over set-rule-set-finalized? - dup resolve-imports - resolve-delegates - ] if ; + dup rule-set-finalized? { + { f [ + 1 over set-rule-set-finalized? + dup resolve-imports + dup resolve-delegates + t swap set-rule-set-finalized? + ] } + { t [ drop ] } + { 1 [ "Mutually recursive rule sets" throw ] } + } case ; -: load-mode ( name -- rule-sets ) - (load-mode) dup rule-sets [ +: finalize-mode ( rulesets -- ) + rule-sets [ dup [ nip finalize-rule-set ] assoc-each ] with-variable ; +: load-mode ( name -- rule-sets ) + (load-mode) dup finalize-mode ; + : reset-modes ( -- ) \ load-mode "memoize" word-prop clear-assoc ; From 77ead806e0cef90f72932aa78f1af45d6afe8c4b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Dec 2007 03:46:48 -0500 Subject: [PATCH 5/5] Fix store unit tests --- extra/store/store-tests.factor | 26 ++++++++++---------------- extra/store/store.factor | 2 +- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/extra/store/store-tests.factor b/extra/store/store-tests.factor index 97b39bcffd..6f33d66101 100644 --- a/extra/store/store-tests.factor +++ b/extra/store/store-tests.factor @@ -4,8 +4,6 @@ IN: temporary SYMBOL: store SYMBOL: foo -SYMBOL: bar - : the-store ( -- path ) "store-test.store" resource-path ; @@ -14,28 +12,24 @@ SYMBOL: bar [ the-store delete-file ] catch drop ; : load-the-store ( -- ) - the-store load-store store set ; + the-store load-store store set-global ; : save-the-store ( -- ) - store get save-store ; + store save-store ; delete-the-store -the-store load-store store set +load-the-store -[ f ] [ foo store get store-data at ] unit-test +[ f ] [ foo store get-persistent ] unit-test -[ ] [ 100 foo store get store-variable ] unit-test +USE: prettyprint +store get-global store-data . + +[ ] [ 100 foo store set-persistent ] unit-test [ ] [ save-the-store ] unit-test -[ 100 ] [ foo store get store-data at ] unit-test - -1000 foo set - -[ ] [ save-the-store ] unit-test - -[ ] [ load-the-store ] unit-test - -[ 1000 ] [ foo store get store-data at ] unit-test +[ 100 ] [ foo store get-persistent ] unit-test delete-the-store +f store set-global diff --git a/extra/store/store.factor b/extra/store/store.factor index 639b6d3fab..46b1a09568 100644 --- a/extra/store/store.factor +++ b/extra/store/store.factor @@ -27,7 +27,7 @@ C: store get-global store-data at ; : set-persistent ( value key store -- ) - get-global [ store-data set-at ] keep save-store ; + [ get-global store-data set-at ] keep save-store ; : init-persistent ( value key store -- ) 2dup get-persistent [ 3drop ] [ set-persistent ] if ;