#use "reader.ml";;

type constant =
  | Sexpr of sexpr
  | Void

type expr =
  | Const of constant
  | Var of string
  | If of expr * expr * expr
  | Seq of expr list
  | Set of expr * expr
  | Def of expr * expr
  | Or of expr list
  | LambdaSimple of string list * expr
  | LambdaOpt of string list * string * expr
  | Applic of expr * (expr list);;

let rec expr_eq e1 e2 =
  match e1, e2 with
  | Const Void, Const Void -> true
  | Const(Sexpr s1), Const(Sexpr s2) -> sexpr_eq s1 s2
  | Var(v1), Var(v2) -> String.equal v1 v2
  | If(t1, th1, el1), If(t2, th2, el2) -> (expr_eq t1 t2) &&
                                            (expr_eq th1 th2) &&
                                              (expr_eq el1 el2)
  | (Seq(l1), Seq(l2)
    | Or(l1), Or(l2)) -> List.for_all2 expr_eq l1 l2
  | (Set(var1, val1), Set(var2, val2)
    | Def(var1, val1), Def(var2, val2)) -> (expr_eq var1 var2) &&
                                             (expr_eq val1 val2)
  | LambdaSimple(vars1, body1), LambdaSimple(vars2, body2) ->
     (List.for_all2 String.equal vars1 vars2) &&
       (expr_eq body1 body2)
  | LambdaOpt(vars1, var1, body1), LambdaOpt(vars2, var2, body2) ->
     (String.equal var1 var2) &&
       (List.for_all2 String.equal vars1 vars2) &&
         (expr_eq body1 body2)
  | Applic(e1, args1), Applic(e2, args2) ->
     (expr_eq e1 e2) &&
       (List.for_all2 expr_eq args1 args2)
  | _ -> false;;


exception X_syntax_error;;

module type TAG_PARSER = sig
  val tag_parse_expression : sexpr -> expr
  val tag_parse_expressions : sexpr list -> expr list
end;; (* signature TAG_PARSER *)

module Tag_Parser : TAG_PARSER = struct

let reserved_word_list =
  ["and"; "begin"; "cond"; "define"; "else";
   "if"; "lambda"; "let"; "let*"; "letrec"; "or";
   "quasiquote"; "quote"; "set!"; "unquote";
   "unquote-splicing"];;

(* work on the tag parser starts here *)
let rec pairsToList=(function
| Pair(Symbol(x),y) -> x::(pairsToList y)
| Nil -> [];
| _ -> raise X_no_match
);;

let rec pairsToListDotted=(function
| Pair(Symbol(x),y) -> x::(pairsToListDotted y)
| Symbol(x) -> [];
| _ -> raise X_no_match
);;
let rec lastOneInListDotted=(function
| Pair(Symbol(x),y) -> lastOneInListDotted y
| Symbol(x) -> x;
| _ -> raise X_no_match
);;
let rec hasLastOneInListDotted=(function
| Pair(Symbol(x),y) -> hasLastOneInListDotted y
| Symbol(x) -> true
| _ -> false
);;

(* let lastElementInList =function  *)

