infix: adding support for constants and ( -- x ) words.

Also speed up subseq steps with negative steps.
char-rename
John Benediktsson 2017-03-18 13:27:33 -07:00
parent 3f04f7b013
commit 9c7655d286
2 changed files with 24 additions and 13 deletions

View File

@ -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

View File

@ -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* [