(** Bombs-Must-Detonate: AST Definition & Print function 
    @author Brian Go *)

(** SYNTAX TREE *)

(** Field info is annotated by the type checker for use in the IR compiler *)
type field_info = 
    VIdUnspecified (** Not yet set by type checker *)
  | VIdStructField of int (** The field is the (int)th field of the struct *)
  | VIdEnumValue of int (** The field is the (int)th value of an enum *)

(** Top-level expressions *)
type global_expression =
    SynFunctionDeclare of function_declare
  | SynRemotableFunctionDeclare of function_declare
  | SynTemplatedDeclare of string list * global_expression 
  | SynFunctionDefine of function_define
  | SynTemplatedDefine of string list * global_expression
  | SynStructDeclare of struct_declare
  | SynGlobalEnumDeclare of enum_declare
  | SynGlobalVarDeclare of var_declare
  | SynInclude of include_data ref
  | SynStateMachine of fsm_state_machine

(** The include string is replaced by an AST so as to only parse it once *)
and include_data =
    IncludeFileName of string
  | IncludeAst of global_expression list

(** Expressions *)
and expression = 
    SynVarDeclare of var_declare
  | SynEnumDeclare of enum_declare
  | SynVarAssign of var_assign
  | SynCond of conditional
  | SynLoop of loop
  | SynFunctionCall of function_call
  | SynReturnStatement of return_statement
  | SynBreak (** Produces a type error if not in a loop *)
  | SynContinue (** Produces a type error if not in a loop *)

(** Functions *)
and function_declare = 
    data_type * string * (data_type * string) list (** return type, name, arg list *)
and function_define = function_declare * expression list (** declaration, body *)
and function_call = 
    SynLocalCall of string * value_producer list * bool ref (** name, args, true if it is a variable-function *)
  | SynRemoteCall of 
      string * value_producer list * var_ident (** name, args, return value target variable *)
  | SynRemoteCallNoResult of
      string * value_producer list (** name, args *)
and return_statement = 
    SynVoidReturn
  | SynValueReturn of value_producer

(** Data Structures *)
and struct_declare = string * var_declare list (** name, fields *)
and enum_declare = string * string list (** name, values *)

(** Variables *)
and var_declare = 
    SynVarDeclareNoInit of data_type * string (** type, name *)
  | SynVarDeclareWithInit of 
      data_type * string * value_producer (** type, name, initial value *)
and var_assign = 
    SynVarAssignment of var_ident * value_producer (** var_ident = value_producer *)
  | SynVarModify of var_ident * binop * value_producer (** e.g. +=,*=.  for cons (::=), the list is on the LHS *)

(** Conditionals *)
and conditional = 
    SynIf of value_producer * expression list 
  | SynIfCase of value_producer 
      * expression list * continued_conditional
and continued_conditional = 
    SynFinalElse of expression list
  | SynElse of conditional

(** Loops *)
and loop =
    SynWhile of value_producer * expression list
  | SynFor of expression * value_producer * expression
      * expression list (** init, test, step, body.  Note: step expression must end in a semicolon *)
  | SynDoWhile of expression list * value_producer

(** Value Producers *)
and value_producer = 
    SynValue of value
  | SynFunctionCallValue of function_call
  | SynVarIdentifier of var_ident
  | SynBinop of value_producer * binop * value_producer
  | SynPrefixUnop of pre_unop * value_producer
  | SynParenthesized of value_producer
  | SynArrayValueProducer of value_producer list
  | SynListValueProducer of list_value_producer

and value = 
    SynIntValue of int
  | SynFloatValue of float
  | SynStringValue of string
  | SynBoolValue of bool

and list_value_producer =
    SynListNil of data_type
  | SynListList of value_producer list
  | SynListCons of value_producer * value_producer (** car, cdr *)

and var_ident =
    SynVarName of string
  | SynStructOrEnumValue of var_ident * string * field_info ref (** field info set by type checker for use by IR compiler *)
  | SynArrayCell of var_ident * value_producer