let rec tag_parse s= (function
| Number(x) -> Const(Sexpr(Number(x)))
| Bool(x) -> Const(Sexpr(Bool(x)))
| Char(x) -> Const(Sexpr(Char(x)))
| String(x) -> Const(Sexpr(String(x)))
| TagRef(x) -> Const(Sexpr(TagRef(x)))
| Pair(Symbol("Quoted"),Pair(x,_)) -> Const(Sexpr(x))
| Pair(Symbol("if"), Pair(test, Pair(dit, Pair(dif, Nil))))-> If(tag_parse test, tag_parse dit, tag_parse dif)
| Pair(Symbol("if"), Pair(test, Pair(dit, Nil)))-> If(tag_parse test, tag_parse dit, Const(Void))
| Pair(Symbol("quote"), Pair(x, Nil)) -> Const(Sexpr(x))
| Pair(Symbol("lambda"), Pair(Symbol(arg), Pair(body, Nil)))-> LambdaOpt([], arg, tag_parse body)
| Pair(Symbol("lambda"), Pair(args, Pair(body, Nil)))-> if(hasLastOneInListDotted args)
                                                            then LambdaOpt(pairsToListDotted args, lastOneInListDotted args, tag_parse body)
                                                            else LambdaSimple(pairsToList args, tag_parse body)
| Pair(Symbol("define"), Pair(Symbol(name), Pair(body, Nil)))-> Def (Var(name),tag_parse body)
| Pair(Symbol("set!"), Pair(Symbol(name), Pair(body, Nil)))-> Set (Var(name),tag_parse body)
| Pair(Symbol("begin"), Nil)-> Const(Void)
| Pair(Symbol("begin"), Pair(Symbol(name),Nil))-> Var(name)
| Pair(Symbol("begin"), args)-> Seq(taggedList args)
| Pair(Symbol("or"), Nil)-> Const(Sexpr(Bool(false)))
| Pair(Symbol("or"), Pair(arg,Nil))-> tag_parse arg
| Pair(Symbol("or"), args)-> Or(taggedList args)
| Pair(Symbol("cond"), Pair(rib1, ribs))-> condMaker (rib1,ribs)
| Pair(Symbol("let"), Pair(args, body))->  if (args=Nil) then Applic(LambdaSimple([], tag_parse body),[])
                                                else Applic(LambdaSimple(leftSideLet args, tag_parse body),rightSideLet args)
| Pair(Symbol("let*"), Pair(Nil, body))->  Applic(LambdaSimple([], tag_parse body),[])
| Pair(Symbol("let*"), Pair(Pair(Pair(Symbol arg,Pair(argLeft,Nil)),Nil), body))->  Applic(LambdaSimple([arg], tag_parse body),[tag_parse argLeft])
| Pair(Symbol("let*"), Pair(Pair(arg, args), body))->  tag_parse (Pair(Symbol("let"), Pair(Pair(arg, Nil), Pair(Symbol("let*"), Pair(args, body)))))
| Pair(Symbol("and"), Nil)-> Const(Sexpr(Bool(true)))
| Pair(Symbol("and"), Pair(arg,Nil))-> tag_parse arg
| Pair(Symbol("and"), Pair(arg,args))-> If(tag_parse arg, tag_parse(Pair (Symbol("and"),args)), Const(Sexpr(Bool(false))))
| Pair(Symbol("letrec"), Pair(args, body))-> tag_parse (Pair(Symbol("let"),Pair(letrecLeft (leftSideLet args), setMaker(leftSideLet args,rightSideLetrec args,body))))


| Pair(x,y) -> Applic((tag_parse x),taggedList y)
| Symbol(x) -> Var(x)
| _ -> raise X_no_match
) s
and taggedList s=(function
| Pair(x,y) -> (tag_parse x)::(taggedList y)
| Nil -> [];
| _ -> raise X_no_match
) s
and condMaker s= (function
(* | (Pair(value,Pair(Symbol("=>"),Pair(body,Nil))),rest) ->
  tag_parse(Pair(Pair(Symbol("let"), Pair(
    Pair(Pair (Symbol "value", value),
    Pair(Pair (Symbol "f",Pair (Pair (Symbol "lambda", Pair (Nil, body)), Nil)),
    Pair(Pair (Symbol "rest",Pair (Pair (Symbol "lambda", Pair (Nil, rest)), Nil)),Nil))),
    Pair (Symbol "if",Pair (Symbol "value",Pair (Pair (Pair (Symbol "f", Nil), Pair (Symbol "value", Nil)),Pair (Pair (Symbol "rest", Nil), Nil)))))),Nil)) *)
| (Pair(Symbol "else",body),rest)-> tag_parse (Pair(Symbol "begin",body))
| (Pair(test,body),rest) -> If(tag_parse test, tag_parse (Pair(Symbol "begin",body)), restCondMaker rest)
| _ -> raise X_no_match
) s
and restCondMaker s= (function
| Pair(rib1,rest) -> condMaker(rib1,rest)
| Nil -> Const(Void)
| _ -> raise X_no_match
) s
and leftSideLet s=(function
| Pair(Pair(Symbol x,y),Nil) -> [x]
| Pair(Pair(Symbol x,y),z) -> x:: (leftSideLet z)
| _ -> raise X_no_match
) s
and rightSideLet s=(function
| Pair(Pair(x,Pair(y,Nil)),Nil) -> [tag_parse y]
| Pair(Pair(x,Pair(y,Nil)),z) -> (tag_parse y):: (rightSideLet z)
| _ -> raise X_no_match
)s
and rightSideLetrec s=(function
| Pair(Pair(x,Pair(y,Nil)),Nil) -> [y]
| Pair(Pair(x,Pair(y,Nil)),z) -> y:: (rightSideLetrec z)
| _ -> raise X_no_match
)s
and letrecLeft s =(function
| [] -> Nil
| a :: b -> Pair (Pair(Symbol a, Pair(Symbol "'whatever",Nil)), letrecLeft b)
)s
and setMaker s =(function
| ([],[],body) -> Pair(Pair(Symbol("let"), Pair(Nil, body)),Nil)
| (a :: b,c::d,body) -> Pair (Pair (Symbol "set!", Pair (Symbol a, Pair (c, Nil))), setMaker (b,d,body))
| _ -> Nil
)s
;;

let tag_parse_expression sexpr = tag_parse sexpr;;

let tag_parse_expressions sexpr = raise X_not_yet_implemented;;


end;; (* struct Tag_Parser *)


(* Pair (Symbol "cond", Pair(Pair (Symbol "t",Pair (Number (Int 1), Pair (Number (Int 2), Pair (Number (Int 3), Nil)))),Nil)) *)

(* Pair (Symbol "cond",Pair(Pair (Symbol "t",Pair(Pair (Number (Int 1), Pair (Number (Int 2), Pair (Number (Int 3), Nil))),Nil)),Nil)) *)
(* Pair (Symbol "cond", Pair(Pair (Symbol "t",Pair (Pair (Number (Int 1), Nil), Pair (Pair (Number (Int 2), Nil), Pair (Pair (Number (Int 3), Nil), Nil)))),Nil)) *)

(* Pair (Symbol "cond", Pair (Pair (Bool true, Pair (Number (Int 1), Pair (Number (Int 2), Pair (Number (Int 3), Nil)))),Nil)) *)

let rec try3 s =(function
| [] -> Nil
| a :: b -> Pair (Pair(a, Pair(Symbol "'whatever",Nil)), try3 b)
)s
;;