steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/infix/infix-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Philipp Brüschweiler ! Copyright (C) 2009 Philipp Brüschweiler
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: infix infix.private kernel locals math math.functions USING: infix infix.private kernel literals locals math
sequences tools.test ; math.constants math.functions sequences tools.test ;
IN: infix.tests IN: infix.tests
{ 0 } [ [infix 0 infix] ] unit-test { 0 } [ [infix 0 infix] ] unit-test
@ -64,3 +64,5 @@ INFIX:: foo ( x y -- z ) x**2-abs(y) ;
] unit-test ] unit-test
{ "foobar" } [ [infix append("foo", "bar") infix] ] unit-test { "foobar" } [ [infix append("foo", "bar") infix] ] unit-test
${ pi } [ [infix pi infix] ] unit-test

29
extra/infix/infix.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2009 Philipp Brüschweiler ! Copyright (C) 2009 Philipp Brüschweiler
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators effects effects.parser fry USING: accessors combinators combinators.short-circuit effects
infix.ast infix.parser kernel locals locals.parser locals.types effects.parser fry infix.ast infix.parser kernel locals
math math.functions math.order math.ranges multiline parser locals.parser locals.types math math.functions math.order
quotations sequences summary vocabs.parser words ; math.ranges multiline parser quotations sequences summary
vocabs.parser words words.constant ;
IN: infix IN: infix
<PRIVATE <PRIVATE
@ -15,8 +16,11 @@ M: local-not-defined summary
drop "local is not defined" ; drop "local is not defined" ;
: >local-word ( string -- word ) : >local-word ( string -- word )
dup search dup local? dup search dup {
[ nip ] [ drop local-not-defined ] if ; [ local? ]
[ constant? ]
[ stack-effect ( -- x ) effect= ]
} 1|| [ nip ] [ drop local-not-defined ] if ;
ERROR: invalid-op string ; ERROR: invalid-op string ;
@ -46,11 +50,16 @@ M: ast-array infix-codegen
[ name>> >local-word ] bi '[ @ _ infix-nth ] ; [ name>> >local-word ] bi '[ @ _ infix-nth ] ;
: infix-subseq-step ( subseq step -- subseq' ) : infix-subseq-step ( subseq step -- subseq' )
dup 0 < [ [ reverse! ] dip ] when {
abs dup 1 = [ drop ] [ { 0 [ "slice step cannot be zero" throw ] }
[ dup length 1 [-] 0 swap ] dip { 1 [ ] }
{ -1 [ reverse! ] }
[
[ dup length 1 [-] 0 ] dip
[ 0 > [ swap ] when ] keep
<range> swap nths <range> swap nths
] if ; ]
} case ;
:: infix-subseq-range ( from to step len -- from to ) :: infix-subseq-range ( from to step len -- from to )
step [ 0 < ] [ f ] if* [ step [ 0 < ] [ f ] if* [