Source

Opifex / src / Language / Common / AST.ml

Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open Batteries

(*************************************************************************************************
 * Common datatypes for Abstract Syntax Trees
 ************************************************************************************************)

type identifier
    = Identifier of string

type variable
    = Variable of identifier

type type_variable
    = TypeVariable of int

type arithmetic_binary_operator
    = AOP_ADD
    | AOP_SUB
    | AOP_MUL
    | AOP_DIV
    | AOP_MOD

type arithmetic_unary_operator
    = AOP_NEG

type boolean_arithmetic_binary_operator
    = BOP_LT
    | BOP_LEQ
    | BOP_EQ
    | BOP_GT
    | BOP_GEQ
    | BOP_NEQ

type boolean_binary_operator
    = BOP_AND
    | BOP_OR

type boolean_unary_operator
    = BOP_NOT

type label
    = Label of int

(*************************************************************************************************
 * Operations
 ************************************************************************************************)

let string_of_identifier (Identifier str) = str

let string_of_variable (Variable id) = string_of_identifier id

let string_of_type_variable (TypeVariable id) = "'" ^ string_of_int id

let int_of_label (Label i) = i

let string_of_label = let prefix s = "$L" ^ s in prefix -| string_of_int -| int_of_label

let string_of_boolean_binary_operator = function
    | BOP_AND -> "&&"
    | BOP_OR  -> "||"

let string_of_boolean_unary_operator = function
    | BOP_NOT -> "not"

let string_of_boolean_arithmetic_binary_operator = function
    | BOP_LT -> "<"
    | BOP_LEQ -> "<="
    | BOP_EQ -> "="
    | BOP_GT -> ">"
    | BOP_GEQ -> ">="
    | BOP_NEQ -> "!="

let string_of_arithmetic_binary_operator = function
    | AOP_ADD -> "+"
    | AOP_SUB -> "-"
    | AOP_MUL -> "*"
    | AOP_DIV -> "/"
    | AOP_MOD -> "%"

let string_of_arithmetic_unary_operator = function
    | AOP_NEG -> "-"


let priority_of_boolean_binary_operator a (b : boolean_binary_operator) =  a < b

(*************************************************************************************************
 * 
 ************************************************************************************************)

let make_identifier s = Identifier s
let make_variable s = Variable (make_identifier s)


(*************************************************************************************************
 * Label counter (move to somewhere else)
 ************************************************************************************************)

module LabelCounter = struct

type t = int ref

let create () = ref 0

let get counter = 
    let v = !counter in
    counter := succ v;
    Label v

end

let get_new_label = 
    let global_counter = LabelCounter.create () in
    fun () -> LabelCounter.get global_counter

(*************************************************************************************************
 * Modules for functors
 ************************************************************************************************)

module VariableOrderedType = struct

    type t = variable

    let compare = compare

end

module LabelOrderedType = struct

    type t = label

    let compare = compare

end