Merge commit 'factor/master'
commit
4489de250f
|
@ -346,7 +346,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
||||||
|
|
||||||
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
|
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
|
||||||
|
|
||||||
|
|
||||||
:: literal-identity-test ( -- a b )
|
:: literal-identity-test ( -- a b )
|
||||||
{ } V{ } ;
|
{ } V{ } ;
|
||||||
|
|
||||||
|
@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
||||||
swapd [ eq? ] [ eq? ] 2bi*
|
swapd [ eq? ] [ eq? ] 2bi*
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ;
|
||||||
|
|
||||||
|
[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test
|
||||||
|
|
||||||
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
|
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
|
||||||
obj1 obj2 <=> {
|
obj1 obj2 <=> {
|
||||||
{ +lt+ [ lt-quot call ] }
|
{ +lt+ [ lt-quot call ] }
|
||||||
|
|
|
@ -137,7 +137,7 @@ ERROR: bad-special-group string ;
|
||||||
DEFER: (parse-regexp)
|
DEFER: (parse-regexp)
|
||||||
: nested-parse-regexp ( token ? -- )
|
: nested-parse-regexp ( token ? -- )
|
||||||
[ push-stack (parse-regexp) pop-stack ] dip
|
[ push-stack (parse-regexp) pop-stack ] dip
|
||||||
[ <negation> ] when pop-stack boa push-stack ;
|
[ <negation> ] when pop-stack new swap >>term push-stack ;
|
||||||
|
|
||||||
! non-capturing groups
|
! non-capturing groups
|
||||||
: (parse-special-group) ( -- )
|
: (parse-special-group) ( -- )
|
||||||
|
|
|
@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser
|
||||||
regexp.traversal eval ;
|
regexp.traversal eval ;
|
||||||
IN: regexp-tests
|
IN: regexp-tests
|
||||||
|
|
||||||
|
\ <regexp> must-infer
|
||||||
|
\ matches? must-infer
|
||||||
|
|
||||||
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
||||||
|
|
|
@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
|
||||||
: increment-state ( dfa-traverser state -- dfa-traverser )
|
: increment-state ( dfa-traverser state -- dfa-traverser )
|
||||||
[
|
[
|
||||||
dup traverse-forward>>
|
dup traverse-forward>>
|
||||||
[ 1+ ] [ 1- ] ? change-current-index
|
[ [ 1+ ] change-current-index ]
|
||||||
|
[ [ 1- ] change-current-index ] if
|
||||||
dup current-state>> >>last-state
|
dup current-state>> >>last-state
|
||||||
] dip
|
] dip
|
||||||
first >>current-state ;
|
first >>current-state ;
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
USING: regexp.utils tools.test ;
|
||||||
|
IN: regexp.utils.tests
|
||||||
|
|
||||||
|
[ [ ] [ ] while-changes ] must-infer
|
|
@ -5,9 +5,7 @@ namespaces regexp.backend sequences unicode.categories
|
||||||
math.ranges fry combinators.short-circuit vectors ;
|
math.ranges fry combinators.short-circuit vectors ;
|
||||||
IN: regexp.utils
|
IN: regexp.utils
|
||||||
|
|
||||||
: (while-changes) ( obj quot pred pred-ret -- obj )
|
: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj )
|
||||||
! quot: ( obj -- obj' )
|
|
||||||
! pred: ( obj -- <=> )
|
|
||||||
[ [ dup slip ] dip pick over call ] dip dupd =
|
[ [ dup slip ] dip pick over call ] dip dupd =
|
||||||
[ 3drop ] [ (while-changes) ] if ; inline recursive
|
[ 3drop ] [ (while-changes) ] if ; inline recursive
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: benchmark.regex-dna.tests
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
||||||
[ regex-dna ] with-string-writer string-lines
|
[ regex-dna ] with-string-writer <string-reader> lines
|
||||||
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
||||||
ascii file-lines =
|
ascii file-lines =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1 @@
|
||||||
|
Slides from a talk at Galois by Slava Pestov, October 2008
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1 @@
|
||||||
|
Slides from Google Tech Talk by Slava Pestov, October 2008
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|
|
@ -18,7 +18,7 @@ IN: hardware-info.windows
|
||||||
: processor-architecture ( -- n )
|
: processor-architecture ( -- n )
|
||||||
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
|
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
|
||||||
|
|
||||||
: os-version
|
: os-version ( -- os-version )
|
||||||
"OSVERSIONINFO" <c-object>
|
"OSVERSIONINFO" <c-object>
|
||||||
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
|
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
|
||||||
[ GetVersionEx ] keep swap zero? [ win32-error ] when ;
|
[ GetVersionEx ] keep swap zero? [ win32-error ] when ;
|
||||||
|
@ -67,4 +67,4 @@ IN: hardware-info.windows
|
||||||
{
|
{
|
||||||
{ [ os wince? ] [ "hardware-info.windows.ce" ] }
|
{ [ os wince? ] [ "hardware-info.windows.ce" ] }
|
||||||
{ [ os winnt? ] [ "hardware-info.windows.nt" ] }
|
{ [ os winnt? ] [ "hardware-info.windows.nt" ] }
|
||||||
} cond [ require ] when* >>
|
} cond require >>
|
||||||
|
|
|
@ -48,19 +48,17 @@ IN: slides
|
||||||
: $divider ( -- )
|
: $divider ( -- )
|
||||||
[
|
[
|
||||||
<gadget>
|
<gadget>
|
||||||
T{ gradient f
|
{
|
||||||
{
|
T{ rgba f 0.25 0.25 0.25 1.0 }
|
||||||
T{ rgba f 0.25 0.25 0.25 1.0 }
|
T{ rgba f 1.0 1.0 1.0 0.0 }
|
||||||
T{ rgba f 1.0 1.0 1.0 0.0 }
|
} <gradient> >>interior
|
||||||
}
|
|
||||||
} >>interior
|
|
||||||
{ 800 10 } >>dim
|
{ 800 10 } >>dim
|
||||||
{ 1 0 } >>orientation
|
{ 1 0 } >>orientation
|
||||||
gadget.
|
gadget.
|
||||||
] ($block) ;
|
] ($block) ;
|
||||||
|
|
||||||
: page-theme ( gadget -- )
|
: page-theme ( gadget -- )
|
||||||
T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } }
|
{ T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } <gradient>
|
||||||
>>interior drop ;
|
>>interior drop ;
|
||||||
|
|
||||||
: <page> ( list -- gadget )
|
: <page> ( list -- gadget )
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1 @@
|
||||||
|
Slides from a talk at VPRI by Slava Pestov, October 2008
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|
Loading…
Reference in New Issue