archivesOfToyLang/ataabu/archive/closure_conv.ml

module SS = Set.Make(String);;
open Printf;;

(*let ex_token_list2 = Tokenizer.total_parser "int a = 15; 3;  1 + 1; a; (lambda(int y){lambda(int x){y+x;};}(12));";;
let ex_parseoutput2 = Parser.stmts ex_token_list2;;

Parser.print_parseoutput ex_parseoutput2;;

Type_inf.type_infer ex_parseoutput2;;*)

let rec find_free_var l bound_vars =
  match l with
  
  | Parser.Item(item) ->
    (*variable*)
    (match item with

    |Tokenizer.Token(var, "ID") ->
      (if List.mem var !bound_vars then
        []
      else
      [var])
    (* constant *)
    | Tokenizer.Token(_, "INT") -> []
    (* operator *)
    | Tokenizer.Token(_, "OP") -> []
    (* operator *)
    | Tokenizer.Token(_, other_op_type) -> [])
  | Parser.Ls(lst) -> (
    match lst with
    (*apply*)
    | [Parser.Item(Tokenizer.Token("%apply", "ID")); caller; callee] ->
        let list_combined = List.append (find_free_var caller bound_vars) (find_free_var callee bound_vars) in
        let empty_set = SS.empty in
        let set = List.fold_right SS.add list_combined empty_set in
        SS.elements set
  (*operator*)
    | [Parser.Item(Tokenizer.Token(op_name, "OP")); lhs; rhs] ->
      let list_combined = List.append (find_free_var lhs bound_vars) (find_free_var rhs bound_vars) in
      let empty_set = SS.empty in
      let set = List.fold_right SS.add list_combined empty_set in
      SS.elements set
    (*define*)
    | [Parser.Item(Tokenizer.Token("%def", "ID")); typ; Parser.Item(Tokenizer.Token(id, "ID")); inner] ->
      let list_inner =  find_free_var inner bound_vars in 
      let list_id = find_free_var (Parser.Item(Tokenizer.Token(id, "ID"))) bound_vars in 
      let empty_set = SS.empty in
      let set_inner = List.fold_right SS.add list_inner empty_set in
      let set_id = List.fold_right SS.add list_id empty_set in
      let set_result = SS.diff set_inner set_id in
      let _ = (bound_vars := id::!bound_vars) in
      SS.elements set_result
    (*lambda*)
    | [Parser.Item(Tokenizer.Token("lambda", "ID")); Parser.Ls([args_header; Parser.Ls([typ; arg])]); body] ->
      let new_bound_var_frame = ref [] in
      let list_body =  find_free_var body new_bound_var_frame in 
      let list_arg = find_free_var arg new_bound_var_frame in 
      let empty_set = SS.empty in
      let set_inner = List.fold_right SS.add list_body empty_set in
      let set_id = List.fold_right SS.add list_arg empty_set in
      let set_result = SS.diff set_inner set_id in
      SS.elements set_result

    | cmds ->
      let cmds_free_var = List.map (fun x -> find_free_var x bound_vars) cmds in
      let cmds_fv_flatten_ls = List.flatten cmds_free_var in
      let empty_set = SS.empty in
      let cmds_fv_flatten_ls_set = List.fold_right SS.add cmds_fv_flatten_ls empty_set in
      SS.elements cmds_fv_flatten_ls_set
  )
  | _ -> [];;



(*
  let ex_token_list = Tokenizer.total_parser "int a = 12 ; int d = 16; lambda(int b){a + b + d;};20;";;
  let ex_parseoutput = Parser.stmts ex_token_list;;

  Type_inf.type_infer ex_parseoutput;; *)

let closure_sym_no = ref 0;;

let genclosure =
    fun () ->
    let tmp = Printf.sprintf "clos%d" (!closure_sym_no) in
    let _ = (closure_sym_no := !closure_sym_no + 1) in
    tmp;;

  
(* Parser.print_parseoutput ex_parseoutput;; *)

let rec get_index_aux ls item idx =
  if idx == (List.length ls) then -1
  else
    (if (List.nth ls idx) == item then idx
    else get_index_aux ls item (idx+1))

let get_index ls item = 
  if List.mem item ls then
    get_index_aux ls item 0
  else -1


  let rec replacing_vars ln fv clos_sym =
    match ln with
    | Parser.Ls([Parser.Item(Tokenizer.Token("lambda", "ID"));args; body]) ->
      let body_replaced = replacing_vars body fv clos_sym in 
      let args_replaced = replacing_vars args fv clos_sym in
      Parser.Ls([Parser.Item(Tokenizer.Token("lambda", "ID"));args_replaced; body_replaced])
    | Parser.Ls([Parser.Ls(list)]) ->  replacing_vars (Parser.Ls(list)) fv clos_sym
    | Parser.Ls(list) -> Parser.Ls(List.map (fun x -> replacing_vars x fv clos_sym) list)
    | Parser.Item(Tokenizer.Token(id, typ)) ->
      if (List.mem id fv) then
        (*let _ = print_string ("上大人" ^ id ^ "孔乙己") in *)

      (let index = get_index fv id in
      let sym_name = Printf.sprintf "fv[%d]" index in
      Parser.Item(Tokenizer.Token(sym_name, "ID")))
      else ln
    | _ -> ln





