civicaml/phases/context_analysis.ml

open Printf
open Ast
open Util

module StrMap = Map.Make (String)

let analyse_context node =
    let scope = ref StrMap.empty in
    let add_to_scope name decl depth desc =
        if StrMap.mem name !scope then(
            raise (NodeError (!decl, sprintf "cannot redeclare %s \"%s\"" desc name))
        ) else
            scope := StrMap.add name (decl, depth) !scope
    in
    let rec analyse depth = function
        (* Add node reference for this varname to vars map *)
        | VarDec (ctype, name, init, loc) as node ->
            let node = match init with
                | Some value ->
                    let value = analyse depth value in
                    VarDec (ctype, name, Some value, loc)
                | None -> node
            in
            add_to_scope name (ref node) depth "variable";
            node

        (* For a variable, look for its declaration in the current scope and
         * save a reference with the relative nesting depth *)
        | Var (name, _) as node ->
            if StrMap.mem name !scope then
                let (decl, decl_depth) = StrMap.find name !scope in
                VarUse (node, decl, depth - decl_depth)
            else
                raise (NodeError (node, (sprintf "undefined variable \"%s\"" name)))

        (*
        (* Increase nesting level when entering function *)
        | FunDef (export, ret_type, name, params, body, loc) as node ->
            let vars = StrMap.add name (ref node) vars in
            let inctrav vars = function
                | [] -> []
                | h :: t -> analyse vars h :: (inctrav vars
            in
            let body = inc_trav body
            let body = List.map (analyse vars) body in
            FunDef (export, ret_type, name, params, body, loc) as node ->
        *)

        | node -> transform_children (analyse depth) node
    in
    analyse 0 node

let rec phase input =
    prerr_endline "- Context analysis";
    match input with
    | Ast (node, args) ->
        Ast (analyse_context node, args)
    | _ -> raise (InvalidInput "context analysis")