calc.lipl

(def parse (x) (words x))

(def printStack ()
    (map (lambda (x) ((compose println show) x))))

(def swapOp (st)
    (if (< (length st) 2)
        (seq (println "not enough elements to swap") st)
        (let {a = (head st), tl = (tail st)
            , b = (head tl), st' = (tail tl)}
            (cons b (cons a st')))))

(def dupOp (st)
    (if (isEmpty st)
        (seq (println "no element to dup") [])
        (cons (head st) st)))

(def popOp (st)
    (if (isEmpty st)
        (seq (println "no element to pop") [])
        (tail st)))

(def arithOp (op st)
    (if (< (length st) 2)
        (seq (println "don't have 2 elements for arithmetic") st)
        (let {tl = (tail st), st' = (tail tl)
            , arg1 = (head tl), arg2 = (head st)}
            (cons (op arg1 arg2) st'))))
(def clearOp (st)
    (if (isEmpty st)
        (seq (println "nothing to clear") [])
        (seq (printStack st) [])))

(def isInt (s)
    (if (isEmpty s)
        False
        (all isNum (if (== '-' (head s)) (tail s) s))))

(def eval (st l) (if (isEmpty l)
    st
    (let {x = (head l), xs = (tail l)}
        (if (== "-" x) (eval (arithOp - st) xs)
        (if (== "+" x) (eval (arithOp + st) xs)
        (if (== "*" x) (eval (arithOp * st) xs)
        (if (== "/" x) (eval (arithOp div st) xs)
        (if (== "swap" x)
            (eval (swapOp st) xs)
        (if (== "dup" x)
            (eval (dupOp st) xs)
        (if (== "pop" x)
            (eval (popOp st) xs)
        (if (== "." x)
            (eval (clearOp st) xs)
        (if (isInt x)
            (eval (cons (readInt x) st) xs)
            (seq (println (concat "not integer: " x)) st)))))))))))))

(def prompt (x) (seq (print x) getLine))

(def repl (st)
    (let { input = (prompt "CALC> ") }
        (if (== ":q" input)
            ()
        (if (== ":s" input)
            (seq (printStack st) (repl st))
            (repl (eval st (parse input)))))))

(def msg ()
    "
Welcome to Stack Based Postfix Calculator
- :q        quits
- :s        shows stack content
- .         clears stack
- swap      swaps top 2 elements from the stack
- dup       duplicates top element from the stack
- pop       pops top element from the stack
- only calculates postfix arithmetic expressions
  involving Integers, +, -, *, /")

(def main ()
    (seq
        (println msg)
        (repl [])))

(main)