ocamltest: make it possible to declare variables in the DSL
parent
79d3f77433
commit
f2e0ae8a17
|
@ -21,7 +21,7 @@ type 'a located = {
|
||||||
}
|
}
|
||||||
|
|
||||||
type environment_statement =
|
type environment_statement =
|
||||||
| Assignment of string located * string located (* variable = value *)
|
| Assignment of bool * string located * string located (* variable = value *)
|
||||||
| Append of string located * string located
|
| Append of string located * string located
|
||||||
| Include of string located (* include named environemnt *)
|
| Include of string located (* include named environemnt *)
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,7 @@ type 'a located = {
|
||||||
}
|
}
|
||||||
|
|
||||||
type environment_statement =
|
type environment_statement =
|
||||||
| Assignment of string located * string located (* variable = value *)
|
| Assignment of bool * string located * string located (* variable = value *)
|
||||||
| Append of string located * string located (* variable += value *)
|
| Append of string located * string located (* variable += value *)
|
||||||
| Include of string located (* include named environemnt *)
|
| Include of string located (* include named environemnt *)
|
||||||
|
|
||||||
|
|
|
@ -45,6 +45,7 @@ rule token = parse
|
||||||
{ let s = Lexing.lexeme lexbuf in
|
{ let s = Lexing.lexeme lexbuf in
|
||||||
match s with
|
match s with
|
||||||
| "include" -> INCLUDE
|
| "include" -> INCLUDE
|
||||||
|
| "set" -> SET
|
||||||
| "with" -> WITH
|
| "with" -> WITH
|
||||||
| _ -> IDENTIFIER s
|
| _ -> IDENTIFIER s
|
||||||
}
|
}
|
||||||
|
|
|
@ -37,7 +37,7 @@ let mkenvstmt envstmt =
|
||||||
%token <int> TEST_DEPTH
|
%token <int> TEST_DEPTH
|
||||||
%token EQUAL PLUSEQUAL
|
%token EQUAL PLUSEQUAL
|
||||||
/* %token COLON */
|
/* %token COLON */
|
||||||
%token INCLUDE WITH
|
%token INCLUDE SET WITH
|
||||||
%token <string> IDENTIFIER
|
%token <string> IDENTIFIER
|
||||||
%token <string> STRING
|
%token <string> STRING
|
||||||
|
|
||||||
|
@ -71,9 +71,12 @@ opt_environment_modifiers:
|
||||||
|
|
||||||
env_item:
|
env_item:
|
||||||
| identifier EQUAL string
|
| identifier EQUAL string
|
||||||
{ mkenvstmt (Assignment ($1, $3)) }
|
{ mkenvstmt (Assignment (false, $1, $3)) }
|
||||||
| identifier PLUSEQUAL string
|
| identifier PLUSEQUAL string
|
||||||
{ mkenvstmt (Append ($1, $3)) }
|
{ mkenvstmt (Append ($1, $3)) }
|
||||||
|
| SET identifier EQUAL string
|
||||||
|
{ mkenvstmt (Assignment (true, $2, $4)) }
|
||||||
|
|
||||||
| INCLUDE identifier
|
| INCLUDE identifier
|
||||||
{ mkenvstmt (Include $2) }
|
{ mkenvstmt (Include $2) }
|
||||||
|
|
||||||
|
|
|
@ -41,7 +41,20 @@ let apply_modifiers env modifiers_name =
|
||||||
| Environments.Modifiers_name_not_found name ->
|
| Environments.Modifiers_name_not_found name ->
|
||||||
no_such_modifiers modifiers_name.loc name
|
no_such_modifiers modifiers_name.loc name
|
||||||
|
|
||||||
let add_or_append f loc variable_name value env =
|
let rec add_to_env decl loc variable_name value env =
|
||||||
|
match (Variables.find_variable variable_name, decl) with
|
||||||
|
| (None, true) ->
|
||||||
|
let newvar = Variables.make (variable_name,"User variable") in
|
||||||
|
Variables.register_variable newvar;
|
||||||
|
add_to_env false loc variable_name value env
|
||||||
|
| (Some variable, false) ->
|
||||||
|
Environments.add variable value env
|
||||||
|
| (None, false) ->
|
||||||
|
raise (Variables.No_such_variable variable_name)
|
||||||
|
| (Some _, true) ->
|
||||||
|
raise (Variables.Variable_already_registered variable_name)
|
||||||
|
|
||||||
|
let append_to_env loc variable_name value env =
|
||||||
let variable =
|
let variable =
|
||||||
match Variables.find_variable variable_name with
|
match Variables.find_variable variable_name with
|
||||||
| None ->
|
| None ->
|
||||||
|
@ -50,15 +63,15 @@ let add_or_append f loc variable_name value env =
|
||||||
variable
|
variable
|
||||||
in
|
in
|
||||||
try
|
try
|
||||||
f variable value env
|
Environments.append variable value env
|
||||||
with Variables.No_such_variable name ->
|
with Variables.No_such_variable name ->
|
||||||
no_such_variable loc name
|
no_such_variable loc name
|
||||||
|
|
||||||
let interprete_environment_statement env statement = match statement.node with
|
let interprete_environment_statement env statement = match statement.node with
|
||||||
| Assignment (var, value) ->
|
| Assignment (decl, var, value) ->
|
||||||
add_or_append Environments.add statement.loc var.node value.node env
|
add_to_env decl statement.loc var.node value.node env
|
||||||
| Append (var, value) ->
|
| Append (var, value) ->
|
||||||
add_or_append Environments.append statement.loc var.node value.node env
|
append_to_env statement.loc var.node value.node env
|
||||||
| Include modifiers_name ->
|
| Include modifiers_name ->
|
||||||
apply_modifiers env modifiers_name
|
apply_modifiers env modifiers_name
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,7 @@ let compare v1 v2 = String.compare v1.variable_name v2.variable_name
|
||||||
|
|
||||||
exception Empty_variable_name
|
exception Empty_variable_name
|
||||||
|
|
||||||
exception Variable_already_registered
|
exception Variable_already_registered of string
|
||||||
|
|
||||||
exception No_such_variable of string
|
exception No_such_variable of string
|
||||||
|
|
||||||
|
@ -57,7 +57,7 @@ let (variables : (string, t) Hashtbl.t) = Hashtbl.create 10
|
||||||
|
|
||||||
let register_variable variable =
|
let register_variable variable =
|
||||||
if Hashtbl.mem variables variable.variable_name
|
if Hashtbl.mem variables variable.variable_name
|
||||||
then raise Variable_already_registered
|
then raise (Variable_already_registered variable.variable_name)
|
||||||
else Hashtbl.add variables variable.variable_name variable
|
else Hashtbl.add variables variable.variable_name variable
|
||||||
|
|
||||||
let find_variable variable_name =
|
let find_variable variable_name =
|
||||||
|
|
|
@ -25,7 +25,7 @@ val compare : t -> t -> int
|
||||||
|
|
||||||
exception Empty_variable_name
|
exception Empty_variable_name
|
||||||
|
|
||||||
exception Variable_already_registered
|
exception Variable_already_registered of string
|
||||||
|
|
||||||
exception No_such_variable of string
|
exception No_such_variable of string
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue