diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor index ec3fd7c1cf..a6bbaa7dd5 100644 --- a/extra/infix/infix-tests.factor +++ b/extra/infix/infix-tests.factor @@ -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 diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 75395a2608..5de1ca52ea 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -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 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 - swap nths - ] if ; + { + { 0 [ "slice step cannot be zero" throw ] } + { 1 [ ] } + { -1 [ reverse! ] } + [ + [ dup length 1 [-] 0 ] dip + [ 0 > [ swap ] when ] keep + swap nths + ] + } case ; :: infix-subseq-range ( from to step len -- from to ) step [ 0 < ] [ f ] if* [