(* This code was written by:
Keir Lauritzen, Leon Song, and Guy Yardeni*)


module A = Ast
module S = Sast

module StringMap = Map.Make(String)

let convert program = 
    let conv_typ = function
    | A.String_t -> S.String_t
    | A.Void -> S.Void
    | A.Bool -> S.Bool
    | A.Float -> S.Float
    | A.Array_f -> S.Array_f
    | A.Array_s -> S.Array_s in

    let conv_bind = function
    | (A.String_t, x) -> (S.String_t, x)
    | (A.Void, x) -> (S.Void, x)
    | (A.Bool, x) -> (S.Bool, x)
    | (A.Float, x) -> (S.Float, x)
    | (A.Array_f, x) -> (S.Array_f, x)
    | (A.Array_s, x) -> (S.Array_s, x) in

    let conv_bind_init = function
    | (A.String_t, x, _) -> (S.String_t, x)
    | (A.Void, x, _) -> (S.Void, x)
    | (A.Bool, x, _) -> (S.Bool, x)
    | (A.Float, x, _) -> (S.Float, x)
    | (A.Array_f, x, _) -> (S.Array_f, x)
    | (A.Array_s, x, _) -> (S.Array_s, x) in


    let rec conv_binop = function
    | A.Add     -> S.Add
    | A.Sub     -> S.Sub
    | A.Mult    -> S.Mult
    | A.Div     -> S.Div
    | A.And     -> S.And
    | A.Or      -> S.Or
    | A.Equal   -> S.Equal
    | A.Neq     -> S.Neq
    | A.Less    -> S.Less
    | A.Leq     -> S.Leq
    | A.Greater -> S.Greater
    | A.Geq     -> S.Geq in

    let rec conv_unop = function
    | A.Neg     -> S.Neg
    | A.Not     -> S.Not in

    let global_vars = 
        let extract_globals l (pattern, action) =
            let extr_glob_action l (binds, stmts) = 
            l@List.map conv_bind_init binds in            
        extr_glob_action l action in
    List.fold_left extract_globals [] program.Ast.rules in

    let conv_patt = function
    | A.Begin -> S.String_Lit "BEGIN"
    | A.End -> S.String_Lit "END"
    | A.RegexPattern s -> S.String_Lit s in

    (* this can be used to declare function pointers*)
    let n_pat = List.fold_left (fun x l -> x+1) 0 program.Ast.rules in

    let interface_globals = [(S.Int, "NPAT"); (S.Char, "FS"); (S.Char, "RS");
        ( S.S_arr_t (S.Action_t, n_pat), "__actions"); 
        ( S.S_arr_t (S.String_t, n_pat), "__patterns") ] in

    let assign_patterns = fun
        (l,n) (pattern, action) -> 
            let patt = conv_patt pattern in
        (S.Expr (S.Assign_array ("__patterns", n, patt))::l, n+1) in
    let (assigned_patts,_) = List.fold_left assign_patterns ([],0) program.Ast.rules in

    
    (*let enum_patts = 
            let enum_patt = fun (x,l) patt -> (x-1, patt:l) in    
    List_fold_left enum_patts (n_pat, []) assigned_patts in



    let checked_patts = 
        let check_patt
    List.map check_patt enum_patts *)


    let symbols = List.fold_left (fun m (t, n) -> StringMap.add n t m)
    StringMap.empty (interface_globals @ global_vars)
    in

    let rec conv_expr = function
    | A.Bool_Lit b -> S.Bool_Lit b
    | A.String_Lit s -> S.String_Lit s
    | A.Float_Lit f -> S.Float_Lit f
    | A.Array_F_Lit afl -> S.Array_F_Lit afl
    | A.Array_S_Lit asl -> S.Array_S_Lit asl
    | A.Retrieve (name, key) -> (match (StringMap.find name symbols) with
        | S.Array_f -> S.Retrieve_Float(name, conv_expr key)
        | S.Array_s -> S.Retrieve_String(name, conv_expr key)
        | _ -> raise (Invalid_argument "Not Valid"))
    | A.Array_Assign (name, key, value) -> (match (StringMap.find name symbols) with
        | S.Array_f -> S.Array_Assign_Float (name, conv_expr key, conv_expr value)
        | S.Array_s -> S.Array_Assign_String (name, conv_expr key, conv_expr value)
        | _ -> raise (Invalid_argument "Not Valid"))
    | A.Noexpr -> S.Noexpr
    | A.Id s -> S.Id s
    | A.Binop (e1, op, e2) ->
        let e1' = conv_expr e1
        and e2' = conv_expr e2 in
        S.Binop (e1', (conv_binop op), e2')
    | A.Unop(op, e) ->
        let e' = conv_expr e in
        S.Unop ((conv_unop op), e')
    | A.Assign (s, e) -> let e' = conv_expr e in
         S.Assign (s,e')
    | A.Call (f, act) -> S.Call (f, List.map conv_expr act) in
    

    let convert_bool = function
    | S.Bool_Lit b -> S.Bool_Lit b
    | S.String_Lit s -> if (String.length s) > 0 then S.Bool_Lit true else S.Bool_Lit false
    | S.Float_Lit f -> if f >= 1.0 then S.Bool_Lit true else S.Bool_Lit false
    | S.Array_F_Lit afl -> raise (Invalid_argument "Not Valid")
    | S.Array_S_Lit asl -> raise (Invalid_argument "Not Valid")
    | S.Noexpr -> raise (Invalid_argument "Must provide an expression")
    | S.Id s -> (match (StringMap.find s symbols) with
                | S.Float -> S.Binop (S.Id s, S.Greater, S.Float_Lit 0.0)
                | S.String_t -> S.Binop (S.Call ("strlen", [(S.Id s)]), S.Greater, S.Float_Lit 0.0)
                | _ -> raise (Invalid_argument "Not Valid"))
    | S.Binop (e1, op, e2) -> S.Binop (e1, op, e2) (*S.Binop (e1', op, e2')*)
    | S.Unop (op, e) -> S.Unop (op, e) (*
        | S.Unop(op, e) ->
            let e' = expr builder e in
            (match op with
            | S.Neg     -> S.Binop ()
            | S.Not     -> S.Not    *)
    | S.Assign (s,e) ->  S.Assign (s,e)  (*S.Binop (s, >=, 1.0) *)
    | S.Call (f, act) -> S.Call (f, act) (*S.Bionp () *)in

    let rec conv_stmt = function
    | A.Block l -> S.Block (List.map conv_stmt l)
    | A.Expr x -> S.Expr (conv_expr x)
    | A.Return x -> S.Return (conv_expr x)
    | A.If (x, s1, s2) -> S.If (convert_bool (conv_expr x), conv_stmt s1, conv_stmt s2)
    | A.For (x1, x2, x3, s) -> S.For ( conv_expr x1, convert_bool (conv_expr x2),conv_expr x3, conv_stmt s)
    | A.While (x, s) -> S.While (convert_bool (conv_expr x), conv_stmt s) in

    let init_assign = function
    | (_, s, A.Noexpr) -> S.Expr (S.Noexpr)
    | (_, s, e) -> S.Expr (S.Assign(s, conv_expr e)) in

    

    let conv_func_decl = function
    func_decl -> 
    {   S.typ = conv_typ func_decl.A.typ;
        S.fname = func_decl.A.fname;
        S.formals = List.map conv_bind func_decl.A.formals;
        S.locals = List.map conv_bind_init func_decl.A.locals;
        S.body = (List.map init_assign func_decl.A.locals) @ (List.map conv_stmt func_decl.A.body);
    } in

    let func_decls = List.map conv_func_decl program.Ast.func_decls in
(*
    let declare_patterns = fun
        (l,n) (pattern, action) ->  (
            (S.String_t, "__pattern" ^ (string_of_int n))
    ::l, n-1) in
    let (decl_patterns,_) = List.fold_left declare_patterns ([],) program.Ast.rules in *)

    (*let action_formals = [(S.Int,"len"); (S.Int, "cfields"); (S.Int, "field_len")] in *)
    let action_formals = [(S.Int,"len"); (S.Charpp, "cfields"); (S.Intp, "field_len")] in
    let define_actions = fun
        (l,n) (pattern, action) ->
        ({  S.typ = S.Void;
            S.fname = "__action" ^ string_of_int n;
            S.formals = action_formals;
            S.locals = [];
            S.body = List.map conv_stmt (snd action);
        } :: l, n+1) in
    let (action_decls,_) = List.fold_left define_actions ([],0) program.Ast.rules in

   
    let assign_actions = fun
        (l,n) (pattern, action) ->
        let action_name = "__action" ^ string_of_int n in
        (S.Expr (S.Assign_func_array ("__actions", n, action_name)) :: l, n+1) in
    let (assigned_actions,_) = List.fold_left assign_actions ([],0) program.Ast.rules in

(*
    let patt1 = S.String_Lit "BEGIN" in
    let pll = S.Assign ("__pattern2", patt1) in
    let pll2 =  in    
    let init_patt_assign = 
         [S.Expr pll; S.Expr pll2]  in *)
    
(*

    let act1 = (S.Action_t, "__act1") in


    let all = S.Assign_func ("__act1", "__action1") in
    let all2 = S.Assign_func_array ("__actions", 1, "__action1") in
    let init_act_assign = 
         [S.Expr all] @ [S.Expr all2]   in *)

    
    (*let blue = S.Assign_func_array *)

    
    let assigned_globals = 
        let extract_globals l (pattern, action) =
            let extr_glob_action l (binds, stmts) = 
            l@List.map init_assign binds in            
        extr_glob_action l action in
    List.fold_left extract_globals [] program.Ast.rules in 

    let assigned_vars = [
        S.Expr(S.Assign("NPAT", S.Int_Lit n_pat ));
        S.Expr(S.Assign("FS", S.Char_Lit ' ' ));
        S.Expr(S.Assign("RS", S.Char_Lit '\n' )); 
    ] in

    let init_function = {
        S.typ = S.Void;
        S.fname = "__init";
        S.formals = [];
        S.locals = [];
        S.body = assigned_globals @ assigned_vars @ assigned_patts @ assigned_actions;
    } in

{ S.var_decls = interface_globals @ global_vars;
  S.func_decls = func_decls @ action_decls @ [init_function] ;
(*S.func_decls = func_decls @ action_decls; *)
}
