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

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 )
@@ -110,4 +111,4 @@ C: <faq> 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 ;

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

extra/store/store.factor

@@ -8,30 +8,26 @@ TUPLE: store path data ;
 C: <store> store
 
 : save-store ( store -- )
-    [ store-data ] keep store-path <file-writer> [
-        [
-            dup
-            [ >r drop [ get ] keep r> set-at ] curry assoc-each
-        ] keep serialize
-    ] with-stream ;
+    get-global dup store-data swap store-path
+    <file-writer> [ serialize ] with-stream ;
 
 : load-store ( path -- store )
     dup exists? [
-        dup <file-reader> [
-            deserialize
-        ] with-stream
+        dup <file-reader> [ deserialize ] with-stream
     ] [
         H{ } clone
     ] if <store> ;
 
-: 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 ;

extra/webapps/pastebin/pastebin.factor

@@ -10,9 +10,9 @@ TUPLE: pastebin pastes ;
 
 ! Persistence
 SYMBOL: store
+
 "pastebin.store" store define-store
-<pastebin> pastebin store get store-variable
-: save-pastebin-store ( -- ) store get-global save-store ;
+<pastebin> pastebin store init-persistent
 
 TUPLE: paste
 summary author channel mode contents date
@@ -25,8 +25,11 @@ TUPLE: annotation summary author mode contents ;
 
 C: <annotation> 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> 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> 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> annotation
 
 : submit-paste ( summary author channel mode contents -- )
     <paste> [
-        \ 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> annotation
 : annotate-paste ( n summary author mode contents -- )
     <annotation> swap get-paste
     paste-annotations push
-    save-pastebin-store ;
+    store save-store ;
 
 \ annotate-paste {
     { "n" v-required v-number }

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 <file-reader> 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 ;