Bigger scheme - sam's capsule: sloum's small s-expression based language - Part 2

           /       \       /
    k --- a         b --- f
   /       \       /       \
           me --- l         i
   \       /       \       /
    j --- c         d --- e
           \       /
            g --- h

Part 1
Part 2

Liposuction

I wrote first version in a quick and dirty way, heavily relying on the copy-paste buffer of my vim.

(define Stack '())
(define PUSH (lambda (val) (set! Stack (cons val Stack))))
(define POP (lambda () (begin0 (car Stack)(set! Stack (cdr Stack)))))
(define PEEK (lambda () (if (not (null? Stack)) (display (car Stack)))))
(define ADD (lambda () ( begin0 (+ (car Stack) (car (cdr Stack))) (set! Stack (cdr (cdr Stack))))))
(define SUB (lambda () ( begin0 (- (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))
(define MUL (lambda () ( begin0 (* (car Stack) (car (cdr Stack))) (set! Stack (cdr (cdr Stack))))))
(define DIV (lambda () ( begin0 (/ (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))

I had to reverse the order of stack operation for SUB and DIV, to make it work
as expected for RPN users.
But there's no reason we couldn't use the same order for ADD and MUL, right?

For those who missed the math class: No, no reason at all

a + b = b + a

a * b = b * a

Let's do it:

(define Stack '())
(define PUSH (lambda (val) (set! Stack (cons val Stack))))
(define POP (lambda () (begin0 (car Stack)(set! Stack (cdr Stack)))))
(define PEEK (lambda () (if (not (null? Stack)) (display (car Stack)))))
(define ADD (lambda () ( begin0 (+ (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))
(define SUB (lambda () ( begin0 (- (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))
(define MUL (lambda () ( begin0 (* (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))
(define DIV (lambda () ( begin0 (/ (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))

See the pattern?
Yes - that part repeats itself...

(define DIV (lambda () ( begin0 (/ (car (cdr Stack))(car Stack)) (set! Stack (cdr (cdr Stack))))))
                                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

And, as we all know, repeating yourself in your code doesn't make you look smart.
(It's not an universal rule, sometimes it's done for efficiency or what not...)

C-C-C-C-Compression!

A reasonably experienced programmer would say - that's the place where a function would make sense.

Yes.

And kind of no[1] :)

** I am not responsible for a stroke one or another person will get now **

(define Stack '())
(define PUSH (lambda (val) (set! Stack (cons val Stack))))
(define POP  (lambda () (begin0 (car Stack)(set! Stack (cdr Stack)))))
(define PEEK (lambda () (if (not (null? Stack)) (display (car Stack)))))

(define OP (lambda (op) (begin0 (op (car (cdr Stack)) (car Stack)) (set! Stack (cdr (cdr Stack))))))

(define ADD (lambda () ( OP + )))
(define SUB (lambda () ( OP - )))
(define MUL (lambda () ( OP * )))
(define DIV (lambda () ( OP / )))

Cleaning up

Last small change - we already have the 'stack operators', why not to use them?

Let's rewrite the line:

(define OP (lambda (op) (begin0 (op (car (cdr Stack)) (car Stack)) (set! Stack (cdr (cdr Stack))))))

into

(define OP (lambda (op) (op (POP)(POP))))

Voila!

(define Stack '())
(define PUSH (lambda (val) (set! Stack (cons val Stack))))
(define POP  (lambda () (begin0 (car Stack)(set! Stack (cdr Stack)))))
(define PEEK (lambda () (if (not (null? Stack)) (display (car Stack)))))

(define OP (lambda (op) (op (POP)(POP))))

(define ADD (lambda () ( OP + )))
(define SUB (lambda () ( OP - )))
(define MUL (lambda () ( OP * )))
(define DIV (lambda () ( OP / )))

That's all for now, folks

If you found it marginally interesting -- get 'slope' (link below), grab the code, play with it.
It won't make you a great programmer over night, it won't make your salary look
like a phone number, but it will give you a different perspective. And that
might (or might not) help you with the former, the latter, or both.

In the worst case it will be another item on your "Hello, World!" list ;-)

See you then,
-- sam

Get slope

Gitea repository (https://git.rawtext.club)

---

[1] or is it?