Merge branch 'master' of git://factorcode.org/git/factor
commit
aa39423509
|
@ -39,19 +39,19 @@ TUPLE: A
|
||||||
dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
|
dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
|
||||||
swap A boa ; inline
|
swap A boa ; inline
|
||||||
|
|
||||||
M: A clone [ length>> ] [ underlying>> clone ] bi A boa ;
|
M: A clone [ length>> ] [ underlying>> clone ] bi A boa ; inline
|
||||||
|
|
||||||
M: A length length>> ;
|
M: A length length>> ; inline
|
||||||
|
|
||||||
M: A nth-unsafe underlying>> NTH call ;
|
M: A nth-unsafe underlying>> NTH call ; inline
|
||||||
|
|
||||||
M: A set-nth-unsafe underlying>> SET-NTH call ;
|
M: A set-nth-unsafe underlying>> SET-NTH call ; inline
|
||||||
|
|
||||||
: >A ( seq -- specialized-array ) A new clone-like ; inline
|
: >A ( seq -- specialized-array ) A new clone-like ;
|
||||||
|
|
||||||
M: A like drop dup A instance? [ >A ] unless ;
|
M: A like drop dup A instance? [ >A ] unless ; inline
|
||||||
|
|
||||||
M: A new-sequence drop (A) ;
|
M: A new-sequence drop (A) ; inline
|
||||||
|
|
||||||
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
|
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
@ -60,9 +60,9 @@ M: A resize
|
||||||
[ T heap-size * ] [ underlying>> ] bi*
|
[ T heap-size * ] [ underlying>> ] bi*
|
||||||
resize-byte-array
|
resize-byte-array
|
||||||
] 2bi
|
] 2bi
|
||||||
A boa ;
|
A boa ; inline
|
||||||
|
|
||||||
M: A byte-length underlying>> length ;
|
M: A byte-length underlying>> length ; inline
|
||||||
|
|
||||||
M: A pprint-delims drop \ A{ \ } ;
|
M: A pprint-delims drop \ A{ \ } ;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1,45 @@
|
||||||
|
! Copyright (C) 2009 Slava Pestov
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors combinators io kernel lists math math.parser
|
||||||
|
sequences splitting ;
|
||||||
|
IN: rpn
|
||||||
|
|
||||||
|
SINGLETONS: add-insn sub-insn mul-insn div-insn ;
|
||||||
|
TUPLE: push-insn value ;
|
||||||
|
|
||||||
|
GENERIC: eval-insn ( stack insn -- stack )
|
||||||
|
|
||||||
|
: binary-op ( stack quot: ( x y -- z ) -- stack )
|
||||||
|
[ uncons uncons ] dip dip cons ; inline
|
||||||
|
|
||||||
|
M: add-insn eval-insn drop [ + ] binary-op ;
|
||||||
|
M: sub-insn eval-insn drop [ - ] binary-op ;
|
||||||
|
M: mul-insn eval-insn drop [ * ] binary-op ;
|
||||||
|
M: div-insn eval-insn drop [ / ] binary-op ;
|
||||||
|
M: push-insn eval-insn value>> swons ;
|
||||||
|
|
||||||
|
: rpn-tokenize ( string -- string' )
|
||||||
|
" " split harvest sequence>list ;
|
||||||
|
|
||||||
|
: rpn-parse ( string -- tokens )
|
||||||
|
rpn-tokenize [
|
||||||
|
{
|
||||||
|
{ "+" [ add-insn ] }
|
||||||
|
{ "-" [ sub-insn ] }
|
||||||
|
{ "*" [ mul-insn ] }
|
||||||
|
{ "/" [ div-insn ] }
|
||||||
|
[ string>number push-insn boa ]
|
||||||
|
} case
|
||||||
|
] lmap ;
|
||||||
|
|
||||||
|
: print-stack ( list -- )
|
||||||
|
[ number>string print ] leach ;
|
||||||
|
|
||||||
|
: rpn-eval ( tokens -- )
|
||||||
|
nil [ eval-insn ] foldl print-stack ;
|
||||||
|
|
||||||
|
: rpn ( -- )
|
||||||
|
"RPN> " write flush
|
||||||
|
readln [ rpn-parse rpn-eval rpn ] when* ;
|
||||||
|
|
||||||
|
MAIN: rpn
|
|
@ -0,0 +1 @@
|
||||||
|
Simple RPN calculator
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|
Loading…
Reference in New Issue