(** Data Types *)
and data_type = 
    SynIntType
  | SynFloatType
  | SynStringType
  | SynBoolType
  | SynVoidType
  | SynEnumOrStructType of string * (data_type list) ref (** field types set by type checker for use by IR compiler *)
  | SynArrayType of data_type * value_producer
  | SynListType of data_type
  | SynRefType of data_type
  | SynArrowType of data_type list * data_type (** arg types, return type  *)

(** Operators *)
and binop =
  | SynBinopAnd
  | SynBinopOr
  | SynBinopAdd
  | SynBinopSub
  | SynBinopMul
  | SynBinopDiv
  | SynBinopIDiv
  | SynBinopMod
  | SynBinopConcat
  | SynBinopCons
  | SynCompLt
  | SynCompGt
  | SynCompLte
  | SynCompGte
  | SynCompEq
  | SynCompNeq

and pre_unop = 
  | SynUnopNot
  | SynUnopCar
  | SynUnopCdr
  | SynUnopTrunc
  | SynUnopDeref
  | SynUnopNeg
  | SynUnopNull

(** State Machine Syntax *)
and fsm_state_machine = string * string * fsm_state list (** name, onInit handler, state list *)
and fsm_state = string * fsm_callback list * fsm_transition list (** name, callbacks, transitions *)
and fsm_callback = 
    SynFsmOnInit of string (** This is not actually a callback but is executed every time the state is visited *)
  | SynFsmOnMoveRequest of string
  | SynFsmOnTeammateDeath of string
  | SynFsmOnBombDetonate of string
  | SynFsmOnDeath of string

and fsm_transition = string list * (string * float) list

and src_program = global_expression list


let concat s = String.concat "" s

let rec string_of_global_expression expr = match expr with
    SynFunctionDeclare (dt,s,arglist) -> 
      concat [string_of_datatype dt;" ";s;"(";string_of_arglist arglist;");\n"]
  | SynRemotableFunctionDeclare (dt,s,arglist) ->
      concat ["remotable ";string_of_datatype dt;" ";s;"(";string_of_arglist arglist;");\n"]
  | SynTemplatedDeclare (slist,gexpr) ->
      concat ["template <";string_of_string_list slist;">\n"; string_of_global_expression gexpr]
  | SynFunctionDefine ((dt,s,arglist),expr_list) ->
      concat [string_of_datatype dt;" ";s;"(";string_of_arglist arglist;") {\n";string_of_expr_list expr_list;"}\n"]
  | SynTemplatedDefine (slist,gexpr) ->
      concat ["template <";string_of_string_list slist;">\n"; string_of_global_expression gexpr]
  | SynStructDeclare (sname,vdecl_list) ->
      concat ["struct ";sname;" {\n";string_of_var_declare_list vdecl_list;"};\n"]
  | SynGlobalEnumDeclare (ename,slist) ->
      concat ["enum ";ename;" {";string_of_string_list slist;"};\n"]
  | SynGlobalVarDeclare vdecl ->
      concat [string_of_var_declare vdecl;";\n"]
  | SynInclude include_data ->
      concat ["include \"";string_of_include !include_data;"\"\n"]
  | SynStateMachine _ ->
      raise (Failure "Source-to-source FSM compilation did not occur (code 2).")

and string_of_arglist arglist = match arglist with
    (dt,vname)::[] -> concat [string_of_datatype dt;" ";vname]
  | (dt,vname)::rest -> concat [string_of_datatype dt;" ";vname;", "]
  | [] -> ""

and string_of_datatype dt = match dt with
    SynIntType -> "int"
  | SynFloatType -> "float"
  | SynStringType -> "string"
  | SynBoolType -> "bool"
  | SynVoidType -> "void"
  | SynEnumOrStructType (sname,_) -> sname
  | SynArrayType (t,vprod) -> concat [string_of_datatype t;" array [";string_of_value_producer vprod;"]"]
  | SynListType t -> concat [string_of_datatype t;" list"]
  | SynRefType t -> concat [string_of_datatype t;" ref"]
  | SynArrowType (dt_list,t) -> concat ["(";string_of_datatype_list dt_list;") -> ";string_of_datatype t]

