taddeus
/
civicaml


			
				
					
						
						
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138
							type location = string * int * int * int * int
let noloc = ("", 0, 0, 0, 0)

type operator = Neg | Not
              | Add | Sub | Mul | Div | Mod
              | Eq | Ne | Lt | Le | Gt | Ge
              | And | Or
type ctype = Void | Bool | Int | Float
           | Array of ctype * node list
           | ArrayDepth of ctype * int  (* TODO: remove? *)
           | FlatArray of ctype
and annotation =
    | Loc of location
    | Depth of int
    | Type of ctype
and ann = annotation list
and node =
    (* Global *)
    | Program of node list * ann
      (* list of declarations *)
    | FunDec of ctype * string * node list * ann
      (* ret_type, name, params *)
    | FunDef of bool * ctype * string * node list * node * ann
      (* export, ret_type, name, params, body *)
    | GlobalDec of ctype * string * ann
      (* type, name *)
    | GlobalDef of bool * ctype * string * node option * ann
      (* export, type, name, initialisation? *)
    | Param of ctype * string * ann
      (* type, name *)
    | Dim of string * ann
      (* dimension name in array Param *)

    (* Statements *)
    | VarDec of ctype * string * node option * ann
      (* type, name, initialisation? *)
    | Assign of string * node list option * node * ann
      (* name, indices?, value *)
    | For of string * node * node * node * node * ann
      (* counter, start, stop, step, body *)
    | Allocate of string * node list * node * ann
      (* name, dims, decl  # name = __allocate(dims) *)
    | Return of node * ann                   (* return <value>; *)
    | Expr of node                           (* <expr>; *)
    | Block of node list                     (* { <body> } *)
    | If of node * node * ann                (* cond, body *)
    | IfElse of node * node * node * ann     (* cond, true_body, false_body *)
    | While of node * node * ann             (* cond, body *)
    | DoWhile of node * node * ann           (* cond, body *)

    (* Expressions *)
    | BoolConst of bool * ann                  (* bool value *)
    | IntConst of int * ann                    (* int value *)
    | FloatConst of float * ann                (* float value *)
    | ArrayConst of node list * ann            (* [<exprs>] *)
    | Var of string * node list option * ann   (* <name> [<indices>]? *)
    | Monop of operator * node * ann           (* op, operand *)
    | Binop of operator * node * node * ann    (* op, left, right *)
    | TypeCast of ctype * node * ann           (* (type) operand *)
    | FunCall of string * node list * ann      (* name(args) *)
    | Arg of node                              (* function argument *)

    (* Additional types for convenience in traversals
     * Mostly used to annotate existing nodes with information from declarations *)
    | VarUse of node * node list option * ann  (* Same as Var, but with decl. *)
    | FunUse of node * node list * ann         (* Same as FunCall, but with decl. *)
    | VarLet of node * node list option * node * ann (* replacement for Assign *)
    | ArrayScalar of node                      (* (Bool|Int|Float)Const *)
    | ArrayInit of node * ctype                (* Array(Scalar|Const) * dimensions *)
    | Cond of node * node * node * ann         (* cond, true_expr, false_expr *)
    | DummyNode                                (* null node, pruned by traversals *)

type instr =
    (* # <comment> *)
    | Comment of string
    (* <label>: *)
    | Label of string

    (* Directives *)
    (* .export "<name>" <ret_type> [ <arg_type>; ... ] <label> *)
    | Export of string * ctype * ctype list * string
    (* .import "<name>" <ret_type> [ <arg_type>; ... ] *)
    | Import of string * ctype * ctype list
    (* .const <value> *)
    | Const of node
    (* .global <type> *)
    | Global of ctype

    (* [ifb]loadg G *)
    | LoadGlob of node
    (* [ifb]loadc C *)
    | LoadConst of ctype * int
    (* [ifb]load_[01tf] <value> *)
    | LoadImm of node

    (* Instructions *)
    (* i(inc|dec) L C *)
    | Inc of int * int
    (* i(inc|dec)_1 C *)
    | IncOne of int

(* Container for command-line arguments *)
type args_record = {
    mutable infile  : string option;
    mutable outfile : string option;
    mutable verbose : int;
    mutable cpp     : bool;
}

(* Default config *)
let verbosity_default = 2  (* TODO: set to 1 when done with debugging *)
let verbosity_debug   = 3

(* Commandline args are stored in a global struct
 * (yes, it IS dirty, but I'd rather have this than having to pass [args] around
 * everywhere) *)
let args = {
    infile  = None;
    outfile = None;
    verbose = verbosity_default;
    cpp     = true;
}

(* intermediate representations between phases *)
type intermediate =
    | Empty
    | FileContent of string * string
    | Types of node
    | Assembly of instr list

(* exceptions *)
exception LocError of location * string
exception NodeError of node * string
exception CompileError of string
exception EmptyError

exception InvalidNode
exception InvalidInput of string