main.ml

open Lexing
open Parser
open Printf
open Tipos
open MenhirLib.General
open Parse

type element = { 
    escopo : int;
    identificador : string;
    tipo : string;
    value : declaracoes;
}

let g_tipo = ref "";;
let escopo_g = ref 0
let sym_tables = Hashtbl.create 255
let global_t : (string, element) Hashtbl.t = Hashtbl.create 255

let create_element ~escopo ~identificador ~tipo ~value =
    { escopo; identificador; tipo; value; }

let create_scope () = 
    begin
        escopo_g := !escopo_g + 1;
        Hashtbl.add sym_tables !escopo_g (Hashtbl.create 255);
    end

let remove_scope () =
    begin
        Hashtbl.remove sym_tables !escopo_g;
        escopo_g := !escopo_g - 1;
    end

let get_tbl ?global () =
    begin
        match global with
        | None ->
            Hashtbl.find sym_tables !escopo_g
        | Some flag ->
            Hashtbl.find sym_tables 0
    end

let exists tbl id = 
    begin
        Hashtbl.mem tbl id
    end

let add_element element =
    let el_t = element.value in
    let id   = element.identificador in
    let tipo = element.tipo in
    let c_escopo = element.escopo in
    printf "new: <escopo: %d, c_escopo: %d, id: %s, tipo: %s>\n" !escopo_g c_escopo id tipo;
    match el_t with 
        | Variavel(vid, _) ->
                begin
                    let tbl = get_tbl () in
                    if exists tbl id then 
                        (
                            printf "Aviso: A variavel %s ja foi declarada.\n" id;
                        )
                    else
                        (
                            Hashtbl.add tbl id element;
                        )
                end
        | DeclaracaoFuncaoTipada(tipo, Identificador(vid), params, corpo) ->
                begin
                    let tbl = get_tbl ~global:true () in
                    if Hashtbl.mem tbl id then 
                        (
                            printf "Aviso: A funcao %s ja foi declarada.\n" id;
                        )
                    else
                        (
                            Hashtbl.add tbl id element;
                        )
                end
        | DeclaracaoFuncaoSemTipo(Identificador(vid), params, corpo) ->
                begin
                    let tbl = get_tbl ~global:true () in
                    if Hashtbl.mem tbl vid then 
                        (
                            printf "Aviso: A funcao %s ja foi declarada.\n" id;
                        )
                    else
                        (
                            Hashtbl.add tbl id element;
                        )
                end
        | DeclaracaoParametroSimples(tipo, vid) ->
                begin
                    let tbl = get_tbl () in 
                    Hashtbl.add tbl id element;
                end
        | DeclaracaoParametroArranjo(tipo, vid, _) ->
                begin
                    let tbl = get_tbl () in 
                    Hashtbl.add tbl id element;
                end
        | DeclaracaoAtribuicao(var, expressao) ->
                begin
                    let vid, idx = match var with
                    | Variavel(Identificador(a),i) -> a,i 
                    |  _ -> assert false;
                    in
                    let tbl = get_tbl () in 
                    if not (Hashtbl.mem tbl vid) then
                        (
                            printf "Erro: Atriuicao da variavel \"%s\" antes de declarar.\n" vid;
                        )
                    else
                        (
                            let v_element = Hashtbl.find tbl vid in
                            let v_escopo = v_element.escopo in
                            let v_id = v_element.identificador in
                            let v_tipo = v_element.tipo in
                            let v_value = v_element.value in
                            let rec do_all expressao = 
                                match expressao with
                                | ExpBin(esq, op, dir) ->
                                        begin
                                            do_all esq;
                                            do_all dir;
                                        end
                                | ExpUna(op, v_exp) ->
                                        begin
                                            do_all v_exp;
                                        end
                                | Id(v_exp) -> 
                                        begin
                                        end
                                | Inteiro(num) ->
                                        begin
                                            g_tipo := "inteiro";
                                            if !g_tipo = v_tipo then
                                                (
                                                )
                                            else
                                                (
                                                    printf "Erro: Variavel \"%s\" é do tipo \"%s\" , tipo recebido \"%s\"\n" v_id v_tipo !g_tipo;
                                                )
                                        end
                                | Flutuante(num) ->
                                        begin
                                            g_tipo := "flutuante";
                                            if !g_tipo = v_tipo then
                                                (
                                                )
                                            else
                                                (
                                                    printf "Erro: Variavel \"%s\" é do tipo \"%s\" , tipo recebido \"%s\"\n" v_id v_tipo !g_tipo;
                                                )
                                        end
                                | ChamadaFuncao(Identificador(t_id), exps) ->
                                        begin
                                            (* funcao escopo global *)
                                            let tbl = get_tbl () in 
                                            if not (Hashtbl.mem tbl t_id) then
                                                (
                                                    printf "Erro: A funcao \"%s\" nao foi declarada\n" t_id;
                                                )
                                            else
                                                (
                                                    let fun_chamada = Hashtbl.find tbl t_id in
                                                    let f_id = fun_chamada.value in
                                                    let f_test = fun_chamada.identificador in
                                                    match f_id with
                                                    | DeclaracaoFuncaoTipada(f_tipo,_,params,_) ->
                                                            begin
                                                                let params_len = List.length params in
                                                                let chamado_len = List.length exps in
                                                                if params_len <> chamado_len then
                                                                    (
                                                                        printf "Erro: A funcao \"%s\" precisa de %d parametros mas foram passados %d parametros\n" t_id params_len chamado_len;
                                                                    )
                                                                else
                                                                    (
                                                                    )

                                                            end
                                                    | DeclaracaoFuncaoSemTipo(_,params,_) ->
                                                            begin
                                                                printf "funcao sem tipada\n";
                                                            end
                                                    | _ -> assert false;
                                                )
                                        end
                                | _ -> assert false;
                            in do_all expressao;
                        )
                end
        | _ -> assert false

