infix: adding support for "seq[from:to]" slice notation.

extra/infix/ast/ast.factor

@@ -5,6 +5,7 @@ IN: infix.ast
 TUPLE: ast-number value ;
 TUPLE: ast-local name ;
 TUPLE: ast-array name index ;
+TUPLE: ast-slice name from to ;
 TUPLE: ast-function name arguments ;
 TUPLE: ast-op left right op ;
 TUPLE: ast-negation term ;

extra/infix/infix-docs.factor

@@ -65,6 +65,13 @@ $nl
     "[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
     "9"
 }
+$nl
+"You can create sub-" { $vocab-link "sequences" } " inside infix expressions using " { $snippet "arr[from:to]" } " notation."
+{ $example
+    "USING: arrays locals infix ;"
+    "[let \"foobar\" :> s [infix s[0:3] infix] ] ."
+    "\"foo\""
+}
 ;
 
 ABOUT: "infix"

extra/infix/infix-tests.factor

@@ -32,3 +32,13 @@ IN: infix.tests
 [ 10 ] [ [infix stupid_function (0, 1, 2, 3, 4) infix] ] unit-test
 
 [ -1 ] [ [let 1 :> a [infix -a infix] ] ] unit-test
+
+[ CHAR: f ] [ [let "foo" :> s [infix s[0] infix] ] ] unit-test
+[ CHAR: r ] [ [let "bar" :> s [infix s[-1] infix] ] ] unit-test
+[ "foo" ] [ [let "foobar" :> s [infix s[0:3] infix] ] ] unit-test
+[ "foo" ] [ [let "foobar" :> s [infix s[:3] infix] ] ] unit-test
+[ "bar" ] [ [let "foobar" :> s [infix s[-3:] infix] ] ] unit-test
+[ "foobar" ] [ [let "foobar" :> s [infix s[:] infix] ] ] unit-test
+[ "bar" ] [ [let "foobar" :> s [infix s[-3:100] infix] ] ] unit-test
+[ "foobar" ] [ [let "foobar" :> s [infix s[-100:100] infix] ] ] unit-test
+

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 assocs combinators combinators.short-circuit
-effects fry infix.parser infix.ast kernel locals.parser
-locals.types math multiline namespaces parser quotations
-sequences summary words vocabs.parser ;
+effects fry infix.parser infix.ast kernel locals locals.parser
+locals.types math math.order multiline namespaces parser
+quotations sequences summary words vocabs.parser ;
+
 IN: infix
 
 <PRIVATE
@@ -33,9 +34,23 @@ M: ast-number infix-codegen value>> ;
 M: ast-local infix-codegen
     name>> >local-word ;
 
+:: infix-nth ( n seq -- elt )
+    n dup 0 < [ seq length + ] when seq nth ;
+
 M: ast-array infix-codegen
     [ index>> infix-codegen prepare-operand ]
-    [ name>> >local-word ] bi '[ @ _ nth ] ;
+    [ name>> >local-word ] bi '[ @ _ infix-nth ] ;
+
+:: infix-subseq ( from to seq -- subseq )
+    seq length :> len
+    from 0 or dup 0 < [ len + ] when
+    to [ dup 0 < [ len + ] when ] [ len ] if*
+    [ 0 len clamp ] bi@ dupd max seq subseq ;
+
+M: ast-slice infix-codegen
+    [ from>> [ infix-codegen prepare-operand ] [ [ f ] ] if* ]
+    [ to>> [ infix-codegen prepare-operand ] [ [ f ] ] if* ]
+    [ name>> >local-word ] tri '[ @ @ _ infix-subseq ] ;
 
 M: ast-op infix-codegen
     [ left>> infix-codegen ] [ right>> infix-codegen ]

extra/infix/parser/parser.factor

@@ -8,6 +8,7 @@ EBNF: parse-infix
 Number      = . ?[ ast-number? ]?
 Identifier  = . ?[ string? ]?
 Array       = Identifier:i "[" Sum:s "]" => [[ i s ast-array boa ]]
+Slice       = Identifier:i "[" Sum?:s ":" Sum?:t "]" => [[ i s t ast-slice boa ]]
 Function    = Identifier:i "(" FunArgs?:a ")" => [[ i a [ V{ } ] unless* ast-function boa ]]
 
 FunArgs     =   FunArgs:a "," Sum:s => [[ s a push a ]]
@@ -15,7 +16,7 @@ FunArgs     =   FunArgs:a "," Sum:s => [[ s a push a ]]
 
 Terminal    =   ("-"|"+"):op Terminal:term => [[ term op "-" = [ ast-negation boa ] when ]]
               | "(" Sum:s ")" => [[ s ]]
-              | Number | Array | Function
+              | Number | Array | Slice | Function
               | Identifier => [[ ast-local boa ]]
 
 Product     =   Product:p ("*"|"/"|"%"):op Terminal:term  => [[ p term op ast-op boa ]]

extra/infix/tokenizer/tokenizer.factor

@@ -17,6 +17,7 @@ NameRest          = NameFirst | Digit
 Name              = NameFirst NameRest* => [[ first2 swap prefix >string ]]
 Special           =   [+*/%(),] | "-" => [[ CHAR: - ]]
                     | "[" => [[ CHAR: [ ]] | "]" => [[ CHAR: ] ]]
+                    | ":" => [[ CHAR: : ]]
 Tok               = Spaces (Name | Number | Special )
 End               = !(.)
 Toks              = Tok* Spaces End