rpn: new demo, simple RPN calculator that doesn't use Factor's evaluator reflectively
parent
bf57d78b09
commit
4fac281b1a
|
@ -39,19 +39,19 @@ TUPLE: A
|
|||
dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
|
||||
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 ;
|
||||
|
||||
|
@ -60,9 +60,9 @@ M: A resize
|
|||
[ T heap-size * ] [ underlying>> ] bi*
|
||||
resize-byte-array
|
||||
] 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{ \ } ;
|
||||
|
||||
|
|
|
@ -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