137 lines
7.0 KiB
Bash
137 lines
7.0 KiB
Bash
#!/usr/bin/env bash
|
|
#{
|
|
# Thanks to http://rosettacode.org/wiki/Multiline_shebang#PicoLisp
|
|
exec pil $0 $1
|
|
# }#
|
|
|
|
(de cadddddr (l) (car (cddr (cdddr l))))
|
|
|
|
(de caddddr (l) (car (cdr (cdddr l))))
|
|
|
|
(de mkexpr (n v) (cond ((= 0 n) (cond ((= 0 v) (list "var" 1 0))
|
|
(T (list "val" v 0))
|
|
))
|
|
(T (list "add" (mkexpr (- n 1) (+ v 1)) (mkexpr (- n 1) (max (- v 1) 0))))
|
|
)
|
|
)
|
|
|
|
(de appendadd (expf exps) (let (S (car expf)
|
|
l (cadr expf)
|
|
r (caddr expf)
|
|
)
|
|
( case S
|
|
("add" (list "add" l (appendadd r exps)))
|
|
(T (list "add" expf exps))
|
|
)
|
|
)
|
|
)
|
|
|
|
(de appendmul (expf exps) (let (S (car expf)
|
|
l (cadr expf)
|
|
r (caddr expf)
|
|
)
|
|
( case S
|
|
("mul" (list "mul" l (appendmul r exps)))
|
|
(T (list "mul" expf exps))
|
|
)
|
|
)
|
|
)
|
|
|
|
(de reassoc (exp) (let (S (car exp)
|
|
l (cadr exp)
|
|
r (caddr exp)
|
|
)
|
|
( case S
|
|
("add" (appendadd (reassoc l) (reassoc r)))
|
|
("mul" (appendmul (reassoc l) (reassoc r)))
|
|
(T exp)
|
|
)
|
|
)
|
|
)
|
|
|
|
(de cfold (exp) (let (S (car exp)
|
|
l (cadr exp)
|
|
r (caddr exp)
|
|
)
|
|
(case S
|
|
("add" (let (lc (cfold l)
|
|
rc (cfold r)
|
|
lcS (car lc)
|
|
lcl (cadr lc)
|
|
lcr (caddr lc)
|
|
rcS (car rc)
|
|
rcl (cadr rc)
|
|
rcr (caddr rc)
|
|
)
|
|
(cond ((= lcS "val") (cond ((= rcS "val) (list "val" (+ lcl rcl) 0))
|
|
((= rcS "add") (let (rclS (car rcl)
|
|
rcll (cadr rcl)
|
|
rclr (caddr rcl)
|
|
rcrS (car rcr)
|
|
rcrl (cadr rcr)
|
|
rcrr (caddr rcr)
|
|
)
|
|
(cond ((= rcrS "val") (list "add" (list "val" (+ lcl rcrl) 0) rcl))
|
|
((= rclS "val") (list "add" (list "val" (+ lcl rcll) 0) rcr))
|
|
(T (list "add" lc rc))
|
|
)
|
|
)
|
|
(T (list "mul" lc rc))
|
|
)
|
|
|
|
)
|
|
)
|
|
(T (list "add" lc rc))
|
|
)
|
|
)
|
|
)
|
|
("mul" (let (lc (cfold l)
|
|
rc (cfold r)
|
|
lcS (car lc)
|
|
lcl (cadr lc)
|
|
lcr (caddr lc)
|
|
rcS (car rc)
|
|
rcl (cadr rc)
|
|
rcr (caddr rc)
|
|
)
|
|
(cond ((= lcS "val") (cond ((= rcS "val) (list "val" (* lcl rcl) 0))
|
|
((= rcS "mul") (let (rclS (car rcl)
|
|
rcll (cadr rcl)
|
|
rclr (caddr rcl)
|
|
rcrS (car rcr)
|
|
rcrl (cadr rcr)
|
|
rcrr (caddr rcr)
|
|
)
|
|
(cond ((= rcrS "val") (list "mul" (list "val" (* lcl rcrl) 0) rcl))
|
|
((= rclS "val") (list "mul" (list "val" (* lcl rcll) 0) rcr))
|
|
(T (list "mul" lc rc))
|
|
)
|
|
)
|
|
)
|
|
(T (list "mul" lc rc))
|
|
)
|
|
)
|
|
(T (list "mul" lc rc))
|
|
)
|
|
)
|
|
)
|
|
(T exp)
|
|
)
|
|
)
|
|
)
|
|
|
|
(de evalE (exp) (let ( S (car exp)
|
|
l (cadr exp)
|
|
r (caddr exp)
|
|
)
|
|
(case S
|
|
("add" (+ (evalE l) (evalE r) ))
|
|
("mul" (* (evalE l) (evalE r) ))
|
|
("var" 0)
|
|
("val" l)
|
|
)
|
|
)
|
|
)
|
|
|
|
(bye (println (evalE (cfold (reassoc (mkexpr (car (str (opt))) 1))))))
|