rpn: new demo, simple RPN calculator that doesn't use Factor's evaluator reflectively

diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor
index 1c855be1a485c84144538cdcc51eea63d683e04e..06b9aef17dc22d8ccebfe2d1fe33a780293a73af 100644 (file)
--- a/basis/specialized-arrays/functor/functor.factor
+++ b/basis/specialized-arrays/functor/functor.factor
@@ -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{ \ } ;
 

diff --git a/extra/rpn/authors.txt b/extra/rpn/authors.txt
new file mode 100644 (file)
index 0000000..1901f27
--- /dev/null
+++ b/extra/rpn/authors.txt
@@ -0,0 +1 @@
+Slava Pestov

diff --git a/extra/rpn/rpn.factor b/extra/rpn/rpn.factor
new file mode 100644 (file)
index 0000000..7175746
--- /dev/null
+++ b/extra/rpn/rpn.factor
@@ -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

diff --git a/extra/rpn/summary.txt b/extra/rpn/summary.txt
new file mode 100644 (file)
index 0000000..e6b4fe2
--- /dev/null
+++ b/extra/rpn/summary.txt
@@ -0,0 +1 @@
+Simple RPN calculator

diff --git a/extra/rpn/tags.txt b/extra/rpn/tags.txt
new file mode 100644 (file)
index 0000000..cb5fc20
--- /dev/null
+++ b/extra/rpn/tags.txt
@@ -0,0 +1 @@
+demos