steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Made backtrack actually faster by removing list push/pops

db4
William Schlieper 2008-07-16 06:08:44 -04:00
parent 01394ef298
commit 2b9df400af
1 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
extra/backtrack/backtrack.factor
View File

@ -7,51 +7,56 @@ USING: kernel continuations combinators sequences quotations arrays namespaces
IN: backtrack IN: backtrack
SYMBOL: failure SYMBOL: failure
V{ } failure set-global
ERROR: amb-failure ; ERROR: amb-failure ;
M: amb-failure summary drop "Backtracking failure" ; M: amb-failure summary drop "Backtracking failure" ;
: fail ( -- ) : fail ( -- )
failure get dup empty? [ amb-failure ] failure get [ continue ]
[ pop continue ] if ; [ amb-failure ] if* ;
: require ( ? -- ) : require ( ? -- )
[ fail ] unless ; [ fail ] unless ;
MACRO: checkpoint ( quot -- quot' ) MACRO: checkpoint ( quot -- quot' )
'[ [ '[ failure get push , continue ] callcc0 @ ] callcc0 ] ; '[ failure get ,
'[ '[ failure set , continue ] callcc0
, failure set @ ] callcc0 ] ;
: number-from ( from -- from+n ) : number-from ( from -- from+n )
[ 1 + number-from ] checkpoint ; [ 1 + number-from ] checkpoint ;
<PRIVATE <PRIVATE
: unsafe-number-from-to ( to from -- to from+n )
2dup = [ [ 1 + unsafe-number-from-to ] checkpoint ] unless ;
: number-from-to ( to from -- to from+n ) : number-from-to ( to from -- to from+n )
2dup <=> 2dup < [ fail ] when unsafe-number-from-to ;
{ { +lt+ [ fail ] }
{ +eq+ [ ] }
{ +gt+ [ [ 1 + number-from-to ] checkpoint ] } } case ;
: amb-integer ( seq -- int ) : amb-integer ( seq -- int )
length 1 - 0 number-from-to nip ; length 1 - 0 number-from-to nip ;
MACRO: unsafe-amb ( seq -- quot )
dup length 1 =
[ first 1quotation ]
[ [ first ] [ rest ] bi
'[ , [ drop , unsafe-amb ] checkpoint ] ] if ;
PRIVATE> PRIVATE>
: amb-lazy ( seq -- elt ) : amb-lazy ( seq -- elt )
[ amb-integer ] [ nth ] bi ; [ amb-integer ] [ nth ] bi ;
MACRO: amb ( seq -- quot ) : amb ( seq -- elt )
dup length dup empty?
{ { 0 [ drop [ fail f ] ] } [ drop fail f ]
{ 1 [ first 1quotation ] } [ unsafe-amb ] if ; inline
[ drop [ first ] [ rest ] bi
'[ , [ drop , amb ] checkpoint ] ] } case ;
MACRO: amb-execute ( seq -- quot ) MACRO: amb-execute ( seq -- quot )
[ length ] [ <enum> [ 1quotation ] assoc-map ] bi [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi
'[ , amb , case ] ; '[ , 0 unsafe-number-from-to nip , case ] ;
: if-amb ( true false -- ) : if-amb ( true false -- )
[ [