finding duplicated variable and type interfence using Racket

closure.c

#include <stdio.h>

/*
lambda 函數的案例
(define foo (lambda (x) 10) [fv ()])
(foo foo)
*/

typedef union object object;

typedef struct closure closure;

// closure 的型別
typedef struct closure{
object (* function);
object* fv;
} closure;


// object 的型別
typedef union object{
closure cl;
long i;
float f;
} object;

// 函數
object foo(closure cl, object x){

 object tmp1;
 tmp1.i = 10;
 return tmp1;
};

/* 函數延伸處
...
*/


int main(void){

 // 建立 foo
 closure closure1;
 closure1.function = (object *)foo;
 object closure1_o;
 closure1_o.cl = closure1;


//  (foo foo)
 object object2;
 object2 = ((object (*)(closure cl, object x))(closure1_o.cl.function))(closure1_o.cl,closure1_o);

 // 檢查 (foo foo) 的內容物，應該是 10
 printf("%ld", object2.i);

}

closure.scm

#include <stdio.h>

/*
lambda 函數的案例
(define foo (lambda (x) 10) [fv ()])
(foo foo)
*/

(typedef [U object] object)

(typedef [Struct closure] closure)

// closure 的型別
typedef struct closure{
object (* function);
object* fv;
} closure;

(typedef [Struct closure
([object (* function)]
 [(object *) fv])]
closure)


(typedef [union object(
[closure cl]
[long i]
[float f]
)] object)

