#!/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))))))