new files

Author: Ioana

ast.ml

@@ -0,0 +1,56 @@
+type ('a) link =
+  | LNK_VALUE of int
+  | FREE
+  | LNK_ANY
+  | LNK_SOME
+  | LNK_TYPE of 'a (* port *)
+    * 'a (*agent_type*)
+
+type internal = string list
+
+type port = {port_nme:string;
+             port_int:internal;
+             port_lnk:string link list;}
+
+type agent = (string * port list)
+
+type mixture = agent list
+
+type rule = {
+  lhs: mixture ;
+  bidirectional:bool ;
+  rhs: mixture ;
+}
+type t = INIT of mixture
+       | OBS of string*mixture
+       | RULE of string*rule
+
+let print_link = function
+  | LNK_VALUE i -> Format.printf "!%d" i
+  | FREE -> ()
+  | LNK_ANY -> Format.printf "!_"
+  | LNK_SOME -> Format.printf "!_"
+  | LNK_TYPE (i,a) -> Format.printf "!%s.%s" i a
+
+let print_port p =
+  Format.printf "%s~[" p.port_nme;
+  List.iter (fun intern -> Format.printf "%s " intern;) p.port_int;
+  Format.printf "]";
+  List.iter (fun p -> print_link p) p.port_lnk
+
+let print_agent (name,plist) =
+  Format.printf "%s(" name;
+  List.iter (fun p -> print_port p) plist;
+  Format.printf ") "
+
+let print_rule r =
+  List.iter (fun a -> print_agent a) r.lhs;
+  if (r.bidirectional) then Format.printf " <-> "
+  else Format.printf " -> ";
+  List.iter (fun a -> print_agent a) r.rhs
+
+let print = function
+  | INIT mix -> Format.printf "\n init "; List.iter (fun a -> print_agent a) mix
+  | OBS (name,mix) -> Format.printf "\n obs '%s' " name;
+                      List.iter (fun a -> print_agent a) mix
+  | RULE (name,r) -> Format.printf "\n rule '%s' " name; print_rule r;

ast.mli

@@ -0,0 +1,27 @@
+type ('a) link =
+  | LNK_VALUE of int
+  | FREE
+  | LNK_ANY
+  | LNK_SOME
+  | LNK_TYPE of 'a (* port *)
+    * 'a (*agent_type*)
+
+type internal = string list
+
+type port = {port_nme:string;
+             port_int:internal;
+             port_lnk:string link list;}
+
+type agent = (string * port list)
+
+type mixture = agent list
+
+type rule = {
+  lhs: mixture ;
+  bidirectional:bool ;
+  rhs: mixture ;
+}
+type t = INIT of mixture
+       | OBS of string*mixture
+       | RULE of string*rule
+val print : t -> unit

concret.ml

@@ -0,0 +1,14 @@
+
+let decorate s = [s]
+
+let linears s =
+  LinearPoset.linearisations(s)
+
+let refine (t:Trace.t) (r: (Event.t*Transition.t) list) s id = [Trace.empty]
+
+let concretise (s:LinearPoset.t) id concretisations1 =
+  List.fold_left
+    (fun concretisations2
+         (t,r) -> refine t r s id) [] concretisations1
+
+let concret (s:Poset.t) = concretise (linears s) 0 []

concret.mli

@@ -0,0 +1,2 @@
+
+val concret : Poset.t -> Trace.t list

grammar/lexerRule.mll

@@ -0,0 +1,55 @@
+{
+open ParserRule(* The type token is defined in parser.mli *)
+open Lexing
+exception Eof
+
+let reach_eof lexbuf =
+    lexbuf.lex_eof_reached <- true
+}
+
+let eol = '\r'? '\n'
+let blank = [' ' '\t']
+let integer = '-'? (['0'-'9']+)
+let real =
+  '-'?
+     ((((['0'-'9']+ ('.' ['0'-'9']*)?) | ('.' ['0'-'9']+))
+	['e' 'E'] ['+' '-']? ['0'-'9']+)
+  | ((['0'-'9']+ '.' ['0'-'9']* ) | (['0'-'9']* '.' ['0'-'9']+)))
+let id = (['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' '+']* )
+let internal_state = '~' (['0'-'9' 'a'-'z' 'A'-'Z' '_' '-' '+']+)
+
+
+rule token = parse
+	 | '\\' blank* eol {Lexing.new_line lexbuf ; token lexbuf}
+	 | "<->" {KAPPA_LRAR}
+	 | "->" {KAPPA_RAR}
+	 | "<-" {LAR}
+	 | eol {Lexing.new_line lexbuf ; NEWLINE}
+	 | integer as n {try INT (int_of_string n)
+	   	         with Failure _ -> raise (ExceptionDefn.Syntax_Error
+	 		 (n^" is a incorrect integer"))}
+	 | real as f {FLOAT (float_of_string f)}
+	 | '\'' ([^'\n''\'']+ as x) '\''{LABEL(x)}
+	 | id as str {ID str}
+	 | '@' {AT}
+	 | ',' {COMMA}
+	 | '(' {OP_PAR}
+	 | ')' {CL_PAR}
+	 | '.' {DOT}
+	 | '|' {PIPE}
+	 | '%' (id as lab) ':' {
+		match lab with
+		| "init" -> INIT
+		| "obs" -> OBS
+		| _ as s ->
+		    raise (ExceptionDefn.Syntax_Error("invalid use of %"))}
+	 | '!' {KAPPA_LNK}
+	 | internal_state as s {let i = String.index s '~' in
+				let r = String.sub s (i+1) (String.length s-i-1) in
+				KAPPA_MRK r
+			       }
+	 | '?' {KAPPA_WLD}
+	 | '_' {KAPPA_SEMI}
+	 | blank  {token lexbuf}
+	 | eof {raise Eof}
+  	 | _ {raise (ExceptionDefn.Syntax_Error("invalid use of character "))}

grammar/parserRule.mly

@@ -0,0 +1,104 @@
+%token EOF NEWLINE SEMICOLON COMMA DOT OP_PAR CL_PAR OP_CUR CL_CUR AT TYPE LAR
+%token GREATER SMALLER TRUE FALSE DIFF KAPPA_RAR KAPPA_LRAR KAPPA_LNK PIPE
+%token INIT OBS KAPPA_WLD KAPPA_SEMI
+%token <int> INT
+%token <string> ID
+%token <string> KAPPA_MRK LABEL
+%token <float> FLOAT
+%token <string> STRING
+%start newline
+%type <Ast.t> newline
+%%
+
+newline:
+    | start_rule NEWLINE {$1}
+;
+
+start_rule:
+    | rule_expression {$1}
+    | instruction {$1}
+    | error
+	{raise (ExceptionDefn.Syntax_Error("start_rule"))}
+    ;
+
+rule_expression:
+    | rule_label lhs_rhs arrow lhs_rhs
+		 { Ast.RULE ($1,({Ast.lhs=$2; Ast.bidirectional=$3;
+			    Ast.rhs=$4;}))}
+    ;
+
+arrow:
+    | KAPPA_RAR {false}
+    | KAPPA_LRAR {true}
+    ;
+
+rule_label:
+    | LABEL {$1}
+    ;
+
+instruction:
+    | INIT init_declaration {$2}
+    | INIT error
+	{ raise (ExceptionDefn.Syntax_Error("Malformed initial condition"))}
+    | OBS variable_declaration {$2}
+    ;
+
+variable_declaration:
+    | LABEL non_empty_mixture {Ast.OBS ($1,$2)}
+;
+
+init_declaration:
+    | non_empty_mixture {(Ast.INIT $1)}
+    ;
+
+lhs_rhs:
+  mixture {$1};
+
+mixture:
+      /*empty*/ {[]}
+    | non_empty_mixture {$1}
+;
+
+non_empty_mixture:
+    | OP_PAR non_empty_mixture CL_PAR {$2}
+    | agent_expression COMMA non_empty_mixture {$1 :: $3}
+    | agent_expression {[$1]}
+    ;
+
+agent_expression:
+    | ID OP_PAR interface_expression CL_PAR {($1,$3)}
+    | ID error
+	 { raise (ExceptionDefn.Syntax_Error("Malformed agent '"^$1^"'"))}
+    ;
+
+interface_expression:
+  /*empty*/ {[]}
+    | ne_interface_expression {$1}
+    ;
+
+ne_interface_expression:
+    | port_expression COMMA ne_interface_expression {$1::$3}
+    | port_expression {[$1]}
+    ;
+
+port_expression:
+    | ID internal_state link_state
+	 {{Ast.port_nme=$1; Ast.port_int=$2; Ast.port_lnk=$3}}
+    ;
+
+internal_state:
+     /*empty*/ {[]}
+    | KAPPA_MRK internal_state {$1::$2}
+    | error
+	{raise (ExceptionDefn.Syntax_Error ("Invalid internal state"))}
+    ;
+
+link_state:
+    /*empty*/ {[]}
+    | KAPPA_LNK INT link_state {(Ast.LNK_VALUE $2)::$3}
+    | KAPPA_LNK KAPPA_SEMI link_state {(Ast.LNK_SOME)::$3}
+    | KAPPA_LNK ID DOT ID link_state {(Ast.LNK_TYPE($2,$4))::$5}
+    | KAPPA_WLD link_state {(Ast.LNK_ANY)::$2}
+    | KAPPA_LNK error
+	{raise (ExceptionDefn.Syntax_Error("Invalid link state"))}
+;

rule.ml

@@ -0,0 +1,13 @@
+
+type kt = INIT of Site_graph.t
+        | OBS of string*Site_graph.t
+        | RULE of string*Site_graph.t*Site_graph.t
+
+type t = {
+    left : Site_graph.t;
+    right : Site_graph.t;
+    middle : Site_graph.t;
+    id : int;
+  }
+
+let print rule = Format.printf "\n"

rule.mli

@@ -0,0 +1,8 @@
+
+type t = {
+    left : Site_graph.t;
+    right : Site_graph.t;
+    middle : Site_graph.t;
+    id : int;
+  }
+ val print : t -> unit

trace.ml

@@ -0,0 +1,6 @@
+
+type t = {
+    transitions : Transition.t list;
+  }
+
+let empty = {transitions = [];}

trace.mli

@@ -0,0 +1,6 @@
+
+type t = {
+    transitions : Transition.t list;
+  }
+
+val empty: t