#lang racket

;; definicja wyrażeń z let-wyrażeniami

(struct const    (val)      #:transparent)
(struct op       (symb l r) #:transparent)
(struct let-expr (x e1 e2)  #:transparent)
(struct variable (x)        #:transparent)
(struct sigma (a b f)       #:transparent)
(struct integral (a b f)       #:transparent)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(struct iff (warunek parw fal))
;;(struct cond (warunek praw if))
(struct lambda (lista arugmentow funkcja))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;(define (expr? e)
;;  (match e
;;    [(variable s)       (symbol? s)]
;;    [(const n)          (number? n)]
;;    [(op s l r)         (and (member s '(+ * ^))
;;                             (expr? l)
;;                             (expr? r))]
;;    [(sigma a b f)      (and (expr? a)
;;                             (expr? b)
;;                             (procedure? f)
;;                             (= (procedure-arity f) 1))]
;;    [(integral a b f)      (and (expr? a)
;;                                (expr? b)
;;                                (procedure? f)
;;                                (= (procedure-arity f) 1))]
;;    [(iff a b f)      (and (expr? a)
;;                           (expr? b)
;;                           (procedure? f)
;;                           (= (procedure-arity f) 1))]
;;    [(let-expr x e1 e2) (and (symbol? x)
;;                             (expr? e1)
;;                             (expr? e2))]
;;    [_                  false]))
;;
;;;; podstawienie wartości (= wyniku ewaluacji wyrażenia) jako stałej w wyrażeniu

;;(define (subst x v e)
;;  (match e
;;    [(op s l r)   (op s (subst x v l)
;;                      (subst x v r))]
;;    [(const n)    (const n)]
;;    [(variable y) (if (eq? x y)
;;                      (const v)
;;                      (variable y))]
;;    [(let-expr y e1 e2)
;;     (if (eq? x y)
;;         (let-expr y
;;                   (subst x v e1)
;;                   e2)
;;;;         (let-expr y
;;;;                   (subst x v e1)
;;;;                   (subst x v e2)))]))
;;;;
;;;;;; (gorliwa) ewaluacja wyrażenia w modelu podstawieniowym
;;;;
;;;;(define (eval e)
;;;;  (match e
;;;;    [(const n)    n]
;;;;    [(op '+ l r)  (+ (eval l) (eval r))]
;;;;    [(op '* l r)  (* (eval l) (eval r))]
;;;;    [(let-expr x e1 e2)
;;;;     (eval (subst x (eval e1) e2))]
;;;;    [(variable n) (error n "cannot referencexdre its definition ;)")]))
;;;;
;;;;;; przykładowe programy
;;;;
;;;;
;;;;;;(define (from-quote t)
;;;;;;    (define (iter xs xd)
;;;;;;        (if (null? xs)
;;;;;;            xd
;;;;;;            (iter (cdr xs) (append (list (car xs)) xd))))
;;;;;;    (iter t `()))
;;;;
;;
;;(define (from-quote t)
;;       (cond
;;          [(number? t) (list `const t)]
;;          [(and (= 1 (length t)) (symbol? (car t))) (list `const 0)]
;;          [(number? (car t)) (list `const t)]
;;          [(and (symbol? (car t)) (= 2 (length t))) (from-quote (second t))]
;;          [else (list `op (car t) (from-quote (second t)) (from-quote (cons (car t) (cddr t))))]))
;;
;;
;;;;(from-quote `(+ 2 (* 1 2) 4))
;;
;;
;;
;;
;;(define f (op '* (op '* (variable) (variable))
;;                 (variable)))
;;
;;;; pochodna funkcji
;;
;;(define (∂ f)
;;  (match f
;;    [(const n)   (const 0)]
;;    [(variable)  (const 1)]
;;    [(op '+ f g) (op '+ (∂ f) (∂ g))]
;;    [(op '* f g) (op '+ (op '* (∂ f) g)
;;                        (op '* f (∂ g)))]))
;;
;;;; przykładowe użycie
;;
;;(define (evali e)
;;  (match e
;;    [(variable) (variable)]
;;    [(const n) (const n)]
;;    [(op `+ (const x) (const y)) (const (+ x y))]
;;    [(op `+ e1 e1) (op `* (const 2) e1)]
;;    [(op `+ e1 e2) (op `+ (evali e1) (evali e2))]
;;    [(op `+ (const 0) e1) e1]
;;    [(op `+ e1 (const 0)) e1]
;;
;;    [(op `* e1 (const 0)) (const 0)]
;;    [(op `* e1 (const 1)) (evali e1)]
;;    [(op `* (variable) (const 0)) (const 0)]
;;    [(op `* (variable) (const 0)) (const 0)]
;;    [(op `* (const 0) e1) (const 0)]
;;    [(op `* (const 1) e1) (evali e1)]
;;    [(op `* (const x) (const y)) (const (* x y))]
;;
;;    [(op `* (variable) e1) (op `* (variable) (evali e1))]
;;    [(op `* e1 (variable)) (op `*  (evali e1) (variable))]
;;
;;    [(op `* e1 e2) (op `* (evali e1) (evali e2))]))
;;
;;;(define df (∂ f))
;;;(define ddf (∂ (∂ f)))
;;(define dddf (∂ (∂ (∂ f))))
;;
;;;dddf
;;
;;;(evali df)
;;
;;(evali (evali (evali (evali (evali (evali (evali ( evali (evali (evali dddf))))))))))
;;
;;
;;(define (make-stos stack)
;;    (define (push x)
;;        (set! stack (mcons x stack)))
;;    (define (top)
;;        (begin (let ((res (mcar stack)))
;;                (pop)
;;                res)))
;;    (define (pop)
;;        (set! stack (mcdr stack)))
;;    (define (dispatch m)
;;        (cond [(eq? m `push) push]
;;              [(eq? m `top)  (top)]
;;              [(eq? m `pop)  (pop)]))
;;    dispatch)
;;
;;(define stosik (make-stos `()))
;;
;;(define (eval-onp xs)
;;    (define (iter xs)
;;        (if (null? xs)
;;            (stosik `top)
;;            (if (member (car xs) `(+ - * /))
;;                (match (car xs)
;;                   [`+ (begin ((stosik `push) (+ (stosik `top) (stosik `top)))
;;                       (iter (cdr xs)))]
;;                   [`* (begin ((stosik `push) (* (stosik `top) (stosik `top)))
;;                       (iter (cdr xs)))])
;;                (begin ((stosik `push) (car xs))
;;                       (iter (cdr xs))))))
;;    (iter xs))
;;
;;
;;
;;(define e1 (op '+ (op '+ (const 2) (const 2))
;;                  (const 2)))
;;
;;(define (to-rpn e)
;;  (match e
;;    [(const n) (list n)]
;;    [(op s l r) (append (to-rpn l)
;;                        (to-rpn r)
;;                        (list s))]))
;;
;;(eval-onp (to-rpn e1))

(define (find e u)
    (match e
        [(const x) #f]
        [(variable x) (if (eq? u x) #t #f)]
        [(op s x y) (or (find x u) (find y u))]
        [(let-expr x e1 e2) (or (find e1 u) (find e2 u))]))

(define (usun e)
    (match e
        [(const x) (const x)]
        [(variable x) (variable x)]
        [(op s x y) (op s (usun x) (usun y))]
        [(let-expr x e1 e2) (if (or (find e1 x) (find e2 x))
                                (let-expr x (usun e1) (usun e2))
                                (usun e2))]))

(usun (let-expr `x
                (op `+ (const 2) (const 2))
                (let-expr `y
                            (op `* (const 3) (variable `x))
                            (op `+ (const 7) (variable `x)))))