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

Also speed up subseq steps with negative steps.

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