let rec closure_conv_replacing fv_outer fv_inner line = 


  let _ = print_string ("===" ^ (Parser.ast2string line) ^ "========") in
  let _ = print_string "fv_inner: " in
  let _ = List.map print_string fv_inner in
  let _ = print_string "\tfv_outer: " in
  let _ = List.map print_string fv_outer in

  let tmp_list1 = List.map (fun var -> Parser.Item(Tokenizer.Token(var, "ID"))) fv_inner in
  let fv_list = Parser.Ls(Parser.Item(Tokenizer.Token("%struct", "ID"))::tmp_list1) in
  match line with
  | Parser.Ls([Parser.Item(Tokenizer.Token("lambda", "ID")); Parser.Ls(args); Parser.Ls(body)]) -> 
    let new_fv = (find_free_var (Parser.Ls(body)) (ref [])) in
    let _ = print_string "new_fv: " in
    let _ = List.map print_string new_fv in
    let _ = print_string "\n\n" in
    let closure_symbol = (genclosure ()) in
    let def_closure_list = Parser.Ls([Parser.Item(Tokenizer.Token("%def", "ID"));
                                      Parser.Item(Tokenizer.Token("STRUCT", "ID"));
                                      Parser.Item(Tokenizer.Token(closure_symbol, "ID"));
                                      fv_list]) in
    let replaced_body = List.map (fun l -> closure_conv_replacing fv_inner new_fv l) body in
    let temp = Parser.Ls([Parser.Item(Tokenizer.Token("Object*", "ID")); Parser.Item(Tokenizer.Token(closure_symbol,"ID"))]) in
    let replaced_lambda = Parser.Ls([Parser.Item(Tokenizer.Token("lambda", "ID")); Parser.Ls(args @ [temp]); Parser.Ls(replaced_body)]) in
    let return_result =  Parser.Ls([def_closure_list; replaced_lambda]) in
    return_result
  | Parser.Ls([Parser.Item(Tokenizer.Token("%apply" , "ID")); caller; callee]) ->
    let caller_new = closure_conv_replacing fv_outer fv_inner caller in 
    let callee_new = closure_conv_replacing fv_outer fv_inner callee in 
    (match caller_new with
    | Parser.Ls([closure_struct; closure_main]) ->
      (match callee_new with 
      | Parser.Ls([callee_struct; callee_main]) -> Parser.Ls([closure_struct; callee_struct;
        Parser.Ls([Parser.Item(Tokenizer.Token("%apply" , "ID")); closure_main; callee_main])])
      | _ -> Parser.Ls([closure_struct;Parser.Ls([Parser.Item(Tokenizer.Token("%apply" , "ID")); closure_main; callee_new])]))
    | _ -> line)
  | _ -> replacing_vars line fv_outer (!closure_sym_no)



  

  let closure_conv_aux2 parseoutput = 
    (match parseoutput with
      | Parser.Success(Ls(lines), remained_tokens) ->
        (let free_var = ref [] in
        List.map (fun ln -> let fv = find_free_var ln free_var in
                            closure_conv_replacing [] fv ln) lines)
      | _ -> []);;

let rec elim_paren_aux middle1 =
  match middle1 with
  | Parser.Ls([Parser.Ls(x)]) -> elim_paren_aux (Parser.Ls(x))
  | Parser.Ls(x) -> Parser.Ls(List.map elim_paren_aux x)
  | _ -> middle1 
      ;;

let elim_paren middle1 = List.map elim_paren_aux middle1;;

let closure_conv_main input =
  let middle1 = closure_conv_aux2 input in
  let middle2 = elim_paren middle1 in
  let rec modifier ls  =
  match ls with
  | Parser.Ls([Parser.Ls(Parser.Item(Tokenizer.Token("%def", "ID"))::Parser.Item(Tokenizer.Token("STRUCT", "ID"))::rs1 ); rs2 ])::rs3 ->
    Parser.Ls(Parser.Item(Tokenizer.Token("%def", "ID"))::Parser.Item(Tokenizer.Token("STRUCT", "ID"))::rs1)::rs2::rs3
  | hd::rs ->hd::(modifier rs)
  | _ -> ls in
  modifier middle2;;

  (*
    List.map (fun x -> print_string (Parser.ast2string x)) (closure_conv_main ex_parseoutput);;*)