Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 123 lines (111 sloc) 2.6 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
;; Exercice 1 of programming praxis
;; http://programmingpraxis.com/2009/02/19/rpn-calculator/

;; TODO comply to the one line rule

;; no srfi-1 avail (function useless in here)
(define fold
  (lambda (f init l)
    (cond
     ((null? l) init)
     (else (f (car l) (fold f init (cdr l))))
     )
    )
  )

;; s -> boolean
(define exit?
  (lambda (s)
    (and (string? s) (eq? (string->symbol s) 'exit))
    )
  )

(define-structure
  operand
  ;; char
  name
  ;; function
  action
  )

;; assume that we act on numbers
(define *operands*
  `(
    ,(make-operand "+" (lambda (a b) (+ a b)))
    ,(make-operand "-" (lambda (a b) (- a b)))
    ,(make-operand "*" (lambda (a b) (* a b)))
    ;; TODO check for div by 0
    ,(make-operand "/" (lambda (a b) (/ a b)))
    )
  )

;; -> operand or #f
(define get-operand
  (lambda (what search-in f)
    (cond
     ((null? search-in) #f)
     ((equal? (f (car search-in)) what) (car search-in))
     (else (get-operand what (cdr search-in) f))
     )
    )
  )

;; small helper
;; string -> operand or #f
(define get-operand-by-name
  (lambda (name)
    (get-operand name *operands* (lambda (operand) (operand-name operand)))
    )
  )

;; string -> boolean
(define operand?
  (lambda (s)
    (and (string? s) (get-operand-by-name s))
    )
  )

(define dispatch-operand
  (lambda (operand rest)
    (if (or (not (operand? operand)) (not (eq? 2 (length rest))))
        (error "Invalid operand name")
        (apply (operand-action (get-operand-by-name operand)) rest)
        )
    )
  )

(define rpn
  (lambda ()
    (define empty-stack '())
    (define push
      (lambda (item stack)
        (cons item stack)
        )
      )
    (define next-token
      (lambda ()
        (read)
        )
      )
    (let loop (
               [stack empty-stack]
               [token (next-token)]
               )
      (cond
       ;; number
       (
        (number? token)
        (loop (push token stack) (next-token))
        )
       ;; operand
       (
        (operand? (symbol->string token))
        (if (>= (length stack) 2)
            (let ([result (dispatch-operand (symbol->string token) (list (cadr stack) (car stack)))])
              (println "result: " result)
              (loop (push result (cddr stack)) (next-token))
              )
            (error "An operand should only be run against a stack of 2 numbers")
          )
        )
       ;; exit?
       (
        (exit? (symbol->string token))
        (println "bye")
        )
       ;; catch all
       (else (error "Invalid (unrecognized token)"))
       )
      )
    )
  )

Something went wrong with that request. Please try again.