infix: adding support for constants and ( -- x ) words.
Also speed up subseq steps with negative steps.char-rename
parent
3f04f7b013
commit
9c7655d286
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009 Philipp Brüschweiler
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: infix infix.private kernel locals math math.functions
|
||||
sequences tools.test ;
|
||||
USING: infix infix.private kernel literals locals math
|
||||
math.constants math.functions sequences tools.test ;
|
||||
IN: infix.tests
|
||||
|
||||
{ 0 } [ [infix 0 infix] ] unit-test
|
||||
|
@ -64,3 +64,5 @@ INFIX:: foo ( x y -- z ) x**2-abs(y) ;
|
|||
] unit-test
|
||||
|
||||
{ "foobar" } [ [infix append("foo", "bar") infix] ] unit-test
|
||||
|
||||
${ pi } [ [infix pi infix] ] unit-test
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2009 Philipp Brüschweiler
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators effects effects.parser fry
|
||||
infix.ast infix.parser kernel locals locals.parser locals.types
|
||||
math math.functions math.order math.ranges multiline parser
|
||||
quotations sequences summary vocabs.parser words ;
|
||||
USING: accessors combinators combinators.short-circuit effects
|
||||
effects.parser fry infix.ast infix.parser kernel locals
|
||||
locals.parser locals.types math math.functions math.order
|
||||
math.ranges multiline parser quotations sequences summary
|
||||
vocabs.parser words words.constant ;
|
||||
IN: infix
|
||||
|
||||
<PRIVATE
|
||||
|
@ -15,8 +16,11 @@ M: local-not-defined summary
|
|||
drop "local is not defined" ;
|
||||
|
||||
: >local-word ( string -- word )
|
||||
dup search dup local?
|
||||
[ nip ] [ drop local-not-defined ] if ;
|
||||
dup search dup {
|
||||
[ local? ]
|
||||
[ constant? ]
|
||||
[ stack-effect ( -- x ) effect= ]
|
||||
} 1|| [ nip ] [ drop local-not-defined ] if ;
|
||||
|
||||
ERROR: invalid-op string ;
|
||||
|
||||
|
@ -46,11 +50,16 @@ M: ast-array infix-codegen
|
|||
[ name>> >local-word ] bi '[ @ _ infix-nth ] ;
|
||||
|
||||
: infix-subseq-step ( subseq step -- subseq' )
|
||||
dup 0 < [ [ reverse! ] dip ] when
|
||||
abs dup 1 = [ drop ] [
|
||||
[ dup length 1 [-] 0 swap ] dip
|
||||
{
|
||||
{ 0 [ "slice step cannot be zero" throw ] }
|
||||
{ 1 [ ] }
|
||||
{ -1 [ reverse! ] }
|
||||
[
|
||||
[ dup length 1 [-] 0 ] dip
|
||||
[ 0 > [ swap ] when ] keep
|
||||
<range> swap nths
|
||||
] if ;
|
||||
]
|
||||
} case ;
|
||||
|
||||
:: infix-subseq-range ( from to step len -- from to )
|
||||
step [ 0 < ] [ f ] if* [
|
||||
|
|
Loading…
Reference in New Issue