Merge branch 'master' of git://factorcode.org/git/factor
commit
3f0ed68893
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Daniel Ehrenberg
|
! Copyright (C) 2007 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml kernel sequences xml.utilities combinators.lib
|
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
|
IN: faq
|
||||||
|
|
||||||
: find-after ( seq quot -- elem after )
|
: find-after ( seq quot -- elem after )
|
||||||
|
@ -110,4 +111,4 @@ C: <faq> faq
|
||||||
] make-xml ;
|
] make-xml ;
|
||||||
|
|
||||||
: read-write-faq ( xml-stream -- )
|
: read-write-faq ( xml-stream -- )
|
||||||
[ read-xml ] with-stream xml>faq faq>html write-xml ;
|
read-xml xml>faq faq>html write-xml ;
|
||||||
|
|
|
@ -4,8 +4,6 @@ IN: temporary
|
||||||
|
|
||||||
SYMBOL: store
|
SYMBOL: store
|
||||||
SYMBOL: foo
|
SYMBOL: foo
|
||||||
SYMBOL: bar
|
|
||||||
|
|
||||||
|
|
||||||
: the-store ( -- path )
|
: the-store ( -- path )
|
||||||
"store-test.store" resource-path ;
|
"store-test.store" resource-path ;
|
||||||
|
@ -14,28 +12,24 @@ SYMBOL: bar
|
||||||
[ the-store delete-file ] catch drop ;
|
[ the-store delete-file ] catch drop ;
|
||||||
|
|
||||||
: load-the-store ( -- )
|
: load-the-store ( -- )
|
||||||
the-store load-store store set ;
|
the-store load-store store set-global ;
|
||||||
|
|
||||||
: save-the-store ( -- )
|
: save-the-store ( -- )
|
||||||
store get save-store ;
|
store save-store ;
|
||||||
|
|
||||||
delete-the-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
|
[ ] [ save-the-store ] unit-test
|
||||||
|
|
||||||
[ 100 ] [ foo store get store-data at ] unit-test
|
[ 100 ] [ foo store get-persistent ] unit-test
|
||||||
|
|
||||||
1000 foo set
|
|
||||||
|
|
||||||
[ ] [ save-the-store ] unit-test
|
|
||||||
|
|
||||||
[ ] [ load-the-store ] unit-test
|
|
||||||
|
|
||||||
[ 1000 ] [ foo store get store-data at ] unit-test
|
|
||||||
|
|
||||||
delete-the-store
|
delete-the-store
|
||||||
|
f store set-global
|
||||||
|
|
|
@ -8,30 +8,26 @@ TUPLE: store path data ;
|
||||||
C: <store> store
|
C: <store> store
|
||||||
|
|
||||||
: save-store ( store -- )
|
: save-store ( store -- )
|
||||||
[ store-data ] keep store-path <file-writer> [
|
get-global dup store-data swap store-path
|
||||||
[
|
<file-writer> [ serialize ] with-stream ;
|
||||||
dup
|
|
||||||
[ >r drop [ get ] keep r> set-at ] curry assoc-each
|
|
||||||
] keep serialize
|
|
||||||
] with-stream ;
|
|
||||||
|
|
||||||
: load-store ( path -- store )
|
: load-store ( path -- store )
|
||||||
dup exists? [
|
dup exists? [
|
||||||
dup <file-reader> [
|
dup <file-reader> [ deserialize ] with-stream
|
||||||
deserialize
|
|
||||||
] with-stream
|
|
||||||
] [
|
] [
|
||||||
H{ } clone
|
H{ } clone
|
||||||
] if <store> ;
|
] 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 -- )
|
: define-store ( path id -- )
|
||||||
over >r
|
over >r
|
||||||
[ >r resource-path load-store r> set-global ] 2curry
|
[ >r resource-path load-store r> set-global ] 2curry
|
||||||
r> add-init-hook ;
|
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 ;
|
||||||
|
|
|
@ -10,9 +10,9 @@ TUPLE: pastebin pastes ;
|
||||||
|
|
||||||
! Persistence
|
! Persistence
|
||||||
SYMBOL: store
|
SYMBOL: store
|
||||||
|
|
||||||
"pastebin.store" store define-store
|
"pastebin.store" store define-store
|
||||||
<pastebin> pastebin store get store-variable
|
<pastebin> pastebin store init-persistent
|
||||||
: save-pastebin-store ( -- ) store get-global save-store ;
|
|
||||||
|
|
||||||
TUPLE: paste
|
TUPLE: paste
|
||||||
summary author channel mode contents date
|
summary author channel mode contents date
|
||||||
|
@ -25,8 +25,11 @@ TUPLE: annotation summary author mode contents ;
|
||||||
|
|
||||||
C: <annotation> annotation
|
C: <annotation> annotation
|
||||||
|
|
||||||
|
: get-pastebin ( -- pastebin )
|
||||||
|
pastebin store get-persistent ;
|
||||||
|
|
||||||
: get-paste ( n -- paste )
|
: get-paste ( n -- paste )
|
||||||
pastebin get pastebin-pastes nth ;
|
get-pastebin pastebin-pastes nth ;
|
||||||
|
|
||||||
: show-paste ( n -- )
|
: show-paste ( n -- )
|
||||||
serving-html
|
serving-html
|
||||||
|
@ -46,7 +49,7 @@ C: <annotation> annotation
|
||||||
[
|
[
|
||||||
[ show-paste ] "show-paste-quot" set
|
[ show-paste ] "show-paste-quot" set
|
||||||
[ new-paste ] "new-paste-quot" set
|
[ new-paste ] "new-paste-quot" set
|
||||||
pastebin get "paste-list" render-component
|
get-pastebin "paste-list" render-component
|
||||||
] with-html-stream ;
|
] with-html-stream ;
|
||||||
|
|
||||||
\ paste-list { } define-action
|
\ paste-list { } define-action
|
||||||
|
@ -55,7 +58,7 @@ C: <annotation> annotation
|
||||||
paste-n number>string [ show-paste ] curry quot-link ;
|
paste-n number>string [ show-paste ] curry quot-link ;
|
||||||
|
|
||||||
: paste-feed ( -- entries )
|
: paste-feed ( -- entries )
|
||||||
pastebin get pastebin-pastes [
|
get-pastebin pastebin-pastes [
|
||||||
{
|
{
|
||||||
paste-summary
|
paste-summary
|
||||||
paste-link
|
paste-link
|
||||||
|
@ -77,8 +80,8 @@ C: <annotation> annotation
|
||||||
|
|
||||||
: submit-paste ( summary author channel mode contents -- )
|
: submit-paste ( summary author channel mode contents -- )
|
||||||
<paste> [
|
<paste> [
|
||||||
\ pastebin get-global add-paste
|
pastebin store get-persistent add-paste
|
||||||
save-pastebin-store
|
store save-store
|
||||||
] keep paste-link permanent-redirect ;
|
] keep paste-link permanent-redirect ;
|
||||||
|
|
||||||
\ submit-paste {
|
\ submit-paste {
|
||||||
|
@ -92,7 +95,7 @@ C: <annotation> annotation
|
||||||
: annotate-paste ( n summary author mode contents -- )
|
: annotate-paste ( n summary author mode contents -- )
|
||||||
<annotation> swap get-paste
|
<annotation> swap get-paste
|
||||||
paste-annotations push
|
paste-annotations push
|
||||||
save-pastebin-store ;
|
store save-store ;
|
||||||
|
|
||||||
\ annotate-paste {
|
\ annotate-paste {
|
||||||
{ "n" v-required v-number }
|
{ "n" v-required v-number }
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
USING: xmode.loader xmode.utilities xmode.rules namespaces
|
||||||
strings splitting assocs sequences kernel io.files xml memoize
|
strings splitting assocs sequences kernel io.files xml memoize
|
||||||
words globs ;
|
words globs combinators ;
|
||||||
IN: xmode.catalog
|
IN: xmode.catalog
|
||||||
|
|
||||||
TUPLE: mode file file-name-glob first-line-glob ;
|
TUPLE: mode file file-name-glob first-line-glob ;
|
||||||
|
@ -40,18 +40,15 @@ MEMO: (load-mode) ( name -- rule-sets )
|
||||||
"extra/xmode/modes/" swap append
|
"extra/xmode/modes/" swap append
|
||||||
resource-path <file-reader> parse-mode ;
|
resource-path <file-reader> parse-mode ;
|
||||||
|
|
||||||
DEFER: load-mode
|
|
||||||
|
|
||||||
SYMBOL: rule-sets
|
SYMBOL: rule-sets
|
||||||
|
|
||||||
: get-rule-set ( name -- rules )
|
: get-rule-set ( name -- rule-sets rules )
|
||||||
dup string? [
|
"::" split1 [ swap (load-mode) ] [ rule-sets get ] if*
|
||||||
"::" split1 [ swap load-mode ] [ rule-sets get ] if* at
|
tuck at ;
|
||||||
] when ;
|
|
||||||
|
|
||||||
: resolve-delegate ( rule -- )
|
: resolve-delegate ( rule -- )
|
||||||
dup rule-delegate dup
|
dup rule-delegate dup string?
|
||||||
[ get-rule-set swap set-rule-delegate ] [ 2drop ] if ;
|
[ get-rule-set nip swap set-rule-delegate ] [ 2drop ] if ;
|
||||||
|
|
||||||
: each-rule ( rule-set quot -- )
|
: each-rule ( rule-set quot -- )
|
||||||
>r rule-set-rules values concat r> each ; inline
|
>r rule-set-rules values concat r> each ; inline
|
||||||
|
@ -71,24 +68,36 @@ SYMBOL: rule-sets
|
||||||
|
|
||||||
: resolve-imports ( ruleset -- )
|
: resolve-imports ( ruleset -- )
|
||||||
dup rule-set-imports [
|
dup rule-set-imports [
|
||||||
get-rule-set
|
get-rule-set dup [
|
||||||
dup resolve-delegates
|
swap rule-sets [
|
||||||
2dup import-keywords
|
2dup import-keywords
|
||||||
import-rules
|
import-rules
|
||||||
|
] with-variable
|
||||||
|
] [
|
||||||
|
3drop
|
||||||
|
] if
|
||||||
] curry* each ;
|
] curry* each ;
|
||||||
|
|
||||||
: finalize-rule-set ( ruleset -- )
|
: finalize-rule-set ( ruleset -- )
|
||||||
dup rule-set-finalized? [ drop ] [
|
dup rule-set-finalized? {
|
||||||
t over set-rule-set-finalized?
|
{ f [
|
||||||
dup resolve-imports
|
1 over set-rule-set-finalized?
|
||||||
resolve-delegates
|
dup resolve-imports
|
||||||
] if ;
|
dup resolve-delegates
|
||||||
|
t swap set-rule-set-finalized?
|
||||||
|
] }
|
||||||
|
{ t [ drop ] }
|
||||||
|
{ 1 [ "Mutually recursive rule sets" throw ] }
|
||||||
|
} case ;
|
||||||
|
|
||||||
: load-mode ( name -- rule-sets )
|
: finalize-mode ( rulesets -- )
|
||||||
(load-mode) dup rule-sets [
|
rule-sets [
|
||||||
dup [ nip finalize-rule-set ] assoc-each
|
dup [ nip finalize-rule-set ] assoc-each
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
|
: load-mode ( name -- rule-sets )
|
||||||
|
(load-mode) dup finalize-mode ;
|
||||||
|
|
||||||
: reset-modes ( -- )
|
: reset-modes ( -- )
|
||||||
\ load-mode "memoize" word-prop clear-assoc ;
|
\ load-mode "memoize" word-prop clear-assoc ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue