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

db4
Bruno Deferrari 2008-09-21 20:54:38 -03:00
commit b1b7fa11f0
11 changed files with 80 additions and 35 deletions

View File

@ -21,8 +21,8 @@ HELP: <date>
{ $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"2010 12 25 <date> ."
"T{ timestamp\n { year 2010 }\n { month 12 }\n { day 25 }\n { gmt-offset T{ duration { hour -5 } } }\n}"
"2010 12 25 <date> >gmt midnight ."
"T{ timestamp { year 2010 } { month 12 } { day 25 } }"
}
} ;

View File

@ -4,8 +4,6 @@ namespaces xml html.components html.forms
splitting unicode.categories furnace accessors ;
IN: html.templates.chloe.tests
reset-templates
: run-template
with-string-writer [ "\r\n\t" member? not ] filter
"?>" split1 nip ; inline

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences combinators kernel fry
namespaces make classes.tuple assocs splitting words arrays
memoize io io.files io.encodings.utf8 io.streams.string
unicode.case mirrors math urls present multiline quotations xml
namespaces make classes.tuple assocs splitting words arrays io
io.files io.encodings.utf8 io.streams.string unicode.case
mirrors math urls present multiline quotations xml logging
xml.data
html.forms
html.elements
@ -89,21 +89,40 @@ CHLOE-TUPLE: choice
CHLOE-TUPLE: checkbox
CHLOE-TUPLE: code
: read-template ( chloe -- xml )
path>> ".xml" append utf8 <file-reader> read-xml ;
SYMBOL: template-cache
MEMO: template-quot ( chloe -- quot )
read-template compile-template ;
H{ } template-cache set-global
MEMO: nested-template-quot ( chloe -- quot )
read-template compile-nested-template ;
TUPLE: cached-template path last-modified quot ;
: reset-templates ( -- )
{ template-quot nested-template-quot } [ reset-memoized ] each ;
: load-template ( chloe -- cached-template )
path>> ".xml" append
[ ]
[ file-info modified>> ]
[ utf8 <file-reader> read-xml compile-template ] tri
\ cached-template boa ;
\ load-template DEBUG add-input-logging
: cached-template ( chloe -- cached-template/f )
template-cache get at* [
[
[ path>> file-info modified>> ]
[ last-modified>> ]
bi =
] keep and
] when ;
: template-quot ( chloe -- quot )
dup cached-template [ ] [
[ load-template dup ] keep
template-cache get set-at
] ?if quot>> ;
: reset-cache ( -- )
template-cache get clear-assoc ;
M: chloe call-template*
nested-template? get
[ nested-template-quot ] [ template-quot ] if
assert-depth ;
template-quot assert-depth ;
INSTANCE: chloe template

View File

@ -3,7 +3,7 @@
USING: assocs namespaces make kernel sequences accessors
combinators strings splitting io io.streams.string present
xml.writer xml.data xml.entities html.forms
html.templates.chloe.syntax ;
html.templates html.templates.chloe.syntax ;
IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' )
@ -98,9 +98,6 @@ DEFER: compile-element
reset-buffer
] [ ] make ; inline
: compile-nested-template ( xml -- quot )
[ compile-element ] with-compiler ;
: compile-chunk ( seq -- )
[ compile-element ] each ;
@ -121,12 +118,25 @@ DEFER: compile-element
: compile-with-scope ( quot -- )
compile-quot [ with-scope ] [code] ; inline
: if-not-nested ( quot -- )
nested-template? get swap unless ; inline
: compile-prologue ( xml -- )
[
[ before>> compile-chunk ]
[ prolog>> [ write-prolog ] [code-with] ]
bi
] compile-quot
[ if-not-nested ] [code] ;
: compile-epilogue ( xml -- )
[ after>> compile-chunk ] compile-quot
[ if-not-nested ] [code] ;
: compile-template ( xml -- quot )
[
{
[ prolog>> [ write-prolog ] [code-with] ]
[ before>> compile-chunk ]
[ compile-element ]
[ after>> compile-chunk ]
} cleave
[ compile-prologue ]
[ compile-element ]
[ compile-epilogue ]
tri
] with-compiler ;

View File

@ -216,9 +216,8 @@ intel_macosx_word_size() {
$ECHO -n "Testing if your Intel Mac supports 64bit binaries..."
sysctl machdep.cpu.extfeatures | grep EM64T >/dev/null
if [[ $? -eq 0 ]] ; then
WORD=32
WORD=64
$ECHO "yes!"
$ECHO "Defaulting to 32bit for now though..."
else
WORD=32
$ECHO "no."

View File

@ -41,8 +41,8 @@ unit-test
[ "-1.0e-2" string>number number>string ]
unit-test
[ "-1.0e-12" ]
[ "-1.0e-12" string>number number>string ]
[ t ]
[ "-1.0e-12" string>number number>string { "-1.0e-12" "-1.0e-012" } member? ]
unit-test
[ f ]

View File

@ -69,7 +69,6 @@ SYMBOL: key-file
SYMBOL: dh-file
: common-configuration ( -- )
reset-templates
"concatenative.org" 25 <inet> smtp-server set-global
"noreply@concatenative.org" lost-password-from set-global
"website@concatenative.org" insomniac-sender set-global

View File

@ -27,7 +27,6 @@ IN: regexp.dfa
nfa-table>> transitions>>
[ at keys ] curry map concat
eps swap remove ;
! dup t member? [ t swap remove t suffix ] when ;
: add-todo-state ( state regexp -- )
2dup visited-states>> key? [

View File

@ -33,7 +33,19 @@ IN: regexp
dupd match
[ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
: match-head ( string regexp -- end ) match length>> 1- ;
: match-head ( string regexp -- end/f ) match [ length>> 1- ] [ f ] if* ;
: match-at ( string m regexp -- n/f finished? )
[
2dup swap length > [ 2drop f f ] [ tail-slice t ] if
] dip swap [ match-head f ] [ 2drop f t ] if ;
: match-range ( string m regexp -- a/f b/f )
3dup match-at over [
drop nip rot drop dupd +
] [
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
] if ;
: initial-option ( regexp option -- regexp' )
over options>> conjoin ;

View File

@ -32,7 +32,12 @@ TUPLE: transition-table transitions start-state final-states ;
H{ } clone >>transitions
H{ } clone >>final-states ;
: maybe-initialize-key ( key hashtable -- )
2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ;
: set-transition ( transition hash -- )
#! set the state as a key
2dup [ to>> ] dip maybe-initialize-key
[ [ to>> ] [ obj>> ] [ from>> ] tri ] dip
2dup at* [ 2nip insert-at ]
[ drop >r >r H{ } clone [ insert-at ] keep r> r> set-at ] if ;

View File

@ -43,6 +43,10 @@ TUPLE: dfa-traverser
dup save-final-state
] when text-finished? ;
: print-flags ( dfa-traverser -- dfa-traverser )
dup [ current-state>> ] [ traversal-flags>> ] bi
;
: increment-state ( dfa-traverser state -- dfa-traverser )
[
[ 1+ ] change-current-index dup current-state>> >>last-state