#lang racket

;; expressions

(define (const? t)
  (number? t))

(define (op? t)
  (and (list? t)
       (member (car t) '(+ - * /))))

(define (op-op e)
  (car e))

(define (op-args e)
  (cdr e))

(define (op-cons op args)
  (cons op args))

(define (op->proc op)
  (cond [(eq? op '+) +]
        [(eq? op '*) *]
        [(eq? op '-) -]
        [(eq? op '/) /]))

(define (let-def? t)
  (and (list? t)
       (= (length t) 2)
       (symbol? (car t))))

(define (let-def-var e)
  (car e))

(define (let-def-expr e)
  (cadr e))

(define (let-def-cons x e)
  (list x e))

(define (let? t)
  (and (list? t)
       (= (length t) 3)
       (eq? (car t) 'let)
       (let-def? (cadr t))))

(define (let-def e)
  (cadr e))

(define (let-expr e)
  (caddr e))

(define (let-cons def e)
  (list 'let def e))

(define (var? t)
  (symbol? t))

(define (var-var e)
  e)

(define (var-cons x)
  x)

(define (arith/let-expr? t)
  (or (const? t)
      (and (op? t)
           (andmap arith/let-expr? (op-args t)))
      (and (let? t)
           (arith/let-expr? (let-expr t))
           (arith/let-expr? (let-def-expr (let-def t))))
      (var? t)))

;; let-lifted expressions

(define (arith-expr? t)
  (or (const? t)
      (and (op? t)
           (andmap arith-expr? (op-args t)))
      (var? t)))

(define (let-lifted-expr? t)
  (or (and (let? t)
           (let-lifted-expr? (let-expr t))
           (arith-expr? (let-def-expr (let-def t))))
      (arith-expr? t)))

;; generating a symbol using a counter

(define (number->symbol i)
  (string->symbol (string-append "x" (number->string i))))

;; environments (could be useful for something)

(define empty-env
  null)

(define (add-to-env x v env)
  (cons (list x v) env))

(define (find-in-env x env)
  (cond [(null? env) (error "undefined variable" x)]
        [(eq? x (caar env)) (cadar env)]
        [else (find-in-env x (cdr env))]))

;; the let-lift procedure

;;wewnętrzna reprezentacja wyrażenia
(define (struct? s) ;; lista zmiennych z ich definicjami, wyrażenie arith-expr, indeks potrzebny do zmiany nazwy
  (and (list? s)
       (= 3 (length s))
       (arith-expr? (second s))
       (list? (first s))
       (number? (third s))))
(define (struct-cons xs e idx)
  (list xs e idx))
(define (struct-varlist s)
  (car s))
(define (struct-expr s)
  (cadr s))
(define (struct-idx s)
  (caddr s))

(define (struct->let-lift s)
  (cond [(null? (struct-varlist s)) (struct-expr s)]
        [else (let-cons (car (struct-varlist s))
                        (struct->let-lift (struct-cons (cdr (struct-varlist s))
                                                       (struct-expr s) 0)))]))

(define (let-lift e)
  (define (helper e env idx)
    (cond [(const? e) (struct-cons '() e idx)]
          [(var? e) (struct-cons '() (find-in-env (var-var e) env) idx)]
          [(op? e) (let ((lis (op-helper (op-args e) env idx)))
                     (struct-cons (app-varlist lis)
                                  (op-cons (op-op e) (app-expr lis))
                                  (+ (length (app-varlist lis))idx)))]
          [(let? e) (let* ((a (helper (let-def-expr (let-def e)) env idx))
                          (new-var (list (let-def-var (let-def e))
                                         (number->symbol (struct-idx a))))
                          (b (helper (let-expr e)
                                     (add-to-env (first new-var) (second new-var) env)
                                     (+ 1 (struct-idx a)))))
                      (struct-cons (append (struct-varlist a)
                                           (list (list (second new-var) (struct-expr a)))
                                           (struct-varlist b))
                                   (struct-expr b)
                                   (struct-idx b)))]))

  (define (op-helper lis env idx)
  (if (null? lis)
      null
      (let ((a (helper (car lis) env idx)))
        (cons a (op-helper (cdr lis) env (struct-idx a))))))

  (define (app-varlist lis-struct )
    (if (null? lis-struct)
        null
        (append (struct-varlist (car lis-struct)) (app-varlist (cdr lis-struct)))))

  (define (app-expr lis-struct)
    (if (null? lis-struct)
        null
        (cons (struct-expr (car lis-struct)) (app-expr (cdr lis-struct)))))

  (struct->let-lift (helper e empty-env 1)))

(let-lift '(let (x 4) (let (y 7) 5)))
(let-lift '(+ (let (x 5) x)
              (let (x 1) x)
              (let (x 7) x)))
(let-lift '(let (z 3) z))
(let-lift '( let ( x (- 2
                        ( let ( z 3) z ) ) )
              (+ x 2) ))
(let-lift '(let (x
                 (* 3
                    (let (z 1)
                        (let (a (+ z 2)) (- a 4)))
                    (let (y 2) (+ 6 y))))
             (- 5 x)))