Commits

Paweł Wieczorek  committed b7ba0fc

Lang.Common -> Lang_Common

  • Participants
  • Parent commits f38849e
  • Branches 2014_03_16_cleaning

Comments (0)

Files changed (57)

File myocamlbuild.ml

     define_forpack_tags "source";
     define_forpack_tags "test"
 
-(*
-TODO: do automatic mlpacks
-
-TEMPORARY: support in Ocamlbuild
-let native_pack_modules x =
-  pack_modules [("cmx",["cmi"; !Options.ext_obj]); ("cmi",[])] "cmx" "cmxa" !Options.ext_lib ocamlopt_p
-    (fun tags -> tags++"ocaml"++"pack"++"native") x
-
-let native_pack_mlpack = link_from_file native_pack_modules
-
-let link_from_file link modules_file cmX env build =
-  let modules_file = env modules_file in
-  let contents_list = string_list_of_file modules_file in
-  link contents_list cmX env build
-
-rule "ocaml: mlpack & cmi & cmx* & o* -> cmx & o"
-  ~tags:["ocaml"; "native"]
-  ~prods:["%.cmx"; x_o(* no cmi here you must make the byte version to have it *)]
-  ~deps:["%.mlpack"; "%.cmi"]
-  (Ocaml_compiler.native_pack_mlpack "%.mlpack" "%.cmx");;
-
-
-let action env build = Ocaml_compiler.native_pack_mlpack "%.mlpack" "%.cmx" env build
-
-action env build
-->
-Ocaml_compiler.native_pack_mlpack "%.mlpack" "%.cmx" env build
-->
-link_from_file native_pack_modules "%.mlpack" "%.cmx" env build
-->
-(*let link_from_file link modules_file cmX env build
-link = native_pack_modules
-modules_file = %.mlpack
-cmX = %.cmx
-env = env
-build = build
-*)
-let modules_file = env "%.mlpack" in
-let contents_list = string_list_of_file modules_file in
-native_pack_modules contents_list "%.cmx" env build
-
-*)
-
 (****************************************************************************************************************
  * Main
  ****************************************************************************************************************)

File source/Command/EvalCommandMaker.ml

 open Batteries
 open CommandTree.Type
 open StringPainter.Prioritized
-open Lang.Common.Wrap
+open Lang_Common.Wrap
 
 (*********************************************************************************************************************
  * ParseCommand

File source/Command/MiniML_Commands.ml

 open Batteries
 open CommandTree.Type
 open Lang.MiniML
-open Lang.Common.Wrap
+open Lang_Common.Wrap
 
 let lang_name = "miniml"
 
     let parse = Parser.parse Lexer.token
 
     let eval ast = 
-        let store      = Lang.Common.Store.create () in
+        let store      = Lang_Common.Store.create () in
         let env, value = Eval.eval_program store ast in
         (value, (env, store))
 
             [ psp_word "Environment:"
             ; psp_indent_group (PrettyPrinter.ValuePrinter.paint_environment env)
             ; psp_word "Store:"
-            ; psp_indent_group (Lang.Common.Store.PrettyPrinter.paint_store PrettyPrinter.ValuePrinter.paint_value store)
+            ; psp_indent_group (Lang_Common.Store.PrettyPrinter.paint_store PrettyPrinter.ValuePrinter.paint_value store)
             ]
             in
 

File source/Command/ParserCommandMaker.ml

 open Batteries
 open CommandTree.Type
 open StringPainter.Prioritized
-open Lang.Common.Wrap
+open Lang_Common.Wrap
 (*********************************************************************************************************************
  * ParseCommand
  ********************************************************************************************************************)

File source/Command/WHILE_Commands.ml

     type eval_extra_result = Eval.store
 
     let eval x = 
-        let store = Lang.Common.Store.create () in
+        let store = Lang_Common.Store.create () in
         Eval.eval_program store Eval.standard_io_driver  x;
         () , store
 
     let paint_eval_result _ = psp_empty
 
     let paint_eval_extra_result = Some begin fun store ->
-        psp_group (Lang.Common.Store.PrettyPrinter.paint_store (fun x -> Eval.paint_value x) store)
+        psp_group (Lang_Common.Store.PrettyPrinter.paint_store (fun x -> Eval.paint_value x) store)
         end
 
 end
         let paint_assembly = Machine.X86.GasPrettyPrinter.paint_assembly
     end
 
-    module Parser = Lang.Common.Wrap.ParserWrap.Make(Signature) 
+    module Parser = Lang_Common.Wrap.ParserWrap.Make(Signature) 
 
     let parse configuration source_filename =
         Parser.parse source_filename

File source/Lang.mlpack

-Common
 While
 CWCPS
 TAC

File source/Lang/CWCPS/AST.ml

  * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
  *)
 
-include Common.AST
+include Lang_Common.AST
 open Batteries