and string_of_string_list slist = match slist with
    cur::[] -> cur
  | cur::rest -> concat [cur;", ";string_of_string_list rest]
  | [] -> ""


and string_of_expr_list expr_list = match expr_list with
    expr::rest -> concat [string_of_expr expr;string_of_expr_list rest]
  | [] -> ""

and string_of_var_declare_list vdecl_list = match vdecl_list with
    vdecl::[] -> concat [string_of_var_declare vdecl]
  | vdecl::rest -> concat [string_of_var_declare vdecl;", ";string_of_var_declare_list rest]
  | [] -> ""

and string_of_var_declare vdecl = match vdecl with
    SynVarDeclareNoInit (dt,name) -> 
      concat [string_of_datatype dt;" ";name]
  | SynVarDeclareWithInit (dt,name,vprod) -> 
      concat [string_of_datatype dt;" ";name;" = ";string_of_value_producer vprod]

and string_of_include data = match data with
    IncludeFileName s -> s
  | _ -> raise (Failure "Source-to-source FSM compilation did not occur (code 1).")

and string_of_value_producer vprod = match vprod with
    SynValue v -> 
      string_of_value v
  | SynFunctionCallValue funcall ->
      string_of_function_call funcall
  | SynVarIdentifier vident ->
      string_of_variable_identifier vident 
  | SynBinop (vprod1,binop,vprod2) ->
      concat [string_of_value_producer vprod1;" "; string_of_binop binop;" "; string_of_value_producer vprod2]
  | SynPrefixUnop (op,vprod) ->
      concat [string_of_unop op;" ";string_of_value_producer vprod]
  | SynParenthesized vprod ->
      concat ["(";string_of_value_producer vprod;")"]
  | SynArrayValueProducer vprod_list ->
      concat ["{";string_of_value_producer_list vprod_list ",";"}"]
  | SynListValueProducer lval_prod ->
      string_of_list_value_producer lval_prod 

and string_of_datatype_list dt_list = match dt_list with
    cur::[] -> string_of_datatype cur
  | cur::rest -> concat [string_of_datatype cur; string_of_datatype_list rest]
  | [] -> ""

and string_of_expr expr = match expr with
    SynVarDeclare vdecl -> 
      concat [string_of_var_declare vdecl;";\n"]
  | SynEnumDeclare (ename,slist) ->
      concat ["enum ";ename;" {";string_of_string_list slist;"};\n"]
  | SynVarAssign vasgn -> 
      concat [string_of_var_assign vasgn;";\n"]
  | SynCond cond ->
      concat [string_of_conditional cond;"\n"]
  | SynLoop loop ->
      concat [string_of_loop loop;"\n"]
  | SynFunctionCall funcall ->
      concat [string_of_function_call funcall;";\n"]
  | SynReturnStatement ret ->
      concat [string_of_return_statement ret;";\n"]
  | SynBreak -> "break;\n"
  | SynContinue -> "continue;\n";

and string_of_value value = match value with
    SynIntValue i -> string_of_int i
  | SynFloatValue f -> string_of_float f
  | SynStringValue s -> s
  | SynBoolValue b -> if b then "true" else "false"

and string_of_function_call funcall = match funcall with
    SynLocalCall (foo,vprod_list,_) ->
      concat [foo;"(";string_of_value_producer_list vprod_list ",";")"]
  | SynRemoteCall (foo,vprod_list,retvar) ->
      concat ["!(";foo;"(";string_of_value_producer_list vprod_list ",";"), ";string_of_variable_identifier retvar;")"]
  | SynRemoteCallNoResult (foo,vprod_list) ->
      concat ["!(";foo;"(";string_of_value_producer_list vprod_list ",";")"]