let debug = true

module I = Parser.MenhirInterpreter
 
let stack checkpoint = 
    match checkpoint with
    | I.HandlingError env -> I.stack env
    | _ -> assert false

let state checkpoint : int =
    match Lazy.force (stack checkpoint) with
    | Nil -> 0
    | Cons (I.Element (s, _, _, _), _) -> I.number s


let init fname channel : Lexing.lexbuf = 
    let lb = Lexing.from_channel channel in
    lb.lex_curr_p <- { lb.lex_curr_p with pos_fname = fname; pos_lnum = 1 }; lb

let succeed prog = 
    begin
        let saida = Buffer.create(255) in 
        (* imprime identificador *)
        let imprime_identificador identificador =
            match identificador with
            | Identificador(id) -> bprintf saida "[id %s]" id;
        in

        (* imprime declaracao *)
        let rec imprime_declaracao declaracao = 
            match declaracao with
            | DeclaracaoListaVariavel(tipo, vars) ->
                    begin
                        bprintf saida "[dcl.vars [%s] " tipo;
                        let rec do_all lst = 
                            match lst with
                            | [] -> ()
                            | x :: xs ->
                                    begin
                                    match x with
                                        | Variavel(Identificador(id), _) -> 
                                            begin
                                                let element = create_element !escopo_g id tipo x in
                                                add_element element;
                                            end
                                        | _ -> assert false ;
                                    do_all xs;
                                    end
                        in
                        do_all vars;
                        bprintf saida "]";
                    end
            | DeclaracaoFuncaoTipada(tipo, Identificador(id), params, corpo) as x ->
                    begin
                        let element = create_element !escopo_g id tipo x in
                        add_element element;
                        create_scope ();
                        bprintf saida "[dcl.func [tipo %s] " tipo;
                        let id = Identificador(id) in
                        imprime_identificador id;
                        bprintf saida "[params ";
                        List.iter imprime_declaracao params;
                        bprintf saida "]";
                        bprintf saida "[corpo ";
                        List.iter imprime_declaracao corpo;
                        bprintf saida "]";
                        bprintf saida "]";
                        remove_scope ();
                    end
            | DeclaracaoFuncaoSemTipo(Identificador(id), params, corpo) as x ->
                    begin
                        let element = create_element !escopo_g id "void" x in
                        add_element element;
                        create_scope ();
                        let id = Identificador(id) in
                        bprintf saida "[dcl.func [tipo void] ";
                        imprime_identificador id;
                        bprintf saida "[params ";
                        List.iter imprime_declaracao params;
                        bprintf saida "]";
                        bprintf saida "[corpo ";
                        List.iter imprime_declaracao corpo;
                        bprintf saida "]";
                        bprintf saida "]";
                        remove_scope ();
                    end
            | DeclaracaoParametroSimples(tipo, Identificador(id)) as x ->
                    begin
                        let element = create_element !escopo_g id tipo x in
                        add_element element;
                        bprintf saida "[dcl.param [tipo %s] " tipo;
                        let id = Identificador(id) in 
                        imprime_identificador id;
                        bprintf saida "]";
                    end
            | DeclaracaoParametroArranjo(tipo, Identificador(id), dim) as x ->
                    begin
                        let element = create_element !escopo_g id tipo x in
                        add_element element;
                        bprintf saida "[dcl.param [tipo %s] " tipo;
                        let id = Identificador(id) in 
                        imprime_identificador id;
                        bprintf saida "[dim %d] " dim;
                        bprintf saida "]";
                    end

            | DeclaracaoAtribuicao(dcl1, dcl2) as x ->
                    begin
                        let element = create_element !escopo_g "atribuicao" "" x in
                        add_element element;
                        bprintf saida "[:= ";
                        imprime_declaracao dcl1;
                        imprime_declaracao dcl2;
                        bprintf saida "]";
                    end
            | DeclaracaoExpressao(dcl) ->
                    begin
                        bprintf saida "[dcl.expr " ;
                        imprime_declaracao dcl;
                        bprintf saida "]";
                    end

            | DeclaracaoCondicional(condicao, corpo) ->
                    begin
                        create_scope ();
                        bprintf saida "[dcl.cond [condicao ";
                        imprime_declaracao condicao;
                        bprintf saida "]" ;
                        bprintf saida "[corpose ";
                        List.iter imprime_declaracao corpo;
                        bprintf saida "]";
                        bprintf saida "]";
                        remove_scope ();
                    end
            | DeclaracaoCondicionalComposta(condicao, corpo_se, corpo_senao) ->
                    begin
                        create_scope ();
                        bprintf saida "[dcl.cond [condicao ";
                        imprime_declaracao condicao;
                        bprintf saida "]" ;
                        bprintf saida "[corpo.se ";
                        List.iter imprime_declaracao corpo_se;
                        remove_scope ();
                        create_scope ();
                        bprintf saida "]";
                        bprintf saida "[corpo.senao ";
                        List.iter imprime_declaracao corpo_senao;
                        bprintf saida "]";
                        bprintf saida "]";
                        remove_scope ();
                    end
            | DeclaracaoRepita(corpo, condicao) ->
                    begin
                        create_scope ();
                        bprintf saida "[dcl.cond [corpo ";
                        List.iter imprime_declaracao corpo;
                        bprintf saida "]" ;
                        bprintf saida "[condicao ";
                        imprime_declaracao condicao;
                        bprintf saida "]";
                        bprintf saida "]";
                        remove_scope ();
                    end
            | DeclaracaoLeitura(id) ->
                    begin
                        bprintf saida "[dcl.leitura ";
                        imprime_identificador id;
                        bprintf saida "]" ;
                    end
            | DeclaracaoEscrita(exp) ->
                    begin
                        bprintf saida "[dcl.escrita ";
                        imprime_declaracao exp;
                        bprintf saida "]" ;
                    end
            | DeclaracaoRetorno(exp) ->
                    begin
                        bprintf saida "[dcl.retorno ";
                        imprime_declaracao exp;
                        bprintf saida "]" ;
                    end
            | Variavel(id, exprs) ->
                    begin
                        bprintf saida "[dcl.var ";
                        imprime_identificador id;

                        let _ = match exprs with
                        | Some exprs -> 
                                begin
                                    bprintf saida "[exprs ";
                                    List.iter imprime_declaracao exprs;
                                    bprintf saida "]";
                                end
                        | _ -> ();
                        in
                        bprintf saida "]";
                    end
            | Literal(literal) ->
                    begin
                        bprintf saida "[literal %s]" literal;
                    end
            | Inteiro(num) ->
                    begin
                        bprintf saida "[inteiro %d]" num;
                    end
            | Flutuante(num) ->
                    begin
                        bprintf saida "[flutuante %f]" num;
                    end
            | Id(dcl) ->
                    begin
                        imprime_declaracao dcl;
                    end
            | ExpBin(dcl1, op, dcl2) ->
                    begin
                        bprintf saida "[exp.bin ";
                        bprintf saida "[exp1 ";
                        imprime_declaracao dcl1;
                        bprintf saida "]";
                        bprintf saida "[op %s] " op;
                        bprintf saida "[exp2 ";
                        imprime_declaracao dcl2;
                        bprintf saida "]";
                        bprintf saida "]";
                    end
            | ExpUna(op, dcl) ->
                    begin
                        bprintf saida "[exp.un ";
                        bprintf saida "[op %s] " op;
                        bprintf saida "[exp ";
                        imprime_declaracao dcl;
                        bprintf saida "]";
                        bprintf saida "]";
                    end
            | ExpAtrib(dcl) ->
                    begin
                        bprintf saida "[exp.atrib ";
                        imprime_declaracao dcl;
                        bprintf saida "]";
                    end
            | ChamadaFuncao(id, exps) ->
                    begin
                        bprintf saida "[chamada.func ";
                        imprime_identificador id;
                        bprintf saida "[param ";
                        List.iter imprime_declaracao exps;
                        bprintf saida "]";
                        bprintf saida "]";
                    end
        in
        (* imprime programa *)
        let imprime_programa programa = 
            bprintf saida "[programa " ;
            List.iter imprime_declaracao programa;
            bprintf saida "]";
        in
        imprime_programa prog;
        Printf.printf "\n%s\n\n" (Buffer.contents saida);
    end

