more cleanup of with-scope.
parent
79c2d567a7
commit
eb2967c56c
|
|
@ -242,15 +242,13 @@ TUPLE: peg-head rule-id involved-set eval-set ;
|
|||
: with-packrat ( input quot -- result )
|
||||
#! Run the quotation with a packrat cache active.
|
||||
[
|
||||
swap input set
|
||||
0 pos set
|
||||
f lrstack set
|
||||
V{ } clone error-stack set
|
||||
H{ } clone \ heads set
|
||||
H{ } clone \ packrat set
|
||||
call
|
||||
] with-scope ; inline
|
||||
|
||||
swap input ,,
|
||||
0 pos ,,
|
||||
f lrstack ,,
|
||||
V{ } clone error-stack ,,
|
||||
H{ } clone \ heads ,,
|
||||
H{ } clone \ packrat ,,
|
||||
] H{ } make swap with-variables ; inline
|
||||
|
||||
GENERIC: (compile) ( peg -- quot )
|
||||
|
||||
|
|
|
|||
|
|
@ -4,19 +4,19 @@ FROM: bank => balance>> ;
|
|||
IN: bank.tests
|
||||
|
||||
SYMBOL: my-account
|
||||
[
|
||||
"Alex's Take Over the World Fund" 0.07 1 2007 11 1 <date> 6101.94 open-account my-account set
|
||||
"Alex's Take Over the World Fund" 0.07 1 2007 11 1 <date> 6101.94 open-account
|
||||
my-account [
|
||||
[ 6137 ] [ my-account get 2007 12 2 <date> process-to-date balance>> round >integer ] unit-test
|
||||
[ 6137 ] [ my-account get 2007 12 2 <date> process-to-date balance>> round >integer ] unit-test
|
||||
] with-scope
|
||||
] with-variable
|
||||
|
||||
[
|
||||
"Petty Cash" 0.07 1 2006 12 1 <date> 10962.18 open-account my-account set
|
||||
"Petty Cash" 0.07 1 2006 12 1 <date> 10962.18 open-account
|
||||
my-account [
|
||||
[ 11027 ] [ my-account get 2007 1 2 <date> process-to-date balance>> round >integer ] unit-test
|
||||
] with-scope
|
||||
] with-variable
|
||||
|
||||
[
|
||||
"Saving to buy a pony" 0.0725 1 2008 3 3 <date> 11106.24 open-account my-account set
|
||||
"Saving to buy a pony" 0.0725 1 2008 3 3 <date> 11106.24 open-account
|
||||
my-account [
|
||||
[ 8416 ] [
|
||||
my-account get [
|
||||
2008 3 11 <date> -750 "Need to buy food" <transaction> ,
|
||||
|
|
@ -25,12 +25,10 @@ SYMBOL: my-account
|
|||
2008 4 8 <date> -700 "Buying a rocking horse" <transaction> ,
|
||||
] { } make inserting-transactions balance>> round >integer
|
||||
] unit-test
|
||||
] with-scope
|
||||
] with-variable
|
||||
|
||||
[
|
||||
[ 6781 ] [
|
||||
"..." 0.07 1 2007 4 10 <date> 4398.50 open-account
|
||||
2007 10 26 <date> 2000 "..." <transaction> 1array inserting-transactions
|
||||
2008 4 10 <date> process-to-date dup balance>> swap unpaid-interest>> + round >integer
|
||||
] unit-test
|
||||
] with-scope
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.data alien.destructors
|
||||
alien.enums alien.syntax classes.struct combinators destructors
|
||||
gdbm.ffi io.backend kernel libc locals math namespaces sequences
|
||||
serialize strings ;
|
||||
fry gdbm.ffi io.backend kernel libc locals math namespaces
|
||||
sequences serialize strings ;
|
||||
IN: gdbm
|
||||
|
||||
ENUM: gdbm-role reader writer wrcreat newdb ;
|
||||
|
|
@ -147,8 +147,10 @@ PRIVATE>
|
|||
: gdbm-file-descriptor ( -- desc ) dbf gdbm_fdesc ;
|
||||
|
||||
: with-gdbm ( gdbm quot -- )
|
||||
[ gdbm-open &gdbm-close current-dbf set ] prepose curry
|
||||
[ with-scope ] curry with-destructors ; inline
|
||||
'[
|
||||
_ gdbm-open &gdbm-close current-dbf
|
||||
_ with-variable
|
||||
] with-destructors ; inline
|
||||
|
||||
:: with-gdbm-role ( name role quot -- )
|
||||
<gdbm> name >>name role >>role quot with-gdbm ; inline
|
||||
|
|
|
|||
|
|
@ -3,27 +3,24 @@ USING: mason.child mason.config tools.test namespaces io kernel
|
|||
sequences system ;
|
||||
|
||||
[ { "nmake" "/f" "nmakefile" "x86-32" } ] [
|
||||
[
|
||||
windows target-os set
|
||||
x86.32 target-cpu set
|
||||
make-cmd
|
||||
] with-scope
|
||||
H{
|
||||
{ target-os windows }
|
||||
{ target-cpu x86.32 }
|
||||
} [ make-cmd ] with-variables
|
||||
] unit-test
|
||||
|
||||
[ { "make" "macosx-x86-32" } ] [
|
||||
[
|
||||
macosx target-os set
|
||||
x86.32 target-cpu set
|
||||
make-cmd
|
||||
] with-scope
|
||||
H{
|
||||
{ target-os macosx }
|
||||
{ target-cpu x86.32 }
|
||||
} [ make-cmd ] with-variables
|
||||
] unit-test
|
||||
|
||||
[ { "./factor.com" "-i=boot.windows-x86.32.image" "-no-user-init" } ] [
|
||||
[
|
||||
windows target-os set
|
||||
x86.32 target-cpu set
|
||||
boot-cmd
|
||||
] with-scope
|
||||
H{
|
||||
{ target-os windows }
|
||||
{ target-cpu x86.32 }
|
||||
} [ boot-cmd ] with-variables
|
||||
] unit-test
|
||||
|
||||
[ [ "Hi" print ] [ drop 3 ] [ 4 ] recover-else ] must-infer
|
||||
|
|
|
|||
Loading…
Reference in New Issue