and string_of_variable_identifier vident = match vident with
    SynVarName s -> s
  | SynStructOrEnumValue (vident,s,_) ->
      concat [string_of_variable_identifier vident;".";s]
  | SynArrayCell (vident,vprod) ->
      concat [string_of_variable_identifier vident;"[";string_of_value_producer vprod;"]"]

and string_of_unop op = match op with
    SynUnopNot -> "not"
  | SynUnopCar -> "car"
  | SynUnopCdr -> "cdr"
  | SynUnopTrunc -> "trunc"
  | SynUnopDeref -> "$"
  | SynUnopNeg -> "-"
  | SynUnopNull -> "null"

and string_of_value_producer_list vprod_list del = match vprod_list with
    cur::[] -> 
      string_of_value_producer cur
  | cur::rest -> 
      concat [string_of_value_producer cur;del;" ";string_of_value_producer_list rest del]
  | [] -> ""
    
and string_of_list_value_producer vprod = match vprod with
    SynListNil dt -> 
      concat ["nil[";string_of_datatype dt;"]"]
  | SynListList vp_lst ->
      concat ["[";string_of_value_producer_list vp_lst ";";"]"]
  | SynListCons (vp1,vp2) ->
      concat [string_of_value_producer vp1;"::";string_of_value_producer vp2]

and string_of_var_assign vasgn = match vasgn with
    SynVarAssignment (vident,vprod) ->
      concat [string_of_variable_identifier vident;" = ";string_of_value_producer vprod]
  | SynVarModify (vident,binop,vprod) -> 
      concat [string_of_variable_identifier vident;" ";string_of_binop binop;"= ";string_of_value_producer vprod]

and string_of_conditional cond = match cond with
    SynIf (vprod,expr_list) ->
      concat ["if (";string_of_value_producer vprod;") {\n";string_of_expr_list expr_list;"}\n"]
  | SynIfCase (vprod,expr_list,continued_cond) ->
      concat ["if (";string_of_value_producer vprod;") {\n";string_of_expr_list expr_list;"}\n";string_of_continued_conditional continued_cond]

and string_of_continued_conditional cond = match cond with
    SynFinalElse expr_list ->
      concat ["else {\n";string_of_expr_list expr_list;"}\n"]
  | SynElse cond ->
      concat ["else ";string_of_conditional cond]

and string_of_loop loop = match loop with
    SynWhile (vprod,expr_list) ->
      concat ["while (";string_of_value_producer vprod;") {\n";string_of_expr_list expr_list;"}\n"]
  | SynFor (expr_init,vprod,expr_step,expr_list) ->
      concat ["for (";string_of_expr expr_init;string_of_value_producer vprod;";\n";string_of_expr expr_step;") {\n";string_of_expr_list expr_list;"}\n"]
  | SynDoWhile (expr_list,vprod) ->
      concat ["do {\n";string_of_expr_list expr_list;"} while (";string_of_value_producer vprod;")"]

and string_of_return_statement ret = match ret with
    SynVoidReturn -> "return"
  | SynValueReturn vprod ->
      concat ["return ";string_of_value_producer vprod]

and string_of_binop op = match op with
    SynBinopAnd -> "and"
  | SynBinopOr -> "or"
  | SynBinopAdd -> "add"
  | SynBinopSub -> "sub"
  | SynBinopMul -> "mul"
  | SynBinopDiv -> "div"
  | SynBinopIDiv -> "idiv"
  | SynBinopMod -> "mod"
  | SynBinopConcat -> "concat"
  | SynBinopCons -> "::"
  | SynCompLt -> "<"
  | SynCompGt -> ">"
  | SynCompLte -> "<="
  | SynCompGte -> ">="
  | SynCompEq -> "="
  | SynCompNeq -> "!="


let string_of_ast ast = concat (List.map string_of_global_expression ast)
let print_ast ast = print_string (string_of_ast ast)