(* taking care of errors *)
let fail lexbuf ( env : Tipos.programa I.checkpoint ) = 
    match env with
    | I.HandlingError v ->
            begin
                let pos = match (I.positions v) with 
                                | (start, final) -> start
                in
                let line = pos.pos_lnum in
                let col  = pos.pos_cnum - pos.pos_bol in
                let curr_state = I.current_state_number v in 
                Printf.fprintf stderr "L[%d]C[%d]: %s\n"
                                        line col (Errors.message curr_state);
                if debug = true then Printf.fprintf stderr "[DEBUG] Estado: %d\n" curr_state;
            end
    | _ -> assert false

(* parser loop function *)
let loop lexbuf result =
    begin
        let supplier = I.lexer_lexbuf_to_supplier Lexer.token lexbuf in
        I.loop_handle succeed (fail lexbuf) supplier result;
    end

(* main entry point *)
let () =
    Hashtbl.add sym_tables 0 global_t;
    let path = Sys.argv.(1) in
    let lexbuf = Lexing.from_channel (open_in path) in
    try
        loop lexbuf (Parser.Incremental.regra_programa lexbuf.lex_curr_p)
    with
    | Lexer.Error(msg, position) -> 
      begin
          let line = position.pos_lnum in
          let col  = position.pos_cnum - position.pos_bol in
          Printf.fprintf stderr "L[%d]C[%d]: Caractere invalido %s\n" line col msg;
      end
;;