From 9c7655d286f171956462acf4777228cc84aa53a4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 18 Mar 2017 13:27:33 -0700 Subject: [PATCH] infix: adding support for constants and ( -- x ) words. Also speed up subseq steps with negative steps. --- extra/infix/infix-tests.factor | 6 ++++-- extra/infix/infix.factor | 31 ++++++++++++++++++++----------- 2 files changed, 24 insertions(+), 13 deletions(-) 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* [