// 函數
(fn object foo [(closure cl) (object x)]
(
 (def object tmp1)
 (set (ref tmp1 i) 10)
 tmp1
};

/* 函數延伸處
...
*/


(fn int main void {

 // 建立 foo
 (def closure closure1)
 (set (ref closure1 function) (cast (object *)) foo)
 (def object closure1_o)
 (set (ref closure1_o cl) closure1)


//  (foo foo)
 (def object object2)
 // (object (*)(closure cl, object x)) -> [type object * [(closure c1) (object x)]]
 (set object2 [call (cast [type object * [(closure c1) (object x)]] [ref [ref closure1_o cl] function]) (ref closure1_o cl) closure1_o];

 // 檢查 (foo foo) 的內容物，應該是 10
 (printf "%ld" (ref object2 i))

}

toy-lang.rkt

#lang racket
(require nanopass/base)

;(let ((x 10)
;      (y 8))
;(lambda (z) (+  x y z)))

(define (neq? x y) (not (eq? x y)))

(define (variable? x)
  (and (symbol? x)))

(define primitive-list '(+ - * / +. -. *. /. and or))

(define (primitive? x)
  (memq x primitive-list))

(define (datatype? x)
  (memq x '(int flo bool void)))

(define (constant? x)
  (or
   (flonum? x)
   (integer? x)
   (boolean? x)))

(define-language L0
  (terminals
    (variable (x))
    (primitive (pr))
    (datatype (dt))
    (constant (c)))


   (Expr (e body)
    x
    pr
    c
    (begin e* ... e)
    (def t x e)
    (lambda ([t* x*] ... ) e)
    (e0 e1 ...))
  (Type (t)
    dt
    (-> t* ... t)
  )
  )

(define-language L1
  (terminals
    (datatype (dt)))
  (Type (t)
    dt
    (-> t* ... t)
  )
  )

(define table-list `(,primitive-list))

;;;
; 找尋有沒有重複定義的變數
;;;
(define (find-dup-var exp table)
  (match exp
     [(? primitive? c) table]
     [(? constant? c) table]
     ; 逐一執行找尋重複變數的子程式
     [(list* 'begin e* ... e) (let loop
                                 [(head (car (append e* (list e))))
                                  (tail (cdr (append e* (list e))))
                                  (t table)
                                  ]
                               (if (equal? tail '(()))
                                   (find-dup-var head t)
                                   (let
                                       [(t1 (find-dup-var head t))]
                                     (loop (car tail) (cdr tail) t1))
                               ))]


    [(? variable? x) (cond
           ; 如果 x 在 table 的其中一格裡面,就是正常的,回傳 table
           [(memq x (flatten table)) table]
           ; 如果不在,就回傳 exception
           [else (raise (format "~a is not defined." x))])]
    ; 定義變數
    [`(def ,t ,x ,e) (cond
                       [(memq x (last table)) (raise (format "~a is duplicated defined." x))]
                       ; 將 table 最後一個列表,加入 x 元素
                       [else (begin
                               [set! table (list-set table [- (length table) 1] [append (last table) (list x)])]
                               table)])]
    ; lambda 函數
    [`(lambda ,var-type-ls ,body) (begin
                                    ;(display var-type-ls)
                               (define var-ls (map cadr var-type-ls))
                               (if
                                ; 找看看有沒有重複的變數定義於 lambda 裡面
                                (check-duplicates var-ls)
                                (raise (format "lambda have duplicated variables: ~a" (check-duplicates var-ls) ))
                                ; table 開新的儲存區，然後再逐一檢查 body 裡面的表達式
                                [let
                                    [(new-table (reverse (cons var-ls (reverse table))))]
                                  (find-dup-var body new-table)
                                table
                                ]))]
    ; 函數調用
    [(list* e* ... e) (let
                            [(exps (cons e* e))]
                          (for
                              [(exp (car exps))]
                            (set! table (find-dup-var exp table)))
                        table
                          )]
   
     ))

(define (find-dup-var-main exp) (find-dup-var exp '(())))


;uncaught exception: "x is not defined."
;(find-dup-var '(begin (+ x y) 3 (def int x 99) x (def int y 10) (lambda (x y z) (+ x y s))) table-list)
;uncaught exception: "s is not defined."
;(find-dup-var '(begin 3 (def int x 99) x (def int y 10) (lambda (x y z) (+ x y s))) table-list)
;uncaught exception: "lambda have duplicated variables: z"
;(find-dup-var '(lambda (x z) (begin 54 (+ x y 12))) table-list)

;(define ex-0 '(begin
;  10.0
;  (+ 2 2)
;(def int x 10)
;(def flo y (+. 2.0 2.0))
;))



(define-parser parse-L0 L0)
(define-parser parse-L1 L1)

(define (list-remove-last ls)
 (reverse (cdr (reverse ls))))

;; 初級函數型別
[define prim-func-type
  (make-hash
   `((+ . ,(parse-L1 '[-> int int int]))
     (- . ,(parse-L1 '[-> int int int]))
     (* . ,(parse-L1 '[-> int int int]))
     (/ . ,(parse-L1 '[-> int int int]))
     (+. . ,(parse-L1 '[-> flo flo flo]))
     (-. . ,(parse-L1 '[-> flo flo flo]))
     (*. . ,(parse-L1 '[-> flo flo flo]))
     (/. . ,(parse-L1 '[-> flo flo flo]))
     (and . ,(parse-L1 '[-> bool bool bool]))
     (or . ,(parse-L1 '[-> bool bool bool]))
     ))
  ]

(define (quoting-to-quasiquoting ls)
  `((unquote-splicing ls))
    )

[define (get-type x a) (let [(result #f)(has-value #f)] (for ((i (reverse a)) #:break (eq? has-value #t))
    (if (memq x (hash-keys i))
        [begin
          (set! result (hash-ref i x))
          (set! has-value #t)]
        #f)) result)]

(define-pass type-inference : L0 (ast) -> L1 ()
  [definitions
   (define orig-hash-table (make-hash))
   (define empty-env `(,orig-hash-table))]
  (type-infer : Expr (exp env) -> * ()
     ; 常數
     [,c (cond
           [(flonum? exp) `(flo ,env)]
           [(integer? exp) `(int ,env)]
           [(boolean? exp) `(bool ,env)])]
     ; 基本運算符調用
     [,pr `(,[hash-ref prim-func-type pr] ,env)]
     ; 變數
     [,x `(,(get-type x env) ,env)]
     ; 逐一執行指令。用 named let
     [(begin ,body* ... ,body) (let [(exprs (append body* (list body)))
                                     (tmp-env env)]
                               ;(display exprs)
                               (let loop
                                 [(head (car exprs))
                                  (tail (cdr exprs))]
                                 (if (equal? tail '())
                                     (type-infer head tmp-env) ; 如果執行到最後一行則傳回最後一行的回傳值
                                     (begin
                                       (set! tmp-env (list-ref (type-infer head env) 1))
                                       ;(display table)
                                       (loop (car tail) (cdr tail))))))]
     ; 定義變數
     [(def ,t ,x ,e)
      (let
          [(rhs-type (parse-L0 (unparse-L1 [list-ref (type-infer e env) 0])))]
        (cond
          [(equal? (unparse-L0 t) (unparse-L0 rhs-type)) (hash-set! (list-ref env [- (length env) 1])  x (parse-L1 (unparse-L0 t)))
                            ; 回傳 void 值
                            `(void ,env)]
          [else (error (format "Expect type of ~a : ~a, found type ~a" x t rhs-type))]

          )
      )]
     ; lambda
     ; (lambda [(int x) (int y)] -> t* = (int int) x* = (x y))
     [(lambda ([,t* ,x*] ... ) ,body)
                                      (let*
                                          [(new-hash-table (make-hash))
                                           (extended-env (append env (list new-hash-table)))] ; 創立新表格附著在後面
                                          
                                          (for
                                              [(t t*)
                                               (x x*)]
                                            (hash-set! (list-ref extended-env [- (length extended-env) 1])  x [parse-L1 (unparse-L0 t)]))
                                            ;(display (format "匿名函數掃描中~a" table))
                                            (let*
                                                [
                                                 (return-type (list-ref (type-infer body extended-env) 0)) ; 回傳值型別
                                                
                                                ;(total-type (quoting-to-quasiquoting total-type-raw))
                                                ] 
                                              (define t*-unparsed (map (lambda (x)  (unparse-L0 x)) t*))
                                              ;(define t*-unparsed-ast (unparse-L1 t*-unparsed))
                                              `[,(parse-L1 `(-> ,@t*-unparsed ,(unparse-L1 return-type))) ,env]
                                              ))]
     [(,e0 ,e1 ...) (let*
                        ((operator-type [list-ref (type-infer e0 env) 0])
                         (arguments-type [map (lambda (x) (unparse-L1 (list-ref (type-infer x env) 0))) e1])
                         (operator-type-without-return (reverse (cdr (reverse (cdr (unparse-L1 operator-type)))))))
                      (display exp)(display operator-type)(display arguments-type)(display env)
                      (if (equal? operator-type-without-return arguments-type)
                          `(,(parse-L1 (last (unparse-L1 operator-type))) ,env)
                          [begin (raise (format "expect argument type ~a, found ~a" operator-type-without-return arguments-type))])
                      )]
     )


  [list-ref (type-infer ast empty-env) 0]
       
  )
      ;[(and (list? e) (= 3 (length e)))
      ; (let ([op (car e)] [e0 (type-infer (cadr e))] [e1 (type-infer (caddr e))])
      ; `(,op ,e0 ,e1))]))
;(define l1 (parse-L0 '(+ 1 0.1)))
;(type-inference l1)

;; convert x -> x1, y -> y2, etc.
(define-pass eta-conversion : L0 (ast) -> L0 ()
  [definitions
    (define var-table `(,(make-hash)))
    (define (combine-two-list x y)
    (if (equal? x '())
        '()
        (cons `(,(car x) ,(car y)) (combine-two-list (cdr x) (cdr y)))))]
(convert : Expr (exp env) -> Expr ()
      [,pr pr]
      [(lambda ([,t* ,x*] ...) ,body)
       (let*
           ((new-x* (map gensym x*))
            (t*-new-x*-pair-ls [combine-two-list t* new-x*])
            (new-env [append env (list (make-hash))]))
         (for ([i x*]
               [j new-x*])
               (hash-set! (last new-env) i j))
         ;(display new-env)
         `(lambda [[,t* ,new-x*] ...] ,(convert body new-env)))]
      [,x
       ;(display (format "執行 ~a\n" x))
       (hash-ref (last env) x)]
      [,c c]

      
      [(def ,t ,x ,e) (let
                          [(new-var (gensym x))]
                        ;(display (format "執行def ~a\n" x))
                        (hash-set! (last env) x new-var)
                        `(def ,t ,new-var ,(convert e env)))
       ]


      )
  (convert ast var-table)
  )
  
; (define l1 (parse-L0 '(begin (def int x 10) (def int y x) x ((lambda [(int x) (int y)] y) x y) y))) (eta-conversion l1)

(define (atom? x) (and
                   [not (pair? x)]
                   [not (list? x)]))

(define (def-undef-lambda-begin ls)
  [let
      [(return '())]
    [for
        ((i ls))
      [match i
        ((list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L1 (type-inference (parse-L0 i)))
                               )
              (new-body (define-undef-lambda body)))
           (set! return (append return (list `(def ,new-lambda-type ,new-lambda ,new-body) new-lambda)))
           
           ])
        (else (set! return (append return (list (define-undef-lambda i)))))]]
    return
  ]
  )


(define (def-undef-lambda-apply ls)
  [let
      [(new-define '())
       (new-apply '())]
    [for
        ((i ls))
      [match i
        ((list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L1 (type-inference (parse-L0 i)))
                               )
              (new-body (define-undef-lambda body))
              (new-lambda-define `(def ,new-lambda-type ,new-lambda (lambda ,var-pair ,new-body))))
           (set! new-define (append new-define (list new-lambda-define)))
           (set! new-apply (append new-apply (list new-lambda)))
           
           ])
        ((list a ...) (let*
                          [[result (def-undef-lambda-apply a)]
                          [new-result (last result)]
                          [new-sub-define (cdr (list-remove-last result))]] ; 出來的結果會有 begin，但在括號內，我們不需要
                        ;(display new-sub-define)
                        (set! new-define (append new-define new-sub-define))
                        (set! new-apply (append new-apply (list new-result)))
                        ))
        (else (set! new-apply (append new-apply (list (define-undef-lambda i)))))]]
    `(begin ,@new-define ,new-apply)
  ]
  )



(define (define-undef-lambda x)
;; 用 match 重寫
  (match x
     [(? atom? x) x]
     ; TODO
     [(list 'def t x (list a b ...))
      [let*
          [(raw-result (def-undef-lambda-apply (append (list a) b)))
           (new-rhs (last raw-result))
           (new-def `(def ,t ,x ,new-rhs))]
        (append (list-remove-last raw-result) (list new-def))
        ]] ;TODO
     [(list 'def t x e) (match e
                          [(list 'lambda var-pair body) `(def ,t ,x ,e)]
                          [else `(def ,t ,x ,(define-undef-lambda e))])]
     [(list 'begin a ...) `(begin ,@(def-undef-lambda-begin a))]
     [(list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L1 (type-inference (parse-L0 x)))
                               )
              (new-body (define-undef-lambda body)))
           `(begin (def ,new-lambda-type ,new-lambda (lambda ,var-pair ,new-body)) ,new-lambda)]]
     [(list a b ...) (def-undef-lambda-apply x)] 
     
    ))

  ;; 用 match 重寫
;[flatten-begin '(begin
;                  12
;                  5
;                  y
;                  (begin  12 1 (begin (lambda [(x 5)(y 7)] y)))
;                  )]
; -> '(begin 12 5 y 12 1 (lambda ((x 5) (y 7)) y))
(define [flatten-begin x]
  (match x
    [(list (list 'begin i ...) o ...) (append (flatten-begin i) (flatten-begin o))]
    [(list a b ...) (append (list (flatten-begin a)) (flatten-begin b))]
    [(? pair? x) x]
    [(? null? x) x]
    [(? atom? x) x]
    [(list a) (list a)]
    )
  )

(define-pass remove-undefined-lambda : L0 (ast) -> L0 ()
  [definitions
    [define unparsed-ast (unparse-L0 ast)]
    [define removed-result-ast (flatten-begin(define-undef-lambda unparsed-ast))]
  ]
  (parse-L0 removed-result-ast)
)

;;;
; Test-area
;;;
;(define-undef-lambda '(begin 7 x  (lambda [(int x)(flo y)] y) 10))
;(define-undef-lambda '(begin 7 x (def int x 2) (def int x (begin (lambda [(int x)(flo y)] y) 10)) ))
;(define-undef-lambda '(lambda ([int x]) (lambda ([int y]) 12)))
;(define-undef-lambda '((lambda ([int x])  20) (lambda ((flo y)) 12))) ; 錯誤需要debug??
;(define-undef-lambda '((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12)))
;(define-undef-lambda '(begin 12 [def int kk ((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12))] 1.0))
;(parse-L0 (flatten-begin (define-undef-lambda '(begin 12 [def int kk ((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12))] 1.0))))


(define test-0 '(lambda ((int x)) 9))
(define test-1 '([lambda ((int x)) (lambda ((flo y)) x)] 9))
(define test-2 '(begin 12 [lambda ((int x)) x] 9))
(define test-3 '(begin 12
                  [def int kk
                    ((lambda ([int x])  20) ((lambda (((-> flo int) y) (int z)) 8) (lambda ((flo z)) 10) 12))]
                  1.0
                  kk))

(define test-4 '([lambda ((int x)) (lambda ((flo y)) x)] 9))
(define test-5 '(begin 12 [lambda ((int x)) x] 9))
(define test-6
  '(begin
     3.0
     (def bool x (and (or #t #t) #f))
     (def flo y 10.0)
     ; uncaught exception: "lambda have duplicated variables: y"
     ;(lambda ([int x] [int y] [int y]) (+ x y 10))
     ;uncaught exception: "z is not defined."
     ;(lambda ([int x] [int y]) (+ x y z 10))
     
     ;(def flo k (lambda (x y z) (+ y x z g)))
     (def flo z (+. 10.0 y))
     (+. 1.0 3.0)
     z
     (lambda ([int x] [int y]) 9.9)
     ))


(define [compiler ast]
  (display "Start compiling...\n")
  (let*
      [(found-dup-var-ast (find-dup-var-main ast))
       (ann-lambda-defined-ast (define-undef-lambda ast))
      (ann-lambda-defined-L0 (parse-L0 ann-lambda-defined-ast))
      (begin-flattened-L0 (remove-undefined-lambda ann-lambda-defined-L0))
      (etaed-L0 (eta-conversion begin-flattened-L0))
      (type-infered-type [begin (display etaed-L0)(type-inference etaed-L0)])]
    (display "End compiling...\n")
    ann-lambda-defined-L0
    )
)



(compiler test-0)
(compiler test-1)
(compiler test-2)
(compiler test-3)
(compiler test-4)
(compiler test-5)
(compiler test-6)

不確定哪一版的toy-lang.rkt

#lang racket
(require nanopass/base)

;(let ((x 10)
;      (y 8))
;(lambda (z) (+  x y z)))

(define (neq? x y) (not (eq? x y)))

(define (variable? x)
  (and (symbol? x)))

(define primitive-list '(+ - * / +. -. *. /. and or))

(define (primitive? x)
  (memq x primitive-list))

(define (datatype? x)
  (memq x '(int flo bool void)))

(define (constant? x)
  (or
   (flonum? x)
   (integer? x)
   (boolean? x)))

(define-language L0
  (terminals
    (variable (x))
    (primitive (pr))
    (datatype (dt))
    (constant (c)))


   (Expr (e body)
    x
    pr
    c
    (begin e* ... e)
    (def t x e)
    (lambda ([t* x*] ... ) e)
    (e0 e1 ...))
  (Type (t)
    dt
    (-> t* ... t)
  )
  )

(define-language L1
  (terminals
    (datatype (dt)))
  (Type (t)
    dt
    (-> t* ... t)
  )
  )

(define table-list `(,primitive-list))

;;;
; 找尋有沒有重複定義的變數
;;;
(define (find-dup-var exp table)
  (match exp
     [(? primitive? c) table]
     [(? constant? c) table]
     ; 逐一執行找尋重複變數的子程式
     [(list* 'begin e* ... e) (let loop
                                 [(head (car (append e* (list e))))
                                  (tail (cdr (append e* (list e))))
                                  (t table)
                                  ]
                               (if (equal? tail '(()))
                                   (find-dup-var head t)
                                   (let
                                       [(t1 (find-dup-var head t))]
                                     (loop (car tail) (cdr tail) t1))
                               ))]


    [(? variable? x) (cond
           ; 如果 x 在 table 的其中一格裡面,就是正常的,回傳 table
           [(memq x (flatten table)) table]
           ; 如果不在,就回傳 exception
           [else (raise (format "~a is not defined." x))])]
    ; 定義變數
    [`(def ,t ,x ,e) (cond
                       [(memq x (last table)) (raise (format "~a is duplicated defined." x))]
                       ; 將 table 最後一個列表,加入 x 元素
                       [else (begin
                               [set! table (list-set table [- (length table) 1] [append (last table) (list x)])]
                               table)])]
    ; lambda 函數
    [`(lambda ,var-type-ls ,body) (begin
                                    ;(display var-type-ls)
                               (define var-ls (map cadr var-type-ls))
                               (if
                                ; 找看看有沒有重複的變數定義於 lambda 裡面
                                (check-duplicates var-ls)
                                (raise (format "lambda have duplicated variables: ~a" (check-duplicates var-ls) ))
                                ; table 開新的儲存區，然後再逐一檢查 body 裡面的表達式
                                [let
                                    [(new-table (reverse (cons var-ls (reverse table))))]
                                  (find-dup-var body new-table)
                                table
                                ]))]
    ; 函數調用
    [(list* e* ... e) (let
                            [(exps (cons e* e))]
                          (for
                              [(exp (car exps))]
                            (set! table (find-dup-var exp table)))
                        table
                          )]
   
     ))

(define (find-dup-var-main exp) (find-dup-var exp '(())))


;uncaught exception: "x is not defined."
;(find-dup-var '(begin (+ x y) 3 (def int x 99) x (def int y 10) (lambda (x y z) (+ x y s))) table-list)
;uncaught exception: "s is not defined."
;(find-dup-var '(begin 3 (def int x 99) x (def int y 10) (lambda (x y z) (+ x y s))) table-list)
;uncaught exception: "lambda have duplicated variables: z"
;(find-dup-var '(lambda (x z) (begin 54 (+ x y 12))) table-list)

;(define ex-0 '(begin
;  10.0
;  (+ 2 2)
;(def int x 10)
;(def flo y (+. 2.0 2.0))
;))



(define-parser parse-L0 L0)
(define-parser parse-L1 L1)

(define (list-remove-last ls)
 (reverse (cdr (reverse ls))))

;; 初級函數型別
[define prim-func-type
  (make-hash
   `((+ . ,(parse-L1 '[-> int int int]))
     (- . ,(parse-L1 '[-> int int int]))
     (* . ,(parse-L1 '[-> int int int]))
     (/ . ,(parse-L1 '[-> int int int]))
     (+. . ,(parse-L1 '[-> flo flo flo]))
     (-. . ,(parse-L1 '[-> flo flo flo]))
     (*. . ,(parse-L1 '[-> flo flo flo]))
     (/. . ,(parse-L1 '[-> flo flo flo]))
     (and . ,(parse-L1 '[-> bool bool bool]))
     (or . ,(parse-L1 '[-> bool bool bool]))
     ))
  ]

(define (quoting-to-quasiquoting ls)
  `((unquote-splicing ls))
    )

[define (get-type x a) (let [(result #f)(has-value #f)] (for ((i (reverse a)) #:break (eq? has-value #t))
    (if (memq x (hash-keys i))
        [begin
          (set! result (hash-ref i x))
          (set! has-value #t)]
        #f)) result)]

(define-pass type-inference : L0 (ast) -> L1 ()
  [definitions
   (define orig-hash-table (make-hash))
   (define empty-env `(,orig-hash-table))]
  (type-infer : Expr (exp env) -> * ()
     ; 常數
     [,c (cond
           [(flonum? exp) `(flo ,env)]
           [(integer? exp) `(int ,env)]
           [(boolean? exp) `(bool ,env)])]
     ; 基本運算符調用
     [,pr `(,[hash-ref prim-func-type pr] ,env)]
     ; 變數
     [,x `(,(get-type x env) ,env)]
     ; 逐一執行指令。用 named let
     [(begin ,body* ... ,body) (let [(exprs (append body* (list body)))
                                     (tmp-env env)]
                               ;(display exprs)
                               (let loop
                                 [(head (car exprs))
                                  (tail (cdr exprs))]
                                 (if (equal? tail '())
                                     (type-infer head tmp-env) ; 如果執行到最後一行則傳回最後一行的回傳值
                                     (begin
                                       (set! tmp-env (list-ref (type-infer head env) 1))
                                       ;(display table)
                                       (loop (car tail) (cdr tail))))))]
     ; 定義變數
     [(def ,t ,x ,e)
      (let
          [(rhs-type (parse-L0 (unparse-L1 [list-ref (type-infer e env) 0])))]
        (cond
          [(equal? (unparse-L0 t) (unparse-L0 rhs-type)) (hash-set! (list-ref env [- (length env) 1])  x (parse-L1 (unparse-L0 t)))
                            ; 回傳 void 值
                            `(void ,env)]
          [else (error (format "Expect type of ~a : ~a, found type ~a" x t rhs-type))]

          )
      )]
     ; lambda
     ; (lambda [(int x) (int y)] -> t* = (int int) x* = (x y))
     [(lambda ([,t* ,x*] ... ) ,body)
                                      (let*
                                          [(new-hash-table (make-hash))
                                           (extended-env (append env (list new-hash-table)))] ; 創立新表格附著在後面
                                          
                                          (for
                                              [(t t*)
                                               (x x*)]
                                            (hash-set! (list-ref extended-env [- (length extended-env) 1])  x [parse-L1 (unparse-L0 t)]))
                                            ;(display (format "匿名函數掃描中~a" table))
                                            (let*
                                                [
                                                 (return-type (list-ref (type-infer body extended-env) 0)) ; 回傳值型別
                                                
                                                ;(total-type (quoting-to-quasiquoting total-type-raw))
                                                ] 
                                              (define t*-unparsed (map (lambda (x)  (unparse-L0 x)) t*))
                                              ;(define t*-unparsed-ast (unparse-L1 t*-unparsed))
                                              `[,(parse-L1 `(-> ,@t*-unparsed ,(unparse-L1 return-type))) ,env]
                                              ))]
     [(,e0 ,e1 ...) (let*
                        ((operator-type [list-ref (type-infer e0 env) 0])
                         (arguments-type [map (lambda (x) (unparse-L1 (list-ref (type-infer x env) 0))) e1])
                         (operator-type-without-return (reverse (cdr (reverse (cdr (unparse-L1 operator-type)))))))
                      (display exp)(display operator-type)(display arguments-type)
                      (if (equal? operator-type-without-return arguments-type)
                          `(,(parse-L1 (last (unparse-L1 operator-type))) ,env)
                          [begin (raise (format "expect argument type ~a, found ~a" operator-type-without-return arguments-type))])
                      )]
     )


  [list-ref (type-infer ast empty-env) 0]
       
  )
      ;[(and (list? e) (= 3 (length e)))
      ; (let ([op (car e)] [e0 (type-infer (cadr e))] [e1 (type-infer (caddr e))])
      ; `(,op ,e0 ,e1))]))
;(define l1 (parse-L0 '(+ 1 0.1)))
;(type-inference l1)

;; convert x -> x1, y -> y2, etc.
(define-pass eta-conversion : L0 (ast) -> L0 ()
  [definitions
    (define var-table `(,(make-hash)))
    (define (combine-two-list x y)
    (if (equal? x '())
        '()
        (cons `(,(car x) ,(car y)) (combine-two-list (cdr x) (cdr y)))))]
(convert : Expr (exp env) -> Expr ()
      [,pr pr]
      [(lambda ([,t* ,x*] ...) ,body)
       (let*
           ((new-x* (map gensym x*))
            (t*-new-x*-pair-ls [combine-two-list t* new-x*])
            (new-env [append env (list (make-hash))]))
         (for ([i x*]
               [j new-x*])
               (hash-set! (last new-env) i j))
         ;(display new-env)
         `(lambda [[,t* ,new-x*] ...] ,(convert body new-env)))]
      [,x
       ;(display (format "執行 ~a\n" x))
       (hash-ref (last env) x)]
      [,c c]

      
      [(def ,t ,x ,e) (let
                          [(new-var (gensym x))]
                        ;(display (format "執行def ~a\n" x))
                        (hash-set! (last env) x new-var)
                        `(def ,t ,new-var ,(convert e env)))
       ]


      )
  (convert ast var-table)
  )
  
; (define l1 (parse-L0 '(begin (def int x 10) (def int y x) x ((lambda [(int x) (int y)] y) x y) y))) (eta-conversion l1)

(define (atom? x) (and
                   [not (pair? x)]
                   [not (list? x)]))

(define (def-undef-lambda-begin ls)
  [let
      [(return '())]
    [for
        ((i ls))
      [match i
        ((list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L0 (type-inference (parse-L0 i)))
                               )
              (new-body (define-undef-lambda body)))
           (set! return (append return (list `(def ,new-lambda-type ,new-lambda ,new-body) new-lambda)))
           
           ])
        (else (set! return (append return (list (define-undef-lambda i)))))]]
    return
  ]
  )


(define (def-undef-lambda-apply ls)
  [let
      [(new-define '())
       (new-apply '())]
    [for
        ((i ls))
      [match i
        ((list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L1 (type-inference (parse-L0 i)))
                               )
              (new-body (define-undef-lambda body))
              (new-lambda-define `(def ,new-lambda-type ,new-lambda (lambda ,var-pair ,new-body))))
           (set! new-define (append new-define (list new-lambda-define)))
           (set! new-apply (append new-apply (list new-lambda)))
           
           ])
        ((list a ...) (let*
                          [[result (def-undef-lambda-apply a)]
                          [new-result (last result)]
                          [new-sub-define (cdr (list-remove-last result))]] ; 出來的結果會有 begin，但在括號內，我們不需要
                        ;(display new-sub-define)
                        (set! new-define (append new-define new-sub-define))
                        (set! new-apply (append new-apply (list new-result)))
                        ))
        (else (set! new-apply (append new-apply (list (define-undef-lambda i)))))]]
    `(begin ,@new-define ,new-apply)
  ]
  )



(define (define-undef-lambda x)
;; 用 match 重寫
  (match x
     [(? atom? x) x]
     ; TODO
     [(list 'def t x (list a b ...))
      [let*
          [(raw-result (def-undef-lambda-apply (append (list a) b)))
           (new-rhs (last raw-result))
           (new-def `(def ,t ,x ,new-rhs))]
        (append (list-remove-last raw-result) (list new-def))
        ]] ;TODO
     [(list 'def t x e) (match e
                          [(list 'lambda var-pair body) `(def ,t ,x ,e)]
                          [else `(def ,t ,x ,(define-undef-lambda e))])]
     [(list 'begin a ...) `(begin ,@(def-undef-lambda-begin a))]
     [(list 'lambda var-pair body)
         [let*
             ((new-lambda (gensym 'lam))
              (new-lambda-type (unparse-L0 (type-inference (parse-L0 x)))
                               )
              (new-body (define-undef-lambda body)))
           `(begin (def ,new-lambda-type ,new-lambda (lambda ,var-pair ,new-body)) ,new-lambda)]]
     [(list a b ...) (def-undef-lambda-apply x)] 
     
    ))

  ;; 用 match 重寫
;[flatten-begin '(begin
;                  12
;                  5
;                  y
;                  (begin  12 1 (begin (lambda [(x 5)(y 7)] y)))
;                  )]
; -> '(begin 12 5 y 12 1 (lambda ((x 5) (y 7)) y))
(define [flatten-begin x]
  (match x
    [(list (list 'begin i ...) o ...) (append (flatten-begin i) (flatten-begin o))]
    [(list a b ...) (append (list (flatten-begin a)) (flatten-begin b))]
    [(? pair? x) x]
    [(? null? x) x]
    [(? atom? x) x]
    [(list a) (list a)]
    )
  )

(define-pass remove-undefined-lambda : L0 (ast) -> L0 ()
  [definitions
    [define unparsed-ast (unparse-L0 ast)]
    [define removed-result-ast (flatten-begin(define-undef-lambda unparsed-ast))]
  ]
  (parse-L0 removed-result-ast)
)

(define test-0 '((lambda ((int x)) 9)))
(define test-1 '([lambda ((int x)) (lambda ((flo y)) x)] 9))
(define test-2 '(begin 12 [lambda ((int x)) x] 9))
(define test-3 '(begin 12
                  [def int kk
                    ((lambda ([int x])  20) ((lambda (((-> flo int) y) (int z)) 8) (lambda ((flo z)) 10) 12))]
                  1.0
                  kk))

(define test-4 '([lambda ((int x)) (lambda ((flo y)) x)] 9))
(define test-5 '(begin 12 [lambda ((int x)) x] 9))
(define test-6
  '(begin
     3.0
     (def bool x (and (or #t #t) #f))
     (def flo y 10.0)
     ; uncaught exception: "lambda have duplicated variables: y"
     ;(lambda ([int x] [int y] [int y]) (+ x y 10))
     ;uncaught exception: "z is not defined."
     ;(lambda ([int x] [int y]) (+ x y z 10))
     
     ;(def flo k (lambda (x y z) (+ y x z g)))
     (def flo z (+. 10.0 y))
     (+. 1.0 3.0)
     z
     (lambda ([int x] [int y]) 9.9)
     ))

;;;
; Test-area
;;;
;(define-undef-lambda '(begin 7 x  (lambda [(int x)(flo y)] y) 10))
;(define-undef-lambda '(begin 7 x (def int x 2) (def int x (begin (lambda [(int x)(flo y)] y) 10)) ))
;(define-undef-lambda '(lambda ([int x]) (lambda ([int y]) 12)))
;(define-undef-lambda '((lambda ([int x])  20) (lambda ((flo y)) 12))) ; 錯誤需要debug??
;(define-undef-lambda '((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12)))
;(define-undef-lambda '(begin 12 [def int kk ((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12))] 1.0))
;(parse-L0 (flatten-begin (define-undef-lambda '(begin 12 [def int kk ((lambda ([int x])  20) ((lambda ((flo y)) 8) (lambda ((flo z)) 10) 12))] 1.0))))



(define [compiler ast]
  (display "Start compiling...\n")
  (let*
      [(found-dup-var-ast (find-dup-var-main ast))
       (ann-lambda-defined-ast (define-undef-lambda ast))
      (ann-lambda-defined-L0 (parse-L0 ann-lambda-defined-ast))
      (begin-flattened-L0 (remove-undefined-lambda ann-lambda-defined-L0))
      (etaed-L0 (eta-conversion begin-flattened-L0))
      (type-infered-type (type-inference etaed-L0))]
    (display "End compiling...\n")
    ann-lambda-defined-L0
    )
)

(compiler test-1)