-open Common.Enumerators
+open Lang_Common.Enumerators
 
 (*********************************************************************************************************************
  * Abstract Syntax Tree

File source/Lang/CWCPS/Eval.ml

 
 open AST
 open Batteries
-open Common
+open Lang_Common
 
 (*********************************************************************************************************************
  * Value 

File source/Lang/CWCPS/Helper.ml

 
 open PrettyPrinter
 open Eval
-open Common
+open Lang_Common
 
 let update_mem (ht,mpath) var = (ht, string_of_variable var :: mpath)
 

File source/Lang/CWCPS/PrettyPrinter.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 open Formatter
 open Batteries
 

File source/Lang/CWCPS/Transformation/NaiveClosureConversion.ml

 open AST
 open Analysis.VariableUsageAnalysis
 open TransformationFramework
-open Common.Enumerators
+open Lang_Common.Enumerators
 
 module ClosureRepresentation = struct
 

File source/Lang/CWCPS/Transformation/UncurryFunctionsTransformation.ml

 open AST
 open TransformationFramework
 open Batteries
-open Common.Enumerators
+open Lang_Common.Enumerators
 
 (*********************************************************************************************************************
  * Fetching Reducer

File source/Lang/CWCPS/TransformationFramework.ml

 
 open AST
 open Lib.Algebra.Monoid
-open Common
+open Lang_Common
 open Batteries
 
 

File source/Lang/Common.mlpack

-AST
-Enumerators
-Environment
-Formatter
-Store
-EvalError
-ParseError
-Wrap
-SourceLocationMap

File source/Lang/Common/AST.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 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
-
-(*********************************************************************************************************************
- * map
- ********************************************************************************************************************)
-
-let identifier_fold f (Identifier s) = f s
-
-let variable_fold f (Variable i) = f i
-
-
-(*********************************************************************************************************************
- * string_of
- ********************************************************************************************************************)
-
-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 identifier_of_variable (Variable id) = 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 -> "-"
-
-(*********************************************************************************************************************
- * priority_of
- ********************************************************************************************************************)
-
-let priority_of_boolean_binary_operator a (b : boolean_binary_operator) =  a < b
-
-(*********************************************************************************************************************
- * make_
- ********************************************************************************************************************)
-
-let make_identifier s = Identifier s
-
-let make_label l = Label l
-
-let make_variable s = Variable (make_identifier s)
-
-
-(*********************************************************************************************************************
- * Label counter (move to somewhere else)
- * TODO: use label_enumerator
- ********************************************************************************************************************)
-
-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
-
-(*********************************************************************************************************************
- * Prepared modules
- ********************************************************************************************************************)
-
-module VariableSet = Util.ExtSet(Set.Make(VariableOrderedType))
-module VariableMap = Util.ExtMap(Map.Make(VariableOrderedType))

File source/Lang/Common/Enumerators.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-open AST
-
-(*********************************************************************************************************************
- * Internal
- ********************************************************************************************************************)
-
-let base_sequence start = 
-    Enum.seq start succ (not % (=) max_int) 
-
-let base_prefixed_sequence prefix start = 
-    base_sequence start
-    |> Enum.map (fun n -> prefix ^ string_of_int n)
-
-(*********************************************************************************************************************
- * Public
- ********************************************************************************************************************)
-
-module LabelEnumerator = struct
-
-    type t = label BatEnum.t
-
-    let make start =
-        base_sequence start
-        |> Enum.map (fun x -> Label x)
-
-    let get_next t =
-        match Enum.get t with
-        | None   -> failwith "Impossible, the label enumerator exhausted?"
-        | Some x -> x
-
-end
-
-(*********************************************************************************************************************
- * VariableEnumerator
- ********************************************************************************************************************)
-
-module VariableEnumerator = struct
-
-    type t = string BatEnum.t
-
-    let make ?(prefix = "_v") start = 
-        base_prefixed_sequence prefix start
-
-    let get_next ?suffix t = 
-        match Enum.get t with
-        | None   -> failwith "Impossible, the variable enumerator exhausted?"
-        | Some x -> match suffix with
-            | Some str ->
-                make_variable (x ^ "_" ^ str)
-            | _ ->
-                make_variable x
-
-end
-
-(*********************************************************************************************************************
- * Public
- ********************************************************************************************************************)
-
-module VariableScanner = struct
-
-    type t = string * int ref
-
-    let make_variable_scanner ?(prefix = "_v") start : t =
-        (prefix, ref start)
-
-    let update (prefix, start) (Variable (Identifier name)) = 
-        if String.starts_with name prefix
-        then
-            try
-                let rest = String.lchop ~n:(String.length prefix) name in
-                start   := succ (String.to_int rest)
-            with
-                _ -> ()
-        else 
-            incr start
-
-    let to_enumerator (prefix, start) =
-        VariableEnumerator.make ~prefix:prefix !start
-
-end
-
-(*********************************************************************************************************************
- * Aggregation
- ********************************************************************************************************************)
-
-type enumerators =
-    { variable_enumerator : VariableEnumerator.t
-    ; label_enumerator    : LabelEnumerator.t
-    }
-

File source/Lang/Common/Enumerators.mli

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-(*********************************************************************************************************************
- * Label enumerator interface
- ********************************************************************************************************************)
-
-module LabelEnumerator : sig
-
-    type t
-
-    val make: int -> t
-
-    val get_next: t -> AST.label
-
-end
-
-(*********************************************************************************************************************
- * Variable enumerator interface
- ********************************************************************************************************************)
-
-module VariableEnumerator : sig
-    
-    type t
-
-    val make: ?prefix:string -> int -> t
-
-    val get_next: ?suffix:string -> t -> AST.variable
-
-end
-
-(*********************************************************************************************************************
- * Scanner
- ********************************************************************************************************************)
-
-module VariableScanner : sig
-
-    type t
-
-    val make_variable_scanner : ?prefix:string -> int -> t
-
-    val update : t -> AST.variable -> unit
-
-    val to_enumerator : t -> VariableEnumerator.t
-
-end
-
-(*********************************************************************************************************************
- * Aggregation
- ********************************************************************************************************************)
-
-type enumerators =
-    { variable_enumerator : VariableEnumerator.t
-    ; label_enumerator    : LabelEnumerator.t 
-    }
-

File source/Lang/Common/Environment.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open AST
-open Batteries
-
-(*********************************************************************************************************************
- * Types
- ********************************************************************************************************************)
-
-type 'value t = int ref * (variable, int * 'value) Hashtbl.t
-
-(*********************************************************************************************************************
- * Exceptions
- ********************************************************************************************************************)
-
-exception Unknown_variable of variable
-
-(*********************************************************************************************************************
- * Public
- ********************************************************************************************************************)
-
-let create () = (ref 0, Hashtbl.create 513)
-
-let clone (timestamp, hashtable) = (timestamp, Hashtbl.copy hashtable)
-
-let put (timestamp, hashtable) variable value =
-    Hashtbl.replace hashtable variable (!timestamp, value);
-    timestamp := !timestamp + 1
-
-let get (_, hashtable) variable =
-    try
-        snd (Hashtbl.find hashtable variable )
-    with
-        Not_found ->
-            raise (Unknown_variable variable)
-
-let with_extended_environment (timestamp, hashtable) variable value cont =
-    Hashtbl.add hashtable variable (!timestamp, value);
-    let r = cont () in
-    Hashtbl.remove hashtable variable;
-    r
-
-let rec with_extended_environment_m context _xs continuation =
-    let rec aux = function
-        | [] ->
-            continuation ()
-
-        | (name, value)::xs ->
-            let cont () = with_extended_environment_m context xs continuation in
-            with_extended_environment context name value cont
-
-        in
-    aux _xs
-
-let get_list (_, hashtable) = 
-    let result = Util.list_of_hashtbl hashtable in
-    let compare_vals a b = compare (snd a) (snd b) in
-    let cut (variable, value) = (variable, snd value) in
-    List.map cut (List.sort compare_vals result)
-
-let map f (_, hashtable) = 
-    let handle_def k (t, v) = 
-        Hashtbl.replace hashtable k (t, (f k v))
-        in
-
-    Hashtbl.iter handle_def hashtable
-
-(*********************************************************************************************************************
- * PrettyPrinter
- ********************************************************************************************************************)
-
-module PrettyPrinter = struct
-
-open Formatter
-
-
-let paint_environment _paint_value update pcxt env = 
-    let handle aux (k, v) = 
-        [ psp_value "val"
-        ; psp_variable k
-        ; psp_operator "="
-        ; psp_group (_paint_value (update pcxt k) v)
-        ; psp_break
-        ; psp_newline
-        ] :: aux
-        in
-        match (List.fold_left handle [] (get_list env)) with
-            | [] ->
-                []
-
-            | output ->
-                [ psp_value_keyword "environment"
-                ; psp_indent_group ((List.concat % List.rev) output)
-                ; psp_value_keyword "end"
-                ]
-
-end

File source/Lang/Common/Environment.mli

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open AST
-
-(*********************************************************************************************************************
- * Types
- ********************************************************************************************************************)
-
-type 'value t
-
-(*********************************************************************************************************************
- * Exceptions
- ********************************************************************************************************************)
-
-exception Unknown_variable of variable
-
-(*********************************************************************************************************************
- * Interface
- ********************************************************************************************************************)
-
-val create : unit -> 'value t
-
-val clone : 'value t -> 'value t
-
-val put : 'value t -> variable -> 'value -> unit
-
-val get : 'value t -> variable -> 'value
-
-val with_extended_environment : 'value t -> variable -> 'value -> (unit -> 'a) -> 'a
-
-val with_extended_environment_m  : 'value t -> (variable * 'value) list -> (unit -> 'a) -> 'a
-
-val get_list : 'value t -> (variable * 'value) list
-
-val map : (variable -> 'value -> 'value) -> 'value t -> unit
-
-(*********************************************************************************************************************
- * PrettyPrinter
- ********************************************************************************************************************)
-
-module PrettyPrinter : sig
-    open Formatter
-
-    val paint_environment : ('ncxt -> 'value -> painter list) 
-                        -> ('pcxt -> variable -> 'ncxt)
-                        -> 'pcxt -> 'value t -> painter list
-
-end

File source/Lang/Common/EvalError.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-type eval_error_reason
-    (* Invalid operation, e.g. applying integer to something, division by zero... *)
-    = EVAL_INVALID_OPERATION        of string
-
-    (* Unknown variable *)
-    | EVAL_UNKNOWN_VARIABLE         of AST.variable
-
-    (* Unknown store location *)
-    | EVAL_UNKNOWN_STORE_LOCATION   of Store.location
-
-    (* Input/output error *)
-    | EVAL_IO_ERROR
-
-    (* Abnormal termination, e.g. abort command, resource exhousted... *)
-    | EVAL_ABNORMAL_TERMINATION     of string
-
-    (* UNCAUGHT exception *)
-    | EVAL_UNCAUGHT_EXCEPTION      of AST.identifier * (string option)
-
-    | EVAL_UNSPECIFIC               of string
-
-exception Eval_error of eval_error_reason
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-let eval_error reason = raise (Eval_error reason)
-
-let invalid_operation msg =  eval_error (EVAL_INVALID_OPERATION msg)
-
-let unknown_variable variable = eval_error (EVAL_UNKNOWN_VARIABLE variable)
-
-let unknown_store_location location = eval_error (EVAL_UNKNOWN_STORE_LOCATION location)
-
-let io_error () = eval_error (EVAL_IO_ERROR)
-
-let unspecific_error msg = eval_error (EVAL_UNSPECIFIC msg)
-
-let abnormal_termination msg = eval_error (EVAL_ABNORMAL_TERMINATION msg)
-
-let uncaught_excepion exnid msg = eval_error (EVAL_UNCAUGHT_EXCEPTION (exnid, msg))
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-let string_of_eval_error_reason = function
-    | EVAL_INVALID_OPERATION (msg) -> String.concat " "
-        [ "invalid operation:"
-        ; msg
-        ]
-
-    | EVAL_UNKNOWN_VARIABLE (variable) -> String.concat " "
-        [ "unknown variable:"
-        ; AST.string_of_variable variable
-        ]
-
-    | EVAL_UNKNOWN_STORE_LOCATION (location) -> String.concat " "
-        [ "unknown store location:"
-        ; "@LOC"
-        ]
-
-    | EVAL_IO_ERROR -> String.concat " "
-        [ "input/output error"
-        ]
-
-    | EVAL_UNSPECIFIC msg -> String.concat " "
-        [ msg
-        ]
-
-    | EVAL_ABNORMAL_TERMINATION msg -> String.concat " "
-        [ "abnormal termination:"
-        ; msg
-        ]
-
-    | EVAL_UNCAUGHT_EXCEPTION (exnid, msg) -> String.concat " "
-        begin
-            [ "uncaught exception:"
-            ; AST.string_of_identifier exnid
-            ] @
-            begin
-                Option.map (List.make 1) msg
-                |> Option.default []
-            end
-        end
-

File source/Lang/Common/Formatter.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open AST
-open Batteries
-
-include StringPainter.Prioritized
-
-(*********************************************************************************************************************
- * String painters for AST
- ********************************************************************************************************************)
-
-let psp_identifier = psp_word % string_of_identifier
-let psp_ast_label  = psp_label % string_of_label
-let psp_variable   = psp_word % string_of_variable
-
-let psp_arithmetic_binary_operator = psp_operator % string_of_arithmetic_binary_operator
-let psp_arithmetic_unary_operator = psp_operator % string_of_arithmetic_unary_operator
-let psp_boolean_binary_operator = psp_operator % string_of_boolean_binary_operator
-let psp_boolean_unary_operator = psp_operator % string_of_boolean_unary_operator
-let psp_boolean_arithmetic_binary_operator = psp_operator % string_of_boolean_arithmetic_binary_operator
-

File source/Lang/Common/ParseError.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-type position = (int * int * string)
-
-type parse_error_reason
-    = PARSER_INVALID_TOKEN  of string * position
-    | PARSER_INVALID_SYNTAX of string * position
-    | PARSER_INVALID_SEMANTIC of string * position
-
-exception Parse_error of parse_error_reason
-
-(*********************************************************************************************************************
- * Helpers
- ********************************************************************************************************************)
-
-let position_from_lexpos lexpos  =
-    let linenum = lexpos.Lexing.pos_lnum in
-    let colnum  = lexpos.Lexing.pos_cnum - lexpos.Lexing.pos_bol + 1 in
-    (linenum, colnum, lexpos.Lexing.pos_fname)
-
-let position_and_token_from_lexbuf lexbuf =
-    let lexpos  = lexbuf.Lexing.lex_curr_p in
-    let position= position_from_lexpos lexpos in
-    let token   = Lexing.lexeme lexbuf in
-    (position, token)
-
-let position_from_lexbuf lexbuf =
-    fst (position_and_token_from_lexbuf lexbuf)
-
-let token_from_lexbuf lexbuf =
-    snd (position_and_token_from_lexbuf lexbuf)
-
-let string_of_position (linenum, colnum, filename) =
-    Printf.sprintf "%s:%i:%i" filename linenum colnum
-
-(*********************************************************************************************************************
- * Wrappers
- ********************************************************************************************************************)
-
-let parse_error reason = raise (Parse_error reason)
-
-let invalid_token token position =
-    parse_error (PARSER_INVALID_TOKEN (token, position))
-
-let invalid_token_on_lexbuf lexbuf =
-    let (position, token) = position_and_token_from_lexbuf lexbuf in
-    invalid_token token position
-
-let invalid_syntax message position =
-    parse_error (PARSER_INVALID_SYNTAX (message, position))
-
-let invalid_syntax_on_lexpos lexpos message =
-    let position = position_from_lexpos lexpos in
-    invalid_syntax message position
-
-let invalid_semantic message position =
-    parse_error (PARSER_INVALID_SEMANTIC (message, position))
-
-let invalid_semantic_on_lexpos lexpos message =
-    let position = position_from_lexpos lexpos in
-    invalid_semantic message position
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-let string_of_parse_error_reason = function
-    | PARSER_INVALID_TOKEN (token, position) ->
-        Printf.sprintf "%s: invalid token %s" 
-            (string_of_position position)
-            token
-
-    | PARSER_INVALID_SYNTAX (message, position) ->
-        Printf.sprintf "%s: syntax error: %s"
-            (string_of_position position)
-            message
-
-    | PARSER_INVALID_SEMANTIC (message, position) ->
-        Printf.sprintf "%s: %s"
-            (string_of_position position)
-            message

File source/Lang/Common/SourceLocationMap.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-open AST
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-type source_location_map = (label, ParseError.position) FrozenHashtbl.t
-
-type temporary_location_map = (label, ParseError.position) Hashtbl.t
-
-module type ParserPosition = sig
-
-    type parser_context
-
-    val get_parser_position : parser_context -> ParseError.position
-
-end
-
-module OcamlyaccParserPosition = struct
-
-    type parser_context = unit
-
-    let get_parser_position () = 
-        ParseError.position_from_lexpos (Parsing.symbol_start_pos ())
-
-end
-
-module Make(M : ParserPosition) = struct
-
-    let mgRef = ManagedRef.create ()
-
-    let init ()  = Hashtbl.create 513
-
-    let generate_label parser_context =
-        let label = get_new_label () in
-
-        let f hashtbl =
-            Hashtbl.replace hashtbl label (M.get_parser_position parser_context)
-            in
-
-        ManagedRef.Autoinit.update init f mgRef;
-        label
-
-    let release () =
-        FrozenHashtbl.freeze (ManagedRef.Autoinit.release init mgRef)
-
-end

File source/Lang/Common/Store.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open AST
-
-(*********************************************************************************************************************
- * Types
- ********************************************************************************************************************)
-
-type location = Location of int
-
-type 'value t = int ref * (location, 'value) Hashtbl.t * (variable, location) Hashtbl.t
-
-(*********************************************************************************************************************
- * Implementation
- ********************************************************************************************************************)
-
-let create () = (ref 0, Hashtbl.create 127, Hashtbl.create 127)
-
-let alloc_location (ref, _, _) = 
-    let loc = !ref in
-    ref := succ loc;
-    Location loc
-
-let release_location (_, hash_table, _) location =
-    Hashtbl.remove hash_table location
-
-let store_location (_, hash_table, _) location value =
-    Hashtbl.replace hash_table location value
-
-let fetch_location (_, hash_table, _) location =
-    Hashtbl.find hash_table location
-
-(*********************************************************************************************************************
- * Version for variable-driven store
- ********************************************************************************************************************)
-
-let map_variable ((_, _, vmap) as store) variable =
-    try
-        Hashtbl.find vmap variable 
-    with
-        Not_found ->
-            let fresh_location = alloc_location store in
-            Hashtbl.replace vmap variable fresh_location;
-            fresh_location
-
-let store_variable store variable value =
-    let loc = map_variable store variable in
-    store_location store loc value
-
-let fetch_variable store variable =
-    let loc = map_variable store variable in
-    fetch_location store loc
-
-(*********************************************************************************************************************
- * PrettyPrinter
- ********************************************************************************************************************)
-
-module PrettyPrinter = struct
-
-open Formatter;;
-
-let build_reverse_vmap vmap =
-    let rvmap = Hashtbl.create 127 in
-    Hashtbl.iter (fun k v -> Hashtbl.replace rvmap v k) vmap;
-    rvmap
-
-let paint_location (Location loc) = 
-    [ psp_special ("@L" ^ string_of_int loc) 
-    ]
-
-let paint_hash_table paint_value hash_table rvmap =
-    let handle_entry l v aux =
-        let variable = 
-            try
-                [ psp_syntax "("
-                ; psp_keyword "variable"
-                ; psp_variable (Hashtbl.find rvmap l)
-                ; psp_syntax ")"
-                ]
-            with 
-                Not_found ->
-                []
-            in
-        [ psp_group (paint_location l)
-        ; psp_group variable
-        ; psp_operator "="
-        ; psp_group (paint_value v)
-        ; psp_break
-        ] :: aux
-        in
-    List.concat (Hashtbl.fold handle_entry hash_table [])
-
-let paint_store paint_value (refc, hash_table, vmap) =
-    [ psp_keyword "fresh location"
-    ; psp_operator "="
-    ; psp_value_int (!refc)
-    ; psp_break
-    ; psp_keyword "memory"
-    ; psp_syntax ":"
-    ; psp_break
-    ; psp_group (paint_hash_table paint_value hash_table (build_reverse_vmap vmap) )
-    ]
-
-end

File source/Lang/Common/Store.mli

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-(*********************************************************************************************************************
- * Types
- ********************************************************************************************************************)
-
-type location 
-
-type 'a t
-
-(*********************************************************************************************************************
- * Interface
- ********************************************************************************************************************)
-
-val create : unit -> 'a t
-
-val alloc_location : 'a t -> location
-val store_location : 'a t -> location -> 'a -> unit
-val fetch_location : 'a t -> location -> 'a
-
-val store_variable : 'a t -> AST.variable -> 'a -> unit
-val fetch_variable : 'a t -> AST.variable -> 'a
-
-(*********************************************************************************************************************
- * PrettyPrinter
- ********************************************************************************************************************)
-
-module PrettyPrinter : sig
-    val paint_location : location -> Formatter.painter list
-    val paint_store : ('a -> Formatter.painter list) -> 'a t -> Formatter.painter list
-end

File source/Lang/Common/Wrap.mlpack

-ParserWrap
-EvalWrap
-TypeWrap

File source/Lang/Common/Wrap/EvalWrap.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-open EvalError
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-module type Signature = sig
-
-    include ParserWrap.Signature
-
-    type eval_result
-
-    type eval_extra_result
-
-    val eval : ast -> eval_result * eval_extra_result
-
-end
-
-
-module Make (M:Signature) = struct
-
-    module Parser = ParserWrap.Make(M)
-
-    let eval file =
-        try
-            let ast = Parser.parse file in
-            Log.debug "Evaluating %s" file;
-            M.eval ast
-        with Eval_error(error_reason) ->
-            Error.failed 
-                [ "evaluation failed:"
-                ; string_of_eval_error_reason error_reason
-                ]
-
-end

File source/Lang/Common/Wrap/ParserWrap.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-open ParseError
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-module type Signature = sig
-
-    type ast
-
-    val parse : Lexing.lexbuf -> ast
-end
-
-
-module Make (M:Signature) = struct
-
-    let alter_lexbuf path lexbuf = 
-        let alter_lexpos position =
-            {position with
-            Lexing.pos_fname = path
-            } in
-        lexbuf.Lexing.lex_start_p <- alter_lexpos lexbuf.Lexing.lex_start_p;
-        lexbuf.Lexing.lex_curr_p  <- alter_lexpos lexbuf.Lexing.lex_curr_p
-
-    let parse path =
-        try
-            Log.debug "Parsing %s" path;
-            let file   = open_in path in
-            let lexbuf = Lexing.from_channel file in
-            alter_lexbuf path lexbuf;
-            let ast    = M.parse lexbuf in
-            ast
-        with Parse_error(error_reason) ->
-            Error.failed
-                [ string_of_parse_error_reason error_reason
-                ]
-
-end

File source/Lang/Common/Wrap/TypeWrap.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-

File source/Lang/MiniML/AST.ml

  * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
  *)
 
-include Common.AST
+include Lang_Common.AST
 
 (*********************************************************************************************************************
  * Abstract Syntax Tree

File source/Lang/MiniML/Eval.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 
 (*********************************************************************************************************************
  * Value 
             Environment.get environment variable
         with
             Not_found ->
-                Common.EvalError.unknown_variable variable
+                Lang_Common.EvalError.unknown_variable variable
 
 
     let with_extended_environment context variable value continuation =

File source/Lang/MiniML/PrettyPrinter.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 open Formatter
 open Batteries
 

File source/Lang/MiniML/TypeChecker.ml

 
 open AST
 open PrettyPrinter
-open Common
+open Lang_Common
 open Environment
 open Batteries
 

File source/Lang/TAC/AST.ml

  * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
  *)
 
-include Common.AST
+include Lang_Common.AST
 
 (*********************************************************************************************************************
  * Abstract Syntax Tree

File source/Lang/TAC/Eval.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 
 (*********************************************************************************************************************
  * Value 

File source/Lang/TAC/Lexer.mll

 
 open Parser
 open Lexing
-open Common.ParseError
+open Lang_Common.ParseError
 
 let create_dictionary xs =
     let htable = Hashtbl.create 17 in

File source/Lang/TAC/Parser.mly

 
 
 let invalid_syntax message =
-    Common.ParseError.invalid_syntax_on_lexpos
+    Lang_Common.ParseError.invalid_syntax_on_lexpos
         (Parsing.symbol_start_pos ())
         message 
 
 let invalid_semantic message =
-    Common.ParseError.invalid_semantic_on_lexpos
+    Lang_Common.ParseError.invalid_semantic_on_lexpos
         (Parsing.symbol_start_pos ())
         message 
 
  * Location map.
  *)
 
-module SrcLocMapBuilder = Common.SourceLocationMap.Make(Common.SourceLocationMap.OcamlyaccParserPosition)
+module SrcLocMapBuilder = Lang_Common.SourceLocationMap.Make(Lang_Common.SourceLocationMap.OcamlyaccParserPosition)
 
 let get_new_label () = 
     SrcLocMapBuilder.generate_label ()

File source/Lang/TAC/PrettyPrinter.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 open Formatter
 open Batteries
 open Formatter

File source/Lang/While/AST.ml

  * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
  *)
 
-include Common.AST
+include Lang_Common.AST
 
 (*********************************************************************************************************************
  * Abstract Syntax Tree

File source/Lang/While/Eval.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 
 (*********************************************************************************************************************
  * Value 

File source/Lang/While/PrettyPrinter.ml

  *)
 
 open AST
-open Common
+open Lang_Common
 open Formatter
 open Batteries
 open Formatter

File source/Lang_Common.mlpack

+AST
+Enumerators
+Environment
+Formatter
+Store
+EvalError
+ParseError
+Wrap
+SourceLocationMap

File source/Lang_Common/AST.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 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
+
+(*********************************************************************************************************************
+ * map
+ ********************************************************************************************************************)
+
+let identifier_fold f (Identifier s) = f s
+
+let variable_fold f (Variable i) = f i
+
+
+(*********************************************************************************************************************
+ * string_of
+ ********************************************************************************************************************)
+
+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 identifier_of_variable (Variable id) = 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 -> "-"
+
+(*********************************************************************************************************************
+ * priority_of
+ ********************************************************************************************************************)
+
+let priority_of_boolean_binary_operator a (b : boolean_binary_operator) =  a < b
+
+(*********************************************************************************************************************
+ * make_
+ ********************************************************************************************************************)
+
+let make_identifier s = Identifier s
+
+let make_label l = Label l
+
+let make_variable s = Variable (make_identifier s)
+
+
+(*********************************************************************************************************************
+ * Label counter (move to somewhere else)
+ * TODO: use label_enumerator
+ ********************************************************************************************************************)
+
+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
+
+(*********************************************************************************************************************
+ * Prepared modules
+ ********************************************************************************************************************)
+
+module VariableSet = Util.ExtSet(Set.Make(VariableOrderedType))
+module VariableMap = Util.ExtMap(Map.Make(VariableOrderedType))

File source/Lang_Common/Enumerators.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open Batteries
+open AST
+
+(*********************************************************************************************************************
+ * Internal
+ ********************************************************************************************************************)
+
+let base_sequence start = 
+    Enum.seq start succ (not % (=) max_int) 
+
+let base_prefixed_sequence prefix start = 
+    base_sequence start
+    |> Enum.map (fun n -> prefix ^ string_of_int n)
+
+(*********************************************************************************************************************
+ * Public
+ ********************************************************************************************************************)
+
+module LabelEnumerator = struct
+
+    type t = label BatEnum.t
+
+    let make start =
+        base_sequence start
+        |> Enum.map (fun x -> Label x)
+
+    let get_next t =
+        match Enum.get t with
+        | None   -> failwith "Impossible, the label enumerator exhausted?"
+        | Some x -> x
+
+end
+
+(*********************************************************************************************************************
+ * VariableEnumerator
+ ********************************************************************************************************************)
+
+module VariableEnumerator = struct
+
+    type t = string BatEnum.t
+
+    let make ?(prefix = "_v") start = 
+        base_prefixed_sequence prefix start
+
+    let get_next ?suffix t = 
+        match Enum.get t with
+        | None   -> failwith "Impossible, the variable enumerator exhausted?"
+        | Some x -> match suffix with
+            | Some str ->
+                make_variable (x ^ "_" ^ str)
+            | _ ->
+                make_variable x
+
+end
+
+(*********************************************************************************************************************
+ * Public
+ ********************************************************************************************************************)
+
+module VariableScanner = struct
+
+    type t = string * int ref
+
+    let make_variable_scanner ?(prefix = "_v") start : t =
+        (prefix, ref start)
+
+    let update (prefix, start) (Variable (Identifier name)) = 
+        if String.starts_with name prefix
+        then
+            try
+                let rest = String.lchop ~n:(String.length prefix) name in
+                start   := succ (String.to_int rest)
+            with
+                _ -> ()
+        else 
+            incr start
+
+    let to_enumerator (prefix, start) =
+        VariableEnumerator.make ~prefix:prefix !start
+
+end
+
+(*********************************************************************************************************************
+ * Aggregation
+ ********************************************************************************************************************)
+
+type enumerators =
+    { variable_enumerator : VariableEnumerator.t
+    ; label_enumerator    : LabelEnumerator.t
+    }
+

File source/Lang_Common/Enumerators.mli

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+(*********************************************************************************************************************
+ * Label enumerator interface
+ ********************************************************************************************************************)
+
+module LabelEnumerator : sig
+
+    type t
+
+    val make: int -> t
+
+    val get_next: t -> AST.label
+
+end
+
+(*********************************************************************************************************************
+ * Variable enumerator interface
+ ********************************************************************************************************************)
+
+module VariableEnumerator : sig
+    
+    type t
+
+    val make: ?prefix:string -> int -> t
+
+    val get_next: ?suffix:string -> t -> AST.variable
+
+end
+
+(*********************************************************************************************************************
+ * Scanner
+ ********************************************************************************************************************)
+
+module VariableScanner : sig
+
+    type t
+
+    val make_variable_scanner : ?prefix:string -> int -> t
+
+    val update : t -> AST.variable -> unit
+
+    val to_enumerator : t -> VariableEnumerator.t
+
+end
+
+(*********************************************************************************************************************
+ * Aggregation
+ ********************************************************************************************************************)
+
+type enumerators =
+    { variable_enumerator : VariableEnumerator.t
+    ; label_enumerator    : LabelEnumerator.t 
+    }
+

File source/Lang_Common/Environment.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open AST
+open Batteries
+
+(*********************************************************************************************************************
+ * Types
+ ********************************************************************************************************************)
+
+type 'value t = int ref * (variable, int * 'value) Hashtbl.t
+
+(*********************************************************************************************************************
+ * Exceptions
+ ********************************************************************************************************************)
+
+exception Unknown_variable of variable
+
+(*********************************************************************************************************************
+ * Public
+ ********************************************************************************************************************)
+
+let create () = (ref 0, Hashtbl.create 513)
+
+let clone (timestamp, hashtable) = (timestamp, Hashtbl.copy hashtable)
+
+let put (timestamp, hashtable) variable value =
+    Hashtbl.replace hashtable variable (!timestamp, value);
+    timestamp := !timestamp + 1
+
+let get (_, hashtable) variable =
+    try
+        snd (Hashtbl.find hashtable variable )
+    with
+        Not_found ->
+            raise (Unknown_variable variable)
+
+let with_extended_environment (timestamp, hashtable) variable value cont =
+    Hashtbl.add hashtable variable (!timestamp, value);
+    let r = cont () in
+    Hashtbl.remove hashtable variable;
+    r
+
+let rec with_extended_environment_m context _xs continuation =
+    let rec aux = function
+        | [] ->
+            continuation ()
+
+        | (name, value)::xs ->
+            let cont () = with_extended_environment_m context xs continuation in
+            with_extended_environment context name value cont
+
+        in
+    aux _xs
+
+let get_list (_, hashtable) = 
+    let result = Util.list_of_hashtbl hashtable in
+    let compare_vals a b = compare (snd a) (snd b) in
+    let cut (variable, value) = (variable, snd value) in
+    List.map cut (List.sort compare_vals result)
+
+let map f (_, hashtable) = 
+    let handle_def k (t, v) = 
+        Hashtbl.replace hashtable k (t, (f k v))
+        in
+
+    Hashtbl.iter handle_def hashtable
+
+(*********************************************************************************************************************
+ * PrettyPrinter
+ ********************************************************************************************************************)
+
+module PrettyPrinter = struct
+
+open Formatter
+
+
+let paint_environment _paint_value update pcxt env = 
+    let handle aux (k, v) = 
+        [ psp_value "val"
+        ; psp_variable k
+        ; psp_operator "="
+        ; psp_group (_paint_value (update pcxt k) v)
+        ; psp_break
+        ; psp_newline
+        ] :: aux
+        in
+        match (List.fold_left handle [] (get_list env)) with
+            | [] ->
+                []
+
+            | output ->
+                [ psp_value_keyword "environment"
+                ; psp_indent_group ((List.concat % List.rev) output)
+                ; psp_value_keyword "end"
+                ]
+
+end

File source/Lang_Common/Environment.mli

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open AST
+
+(*********************************************************************************************************************
+ * Types
+ ********************************************************************************************************************)
+
+type 'value t
+
+(*********************************************************************************************************************
+ * Exceptions
+ ********************************************************************************************************************)
+
+exception Unknown_variable of variable
+
+(*********************************************************************************************************************
+ * Interface
+ ********************************************************************************************************************)
+
+val create : unit -> 'value t
+
+val clone : 'value t -> 'value t
+
+val put : 'value t -> variable -> 'value -> unit
+
+val get : 'value t -> variable -> 'value
+
+val with_extended_environment : 'value t -> variable -> 'value -> (unit -> 'a) -> 'a
+
+val with_extended_environment_m  : 'value t -> (variable * 'value) list -> (unit -> 'a) -> 'a
+
+val get_list : 'value t -> (variable * 'value) list
+
+val map : (variable -> 'value -> 'value) -> 'value t -> unit
+
+(*********************************************************************************************************************
+ * PrettyPrinter
+ ********************************************************************************************************************)
+
+module PrettyPrinter : sig
+    open Formatter
+
+    val paint_environment : ('ncxt -> 'value -> painter list) 
+                        -> ('pcxt -> variable -> 'ncxt)
+                        -> 'pcxt -> 'value t -> painter list
+
+end

File source/Lang_Common/EvalError.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open Batteries
+
+(*********************************************************************************************************************
+ *
+ ********************************************************************************************************************)
+
+type eval_error_reason
+    (* Invalid operation, e.g. applying integer to something, division by zero... *)
+    = EVAL_INVALID_OPERATION        of string
+
+    (* Unknown variable *)
+    | EVAL_UNKNOWN_VARIABLE         of AST.variable
+
+    (* Unknown store location *)
+    | EVAL_UNKNOWN_STORE_LOCATION   of Store.location
+
+    (* Input/output error *)
+    | EVAL_IO_ERROR
+
+    (* Abnormal termination, e.g. abort command, resource exhousted... *)
+    | EVAL_ABNORMAL_TERMINATION     of string
+
+    (* UNCAUGHT exception *)
+    | EVAL_UNCAUGHT_EXCEPTION      of AST.identifier * (string option)