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

db4
Eduardo Cavazos 2007-12-10 03:12:35 -06:00
commit 3f0ed68893
5 changed files with 65 additions and 62 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

View File

@ -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 }

View File

@ -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 ;