From 4fac281b1aa26ad9ca2300d3b8eab7489ab91332 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 17 Aug 2009 20:12:05 -0500 Subject: [PATCH] rpn: new demo, simple RPN calculator that doesn't use Factor's evaluator reflectively --- .../specialized-arrays/functor/functor.factor | 18 ++++---- extra/rpn/authors.txt | 1 + extra/rpn/rpn.factor | 45 +++++++++++++++++++ extra/rpn/summary.txt | 1 + extra/rpn/tags.txt | 1 + 5 files changed, 57 insertions(+), 9 deletions(-) create mode 100644 extra/rpn/authors.txt create mode 100644 extra/rpn/rpn.factor create mode 100644 extra/rpn/summary.txt create mode 100644 extra/rpn/tags.txt diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 1c855be1a4..06b9aef17d 100644 --- 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 index 0000000000..1901f27a24 --- /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 index 0000000000..7175746862 --- /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 index 0000000000..e6b4fe239b --- /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 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/rpn/tags.txt @@ -0,0 +1 @@ +demos -- 2.34.1