Page MenuHomeHEPForge
Files F7877534

No OneTemporary
Actions

View Options

Index: trunk/src/omega/src/model_parser.mly
===================================================================
--- trunk/src/omega/src/model_parser.mly (revision 4104)
+++ trunk/src/omega/src/model_parser.mly (revision 4105)
@@ -1,102 +0,0 @@
-/* $Id$
-
- Copyright (C) 1999-2013 by
-
- Wolfgang Kilian <kilian@physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@desy.de>
- Christian Speckner <cnspeckn@googlemail.com>
-
- WHIZARD is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- WHIZARD is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
-
-%{
-let parse_error msg =
- raise (Model_syntax.Syntax_Error (msg, symbol_start (), symbol_end ()))
-%}
-
-%token < string > STRING EXPR
-%token PARTICLE COUPLING VERTEX
-%token AUTHOR VERSION CREATED REVISED
-%token COMMA EQUAL COLON
-%token END
-
-%start file
-%type < Model_syntax.file > file
-
-%%
-
-file:
- declarations END { $1 }
-;
-
-declarations:
- { Model_syntax.empty () }
- | declarations particle_declaration
- { Model_syntax.add_particle $2 $1 }
- | declarations vertex_declaration
- { Model_syntax.add_vertex $2 $1 }
- | declarations coupling_declaration
- { Model_syntax.add_coupling $2 $1 }
- | declarations AUTHOR EXPR { Model_syntax.add_author $3 $1 }
- | declarations VERSION EXPR { Model_syntax.add_version $3 $1 }
- | declarations CREATED EXPR { Model_syntax.add_created $3 $1 }
- | declarations REVISED EXPR { Model_syntax.add_revised $3 $1 }
-;
-
-particle_declaration:
- PARTICLE STRING attrib_list
- { Model_syntax.neutral $2 $3 }
- | PARTICLE STRING opt_comma STRING attrib_list
- { Model_syntax.charged $2 $4 $5 }
-;
-
-attrib_list:
- { List.rev [] }
- | COLON { List.rev [] }
- | COLON rev_attrib_list { List.rev $2 }
-
-rev_attrib_list:
- attrib { [$1] }
- | rev_attrib_list opt_comma attrib
- { $3 :: $1 }
-;
-
-attrib:
- STRING { ($1, "true") }
- | STRING EQUAL STRING { ($1, $3) }
-;
-
-coupling_declaration:
- COUPLING STRING { Model_syntax.coupling $2 }
-;
-
-vertex_declaration:
- VERTEX particle_list COLON EXPR
- { Model_syntax.vertex $2 $4 }
-;
-
-particle_list:
- rev_particle_list { List.rev $1 }
-
-rev_particle_list:
- STRING { [$1] }
- | rev_particle_list opt_comma STRING
- { $3 :: $1 }
-;
-
-opt_comma:
- { () }
- | COMMA { () }
-;
Index: trunk/src/omega/src/model_lexer.mll
===================================================================
--- trunk/src/omega/src/model_lexer.mll (revision 4104)
+++ trunk/src/omega/src/model_lexer.mll (revision 4105)
@@ -1,59 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2013 by
-
- Wolfgang Kilian <kilian@physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@desy.de>
- Christian Speckner <cnspeckn@googlemail.com>
-
- WHIZARD is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- WHIZARD is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
-
-{
-open Model_parser
-let unquote s =
- String.sub s 1 (String.length s - 2)
-}
-
-let digit = ['0'-'9']
-let upper = ['A'-'Z']
-let lower = ['a'-'z']
-let char = upper | lower
-let white = [' ' '\t' '\n']
-
-(* We use a very liberal definition of strings in order to avoid
- the need for quotes in the declaration section. *)
-rule token = parse
- white { token lexbuf } (* skip blanks *)
- | '%' [^'\n']* '\n'
- { token lexbuf } (* skip comments *)
- | "particle" { PARTICLE }
- | "coupling" { COUPLING }
- | "vertex" { VERTEX }
- | "author" { AUTHOR }
- | "version" { VERSION }
- | "created" { CREATED }
- | "revised" { REVISED }
- | ',' { COMMA }
- | '=' { EQUAL }
- | ':' { COLON }
- | [^ ' ' '\t' '\n' ',' '=' ':' '{' '}']+
- { STRING (Lexing.lexeme lexbuf) }
- | '"' [^ '"']* '"'
- { STRING (unquote (Lexing.lexeme lexbuf)) }
- | '{' [^ '}']* '}'
- { EXPR (unquote (Lexing.lexeme lexbuf)) }
- | '}' { failwith "unexpected `}' outside of expression" }
- | eof { END }
Index: trunk/src/omega/src/model_syntax.mli
===================================================================
--- trunk/src/omega/src/model_syntax.mli (revision 4104)
+++ trunk/src/omega/src/model_syntax.mli (revision 4105)
@@ -1,68 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2013 by
-
- Wolfgang Kilian <kilian@physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@desy.de>
- Christian Speckner <cnspeckn@googlemail.com>
-
- WHIZARD is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- WHIZARD is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
-
-(* This is not supposed to be an abstract data type, just the skeleton that
- the parser is based on. *)
-
-type name =
- | Charged of string * string
- | Neutral of string
-
-type particle = { name : name; attribs : (string * string) list }
-val charged : string -> string -> (string * string) list -> particle
-val neutral : string -> (string * string) list -> particle
-
-type vertex = { fields : string list; expr : Vertex_syntax.scalar }
-val vertex : string list -> string -> vertex
-
-type coupling = string
-val coupling : string -> coupling
-
-type file =
- { particles : particle list;
- couplings : coupling list;
- vertices : vertex list;
- authors : string list;
- version : string list;
- created : string list;
- revised : string list }
-
-val empty : unit -> file
-val add_particle : particle -> file -> file
-val add_coupling : string -> file -> file
-val add_vertex : vertex -> file -> file
-val add_author : string -> file -> file
-val add_version : string -> file -> file
-val add_created : string -> file -> file
-val add_revised : string -> file -> file
-
-exception Syntax_Error of string * int * int
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
-
Index: trunk/src/omega/src/model_syntax.ml
===================================================================
--- trunk/src/omega/src/model_syntax.ml (revision 4104)
+++ trunk/src/omega/src/model_syntax.ml (revision 4105)
@@ -1,91 +0,0 @@
-(* $Id$
-
- Copyright (C) 1999-2013 by
-
- Wolfgang Kilian <kilian@physik.uni-siegen.de>
- Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
- Juergen Reuter <juergen.reuter@desy.de>
- Christian Speckner <cnspeckn@googlemail.com>
-
- WHIZARD is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- WHIZARD is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
-
-type name =
- | Charged of string * string
- | Neutral of string
-
-type particle = { name : name; attribs : (string * string) list }
-type vertex = { fields : string list; expr : Vertex_syntax.scalar }
-type coupling = string
-
-type file =
- { particles : particle list;
- couplings : coupling list;
- vertices : vertex list;
- authors : string list;
- version : string list;
- created : string list;
- revised : string list }
-
-let empty () =
- { particles = [];
- couplings = [];
- vertices = [];
- authors = [];
- version = [];
- created = [];
- revised = [] }
-
-let add_particle particle file =
- { file with particles = particle :: file.particles }
-
-let add_coupling coupling file =
- { file with couplings = coupling :: file.couplings }
-
-let add_vertex vertex file =
- { file with vertices = vertex :: file.vertices }
-
-let add_author author file =
- { file with authors = author :: file.authors }
-
-let add_version version file =
- { file with version = version :: file.version }
-
-let add_created created file =
- { file with created = created :: file.created }
-
-let add_revised revised file =
- { file with revised = revised :: file.revised }
-
-let neutral name attribs =
- { name = Neutral name; attribs = attribs }
-
-let charged name anti attribs =
- { name = Charged (name, anti); attribs = attribs }
-
-let coupling name = name
-
-let vertex fields expr =
- { fields = fields; expr = Vertex.parse expr }
-
-exception Syntax_Error of string * int * int
-
-(*i
- * Local Variables:
- * mode:caml
- * indent-tabs-mode:nil
- * page-delimiter:"^(\\* .*\n"
- * End:
-i*)
-
Index: trunk/src/omega/src/permutation.mli
===================================================================
--- trunk/src/omega/src/permutation.mli (revision 0)
+++ trunk/src/omega/src/permutation.mli (revision 4105)
@@ -0,0 +1,41 @@
+(* $Id: permutation.ml 4015 2013-01-03 16:04:18Z jr_reuter $
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+module type T =
+ sig
+ type t
+ val of_list : int list -> t
+ val of_array : int array -> t
+ val inverse : t -> t
+ val compose : t -> t -> t
+ val list : t -> 'a list -> 'a list
+ val array : t -> 'a array -> 'a array
+ end
+
+module Using_Lists : T
+module Using_Arrays : T
+
+module Default : T
+
+module Test : functor (P : T) ->
+ sig val suite : OUnit.test val time : unit -> unit end
Index: trunk/src/omega/src/vertex.ml
===================================================================
--- trunk/src/omega/src/vertex.ml (revision 4104)
+++ trunk/src/omega/src/vertex.ml (revision 4105)
@@ -1,212 +1,527 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+type context =
+ { arity : int;
+ lorentz_reps : Coupling.lorentz array;
+ color_reps : Color.t array }
+
+type field = int
+
+module type Lorentz =
+ sig
+ end
+
+module Lorentz (* : Lorentz *) =
+ struct
+
+ type index = int
+
+ type primitive =
+ | G of index * index
+ | E of index * index * index * index
+ | K of index * field
+ | S of field * field
+ | V of index * field * field
+ | T of index * index * field * field
+ | A of index * field * field
+ | P of field * field
+
+ let map_primitive fi ff = function
+ | G (mu, nu) -> G (fi mu, fi nu)
+ | E (mu, nu, rho, sigma) -> E (fi mu, fi nu, fi rho, fi sigma)
+ | K (mu, i) -> K (fi mu, ff i)
+ | S (i, j) -> S (ff i, ff j)
+ | V (mu, i, j) -> V (fi mu, ff i, ff j)
+ | T (mu, nu, i, j) -> T (fi mu, fi nu, ff i, ff j)
+ | A (mu, i, j) -> A (fi mu, ff i, ff j)
+ | P (i, j) -> P (ff i, ff j)
+
+ let primitive_ok context =
+ let field_in_bounds i = 0 <= i && i < context.arity in
+ function
+ | G (_, _) | E (_, _, _, _) -> true
+ | K (_, i) -> field_in_bounds i
+ | S (i, j) | V (_, i, j)
+ | T (_, _, i, j)
+ | A (_, i, j) | P (i, j) ->
+ i <> j && field_in_bounds i && field_in_bounds j &&
+ (match context.lorentz_reps.(i), context.lorentz_reps.(j) with
+ | Coupling.ConjSpinor, Coupling.Spinor -> true
+ | (Coupling.Vectorspinor|Coupling.Majorana), _ ->
+ failwith "Lorentz.primitive_ok: incomplete"
+ | _, (Coupling.Vectorspinor|Coupling.Majorana) ->
+ failwith "Lorentz.primitive_ok: incomplete"
+ | _, _ -> false)
+
+ let primitive_indices = function
+ | G (mu, nu) | T (mu, nu, _, _) -> [mu; nu]
+ | E (mu, nu, rho, sigma) -> [mu; nu; rho; sigma]
+ | K (mu, _) | V (mu, _, _) | A (mu, _, _) -> [mu]
+ | S (_, _) | P (_, _) -> []
+
+ let indices p =
+ ThoList.flatmap primitive_indices p
+
+ let contraction_ok p =
+ List.for_all
+ (fun (n, _) -> n = 2)
+ (ThoList.classify (indices p))
+
+ type factor =
+ | Integer of int
+ | Contraction of primitive list
+
+ let map_factor fi ff = function
+ | Integer _ as i -> i
+ | Contraction p ->
+ Contraction (List.map (map_primitive fi ff) p)
+
+ let factor_ok context = function
+ | Integer _ -> true
+ | Contraction p ->
+ List.for_all (primitive_ok context) p && contraction_ok p
+
+ type tensor = factor * primitive list
+
+ let map_tensor fi ff (factor, primitives) =
+ (map_factor fi ff factor,
+ List.map (map_primitive fi ff) primitives)
+
+ let tensor_ok context (factor, primitives) =
+ factor_ok context factor &&
+ List.for_all (primitive_ok context) primitives
+
+ end
+
+module type Color =
+ sig
+ end
+
+module Color (* : Color *) =
+ struct
+
+ type color =
+ | Fundamental of field
+ | Conjugate of field
+ | Adjoint of field
+
+ type primitive =
+ | D of field * field
+ | E of field * field * field (* $SU(3)$ *)
+ | T of field * field * field
+ | F of field * field * field
+
+ let map_primitive f = function
+ | D (i, j) -> D (f i, f j)
+ | E (i, j, k) -> E (f i, f j, f k)
+ | T (a, i, j) -> T (f a, f i, f j)
+ | F (a, b, c) -> F (f a, f b, f c)
+
+ let primitive_ok context =
+ let field_in_bounds i = 0 <= i && i < context.arity in
+ function
+ | D (i, j) ->
+ i <> j && field_in_bounds i && field_in_bounds j &&
+ (match context.color_reps.(i), context.color_reps.(j) with
+ | Color.SUN (n1), Color.SUN (n2) ->
+ n1 = - n2 && n2 > 0
+ | _, _ -> false)
+ | E (i, j, k) ->
+ i <> j && i <> k && k <> k &&
+ field_in_bounds i && field_in_bounds j &&field_in_bounds k &&
+ (match context.color_reps.(i),
+ context.color_reps.(j), context.color_reps.(k) with
+ | Color.SUN (n1), Color.SUN (n2), Color.SUN (n3) ->
+ n1 = 3 && n2 = 3 && n3 = 3 ||
+ n1 = -3 && n2 = -3 && n3 = -3
+ | _, _, _ -> false)
+ | T (a, i, j) ->
+ i <> j && a <> i && a <> j &&
+ field_in_bounds a && field_in_bounds i && field_in_bounds j &&
+ (match context.color_reps.(a),
+ context.color_reps.(i), context.color_reps.(j) with
+ | Color.AdjSUN(n1), Color.SUN (n2), Color.SUN (n3) ->
+ n1 = n3 && n2 = - n3 && n3 > 0
+ | _, _, _ -> false)
+ | F (a, b, c) ->
+ a <> b && a <> b && b <> c &&
+ field_in_bounds a && field_in_bounds b && field_in_bounds c &&
+ (match context.color_reps.(a),
+ context.color_reps.(b), context.color_reps.(c) with
+ | Color.AdjSUN(n1), Color.AdjSUN (n2), Color.AdjSUN (n3) ->
+ n1 = n2 && n2 = n3 && n1 > 0
+ | _, _, _ -> false)
+
+ let primitive_indices = function
+ | D (_, _) -> []
+ | E (_, _, _) -> []
+ | T (a, _, _) -> [a]
+ | F (a, b, c) -> [a; b; c]
+
+ let indices p =
+ ThoList.flatmap primitive_indices p
+
+ let contraction_ok p =
+ let c = ThoList.classify (indices p) in
+ let res = List.for_all
+ (fun (n, _) -> n = 2)
+ (c)
+ in
+ print_endline
+ (String.concat ", "
+ (List.map
+ (fun (n, i) -> string_of_int n ^ " * " ^ string_of_int i)
+ c));
+ flush stdout;
+ res
+
+ type factor =
+ | Integer of int
+ | Contraction of primitive list
+
+ let map_factor f = function
+ | Integer _ as i -> i
+ | Contraction p ->
+ Contraction (List.map (map_primitive f) p)
+
+ let factor_ok context = function
+ | Integer _ -> true
+ | Contraction p ->
+ List.for_all (primitive_ok context) p &&
+ contraction_ok p
+
+ type tensor = factor * primitive list
+
+ let map_tensor f (factor, primitives) =
+ (map_factor f factor, List.map (map_primitive f) primitives)
+
+ let tensor_ok context (factor, primitives) =
+ factor_ok context factor &&
+ List.for_all (primitive_ok context) primitives
+
+ end
+
+type t =
+ { fields : string array;
+ lorentz : Lorentz.tensor list;
+ color : Color.tensor list }
+
+module Test (M : Model.T) :
+ sig val example : unit -> unit val suite : OUnit.test end =
+ struct
+
+ module Permutation = Permutation.Default
+
+ let ok v =
+ let fields = Array.map M.flavor_of_string v.fields in
+ let context =
+ { arity = Array.length v.fields;
+ lorentz_reps = Array.map M.lorentz fields;
+ color_reps = Array.map M.color fields } in
+ List.for_all (Lorentz.tensor_ok context) v.lorentz &&
+ List.for_all (Color.tensor_ok context) v.color
+
+ module PM = Partial.Make (struct type t = int let compare = compare end)
+
+ let id x = x
+
+ let permute v p =
+ let sorted = ThoList.range 0 (Array.length v.fields - 1) in
+ let permute_fields = PM.apply (PM.of_lists sorted p) in
+ { fields = Permutation.array (Permutation.of_list p) v.fields;
+ lorentz = List.map (Lorentz.map_tensor id permute_fields) v.lorentz;
+ color = List.map (Color.map_tensor permute_fields) v.color }
+
+ let permutations v =
+ List.map (permute v)
+ (Combinatorics.permute (ThoList.range 0 (Array.length v.fields - 1)))
+
+ let write_fusion v =
+ match Array.to_list v.fields with
+ | lhs :: rhs ->
+ Printf.printf "! FUSION: %s <- %s\n" lhs (String.concat " + " rhs);
+ ()
+ | [] -> ()
+
+ let write_fusions v =
+ List.iter write_fusion (permutations v)
+
+(* Testing: *)
+
+ let mu = 0
+
+ let vector_current =
+ { fields = [| "tbar"; "gl"; "t" |];
+ lorentz = [ (Lorentz.Integer 1, [Lorentz.V (mu, 0, 2)]) ];
+ color = [ (Color.Integer 1, [Color.T (1, 0, 2)])] }
+
+ let vector_current_out_of_bounds =
+ { fields = [| "tbar"; "gl"; "t" |];
+ lorentz = [ (Lorentz.Integer 1, [Lorentz.V (mu, 3, 2)]) ];
+ color = [ (Color.Integer 1, [Color.T (1, 0, 2)])] }
+
+ let vector_current_color_mismatch =
+ { fields = [| "t"; "gl"; "t" |];
+ lorentz = [ (Lorentz.Integer 1, [Lorentz.V (mu, 3, 2)]) ];
+ color = [ (Color.Integer 1, [Color.T (1, 0, 2)])] }
+
+ let anomalous_couplings =
+ { fields = [| "W+"; "W-"; "Z"; "Z" |];
+ lorentz = [ (Lorentz.Integer 1, [ Lorentz.P (1, 0);
+ Lorentz.P (1, 1) ]) ];
+ color = [ ] }
+
+ exception Inconsistent_vertex
+
+ let example () =
+ if not (ok vector_current) then begin
+ raise Inconsistent_vertex
+ end;
+ write_fusions vector_current
+
+ open OUnit
+
+ let vertex_indices_ok =
+ "indices/ok" >::
+ (fun () ->
+ List.iter
+ (fun v ->
+ assert_bool "vector_current" (ok v))
+ (permutations vector_current))
+
+ let vertex_indices_broken =
+ "indices/broken" >::
+ (fun () ->
+ assert_bool "out of bounds"
+ (not (ok vector_current_out_of_bounds));
+ assert_bool "color mismatch"
+ (not (ok vector_current_color_mismatch)))
+
+ let anomalous_couplings_ok =
+ "anomalous_couplings/ok" >::
+ (fun () ->
+ assert_bool "anomalous couplings"
+ (ok anomalous_couplings))
+
+ let suite =
+ "Vertex" >:::
+ [vertex_indices_ok;
+ vertex_indices_broken;
+ anomalous_couplings_ok]
+
+ end
+
+(*i ********************************************************************
+
open Vertex_syntax
let parse text =
try
Vertex_parser.coupling Vertex_lexer.token (Lexing.from_string text)
with
| Vertex_syntax.Syntax_Error (msg, i, j) ->
invalid_arg (Printf.sprintf "syntax error (%s) at: `%s'"
msg (String.sub text i (j - i + 1)))
| Parsing.Parse_error -> invalid_arg ("parse error: " ^ text)
(*i
let tgv = parse
"(k1.e3 - k2.e3)*e1.e2 + (k2.e1 - k3.e1)*e2.e3 + (k3.e2 - k1.e2)*e3.e1"
let tgv = parse
"(k1 - k2).e3*e1.e2 + (k2 - k3).e1*e2.e3 + (k3 - k1).e2*e3.e1"
i*)
type wf =
{ lorentz : Coupling.lorentz;
momentum : bool }
type vertex =
{ coupling : Vertex_syntax.scalar;
wfs : wf list }
let take_nth n list =
let rec take_nth' i rev_head tail =
if i < 0 then
invalid_arg "take_nth"
else if i = 0 then
match tail with
| [] -> invalid_arg "take_nth"
| x :: tail' -> (x, List.rev_append rev_head tail')
else
match tail with
| [] -> invalid_arg "take_nth"
| x :: tail' -> take_nth' (pred i) (x :: rev_head) tail'
in
take_nth' n [] list
module Fortran =
struct
let type_of_lorentz kind = function
| Coupling.Scalar -> "complex(kind=" ^ kind ^ ")"
| Coupling.Spinor -> "type(spinor)"
| Coupling.ConjSpinor -> "type(conjspinor)"
| Coupling.Majorana -> "type(bispinor)"
| Coupling.Maj_Ghost -> assert false
| Coupling.Vector | Coupling.Massive_Vector -> "type(vector)"
| Coupling.Vectorspinor -> assert false
| Coupling.Tensor_1 -> assert false
| Coupling.Tensor_2 -> assert false
| Coupling.BRS _ -> assert false
let mnemonic = function
| Coupling.Scalar -> "phi"
| Coupling.Spinor -> "psi"
| Coupling.ConjSpinor -> "psibar"
| Coupling.Majorana -> "chi"
| Coupling.Maj_Ghost -> assert false
| Coupling.Vector | Coupling.Massive_Vector -> "V"
| Coupling.Vectorspinor -> assert false
| Coupling.Tensor_1 -> assert false
| Coupling.Tensor_2 -> assert false
| Coupling.BRS _ -> assert false
let declare_wf ?(kind = "default") i wf =
Printf.printf " %s, intent(in) :: %s%d\n"
(type_of_lorentz kind wf.lorentz) (mnemonic wf.lorentz) (succ i);
if wf.momentum then begin
Printf.printf " type(momentum), intent(in) :: k%d\n" (succ i);
Printf.printf " type(vector) :: k%dv\n" (succ i)
end
let vector_of_momentum i wf =
if wf.momentum then begin
Printf.printf " k%dv = k%d\n" (succ i) (succ i)
end
let print_fusion name i v =
let result, children = take_nth i v.wfs in
let result_name = mnemonic result.lorentz
and result_type = type_of_lorentz "default" result.lorentz in
let children = Array.of_list children in
Printf.printf "pure function %s (%s) result (%s)\n"
name "???" result_name;
Array.iteri declare_wf children;
Printf.printf " %s :: %s\n" result_type result_name;
if result.momentum then
begin
Printf.printf " type(momentum), intent(in) :: k\n";
Printf.printf " k = \n"
end;
Array.iteri vector_of_momentum children;
Printf.printf "end function %s\n" name
end
(* NB:
\begin{dubious}
If the outgoing momentum is used, \emph{all} the incoming momenta
must be passed too, unless the outgoing momentum is passed itself.
\end{dubious} *)
(*i module IMap = Map.Make (struct type t = int let compare = compare end) i*)
let insert_scalars order wfs =
let rec insert_scalars' n order = function
| [] -> []
in
insert_scalars' 0 order wfs
let wfs order atoms =
List.sort (fun (n1, _) (n2, _) -> compare n1 n2)
(List.map (fun n -> (n, { lorentz = Coupling.Vector;
momentum = List.mem n atoms.momenta })) atoms.polarizations @
List.map (fun n -> (n, { lorentz = Coupling.Spinor;
momentum = List.mem n atoms.momenta })) atoms.spinors @
List.map (fun n -> (n, { lorentz = Coupling.ConjSpinor;
momentum = List.mem n atoms.momenta })) atoms.conj_spinors)
open Fortran
open Printf
let process_vertex coupling =
let order = 3 in
printf ">>>>>>>> %s\n" (scalar_to_string coupling);
let atoms = scalar_atoms coupling in
printf " constants: %s\n"
(String.concat ", " atoms.constants);
printf " momenta: %s\n"
(String.concat ", " (List.map string_of_int atoms.momenta));
printf " polarizations: %s\n"
(String.concat ", " (List.map string_of_int atoms.polarizations));
printf " external momenta: %s\n"
(String.concat ", " atoms.external_momenta);
printf " spinors: %s\n"
(String.concat ", " (List.map string_of_int atoms.spinors));
printf "conjugated spinors: %s\n"
(String.concat ", " (List.map string_of_int atoms.conj_spinors));
printf "d/deps1: %s\n" (vector_to_string (partial_vector (e 1) coupling));
printf "d/deps2: %s\n" (vector_to_string (partial_vector (e 2) coupling));
printf "d/deps3: %s\n" (vector_to_string (partial_vector (e 3) coupling));
printf "d/|1>: %s\n" (conj_spinor_to_string (partial_spinor 1 coupling));
printf "d/|2>: %s\n" (conj_spinor_to_string (partial_spinor 2 coupling));
printf "d/|3>: %s\n" (conj_spinor_to_string (partial_spinor 3 coupling));
printf "d/<1|: %s\n" (spinor_to_string (partial_conj_spinor 1 coupling));
printf "d/<2|: %s\n" (spinor_to_string (partial_conj_spinor 2 coupling));
printf "d/<3|: %s\n" (spinor_to_string (partial_conj_spinor 3 coupling));
print_fusion "foo" 0
{ coupling = coupling;
wfs = List.map snd (wfs order atoms) };
print_fusion "foo" 1
{ coupling = coupling;
wfs = List.map snd (wfs order atoms) };
print_fusion "foo" 2
{ coupling = coupling;
wfs = List.map snd (wfs order atoms) }
let process_vertex coupling =
try
process_vertex coupling
with
| Failure s ->
printf "************************************************************************\n";
printf "FAILURE: %s!!!\n" s;
printf "************************************************************************\n"
(*i
let _ =
process_vertex (parse (read_line ()))
i*)
(* \thocwmodulesection{Code Generation}
\begin{dubious}
Most of this will be moved to [Targets].
\end{dubious} *)
+******************************************************************** i*)
+
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml"
* End:
i*)
Index: trunk/src/omega/src/permutation.ml
===================================================================
--- trunk/src/omega/src/permutation.ml (revision 0)
+++ trunk/src/omega/src/permutation.ml (revision 4105)
@@ -0,0 +1,280 @@
+(* $Id: permutation.ml 4015 2013-01-03 16:04:18Z jr_reuter $
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+module type T =
+ sig
+ type t
+ val of_list : int list -> t
+ val of_array : int array -> t
+ val inverse : t -> t
+ val compose : t -> t -> t
+ val list : t -> 'a list -> 'a list
+ val array : t -> 'a array -> 'a array
+ end
+
+module Using_Lists : T =
+ struct
+
+ type t = int list
+
+ let of_list p =
+ if List.sort compare p <> (ThoList.range 0 (List.length p - 1)) then
+ invalid_arg "Permutation.of_list"
+ else
+ p
+
+ let of_array p =
+ try
+ of_list (Array.to_list p)
+ with
+ | Invalid_argument "Permutation.of_list" ->
+ invalid_arg "Permutation.of_array"
+
+ let inverse p = snd (ThoList.ariadne_sort p)
+
+ let list p l =
+ List.map snd
+ (List.sort compare
+ (try
+ List.rev_map2 (fun i x -> (i, x)) p l
+ with
+ | Invalid_argument "List.rev_map2" ->
+ invalid_arg "Permutation.list: length mismatch"))
+
+ let array p a =
+ try
+ Array.of_list (list p (Array.to_list a))
+ with
+ | Invalid_argument "Permutation.list: length mismatch" ->
+ invalid_arg "Permutation.array: length mismatch"
+
+(* Probably not optimal (or really inefficient), but correct by
+ associativity. *)
+
+ let compose p q =
+ list (inverse q) p
+
+ end
+
+module Using_Arrays : T =
+ struct
+
+ type t = int array
+
+ let of_list p =
+ if List.sort compare p <> (ThoList.range 0 (List.length p - 1)) then
+ invalid_arg "Permutation.of_list"
+ else
+ Array.of_list p
+
+ let of_array p =
+ try
+ of_list (Array.to_list p)
+ with
+ | Invalid_argument "Permutation.of_list" ->
+ invalid_arg "Permutation.of_array"
+
+ let inverse p =
+ let len_p = Array.length p in
+ let p' = Array.make len_p p.(0) in
+ for i = 0 to pred len_p do
+ p'.(p.(i)) <- i
+ done;
+ p'
+
+ let array p a =
+ let len_a = Array.length a
+ and len_p = Array.length p in
+ if len_a <> len_p then
+ invalid_arg "Permutation.array: length mismatch";
+ let a' = Array.make len_a a.(0) in
+ for i = 0 to pred len_a do
+ a'.(p.(i)) <- a.(i)
+ done;
+ a'
+
+ let list p l =
+ try
+ Array.to_list (array p (Array.of_list l))
+ with
+ | Invalid_argument "Permutation.array: length mismatch" ->
+ invalid_arg "Permutation.list: length mismatch"
+
+ let compose p q =
+ array (inverse q) p
+
+ end
+
+module Default = Using_Arrays
+
+(* To shuffle an array a of n elements (indices 0..n-1):
+
+ for i from n − 1 downto 1 do
+ j ← random integer with 0 ≤ j ≤ i
+ exchange a[j] and a[i]
+
+ To initialize an array a of n elements to a randomly shuffled copy
+ of source, both 0-based:
+
+ a[0] ← source[0]
+ for i from 1 to n − 1 do
+ j ← random integer with 0 ≤ j ≤ i
+ a[i] ← a[j]
+ a[j] ← source[i] *)
+
+let shuffle l =
+ let a = Array.of_list l in
+ for n = Array.length a - 1 downto 1 do
+ let k = Random.int (succ n) in
+ if k <> n then
+ let tmp = Array.get a n in
+ Array.set a n (Array.get a k);
+ Array.set a k tmp
+ done;
+ Array.to_list a
+
+let time f x =
+ let start = Sys.time () in
+ let f_x = f x in
+ let stop = Sys.time () in
+ (f_x, stop -. start)
+
+let print_time msg f x =
+ let f_x, seconds = time f x in
+ Printf.printf "%s took %10.2f ms\n" msg (seconds *. 1000.);
+ f_x
+
+module Test (P : T) : sig val suite : OUnit.test val time : unit -> unit end =
+ struct
+
+ open OUnit
+ open P
+
+ let of_list_overlap =
+ "overlap" >::
+ (fun () ->
+ assert_raises (Invalid_argument "Permutation.of_list")
+ (fun () ->
+ of_list [0;1;2;2]))
+
+ let of_list_gap =
+ "gap" >::
+ (fun () ->
+ assert_raises (Invalid_argument "Permutation.of_list")
+ (fun () ->
+ of_list [0;1;2;4;5]))
+
+ let of_list_ok =
+ "ok" >::
+ (fun () ->
+ let l = ThoList.range 0 10 in
+ assert_equal (of_list l) (of_list l))
+
+ let suite_of_list =
+ "of_list" >:::
+ [of_list_overlap;
+ of_list_gap;
+ of_list_ok]
+
+ let apply_invalid_lengths =
+ "invalid/lengths" >::
+ (fun () ->
+ assert_raises
+ (Invalid_argument "Permutation.list: length mismatch")
+ (fun () ->
+ list (of_list [0;1;2;3;4]) [0;1;2;3]))
+
+ let apply_ok =
+ "ok" >::
+ (fun () ->
+ assert_equal [2;0;1;3;5;4]
+ (list (of_list [1;2;0;3;5;4]) [0;1;2;3;4;5]))
+
+ let suite_apply =
+ "apply" >:::
+ [apply_invalid_lengths;
+ apply_ok]
+
+ let inverse_ok =
+ "ok" >::
+ (fun () ->
+ let l = shuffle (ThoList.range 0 1000) in
+ let p = of_list (shuffle l) in
+ assert_equal l (list (inverse p) (list p l)))
+
+ let suite_inverse =
+ "inverse" >:::
+ [inverse_ok]
+
+ let compose_ok =
+ "ok" >::
+ (fun () ->
+ let id = ThoList.range 0 1000 in
+ let p = of_list (shuffle id)
+ and q = of_list (shuffle id)
+ and l = id in
+ assert_equal (list p (list q l)) (list (compose p q) l))
+
+ let compose_inverse_ok =
+ "inverse/ok" >::
+ (fun () ->
+ let id = ThoList.range 0 1000 in
+ let p = of_list (shuffle id)
+ and q = of_list (shuffle id) in
+ assert_equal
+ (compose (inverse p) (inverse q))
+ (inverse (compose q p)))
+
+ let suite_compose =
+ "compose" >:::
+ [compose_ok;
+ compose_inverse_ok]
+
+ let suite =
+ "Permutations" >:::
+ [suite_of_list;
+ suite_apply;
+ suite_inverse;
+ suite_compose]
+
+ let repeat repetitions size =
+ let id = ThoList.range 0 size in
+ let p = of_list (shuffle id)
+ and l = shuffle (List.map string_of_int id) in
+ print_time (Printf.sprintf "reps=%d, len=%d" repetitions size)
+ (fun () ->
+ for i = 1 to repetitions do
+ ignore (P.list p l)
+ done)
+ ()
+
+ let time () =
+ repeat 100000 10;
+ repeat 10000 100;
+ repeat 1000 1000;
+ repeat 100 10000;
+ repeat 10 100000;
+ ()
+
+ end
+
Index: trunk/src/omega/src/model_file_lexer.mll
===================================================================
--- trunk/src/omega/src/model_file_lexer.mll (revision 0)
+++ trunk/src/omega/src/model_file_lexer.mll (revision 4105)
@@ -0,0 +1,59 @@
+(* $Id$
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+{
+open Model_file_parser
+let unquote s =
+ String.sub s 1 (String.length s - 2)
+}
+
+let digit = ['0'-'9']
+let upper = ['A'-'Z']
+let lower = ['a'-'z']
+let char = upper | lower
+let white = [' ' '\t' '\n']
+
+(* We use a very liberal definition of strings in order to avoid
+ the need for quotes in the declaration section. *)
+rule token = parse
+ white { token lexbuf } (* skip blanks *)
+ | '%' [^'\n']* '\n'
+ { token lexbuf } (* skip comments *)
+ | "particle" { PARTICLE }
+ | "coupling" { COUPLING }
+ | "vertex" { VERTEX }
+ | "author" { AUTHOR }
+ | "version" { VERSION }
+ | "created" { CREATED }
+ | "revised" { REVISED }
+ | ',' { COMMA }
+ | '=' { EQUAL }
+ | ':' { COLON }
+ | [^ ' ' '\t' '\n' ',' '=' ':' '{' '}']+
+ { STRING (Lexing.lexeme lexbuf) }
+ | '"' [^ '"']* '"'
+ { STRING (unquote (Lexing.lexeme lexbuf)) }
+ | '{' [^ '}']* '}'
+ { EXPR (unquote (Lexing.lexeme lexbuf)) }
+ | '}' { failwith "unexpected `}' outside of expression" }
+ | eof { END }
Property changes on: trunk/src/omega/src/model_file_lexer.mll
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision HeadURL URL
\ No newline at end of property
Index: trunk/src/omega/src/Makefile.sources
===================================================================
--- trunk/src/omega/src/Makefile.sources (revision 4104)
+++ trunk/src/omega/src/Makefile.sources (revision 4105)
@@ -1,273 +1,275 @@
# Makefile.sources -- Makefile component for O'Mega
# $Id$
##
## Process Makefile.am with automake to include this file in Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2013 by
# Wolfgang Kilian <kilian@physik.uni-siegen.de>
# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
# Juergen Reuter <juergen.reuter@desy.de>
# Christian Speckner <cnspeckn@googlemail.com>
#
# WHIZARD is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# WHIZARD is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
########################################################################
##
## We define the source files in a separate file so that they can be
## include by Makefiles in multiple directories.
##
########################################################################
########################################################################
#
# O'Caml sources
#
########################################################################
#
# NB:
#
# * all modules MUST be given in the correct sequence for linking
#
# * foo.ml as a source file implies foo.mli as a source files
#
# * we must use ocamlc -i to generate *_lexer.mli from *_lexer.ml in
# order to treat *_lexer.ml like all other modules
#
# * automake conditionals are not available here, use
# autoconf substitutions that expand to '#' or ''
#
########################################################################
CASCADE_MLL = cascade_lexer.mll
CASCADE_MLY = cascade_parser.mly
CASCADE_MLD = $(CASCADE_MLL:.mll=.ml) $(CASCADE_MLY:.mly=.ml)
CASCADE_ML_PRIMARY = cascade_syntax.ml cascade.ml
CASCADE_ML = cascade_syntax.ml $(CASCADE_MLD) cascade.ml
COMPHEP_MLL = comphep_lexer.mll
COMPHEP_MLY = comphep_parser.mly
COMPHEP_MLD = $(COMPHEP_MLL:.mll=.ml) $(COMPHEP_MLY:.mly=.ml)
COMPHEP_ML_PRIMARY = comphep_syntax.ml comphep.ml
COMPHEP_ML = comphep_syntax.ml $(COMPHEP_MLD) comphep.ml
VERTEX_MLL = @comment_model_file@ vertex_lexer.mll
VERTEX_MLY = @comment_model_file@ vertex_parser.mly
VERTEX_MLD = $(VERTEX_MLL:.mll=.ml) $(VERTEX_MLY:.mly=.ml)
VERTEX_ML_PRIMARY = @comment_model_file@ vertex_syntax.ml vertex.ml
VERTEX_ML = @comment_model_file@ vertex_syntax.ml $(VERTEX_MLD) vertex.ml
-MODEL_MLL = @comment_model_file@ model_lexer.mll
-MODEL_MLY = @comment_model_file@ model_parser.mly
+MODEL_MLL = @comment_model_file@ # model_file_lexer.mll
+MODEL_MLY = @comment_model_file@ # model_file_parser.mly
MODEL_MLD = $(MODEL_MLL:.mll=.ml) $(MODEL_MLY:.mly=.ml)
-MODEL_ML_PRIMARY = @comment_model_file@ model_syntax.ml model.ml
-MODEL_ML = @comment_model_file@ model_syntax.ml $(MODEL_MLD) model.ml
+MODEL_ML_PRIMARY = @comment_model_file@ # model_file_syntax.ml model_file.ml
+MODEL_ML = @comment_model_file@ # model_file_syntax.ml $(MODEL_MLD) model_file.ml
OMEGA_MLL = $(CASCADE_MLL) $(COMPHEP_MLL) $(VERTEX_MLL) $(MODEL_MLL)
OMEGA_MLY = $(CASCADE_MLY) $(COMPHEP_MLY) $(VERTEX_MLY) $(MODEL_MLY)
OMEGA_DERIVED_CAML = \
$(OMEGA_MLL:.mll=.mli) $(OMEGA_MLL:.mll=.ml) \
$(OMEGA_MLY:.mly=.mli) $(OMEGA_MLY:.mly=.ml)
OMEGA_INTERFACES_MLI = \
coupling.mli \
model.mli \
target.mli
########################################################################
# We need lists of all modules including and excluding derived
# files (*_PRIMARY). Unfortunately, we need the longer list in
# proper linking order, so we can't just tack the additional
# files to the end of the shorter list.
########################################################################
OMEGA_CORE_ML_PART1 = \
- config.ml pmap.ml thoList.ml thoArray.ml thoString.ml bundle.ml powSet.ml \
+ oUnit.ml oUnitDiff.ml \
+ config.ml partial.ml pmap.ml \
+ thoList.ml thoArray.ml thoString.ml permutation.ml bundle.ml powSet.ml \
rCS.ml thoFilename.ml cache.ml progress.ml trie.ml linalg.ml tree2.ml \
algebra.ml options.ml product.ml combinatorics.ml partition.ml tree.ml \
tuple.ml topology.ml dAG.ml momentum.ml phasespace.ml \
charges.ml color.ml modeltools.ml whizard.ml
OMEGA_CORE_ML_PART2 = \
$(VERTEX_ML) $(MODEL_ML) $(COMPHEP_ML) $(CASCADE_ML)
OMEGA_CORE_ML_PART2_PRIMARY = \
$(VERTEX_ML_PRIMARY) $(MODEL_ML_PRIMARY) $(COMPHEP_ML_PRIMARY) $(CASCADE_ML_PRIMARY)
OMEGA_CORE_ML_PART3 = \
colorize.ml process.ml fusion.ml omega.ml
OMEGA_CORE_ML_PRIMARY = \
$(OMEGA_CORE_ML_PART1) $(OMEGA_CORE_ML_PART2_PRIMARY) $(OMEGA_CORE_ML_PART3)
OMEGA_CORE_ML = \
$(OMEGA_CORE_ML_PART1) $(OMEGA_CORE_ML_PART2) $(OMEGA_CORE_ML_PART3)
OMEGA_CORE_MLI_PRIMARY = $(OMEGA_INTERFACES_MLI) $(OMEGA_CORE_ML_PRIMARY:.ml=.mli)
OMEGA_CORE_MLI = $(OMEGA_INTERFACES_MLI) $(OMEGA_CORE_ML:.ml=.mli)
OMEGA_MODELLIB_ML = \
modellib_SM.ml \
modellib_MSSM.ml \
modellib_NMSSM.ml \
modellib_PSSSM.ml \
modellib_BSM.ml
OMEGA_MODELLIB_MLI = $(OMEGA_MODELLIB_ML:.ml=.mli)
OMEGA_TARGETLIB_ML = \
targets_Kmatrix.ml \
targets.ml
OMEGA_TARGETLIB_MLI = $(OMEGA_TARGETLIB_ML:.ml=.mli)
########################################################################
# The supported models:
########################################################################
OMEGA_MINIMAL_APPLICATIONS_ML = \
omega_QED.ml \
omega_QCD.ml \
omega_SM.ml
OMEGA_APPLICATIONS_ML = \
omega_QED.ml \
omega_QCD.ml \
omega_SM.ml \
omega_SM_CKM.ml \
omega_SM_ac.ml \
omega_SM_ac_CKM.ml \
omega_SM_QCD.ml \
omega_SM_top.ml \
omega_SM_top_anom.ml \
omega_SM_Higgs.ml \
omega_2HDM.ml \
omega_MSSM.ml \
omega_MSSM_CKM.ml \
omega_MSSM_Grav.ml \
omega_MSSM_Hgg.ml \
omega_NMSSM.ml \
omega_NMSSM_CKM.ml \
omega_NMSSM_Hgg.ml \
omega_PSSSM.ml \
omega_Littlest.ml \
omega_Littlest_Eta.ml \
omega_Littlest_Tpar.ml \
omega_Simplest.ml \
omega_Simplest_univ.ml \
omega_Xdim.ml \
omega_GravTest.ml \
omega_SM_km.ml \
omega_UED.ml \
omega_Zprime.ml \
omega_Threeshl.ml \
omega_Threeshl_nohf.ml \
omega_Template.ml \
omega_SYM.ml
OMEGA_CORE_CMO = $(OMEGA_CORE_ML:.ml=.cmo)
OMEGA_CORE_CMX = $(OMEGA_CORE_ML:.ml=.cmx)
OMEGA_TARGETS_CMO = $(OMEGA_TARGETLIB_ML:.ml=.cmo)
OMEGA_TARGETS_CMX = $(OMEGA_TARGETLIB_ML:.ml=.cmx)
OMEGA_MODELS_CMO = $(OMEGA_MODELLIB_ML:.ml=.cmo)
OMEGA_MODELS_CMX = $(OMEGA_MODELLIB_ML:.ml=.cmx)
OMEGA_APPLICATIONS_CMO = $(OMEGA_APPLICATIONS_ML:.ml=.cmo)
OMEGA_APPLICATIONS_CMX = $(OMEGA_APPLICATIONS_ML:.ml=.cmx)
OMEGA_APPLICATIONS_BYTECODE = $(OMEGA_APPLICATIONS_ML:.ml=$(OCAML_BYTECODE_EXT))
OMEGA_APPLICATIONS_NATIVE = $(OMEGA_APPLICATIONS_ML:.ml=$(OCAML_NATIVE_EXT))
OMEGA_CACHES = $(OMEGA_APPLICATIONS_ML:.ml=.$(OMEGA_CACHE_SUFFIX))
OMEGA_MINIMAL_APPLICATIONS_BYTECODE = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=$(OCAML_BYTECODE_EXT))
OMEGA_MINIMAL_APPLICATIONS_NATIVE = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=$(OCAML_NATIVE_EXT))
OMEGA_MINIMAL_CACHES = $(OMEGA_MINIMAL_APPLICATIONS_ML:.ml=.$(OMEGA_CACHE_SUFFIX))
# Only primary sources, excluding generated parsers and lexers
# (used for dependency generation)
OMEGA_ML_PRIMARY = \
$(OMEGA_CORE_ML_PRIMARY) \
$(OMEGA_MODELLIB_ML) \
$(OMEGA_TARGETLIB_ML) \
$(OMEGA_APPLICATIONS_ML)
OMEGA_MLI_PRIMARY = \
$(OMEGA_CORE_MLI_PRIMARY) \
$(OMEGA_MODELLIB_MLI) \
$(OMEGA_TARGETLIB_MLI)
OMEGA_CAML_PRIMARY = $(OMEGA_ML_PRIMARY) $(OMEGA_MLI_PRIMARY) $(OMEGA_MLL) $(OMEGA_MLY)
# All sources, including generated parsers and lexers
# (used for linking and distribution)
OMEGA_ML = \
$(OMEGA_CORE_ML) \
$(OMEGA_MODELLIB_ML) \
$(OMEGA_TARGETLIB_ML) \
$(OMEGA_APPLICATIONS_ML)
OMEGA_MLI = \
$(OMEGA_CORE_MLI) \
$(OMEGA_MODELLIB_MLI) \
$(OMEGA_TARGETLIB_MLI)
OMEGA_CAML = $(OMEGA_ML) $(OMEGA_MLI) $(OMEGA_MLL) $(OMEGA_MLY) $(OMEGA_DERIVED_CAML)
########################################################################
#
# Fortran 90/95/2003 sources
#
########################################################################
AM_FCFLAGS =
## Profiling
if FC_USE_PROFILING
AM_FCFLAGS += $(FCFLAGS_PROFILING)
endif
## OpenMP
if FC_USE_OPENMP
AM_FCFLAGS += $(FCFLAGS_OPENMP)
endif
if STANDALONE_OMEGA_BUILD
KINDS_F90 = kinds.f90
CONSTANTS_F90 = constants.f90
OMEGA_PARAMETERS_F90 = # omega_parameters.f90 omega_parameters_madgraph.f90
else
# use the copies in ../../misc instead
endif
OMEGALIB_DERIVED_F90 = \
omega_spinors.f90 omega_bispinors.f90 omega_vectors.f90 \
omega_vectorspinors.f90 omega_tensors.f90 \
omega_couplings.f90 omega_spinor_couplings.f90 omega_bispinor_couplings.f90 \
omega_polarizations.f90 omega_polarizations_madgraph.f90 \
omega_tensor_polarizations.f90 omega_vspinor_polarizations.f90 \
omega_color.f90 omega_utils.f90 \
omega95.f90 omega95_bispinors.f90
OMEGALIB_F90 = \
$(KINDS_F90) $(CONSTANTS_F90) \
$(OMEGALIB_DERIVED_F90) \
$(OMEGA_PARAMETERS_F90)
OMEGALIB_MOD = $(OMEGALIB_F90:.f90=.mod)
########################################################################
## The End.
########################################################################
Index: trunk/src/omega/src/model_file_syntax.ml
===================================================================
--- trunk/src/omega/src/model_file_syntax.ml (revision 0)
+++ trunk/src/omega/src/model_file_syntax.ml (revision 4105)
@@ -0,0 +1,91 @@
+(* $Id$
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+type name =
+ | Charged of string * string
+ | Neutral of string
+
+type particle = { name : name; attribs : (string * string) list }
+type vertex = { fields : string list; expr : Vertex_syntax.scalar }
+type coupling = string
+
+type file =
+ { particles : particle list;
+ couplings : coupling list;
+ vertices : vertex list;
+ authors : string list;
+ version : string list;
+ created : string list;
+ revised : string list }
+
+let empty () =
+ { particles = [];
+ couplings = [];
+ vertices = [];
+ authors = [];
+ version = [];
+ created = [];
+ revised = [] }
+
+let add_particle particle file =
+ { file with particles = particle :: file.particles }
+
+let add_coupling coupling file =
+ { file with couplings = coupling :: file.couplings }
+
+let add_vertex vertex file =
+ { file with vertices = vertex :: file.vertices }
+
+let add_author author file =
+ { file with authors = author :: file.authors }
+
+let add_version version file =
+ { file with version = version :: file.version }
+
+let add_created created file =
+ { file with created = created :: file.created }
+
+let add_revised revised file =
+ { file with revised = revised :: file.revised }
+
+let neutral name attribs =
+ { name = Neutral name; attribs = attribs }
+
+let charged name anti attribs =
+ { name = Charged (name, anti); attribs = attribs }
+
+let coupling name = name
+
+let vertex fields expr =
+ { fields = fields; expr = Vertex.parse expr }
+
+exception Syntax_Error of string * int * int
+
+(*i
+ * Local Variables:
+ * mode:caml
+ * indent-tabs-mode:nil
+ * page-delimiter:"^(\\* .*\n"
+ * End:
+i*)
+
Property changes on: trunk/src/omega/src/model_file_syntax.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision HeadURL URL
\ No newline at end of property
Index: trunk/src/omega/src/model_file.mli
===================================================================
--- trunk/src/omega/src/model_file.mli (revision 4104)
+++ trunk/src/omega/src/model_file.mli (revision 4105)
@@ -1,33 +1,33 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
-val model_of_channel : in_channel -> Model_syntax.file
-val model_of_file : string -> Model_syntax.file
+val model_of_channel : in_channel -> Model_file_syntax.file
+val model_of_file : string -> Model_file_syntax.file
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/partial.ml
===================================================================
--- trunk/src/omega/src/partial.ml (revision 0)
+++ trunk/src/omega/src/partial.ml (revision 4105)
@@ -0,0 +1,82 @@
+(* $Id: partial.ml 4015 2013-01-03 16:04:18Z jr_reuter $
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+module type T =
+ sig
+ type domain
+ type 'a t
+ val of_list : (domain * 'a) list -> 'a t
+ val of_lists : domain list -> 'a list -> 'a t
+ val apply : 'a t -> domain -> 'a
+ end
+
+module Make (D : Map.OrderedType) : T with type domain = D.t =
+ struct
+
+ module M = Map.Make (D)
+
+ type domain = D.t
+ type 'a t = 'a M.t
+
+ let of_list l =
+ List.fold_left (fun m (d, v) -> M.add d v m) M.empty l
+
+ let of_lists domain values =
+ of_list
+ (try
+ List.rev_map2 (fun d v -> (d, v)) domain values
+ with
+ | Invalid_argument "List.rev_map2" ->
+ invalid_arg "Partial.of_lists: length mismatch")
+
+ let apply partial d = M.find d partial
+
+ end
+
+module Test : sig val suite : OUnit.test end =
+ struct
+
+ open OUnit
+
+ module P = Make (struct type t = int let compare = compare end)
+
+ let apply_ok =
+ "apply/ok" >::
+ (fun () ->
+ let p = P.of_list [ (0,"a"); (1,"b"); (2,"c") ]
+ and l = [ 0; 1; 2 ] in
+ assert_equal [ "a"; "b"; "c" ] (List.map (P.apply p) l))
+
+ let suite_apply =
+ "apply" >:::
+ [apply_ok]
+
+ let suite =
+ "Partial" >:::
+ [suite_apply]
+
+ let time () =
+ ()
+
+ end
+
Index: trunk/src/omega/src/oUnitDiff.mli
===================================================================
--- trunk/src/omega/src/oUnitDiff.mli (revision 0)
+++ trunk/src/omega/src/oUnitDiff.mli (revision 4105)
@@ -0,0 +1,139 @@
+(* $Id$ *)
+
+(***********************************************************************)
+(* The OUnit library *)
+(* *)
+(* Copyright (C) 2010 OCamlCore SARL *)
+(* *)
+(***********************************************************************)
+
+(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
+
+(************************************************************************
+
+The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this document and the OUnit software ("the Software"), to
+deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute,
+sublicense, and/or sell copies of the Software, and to permit persons
+to whom the Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+The Software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall Maas-Maarten Zeeman be liable for any claim, damages
+or other liability, whether in an action of contract, tort or
+otherwise, arising from, out of or in connection with the Software or
+the use or other dealings in the software.
+
+************************************************************************)
+
+(** Unit tests for collection of elements
+
+ This module allows to define a more precise way to display differences
+ between collection of elements. When collection differ, the tester is
+ interested by what are the missing/extra elements. This module provides
+ a [diff] operation to spot the difference quickly between two sets of
+ elements.
+
+ Example:
+{[
+open OUnit;;
+
+module EInt =
+struct
+ type t = int
+ let compare = ( - )
+ let pp_print = Format.pp_print_int
+ let pp_print_sep = OUnitDiff.comma_separator
+end
+
+module ListInt = OUnitDiff.ListSimpleMake(EInt);;
+
+let test_diff () =
+ ListInt.assert_equal
+ [1; 2; 3; 4; 5]
+ [1; 2; 5; 4]
+;;
+
+let _ =
+ run_test_tt_main ("test_diff" >:: test_diff)
+;;
+]}
+
+when run this test outputs:
+{[
+OUnit: expected: 1, 2, 3, 4, 5 but got: 1, 2, 5, 4
+differences: element number 2 differ (3 <> 5)
+]}
+
+ @since 1.1.0
+ @author Sylvain Le Gall
+ *)
+
+(** {2 Signatures} *)
+
+(** Definition of an element
+ *)
+module type DIFF_ELEMENT =
+ sig
+ (** Type of an element *)
+ type t
+
+ (** Pretty printer for an element *)
+ val pp_printer : Format.formatter -> t -> unit
+
+ (** Element comparison *)
+ val compare : t -> t -> int
+
+ (** Pretty print element separator *)
+ val pp_print_sep : Format.formatter -> unit -> unit
+ end
+
+(** Definition of standard operations
+ *)
+module type S =
+ sig
+ (** Type of an element *)
+ type e
+
+ (** Type of a collection of element *)
+ type t
+
+ (** Compare a collection of element *)
+ val compare : t -> t -> int
+
+ (** Pretty printer a collection of element *)
+ val pp_printer : Format.formatter -> t -> unit
+
+ (** Pretty printer for collection differences *)
+ val pp_diff : Format.formatter -> t * t -> unit
+
+ (** {!assert_equal} with [~diff], [~cmp] and [~printer] predefined for
+ this collection events
+ *)
+ val assert_equal : ?msg:string -> t -> t -> unit
+
+ (** Create [t] using of list *)
+ val of_list : e list -> t
+ end
+
+(** {2 Implementations} *)
+
+(** Collection of elements based on a Set, elements order doesn't matter *)
+module SetMake : functor (D : DIFF_ELEMENT) -> S
+ with type e = D.t
+
+(** Collection of elements based on a List, order matters but difference display
+ is very simple. It stops at the first element which differs.
+ *)
+module ListSimpleMake : functor (D: DIFF_ELEMENT) -> S
+ with type e = D.t and type t = D.t list
+
+val pp_comma_separator : Format.formatter -> unit -> unit
Property changes on: trunk/src/omega/src/oUnitDiff.mli
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/src/oUnit.mli
===================================================================
--- trunk/src/omega/src/oUnit.mli (revision 0)
+++ trunk/src/omega/src/oUnit.mli (revision 4105)
@@ -0,0 +1,283 @@
+(* $Id$ *)
+
+(***********************************************************************)
+(* The OUnit library *)
+(* *)
+(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *)
+(* Copyright (C) 2010 OCamlCore SARL *)
+(* *)
+(***********************************************************************)
+
+(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
+
+(************************************************************************
+
+The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this document and the OUnit software ("the Software"), to
+deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute,
+sublicense, and/or sell copies of the Software, and to permit persons
+to whom the Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+The Software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall Maas-Maarten Zeeman be liable for any claim, damages
+or other liability, whether in an action of contract, tort or
+otherwise, arising from, out of or in connection with the Software or
+the use or other dealings in the software.
+
+************************************************************************)
+
+(** Unit test building blocks
+
+ @author Maas-Maarten Zeeman
+ @author Sylvain Le Gall
+ *)
+
+(** {2 Assertions}
+
+ Assertions are the basic building blocks of unittests. *)
+
+(** Signals a failure. This will raise an exception with the specified
+ string.
+
+ @raise Failure signal a failure *)
+val assert_failure : string -> 'a
+
+(** Signals a failure when bool is false. The string identifies the
+ failure.
+
+ @raise Failure signal a failure *)
+val assert_bool : string -> bool -> unit
+
+(** Shorthand for assert_bool
+
+ @raise Failure to signal a failure *)
+val ( @? ) : string -> bool -> unit
+
+(** Signals a failure when the string is non-empty. The string identifies the
+ failure.
+
+ @raise Failure signal a failure *)
+val assert_string : string -> unit
+
+(** [assert_command prg args] Run the command provided.
+
+ @param exit_code expected exit code
+ @param sinput provide this [char Stream.t] as input of the process
+ @param foutput run this function on output, it can contains an
+ [assert_equal] to check it
+ @param use_stderr redirect [stderr] to [stdout]
+ @param env Unix environment
+ @param verbose if a failure arise, dump stdout/stderr of the process to stderr
+
+ @since 1.1.0
+ *)
+val assert_command :
+ ?exit_code:Unix.process_status ->
+ ?sinput:char Stream.t ->
+ ?foutput:(char Stream.t -> unit) ->
+ ?use_stderr:bool ->
+ ?env:string array ->
+ ?verbose:bool ->
+ string -> string list -> unit
+
+(** [assert_equal expected real] Compares two values, when they are not equal a
+ failure is signaled.
+
+ @param cmp customize function to compare, default is [=]
+ @param printer value printer, don't print value otherwise
+ @param pp_diff if not equal, ask a custom display of the difference
+ using [diff fmt exp real] where [fmt] is the formatter to use
+ @param msg custom message to identify the failure
+
+ @raise Failure signal a failure
+
+ @version 1.1.0
+ *)
+val assert_equal :
+ ?cmp:('a -> 'a -> bool) ->
+ ?printer:('a -> string) ->
+ ?pp_diff:(Format.formatter -> ('a * 'a) -> unit) ->
+ ?msg:string -> 'a -> 'a -> unit
+
+(** Asserts if the expected exception was raised.
+
+ @param msg identify the failure
+
+ @raise Failure description *)
+val assert_raises : ?msg:string -> exn -> (unit -> 'a) -> unit
+
+(** {2 Skipping tests }
+
+ In certain condition test can be written but there is no point running it, because they
+ are not significant (missing OS features for example). In this case this is not a failure
+ nor a success. Following functions allow you to escape test, just as assertion but without
+ the same error status.
+
+ A test skipped is counted as success. A test todo is counted as failure.
+ *)
+
+(** [skip cond msg] If [cond] is true, skip the test for the reason explain in [msg].
+ For example [skip_if (Sys.os_type = "Win32") "Test a doesn't run on windows"].
+
+ @since 1.0.3
+ *)
+val skip_if : bool -> string -> unit
+
+(** The associated test is still to be done, for the reason given.
+
+ @since 1.0.3
+ *)
+val todo : string -> unit
+
+(** {2 Compare Functions} *)
+
+(** Compare floats up to a given relative error.
+
+ @param epsilon if the difference is smaller [epsilon] values are equal
+ *)
+val cmp_float : ?epsilon:float -> float -> float -> bool
+
+(** {2 Bracket}
+
+ A bracket is a functional implementation of the commonly used
+ setUp and tearDown feature in unittests. It can be used like this:
+
+ ["MyTestCase" >:: (bracket test_set_up test_fun test_tear_down)]
+
+ *)
+
+(** [bracket set_up test tear_down] The [set_up] function runs first, then
+ the [test] function runs and at the end [tear_down] runs. The
+ [tear_down] function runs even if the [test] failed and help to clean
+ the environment.
+ *)
+val bracket: (unit -> 'a) -> ('a -> unit) -> ('a -> unit) -> unit -> unit
+
+(** [bracket_tmpfile test] The [test] function takes a temporary filename
+ and matching output channel as arguments. The temporary file is created
+ before the test and removed after the test.
+
+ @param prefix see [Filename.open_temp_file]
+ @param suffix see [Filename.open_temp_file]
+ @param mode see [Filename.open_temp_file]
+
+ @since 1.1.0
+ *)
+val bracket_tmpfile:
+ ?prefix:string ->
+ ?suffix:string ->
+ ?mode:open_flag list ->
+ ((string * out_channel) -> unit) -> unit -> unit
+
+(** {2 Constructing Tests} *)
+
+(** The type of test function *)
+type test_fun = unit -> unit
+
+(** The type of tests *)
+type test =
+ TestCase of test_fun
+ | TestList of test list
+ | TestLabel of string * test
+
+(** Create a TestLabel for a test *)
+val (>:) : string -> test -> test
+
+(** Create a TestLabel for a TestCase *)
+val (>::) : string -> test_fun -> test
+
+(** Create a TestLabel for a TestList *)
+val (>:::) : string -> test list -> test
+
+(** Some shorthands which allows easy test construction.
+
+ Examples:
+
+ - ["test1" >: TestCase((fun _ -> ()))] =>
+ [TestLabel("test2", TestCase((fun _ -> ())))]
+ - ["test2" >:: (fun _ -> ())] =>
+ [TestLabel("test2", TestCase((fun _ -> ())))]
+ - ["test-suite" >::: ["test2" >:: (fun _ -> ());]] =>
+ [TestLabel("test-suite", TestSuite([TestLabel("test2", TestCase((fun _ -> ())))]))]
+*)
+
+(** [test_decorate g tst] Apply [g] to test function contains in [tst] tree.
+
+ @since 1.0.3
+ *)
+val test_decorate : (test_fun -> test_fun) -> test -> test
+
+(** [test_filter paths tst] Filter test based on their path string representation.
+
+ @param skip] if set, just use [skip_if] for the matching tests.
+ @since 1.0.3
+ *)
+val test_filter : ?skip:bool -> string list -> test -> test option
+
+(** {2 Retrieve Information from Tests} *)
+
+(** Returns the number of available test cases *)
+val test_case_count : test -> int
+
+(** Types which represent the path of a test *)
+type node = ListItem of int | Label of string
+type path = node list (** The path to the test (in reverse order). *)
+
+(** Make a string from a node *)
+val string_of_node : node -> string
+
+(** Make a string from a path. The path will be reversed before it is
+ tranlated into a string *)
+val string_of_path : path -> string
+
+(** Returns a list with paths of the test *)
+val test_case_paths : test -> path list
+
+(** {2 Performing Tests} *)
+
+(** The possible results of a test *)
+type test_result =
+ RSuccess of path
+ | RFailure of path * string
+ | RError of path * string
+ | RSkip of path * string
+ | RTodo of path * string
+
+(** Events which occur during a test run *)
+type test_event =
+ EStart of path
+ | EEnd of path
+ | EResult of test_result
+
+(** Perform the test, allows you to build your own test runner *)
+val perform_test : (test_event -> 'a) -> test -> test_result list
+
+(** A simple text based test runner. It prints out information
+ during the test.
+
+ @param verbose print verbose message
+ *)
+val run_test_tt : ?verbose:bool -> test -> test_result list
+
+(** Main version of the text based test runner. It reads the supplied command
+ line arguments to set the verbose level and limit the number of test to
+ run.
+
+ @param arg_specs add extra command line arguments
+ @param set_verbose call a function to set verbosity
+
+ @version 1.1.0
+ *)
+val run_test_tt_main :
+ ?arg_specs:(Arg.key * Arg.spec * Arg.doc) list ->
+ ?set_verbose:(bool -> unit) ->
+ test -> test_result list
Property changes on: trunk/src/omega/src/oUnit.mli
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/src/model_file.ml
===================================================================
--- trunk/src/omega/src/model_file.ml (revision 4104)
+++ trunk/src/omega/src/model_file.ml (revision 4105)
@@ -1,365 +1,367 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
(* In this module, the label [[v]] is ubiquitous for an optional
``verbose'' flag. *)
open Printf
(* \thocwmodulesubsection{Parsing} *)
let model_of_channel channel =
try
- Model_parser.file Model_lexer.token (Lexing.from_channel channel)
+ Model_file_parser.file Model_file_lexer.token (Lexing.from_channel channel)
with
- | Model_syntax.Syntax_Error (msg, i, j) ->
+ | Model_file_syntax.Syntax_Error (msg, i, j) ->
invalid_arg (sprintf "syntax error (%s) at: [%d,%d]" msg i j)
let model_of_file = function
| "-" -> model_of_channel stdin
| name ->
let channel = open_in name in
let model = model_of_channel channel in
close_in channel;
model
type error_level = Info | Warning | Error | Panic
let error_level_to_string = function
| Info -> "INFO"
| Warning -> "WARNING"
| Error -> "ERROR"
| Panic -> "PANIC"
let error ?(v = false) ?pfx ?(lvl = Error) msg =
if v then begin
begin match pfx with
| Some pfx -> eprintf "%s: " pfx
| None -> ()
end;
eprintf "%s: %s\n" (error_level_to_string lvl) msg
end
(* \thocwmodulesubsection{Metadata} *)
type metadata =
{ name : string;
version : string option;
authors : string list;
created : string option;
revised : string list }
(* Printing metadata and adding defaults, if necessary. *)
let print_metadata md =
printf "%% %s -- O'Mega model description file\n" md.name;
begin match md.version with
| None -> printf "version { %cId:%c } %% missing in input file\n" '$' '$';
| Some version -> printf "version {%s}\n" version
end;
begin match md.authors with
| [] -> printf "%% author missing in input file\n";
| authors -> List.iter (fun a -> printf "author {%s}\n" a) authors;
end;
begin match md.created with
| None -> printf "%% creation date missing in input file\n";
| Some created -> printf "created {%s}\n" created
end;
List.iter (fun r -> printf "revised {%s}\n" r) md.revised
(* Extract metadata from the abstract syntax ``tree'', dropping duplicate data. *)
let extract_authors ?(v = false) ?pfx = function
| [] ->
error ~v ?pfx ~lvl:Warning "no author in model file!";
[]
| rev_authors -> List.rev rev_authors
let extract_version ?(v = false) ?pfx = function
| [] ->
error ~v ?pfx ~lvl:Warning "no version in model file!";
None
| [version] -> Some version
| version :: _ ->
error ~v ?pfx ~lvl:Warning "multiple versions in model file!";
error ~v ?pfx ~lvl:Info "keeping the last version.";
Some version
let extract_created ?(v = false) ?pfx rev_created =
match List.rev rev_created with
| [] ->
error ~v ?pfx ~lvl:Warning "no creation date in model file!";
None
| [created] -> Some created
| created :: _ ->
error ~v ?pfx ~lvl:Warning "multiple creation dates in model file!";
error ~v ?pfx ~lvl:Info "keeping the first date.";
Some created
let extract_metadata ?v name file =
{ name = name;
- authors = extract_authors ?v ~pfx:name file.Model_syntax.authors;
- version = extract_version ?v ~pfx:name file.Model_syntax.version;
- created = extract_created ?v ~pfx:name file.Model_syntax.created;
- revised = List.rev file.Model_syntax.revised }
+ authors = extract_authors ?v ~pfx:name file.Model_file_syntax.authors;
+ version = extract_version ?v ~pfx:name file.Model_file_syntax.version;
+ created = extract_created ?v ~pfx:name file.Model_file_syntax.created;
+ revised = List.rev file.Model_file_syntax.revised }
(* \thocwmodulesubsection{Particles} *)
type particle =
{ name : string;
is_anti : bool;
lorentz : Coupling.lorentz;
fermion : int;
charge : int option;
color : int option;
pdg : int option;
tex : string option }
let print_opt_pdg name = function
| None -> ()
| Some pdg -> printf "%% %s : pdg = %d\n" name pdg
let print_neutral p =
printf "particle %s : ... \n" p.name;
print_opt_pdg p.name p.pdg
let print_charged p a =
printf "particle %s %s : ... \n" p.name a.name;
print_opt_pdg p.name p.pdg;
print_opt_pdg a.name a.pdg
let print_particle = function
| (p, None) -> print_neutral p
| (p, Some a) -> if not p.is_anti then print_charged p a
module SMap =
Map.Make (struct type t = string let compare = compare end)
type particles = (particle * particle option) SMap.t
let add_neutral name particle map =
SMap.add name (particle, None) map
let add_charged name1 particle1 name2 particle2 map =
SMap.add name1 (particle1, Some particle2)
(SMap.add name2 (particle2, Some particle1) map)
(* Boolean values default to [[false]]. *)
let boolean_attrib ?v ?pfx name attribs =
try
match String.lowercase (List.assoc name attribs) with
| "true" | "t" | "1" -> true
| "false" | "f" | "0" -> false
| value ->
error ?v ?pfx ("invalid boolean value for `" ^ name ^ "': `" ^ value ^ "'!");
error ?v ?pfx ~lvl:Info "assuming false.";
false
with
| Not_found -> false
let opt_attrib name attribs =
try Some (List.assoc name attribs) with Not_found -> None
let opt_int_attrib ?v ?pfx name attribs =
try
Some (int_of_string (List.assoc name attribs))
with
| Not_found -> None
| Failure "int_of_string" ->
error ?v ?pfx ("invalid optional integer value for `" ^ name ^
"': `" ^ List.assoc name attribs ^ "'!");
error ?v ?pfx ~lvl:Info "ignored.";
None
(* Extract the lorentz representation from the \texttt{spin},
\texttt{majorana} and \texttt{massive} attributes. *)
let lorentz_of_attribs ?v ?pfx name is_anti attribs =
try
match List.assoc "spin" attribs with
| "0" ->
Coupling.Scalar
| "1/2" ->
if boolean_attrib "majorana" attribs then
Coupling.Majorana
else if is_anti then
Coupling.ConjSpinor
else
Coupling.Spinor
| "1" ->
if boolean_attrib "massive" attribs then
Coupling.Massive_Vector
else
Coupling.Vector
| "2" ->
Coupling.Tensor_2
| s ->
error ?v ?pfx ("invalid spin for particle `" ^ name ^ "': `" ^ s ^ "'!");
error ?v ?pfx ~lvl:Info "assuming spin=0.";
Coupling.Scalar
with
| Not_found ->
error ?v ?pfx ("no spin given for particle `" ^ name ^ "'!");
error ?v ?pfx ~lvl:Info "assuming spin=0.";
Coupling.Scalar
let charge_of_attribs ?v ?pfx name is_anti attribs =
try
match List.assoc "spin" attribs with
| "0" ->
Coupling.Scalar
| "1/2" ->
if boolean_attrib "majorana" attribs then
Coupling.Majorana
else if is_anti then
Coupling.ConjSpinor
else
Coupling.Spinor
| "1" ->
if boolean_attrib "massive" attribs then
Coupling.Massive_Vector
else
Coupling.Vector
| "2" ->
Coupling.Tensor_2
| s ->
error ?v ?pfx ("invalid spin for particle `" ^ name ^ "': `" ^ s ^ "'!");
error ?v ?pfx ~lvl:Info "assuming spin=0.";
Coupling.Scalar
with
| Not_found ->
error ?v ?pfx ("no spin given for particle `" ^ name ^ "'!");
error ?v ?pfx ~lvl:Info "assuming spin=0.";
Coupling.Scalar
let rec fermion_of_lorentz = function
| Coupling.Scalar -> 0
| Coupling.Spinor -> 1
| Coupling.ConjSpinor -> -1
| Coupling.Majorana -> 1
| Coupling.Maj_Ghost -> 0
| Coupling.Vector -> 0
| Coupling.Massive_Vector -> 0
| Coupling.Vectorspinor -> 1
| Coupling.Tensor_1 -> 0
| Coupling.Tensor_2 -> 0
| Coupling.BRS lorentz -> fermion_of_lorentz lorentz
let fermion_of_attribs ?v ?pfx name is_anti attribs =
match
(boolean_attrib ?v ?pfx "fermion" attribs,
boolean_attrib ?v ?pfx "boson" attribs) with
| false, true -> 0
| true, false -> if is_anti then 1 else -1
| true, true ->
error ?v ?pfx ("both `fermion' and `boson' given for `" ^ name ^ "'!");
error ?v ?pfx ~lvl:Info "ignored.";
fermion_of_lorentz (lorentz_of_attribs ?v ?pfx name is_anti attribs)
| false, false ->
fermion_of_lorentz (lorentz_of_attribs ?v ?pfx name is_anti attribs)
let particle_of_attribs ?v ?pfx name attribs =
let lorentz = lorentz_of_attribs ?v ?pfx name false attribs in
let fermion = fermion_of_attribs ?v ?pfx name false attribs in
{ name = name;
is_anti = false;
lorentz = lorentz;
fermion = fermion;
charge = opt_int_attrib ?v ?pfx "charge" attribs;
color = opt_int_attrib ?v ?pfx "color" attribs;
pdg = opt_int_attrib ?v ?pfx "pdg" attribs;
tex = opt_attrib "tex" attribs }
let flip_opt_sign = function
| None -> None
| Some n -> Some (- n)
let color_opt_sign = function
| None -> None
| Some n when n = 3 || n = -3 -> Some (-n)
| Some n -> Some n
let anti_particle_of_attribs ?v ?pfx name attribs =
let lorentz = lorentz_of_attribs ?v ?pfx name true attribs in
let fermion = fermion_of_attribs ?v ?pfx name true attribs in
{ name = name;
is_anti = true;
lorentz = lorentz;
fermion = fermion;
charge = flip_opt_sign (opt_int_attrib ?v ?pfx "charge" attribs);
color = color_opt_sign (opt_int_attrib ?v ?pfx "color" attribs);
pdg = flip_opt_sign (opt_int_attrib ?v ?pfx "pdg" attribs);
tex = opt_attrib "tex.anti" attribs }
module SSet =
Set.Make (struct type t = string let compare = compare end)
let known_attribs =
List.fold_right SSet.add
["spin"; "massive"; "majorana"; "fermion"; "boson";
"pdg"; "tex"; "tex.anti"; "charge"; "color"] SSet.empty
let scan_particle_attrib ?v ?pfx (name, value) =
if not (SSet.mem name known_attribs) then begin
error ?v ?pfx ("unknown particle attribute `" ^ name ^ "' = `" ^ value ^ "'!");
error ?v ?pfx ~lvl:Info "ignored."
end
let scan_particle_attribs ?v ?pfx attribs =
List.iter (scan_particle_attrib ?v ?pfx) attribs
let add_particle ?v ?pfx raw_particle map =
- scan_particle_attribs ?v ?pfx raw_particle.Model_syntax.attribs;
- match raw_particle.Model_syntax.name with
- | Model_syntax.Neutral name ->
+ scan_particle_attribs ?v ?pfx raw_particle.Model_file_syntax.attribs;
+ match raw_particle.Model_file_syntax.name with
+ | Model_file_syntax.Neutral name ->
add_neutral name (particle_of_attribs ?v ?pfx name
- raw_particle.Model_syntax.attribs) map
- | Model_syntax.Charged (name, anti) ->
+ raw_particle.Model_file_syntax.attribs) map
+ | Model_file_syntax.Charged (name, anti) ->
add_charged
name (particle_of_attribs ?v ?pfx name
- raw_particle.Model_syntax.attribs)
+ raw_particle.Model_file_syntax.attribs)
anti (anti_particle_of_attribs ?v ?pfx anti
- raw_particle.Model_syntax.attribs)
+ raw_particle.Model_file_syntax.attribs)
map
let extract_particles ?v name file =
- List.fold_right (add_particle ?v ~pfx:name) file.Model_syntax.particles SMap.empty
+ List.fold_right
+ (add_particle ?v ~pfx:name)
+ file.Model_file_syntax.particles SMap.empty
(* \thocwmodulesection{Test Program} *)
let _ =
let file = "-" in
let model = model_of_file file in
let metadata = extract_metadata ~v:true file model in
let particles = extract_particles ~v:true file model in
- let vertices = model.Model_syntax.vertices in
+ let vertices = model.Model_file_syntax.vertices in
print_metadata metadata;
SMap.iter (fun name p -> print_particle p) particles;
- List.iter (fun v -> Vertex.process_vertex v.Model_syntax.expr) vertices
+ List.iter (fun v -> Vertex.process_vertex v.Model_file_syntax.expr) vertices
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/vertex.mli
===================================================================
--- trunk/src/omega/src/vertex.mli (revision 4104)
+++ trunk/src/omega/src/vertex.mli (revision 4105)
@@ -1,57 +1,64 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+module Test : functor (M : Model.T) ->
+ sig val example : unit -> unit val suite : OUnit.test end
+
+(*i
+
(* We're dealing with the tensor algebra freely generated by
momenta, metric and $\epsilon$ tensors, as well as scalars,
vectors and tensors constructed from fermionic bilinears.
The design problem that we're dealing with is that an implementation
relying on types to guarantee that only legal expressions can be
constructed will be hideously complex. A ``correct'' solution would
represent vertices as tensors, without using indices, external
polarization vectors or currents. However, the presence of
contractions~$g^{\mu\nu}$ and~$\epsilon^{\mu\nu\rho\sigma}$ introduces
a wealth of special cases, corresponding to which combinations of invariant
tensors remains uncontracted.
Therefore, it appears to be a better strategy to use arithmetic expressions
built from tensors contrated with external polarization vectors. We can then
check at runtime that the expression is linear in these polarization vectors. *)
(* \thocwmodulesection{Code Generation}
\begin{dubious}
Most of this will be moved to [Targets].
\end{dubious} *)
val parse : string -> Vertex_syntax.scalar
val process_vertex : Vertex_syntax.scalar -> unit
+i*)
+
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* compile-command:"ocamlc -o vertex thoList.ml{i,} pmap.ml{i,} vertex.ml"
* End:
i*)
Index: trunk/src/omega/src/oUnitDiff.ml
===================================================================
--- trunk/src/omega/src/oUnitDiff.ml (revision 0)
+++ trunk/src/omega/src/oUnitDiff.ml (revision 4105)
@@ -0,0 +1,212 @@
+(* $Id$ *)
+
+(***********************************************************************)
+(* The OUnit library *)
+(* *)
+(* Copyright (C) 2010 OCamlCore SARL *)
+(* *)
+(***********************************************************************)
+
+(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
+
+(************************************************************************
+
+The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this document and the OUnit software ("the Software"), to
+deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute,
+sublicense, and/or sell copies of the Software, and to permit persons
+to whom the Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+The Software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall Maas-Maarten Zeeman be liable for any claim, damages
+or other liability, whether in an action of contract, tort or
+otherwise, arising from, out of or in connection with the Software or
+the use or other dealings in the software.
+
+************************************************************************)
+
+open Format
+
+module type DIFF_ELEMENT =
+sig
+ type t
+
+ val pp_printer: Format.formatter -> t -> unit
+
+ val compare: t -> t -> int
+
+ val pp_print_sep: Format.formatter -> unit -> unit
+end
+
+module type S =
+sig
+ type e
+
+ type t
+
+ val compare: t -> t -> int
+
+ val pp_printer: Format.formatter -> t -> unit
+
+ val pp_diff: Format.formatter -> (t * t) -> unit
+
+ val assert_equal: ?msg:string -> t -> t -> unit
+
+ val of_list: e list -> t
+end
+
+let assert_equal ?msg compare pp_printer pp_diff exp act =
+ OUnit.assert_equal
+ ~cmp:(fun t1 t2 -> (compare t1 t2) = 0)
+ ~printer:(fun t ->
+ let buff = Buffer.create 13 in
+ let fmt = formatter_of_buffer buff in
+ pp_printer fmt t;
+ pp_print_flush fmt ();
+ Buffer.contents buff)
+ ~pp_diff
+ ?msg
+ exp act
+
+module SetMake (D: DIFF_ELEMENT) : S with type e = D.t =
+struct
+ module Set = Set.Make(D)
+
+ type e = D.t
+
+ type t = Set.t
+
+ let compare =
+ Set.compare
+
+ let pp_printer fmt t =
+ let first = ref true in
+ pp_open_box fmt 0;
+ Set.iter
+ (fun e ->
+ if not !first then
+ D.pp_print_sep fmt ();
+ D.pp_printer fmt e;
+ first := false)
+ t;
+ pp_close_box fmt ()
+
+ let pp_diff fmt (t1, t2) =
+ let first = ref true in
+ let print_list c t =
+ Set.iter
+ (fun e ->
+ if not !first then
+ D.pp_print_sep fmt ();
+ pp_print_char fmt c;
+ D.pp_printer fmt e;
+ first := false)
+ t
+ in
+ pp_open_box fmt 0;
+ print_list '+' (Set.diff t2 t1);
+ print_list '-' (Set.diff t1 t2);
+ pp_close_box fmt ()
+
+ let assert_equal ?msg exp act =
+ assert_equal ?msg compare pp_printer pp_diff exp act
+
+ let of_list lst =
+ List.fold_left
+ (fun acc e ->
+ Set.add e acc)
+ Set.empty
+ lst
+
+end
+
+module ListSimpleMake (D: DIFF_ELEMENT) : S with type e = D.t and type t = D.t list =
+struct
+ type e = D.t
+
+ type t = e list
+
+ let rec compare t1 t2 =
+ match t1, t2 with
+ | e1 :: tl1, e2 :: tl2 ->
+ begin
+ match D.compare e1 e2 with
+ | 0 ->
+ compare tl1 tl2
+ | n ->
+ n
+ end
+
+ | [], [] ->
+ 0
+
+ | _, [] ->
+ -1
+
+ | [], _ ->
+ 1
+
+ let pp_print_gen pre fmt t =
+ let first = ref true in
+ pp_open_box fmt 0;
+ List.iter
+ (fun e ->
+ if not !first then
+ D.pp_print_sep fmt ();
+ fprintf fmt "%s%a" pre D.pp_printer e;
+ first := false)
+ t;
+ pp_close_box fmt ()
+
+ let pp_printer fmt t =
+ pp_print_gen "" fmt t
+
+ let pp_diff fmt (t1, t2) =
+ let rec pp_diff' n t1 t2 =
+ match t1, t2 with
+ | e1 :: tl1, e2 :: tl2 ->
+ begin
+ match D.compare e1 e2 with
+ | 0 ->
+ pp_diff' (n + 1) tl1 tl2
+ | _ ->
+ fprintf fmt
+ "element number %d differ (%a <> %a)"
+ n
+ D.pp_printer e1
+ D.pp_printer e2
+ end
+
+ | [], [] ->
+ ()
+
+ | [], lst ->
+ fprintf fmt "at end,@ ";
+ pp_print_gen "+" fmt lst
+
+ | lst, [] ->
+ fprintf fmt "at end,@ ";
+ pp_print_gen "-" fmt lst
+ in
+ pp_open_box fmt 0;
+ pp_diff' 0 t1 t2;
+ pp_close_box fmt ()
+
+ let assert_equal ?msg exp act =
+ assert_equal ?msg compare pp_printer pp_diff exp act
+
+ let of_list lst =
+ lst
+end
+
+let pp_comma_separator fmt () =
+ fprintf fmt ",@ "
Property changes on: trunk/src/omega/src/oUnitDiff.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/src/model_file_parser.mly
===================================================================
--- trunk/src/omega/src/model_file_parser.mly (revision 0)
+++ trunk/src/omega/src/model_file_parser.mly (revision 4105)
@@ -0,0 +1,102 @@
+/* $Id$
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+%{
+let parse_error msg =
+ raise (Model_file_syntax.Syntax_Error (msg, symbol_start (), symbol_end ()))
+%}
+
+%token < string > STRING EXPR
+%token PARTICLE COUPLING VERTEX
+%token AUTHOR VERSION CREATED REVISED
+%token COMMA EQUAL COLON
+%token END
+
+%start file
+%type < Model_file_syntax.file > file
+
+%%
+
+file:
+ declarations END { $1 }
+;
+
+declarations:
+ { Model_file_syntax.empty () }
+ | declarations particle_declaration
+ { Model_file_syntax.add_particle $2 $1 }
+ | declarations vertex_declaration
+ { Model_file_syntax.add_vertex $2 $1 }
+ | declarations coupling_declaration
+ { Model_file_syntax.add_coupling $2 $1 }
+ | declarations AUTHOR EXPR { Model_file_syntax.add_author $3 $1 }
+ | declarations VERSION EXPR { Model_file_syntax.add_version $3 $1 }
+ | declarations CREATED EXPR { Model_file_syntax.add_created $3 $1 }
+ | declarations REVISED EXPR { Model_file_syntax.add_revised $3 $1 }
+;
+
+particle_declaration:
+ PARTICLE STRING attrib_list
+ { Model_file_syntax.neutral $2 $3 }
+ | PARTICLE STRING opt_comma STRING attrib_list
+ { Model_file_syntax.charged $2 $4 $5 }
+;
+
+attrib_list:
+ { List.rev [] }
+ | COLON { List.rev [] }
+ | COLON rev_attrib_list { List.rev $2 }
+
+rev_attrib_list:
+ attrib { [$1] }
+ | rev_attrib_list opt_comma attrib
+ { $3 :: $1 }
+;
+
+attrib:
+ STRING { ($1, "true") }
+ | STRING EQUAL STRING { ($1, $3) }
+;
+
+coupling_declaration:
+ COUPLING STRING { Model_file_syntax.coupling $2 }
+;
+
+vertex_declaration:
+ VERTEX particle_list COLON EXPR
+ { Model_file_syntax.vertex $2 $4 }
+;
+
+particle_list:
+ rev_particle_list { List.rev $1 }
+
+rev_particle_list:
+ STRING { [$1] }
+ | rev_particle_list opt_comma STRING
+ { $3 :: $1 }
+;
+
+opt_comma:
+ { () }
+ | COMMA { () }
+;
Property changes on: trunk/src/omega/src/model_file_parser.mly
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision HeadURL URL
\ No newline at end of property
Index: trunk/src/omega/src/oUnit.ml
===================================================================
--- trunk/src/omega/src/oUnit.ml (revision 0)
+++ trunk/src/omega/src/oUnit.ml (revision 4105)
@@ -0,0 +1,805 @@
+(* $Id$ *)
+
+(***********************************************************************)
+(* The OUnit library *)
+(* *)
+(* Copyright (C) 2002-2008 Maas-Maarten Zeeman. *)
+(* Copyright (C) 2010 OCamlCore SARL *)
+(* *)
+(***********************************************************************)
+
+(* Version 1.1.2, with minor modifications by Thorsten Ohl *)
+
+(************************************************************************
+
+The package OUnit is copyright by Maas-Maarten Zeeman and OCamlCore SARL.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this document and the OUnit software ("the Software"), to
+deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute,
+sublicense, and/or sell copies of the Software, and to permit persons
+to whom the Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+The Software is provided ``as is'', without warranty of any kind,
+express or implied, including but not limited to the warranties of
+merchantability, fitness for a particular purpose and noninfringement.
+In no event shall Maas-Maarten Zeeman be liable for any claim, damages
+or other liability, whether in an action of contract, tort or
+otherwise, arising from, out of or in connection with the Software or
+the use or other dealings in the software.
+
+************************************************************************)
+
+open Format
+
+(* TODO: really use Format in printf call. Most of the time, not
+ * cuts/spaces/boxes are used
+ *)
+
+let global_verbose = ref false
+
+let buff_printf f =
+ let buff = Buffer.create 13 in
+ let fmt = formatter_of_buffer buff in
+ f fmt;
+ pp_print_flush fmt ();
+ Buffer.contents buff
+
+let bracket set_up f tear_down () =
+ let fixture =
+ set_up ()
+ in
+ let () =
+ try
+ let () = f fixture in
+ tear_down fixture
+ with e ->
+ let () =
+ tear_down fixture
+ in
+ raise e
+ in
+ ()
+
+let bracket_tmpfile ?(prefix="ounit-") ?(suffix=".txt") ?mode f =
+ bracket
+ (fun () ->
+ Filename.open_temp_file ?mode prefix suffix)
+ f
+ (fun (fn, chn) ->
+ begin
+ try
+ close_out chn
+ with _ ->
+ ()
+ end;
+ begin
+ try
+ Sys.remove fn
+ with _ ->
+ ()
+ end)
+
+exception Skip of string
+let skip_if b msg =
+ if b then
+ raise (Skip msg)
+
+exception Todo of string
+let todo msg =
+ raise (Todo msg)
+
+let assert_failure msg =
+ failwith ("OUnit: " ^ msg)
+
+let assert_bool msg b =
+ if not b then assert_failure msg
+
+let assert_string str =
+ if not (str = "") then assert_failure str
+
+let assert_equal ?(cmp = ( = )) ?printer ?pp_diff ?msg expected actual =
+ let get_error_string () =
+(* let max_len = pp_get_margin fmt () in *)
+(* let ellipsis_text = "[...]" in *)
+ let print_ellipsis p fmt s =
+ (* TODO: find a way to do this
+ let res = p s in
+ let len = String.length res in
+ if diff <> None && len > max_len then
+ begin
+ let len_with_ellipsis =
+ (max_len - (String.length ellipsis_text)) / 2
+ in
+ (* TODO: we should use %a here to print values *)
+ fprintf fmt
+ "@[%s[...]%s@]"
+ (String.sub res
+ 0
+ len_with_ellipsis)
+ (String.sub res
+ (len - len_with_ellipsis)
+ len_with_ellipsis)
+ end
+ else
+ begin
+ (* TODO: we should use %a here to print values *)
+ fprintf fmt "@[%s@]" res
+ end
+ *)
+ pp_print_string fmt (p s)
+ in
+
+ let res =
+ buff_printf
+ (fun fmt ->
+ pp_open_vbox fmt 0;
+ begin
+ match msg with
+ | Some s ->
+ pp_open_box fmt 0;
+ pp_print_string fmt s;
+ pp_close_box fmt ();
+ pp_print_cut fmt ()
+ | None ->
+ ()
+ end;
+
+ begin
+ match printer with
+ | Some p ->
+ let p_ellipsis = print_ellipsis p in
+ fprintf fmt
+ "@[expected: @[%a@]@ but got: @[%a@]@]@,"
+ p_ellipsis expected
+ p_ellipsis actual
+
+ | None ->
+ fprintf fmt "@[not equal@]@,"
+ end;
+
+ begin
+ match pp_diff with
+ | Some d ->
+ fprintf fmt
+ "@[differences: %a@]@,"
+ d (expected, actual)
+
+ | None ->
+ ()
+ end;
+
+ pp_close_box fmt ())
+ in
+ let len =
+ String.length res
+ in
+ if len > 0 && res.[len - 1] = '\n' then
+ String.sub res 0 (len - 1)
+ else
+ res
+
+ in
+
+ if not (cmp expected actual) then
+ assert_failure (get_error_string ())
+
+let assert_command
+ ?(exit_code=Unix.WEXITED 0)
+ ?(sinput=Stream.of_list [])
+ ?(foutput=ignore)
+ ?(use_stderr=true)
+ ?env
+ ?verbose
+ prg args =
+
+ let verbose =
+ match verbose with
+ | Some v -> v
+ | None -> !global_verbose
+ in
+
+ bracket_tmpfile
+ (fun (fn_out, chn_out) ->
+ let cmd_print fmt =
+ let () =
+ match env with
+ | Some e ->
+ begin
+ pp_print_string fmt "env";
+ Array.iter (fprintf fmt "@ %s") e;
+ pp_print_space fmt ()
+ end
+
+ | None ->
+ ()
+ in
+ pp_print_string fmt prg;
+ List.iter (fprintf fmt "@ %s") args
+ in
+
+ (* Start the process *)
+ let in_write =
+ Unix.dup (Unix.descr_of_out_channel chn_out)
+ in
+ let (out_read, out_write) =
+ Unix.pipe ()
+ in
+ let err =
+ if use_stderr then
+ in_write
+ else
+ Unix.stderr
+ in
+ let args =
+ Array.of_list (prg :: args)
+ in
+ let pid =
+ Unix.set_close_on_exec out_write;
+ if verbose then
+ printf "@[Starting command '%t'@]\n" cmd_print;
+ match env with
+ | Some e ->
+ Unix.create_process_env prg args e out_read in_write err
+ | None ->
+ Unix.create_process prg args out_read in_write err
+ in
+ let () =
+ Unix.close out_read;
+ Unix.close in_write
+ in
+ let () =
+ (* Dump sinput into the process stdin *)
+ let buff = " " in
+ Stream.iter
+ (fun c ->
+ let _i : int =
+ buff.[0] <- c;
+ Unix.write out_write buff 0 1
+ in
+ ())
+ sinput;
+ Unix.close out_write
+ in
+ let _, real_exit_code =
+ let rec wait_intr () =
+ try
+ Unix.waitpid [] pid
+ with Unix.Unix_error (Unix.EINTR, _, _) ->
+ wait_intr ()
+ in
+ wait_intr ()
+ in
+ let exit_code_printer =
+ function
+ | Unix.WEXITED n ->
+ Printf.sprintf "exit code %d" n
+ | Unix.WSTOPPED n ->
+ Printf.sprintf "stopped by signal %d" n
+ | Unix.WSIGNALED n ->
+ Printf.sprintf "killed by signal %d" n
+ in
+
+ (* Dump process output to stderr *)
+ if verbose then
+ begin
+ let chn =
+ open_in fn_out
+ in
+ let buff = String.make 4096 'X' in
+ let len = ref (-1) in
+ while !len <> 0 do
+ len := input chn buff 0 (String.length buff);
+ printf "%s" (String.sub buff 0 !len);
+ done;
+ printf "@?";
+ close_in chn
+ end;
+
+ (* Check process status *)
+ assert_equal
+ ~msg:(buff_printf
+ (fun fmt ->
+ fprintf fmt
+ "@[Exit status of command '%t'@]" cmd_print))
+ ~printer:exit_code_printer
+ exit_code
+ real_exit_code;
+
+ begin
+ let chn =
+ open_in fn_out
+ in
+ try
+ foutput (Stream.of_channel chn)
+ with e ->
+ close_in chn;
+ raise e
+ end)
+ ()
+
+let raises f =
+ try
+ f ();
+ None
+ with e ->
+ Some e
+
+let assert_raises ?msg exn (f: unit -> 'a) =
+ let pexn =
+ Printexc.to_string
+ in
+ let get_error_string () =
+ let str =
+ Format.sprintf
+ "expected exception %s, but no exception was raised."
+ (pexn exn)
+ in
+ match msg with
+ | None ->
+ assert_failure str
+
+ | Some s ->
+ assert_failure (Format.sprintf "%s\n%s" s str)
+ in
+ match raises f with
+ | None ->
+ assert_failure (get_error_string ())
+
+ | Some e ->
+ assert_equal ?msg ~printer:pexn exn e
+
+(* Compare floats up to a given relative error *)
+let cmp_float ?(epsilon = 0.00001) a b =
+ abs_float (a -. b) <= epsilon *. (abs_float a) ||
+ abs_float (a -. b) <= epsilon *. (abs_float b)
+
+(* Now some handy shorthands *)
+let (@?) = assert_bool
+
+(* The type of test function *)
+type test_fun = unit -> unit
+
+(* The type of tests *)
+type test =
+ | TestCase of test_fun
+ | TestList of test list
+ | TestLabel of string * test
+
+(* Some shorthands which allows easy test construction *)
+let (>:) s t = TestLabel(s, t) (* infix *)
+let (>::) s f = TestLabel(s, TestCase(f)) (* infix *)
+let (>:::) s l = TestLabel(s, TestList(l)) (* infix *)
+
+(* Utility function to manipulate test *)
+let rec test_decorate g =
+ function
+ | TestCase f ->
+ TestCase (g f)
+ | TestList tst_lst ->
+ TestList (List.map (test_decorate g) tst_lst)
+ | TestLabel (str, tst) ->
+ TestLabel (str, test_decorate g tst)
+
+(* Return the number of available tests *)
+let rec test_case_count =
+ function
+ | TestCase _ ->
+ 1
+
+ | TestLabel (_, t) ->
+ test_case_count t
+
+ | TestList l ->
+ List.fold_left
+ (fun c t -> c + test_case_count t)
+ 0 l
+
+type node =
+ | ListItem of int
+ | Label of string
+
+type path = node list
+
+let string_of_node =
+ function
+ | ListItem n ->
+ string_of_int n
+ | Label s ->
+ s
+
+let string_of_path path =
+ String.concat ":" (List.rev_map string_of_node path)
+
+(* Some helper function, they are generally applicable *)
+(* Applies function f in turn to each element in list. Function f takes
+ one element, and integer indicating its location in the list *)
+let mapi f l =
+ let rec rmapi cnt l =
+ match l with
+ | [] ->
+ []
+
+ | h :: t ->
+ (f h cnt) :: (rmapi (cnt + 1) t)
+ in
+ rmapi 0 l
+
+let fold_lefti f accu l =
+ let rec rfold_lefti cnt accup l =
+ match l with
+ | [] ->
+ accup
+
+ | h::t ->
+ rfold_lefti (cnt + 1) (f accup h cnt) t
+ in
+ rfold_lefti 0 accu l
+
+(* Returns all possible paths in the test. The order is from test case
+ to root
+ *)
+let test_case_paths test =
+ let rec tcps path test =
+ match test with
+ | TestCase _ ->
+ [path]
+
+ | TestList tests ->
+ List.concat
+ (mapi (fun t i -> tcps ((ListItem i)::path) t) tests)
+
+ | TestLabel (l, t) ->
+ tcps ((Label l)::path) t
+ in
+ tcps [] test
+
+(* Test filtering with their path *)
+module SetTestPath = Set.Make(String)
+
+let test_filter ?(skip=false) only test =
+ let set_test =
+ List.fold_left
+ (fun st str -> SetTestPath.add str st)
+ SetTestPath.empty
+ only
+ in
+ let rec filter_test path tst =
+ if SetTestPath.mem (string_of_path path) set_test then
+ begin
+ Some tst
+ end
+
+ else
+ begin
+ match tst with
+ | TestCase f ->
+ begin
+ if skip then
+ Some
+ (TestCase
+ (fun () ->
+ skip_if true "Test disabled";
+ f ()))
+ else
+ None
+ end
+
+ | TestList tst_lst ->
+ begin
+ let ntst_lst =
+ fold_lefti
+ (fun ntst_lst tst i ->
+ let nntst_lst =
+ match filter_test ((ListItem i) :: path) tst with
+ | Some tst ->
+ tst :: ntst_lst
+ | None ->
+ ntst_lst
+ in
+ nntst_lst)
+ []
+ tst_lst
+ in
+ if not skip && ntst_lst = [] then
+ None
+ else
+ Some (TestList (List.rev ntst_lst))
+ end
+
+ | TestLabel (lbl, tst) ->
+ begin
+ let ntst_opt =
+ filter_test
+ ((Label lbl) :: path)
+ tst
+ in
+ match ntst_opt with
+ | Some ntst ->
+ Some (TestLabel (lbl, ntst))
+ | None ->
+ if skip then
+ Some (TestLabel (lbl, tst))
+ else
+ None
+ end
+ end
+ in
+ filter_test [] test
+
+
+(* The possible test results *)
+type test_result =
+ | RSuccess of path
+ | RFailure of path * string
+ | RError of path * string
+ | RSkip of path * string
+ | RTodo of path * string
+
+let is_success =
+ function
+ | RSuccess _ -> true
+ | RFailure _ | RError _ | RSkip _ | RTodo _ -> false
+
+let is_failure =
+ function
+ | RFailure _ -> true
+ | RSuccess _ | RError _ | RSkip _ | RTodo _ -> false
+
+let is_error =
+ function
+ | RError _ -> true
+ | RSuccess _ | RFailure _ | RSkip _ | RTodo _ -> false
+
+let is_skip =
+ function
+ | RSkip _ -> true
+ | RSuccess _ | RFailure _ | RError _ | RTodo _ -> false
+
+let is_todo =
+ function
+ | RTodo _ -> true
+ | RSuccess _ | RFailure _ | RError _ | RSkip _ -> false
+
+let result_flavour =
+ function
+ | RError _ -> "Error"
+ | RFailure _ -> "Failure"
+ | RSuccess _ -> "Success"
+ | RSkip _ -> "Skip"
+ | RTodo _ -> "Todo"
+
+let result_path =
+ function
+ | RSuccess path
+ | RError (path, _)
+ | RFailure (path, _)
+ | RSkip (path, _)
+ | RTodo (path, _) -> path
+
+let result_msg =
+ function
+ | RSuccess _ -> "Success"
+ | RError (_, msg)
+ | RFailure (_, msg)
+ | RSkip (_, msg)
+ | RTodo (_, msg) -> msg
+
+(* Returns true if the result list contains successes only *)
+let rec was_successful =
+ function
+ | [] -> true
+ | RSuccess _::t
+ | RSkip _::t ->
+ was_successful t
+
+ | RFailure _::_
+ | RError _::_
+ | RTodo _::_ ->
+ false
+
+(* Events which can happen during testing *)
+type test_event =
+ | EStart of path
+ | EEnd of path
+ | EResult of test_result
+
+let maybe_backtrace () =
+ if Printexc.backtrace_status () then
+ "\n" ^ Printexc.get_backtrace ()
+ else ""
+
+(* Run all tests, report starts, errors, failures, and return the results *)
+let perform_test report test =
+ let run_test_case f path =
+ try
+ f ();
+ RSuccess path
+ with
+ | Failure s ->
+ RFailure (path, s ^ maybe_backtrace ())
+
+ | Skip s ->
+ RSkip (path, s)
+
+ | Todo s ->
+ RTodo (path, s)
+
+ | s ->
+ RError (path, Printexc.to_string s ^ maybe_backtrace ())
+ in
+ let rec run_test path results =
+ function
+ | TestCase(f) ->
+ begin
+ let result =
+ report (EStart path);
+ run_test_case f path
+ in
+ report (EResult result);
+ report (EEnd path);
+ result::results
+ end
+
+ | TestList (tests) ->
+ begin
+ fold_lefti
+ (fun results t cnt ->
+ run_test
+ ((ListItem cnt)::path)
+ results t)
+ results tests
+ end
+
+ | TestLabel (label, t) ->
+ begin
+ run_test ((Label label)::path) results t
+ end
+ in
+ run_test [] [] test
+
+(* Function which runs the given function and returns the running time
+ of the function, and the original result in a tuple *)
+let time_fun f x y =
+ let begin_time = Unix.gettimeofday () in
+ (Unix.gettimeofday () -. begin_time, f x y)
+
+(* A simple (currently too simple) text based test runner *)
+let run_test_tt ?verbose test =
+ let verbose =
+ match verbose with
+ | Some v -> v
+ | None -> !global_verbose
+ in
+ let printf = Format.printf in
+ let separator1 =
+ String.make (get_margin ()) '='
+ in
+ let separator2 =
+ String.make (get_margin ()) '-'
+ in
+ let string_of_result =
+ function
+ | RSuccess _ ->
+ if verbose then "ok\n" else "."
+ | RFailure (_, _) ->
+ if verbose then "FAIL\n" else "F"
+ | RError (_, _) ->
+ if verbose then "ERROR\n" else "E"
+ | RSkip (_, _) ->
+ if verbose then "SKIP\n" else "S"
+ | RTodo (_, _) ->
+ if verbose then "TODO\n" else "T"
+ in
+ let report_event =
+ function
+ | EStart p ->
+ if verbose then printf "%s ...\n" (string_of_path p)
+ | EEnd _ ->
+ ()
+ | EResult result ->
+ printf "%s@?" (string_of_result result)
+ in
+ let print_result_list results =
+ List.iter
+ (fun result ->
+ printf "%s\n%s: %s\n\n%s\n%s\n"
+ separator1
+ (result_flavour result)
+ (string_of_path (result_path result))
+ (result_msg result)
+ separator2)
+ results
+ in
+
+ (* Now start the test *)
+ let running_time, results = time_fun perform_test report_event test in
+ let errors = List.filter is_error results in
+ let failures = List.filter is_failure results in
+ let skips = List.filter is_skip results in
+ let todos = List.filter is_todo results in
+
+ if not verbose then printf "\n";
+
+ (* Print test report *)
+ print_result_list errors;
+ print_result_list failures;
+ printf "Ran: %d tests in: %.2f seconds.\n"
+ (List.length results) running_time;
+
+ (* Print final verdict *)
+ if was_successful results then
+ (
+ if skips = [] then
+ printf "OK"
+ else
+ printf "OK: Cases: %d Skip: %d\n"
+ (test_case_count test) (List.length skips)
+ )
+ else
+ printf "FAILED: Cases: %d Tried: %d Errors: %d \
+ Failures: %d Skip:%d Todo:%d\n"
+ (test_case_count test) (List.length results)
+ (List.length errors) (List.length failures)
+ (List.length skips) (List.length todos);
+
+ (* Return the results possibly for further processing *)
+ results
+
+(* Call this one from you test suites *)
+let run_test_tt_main ?(arg_specs=[]) ?(set_verbose=ignore) suite =
+ let only_test = ref [] in
+ let () =
+ Arg.parse
+ (Arg.align
+ [
+ "-verbose",
+ Arg.Set global_verbose,
+ " Run the test in verbose mode.";
+
+ "-only-test",
+ Arg.String (fun str -> only_test := str :: !only_test),
+ "path Run only the selected test";
+
+ "-list-test",
+ Arg.Unit
+ (fun () ->
+ List.iter
+ (fun pth ->
+ print_endline (string_of_path pth))
+ (test_case_paths suite);
+ exit 0),
+ " List tests";
+ ] @ arg_specs
+ )
+ (fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
+ ("usage: " ^ Sys.argv.(0) ^ " [-verbose] [-only-test path]*")
+ in
+ let nsuite =
+ if !only_test = [] then
+ suite
+ else
+ begin
+ match test_filter ~skip:true !only_test suite with
+ | Some test ->
+ test
+ | None ->
+ failwith ("Filtering test "^
+ (String.concat ", " !only_test)^
+ " lead to no test")
+ end
+ in
+
+ let result =
+ set_verbose !global_verbose;
+ run_test_tt ~verbose:!global_verbose nsuite
+ in
+ if not (was_successful result) then
+ exit 1
+ else
+ result
Property changes on: trunk/src/omega/src/oUnit.ml
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Id
\ No newline at end of property
Index: trunk/src/omega/src/partial.mli
===================================================================
--- trunk/src/omega/src/partial.mli (revision 0)
+++ trunk/src/omega/src/partial.mli (revision 4105)
@@ -0,0 +1,36 @@
+(* $Id: partial.mli 4015 2013-01-03 16:04:18Z jr_reuter $
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+(* Partial maps that are constructed from assoc lists. *)
+
+module type T =
+ sig
+ type domain
+ type 'a t
+ val of_list : (domain * 'a) list -> 'a t
+ val of_lists : domain list -> 'a list -> 'a t
+ val apply : 'a t -> domain -> 'a
+ end
+
+module Make : functor (D : Map.OrderedType) -> T with type domain = D.t
+module Test : sig val suite : OUnit.test end
Index: trunk/src/omega/src/model_file_syntax.mli
===================================================================
--- trunk/src/omega/src/model_file_syntax.mli (revision 0)
+++ trunk/src/omega/src/model_file_syntax.mli (revision 4105)
@@ -0,0 +1,68 @@
+(* $Id$
+
+ Copyright (C) 1999-2013 by
+
+ Wolfgang Kilian <kilian@physik.uni-siegen.de>
+ Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+ Juergen Reuter <juergen.reuter@desy.de>
+ Christian Speckner <cnspeckn@googlemail.com>
+
+ WHIZARD is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ WHIZARD is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
+
+(* This is not supposed to be an abstract data type, just the skeleton that
+ the parser is based on. *)
+
+type name =
+ | Charged of string * string
+ | Neutral of string
+
+type particle = { name : name; attribs : (string * string) list }
+val charged : string -> string -> (string * string) list -> particle
+val neutral : string -> (string * string) list -> particle
+
+type vertex = { fields : string list; expr : Vertex_syntax.scalar }
+val vertex : string list -> string -> vertex
+
+type coupling = string
+val coupling : string -> coupling
+
+type file =
+ { particles : particle list;
+ couplings : coupling list;
+ vertices : vertex list;
+ authors : string list;
+ version : string list;
+ created : string list;
+ revised : string list }
+
+val empty : unit -> file
+val add_particle : particle -> file -> file
+val add_coupling : string -> file -> file
+val add_vertex : vertex -> file -> file
+val add_author : string -> file -> file
+val add_version : string -> file -> file
+val add_created : string -> file -> file
+val add_revised : string -> file -> file
+
+exception Syntax_Error of string * int * int
+
+(*i
+ * Local Variables:
+ * mode:caml
+ * indent-tabs-mode:nil
+ * page-delimiter:"^(\\* .*\n"
+ * End:
+i*)
+
Property changes on: trunk/src/omega/src/model_file_syntax.mli
___________________________________________________________________
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision HeadURL URL
\ No newline at end of property
Index: trunk/src/omega/src/omega.tex
===================================================================
--- trunk/src/omega/src/omega.tex (revision 4104)
+++ trunk/src/omega/src/omega.tex (revision 4105)
@@ -1,1205 +1,1207 @@
% $Id$
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\NeedsTeXFormat{LaTeX2e}
\RequirePackage{ifpdf}
\ifpdf
\documentclass[a4paper,notitlepage,chapters]{flex}
\usepackage{type1cm}
\usepackage[pdftex,colorlinks]{hyperref}
\usepackage[pdftex]{graphicx,feynmp,emp}
\DeclareGraphicsRule{*}{mps}{*}{}
\else
\documentclass[a4paper,notitlepage,chapters]{flex}
\usepackage[T1]{fontenc}
% \usepackage[hypertex]{hyperref}
\usepackage{graphicx,feynmp,emp}
\fi
\usepackage{verbatim,array,amsmath,amssymb}
\usepackage{url,thophys,thohacks}
\setlength{\unitlength}{1mm}
\empaddtoTeX{\usepackage{amsmath,amssymb}}
\empaddtoTeX{\usepackage{thophys,thohacks}}
\empaddtoprelude{input graph;}
\empaddtoprelude{input boxes;}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% This should be part of flex.cls and/or thopp.sty
\makeatletter
\@ifundefined{frontmatter}%
{\def\frontmatter{\pagenumbering{roman}}%
\def\mainmatter{\cleardoublepage\pagenumbering{arabic}}}
{}
\makeatother
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \makeatletter
%%% %%% Italic figure captions to separate them visually from the text
%%% %%% (this should be supported by flex.cls):
%%% \makeatletter
%%% \@secpenalty=-1000
%%% \def\fps@figure{t}
%%% \def\fps@table{b}
%%% \long\def\@makecaption#1#2{%
%%% \vskip\abovecaptionskip
%%% \sbox\@tempboxa{#1: \textit{#2}}%
%%% \ifdim\wd\@tempboxa>\hsize
%%% #1: \textit{#2}\par
%%% \else
%%% \global\@minipagefalse
%%% \hb@xt@\hsize{\hfil\box\@tempboxa\hfil}%
%%% \fi
%%% \vskip\belowcaptionskip}
%%% \makeatother
\widowpenalty=4000
\clubpenalty=4000
\displaywidowpenalty=4000
%%% \pagestyle{headings}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\allowdisplaybreaks
\renewcommand{\topfraction}{0.8}
\renewcommand{\bottomfraction}{0.8}
\renewcommand{\textfraction}{0.2}
\setlength{\abovecaptionskip}{.5\baselineskip}
\setlength{\belowcaptionskip}{\baselineskip}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% allow VERY overfull hboxes
\setlength{\hfuzz}{5cm}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\usepackage{noweb}
%%% \usepackage{nocondmac}
\setlength{\nwmarginglue}{1em}
\noweboptions{smallcode,noidentxref}%%%{webnumbering}
%%% Saving paper:
\def\nwendcode{\endtrivlist\endgroup}
\nwcodepenalty=0
\let\nwdocspar\relax
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\usepackage[noweb,bypages]{ocamlweb}
\empaddtoTeX{\usepackage[noweb,bypages]{ocamlweb}}
\renewcommand{\ocwinterface}[1]{\section{Interface of \ocwupperid{#1}}}
\renewcommand{\ocwmodule}[1]{\section{Implementation of \ocwupperid{#1}}}
\renewcommand{\ocwinterfacepart}{\relax}
\renewcommand{\ocwcodepart}{\relax}
\renewcommand{\ocwbeginindex}{\begin{theindex}}
\newcommand{\thocwmodulesection}[1]{\subsection{#1}}
\newcommand{\thocwmodulesubsection}[1]{\subsubsection{#1}}
\newcommand{\thocwmoduleparagraph}[1]{\paragraph{#1}}
\renewcommand{\ocweol}{\setlength\parskip{0pt}\par}
\makeatletter
\renewcommand{\@oddfoot}{\reset@font\hfil\thepage\hfil}
\let\@evenfoot\@oddfoot
\def\@evenhead{\leftmark{} \hrulefill}%
\def\@oddhead{\hrulefill{} \rightmark}%
\let\@mkboth\markboth
\renewcommand{\chaptermark}[1]{\markboth{\hfil}{\hfil}}%
\renewcommand{\sectionmark}[1]{\markboth{#1}{#1}}
\renewcommand{\chapter}{%
\clearpage\global\@topnum\z@\@afterindentfalse
\secdef\@chapter\@schapter}
\makeatother
\newcommand{\signature}[1]{%
\InputIfFileExists{#1.interface}{}%
{\begin{dubious}\textit{Interface \texttt{#1.mli} unavailable!}\end{dubious}}}
\newcommand{\application}[1]{%
\InputIfFileExists{#1.implementation}{}%
{\begin{dubious}\textit{Application \texttt{#1.ml} unavailable!}\end{dubious}}}
\newcommand{\module}[1]{%
\label{mod:#1}%
\InputIfFileExists{#1.interface}{}%
{\begin{dubious}\textit{Interface \texttt{#1.mli} unavailable!}\end{dubious}}%
\InputIfFileExists{#1.implementation}{}%
{\begin{dubious}\textit{Implementation \texttt{#1.ml} unavailable!}\end{dubious}}}
\newcommand{\lexer}[1]{\application{#1_lexer}}
\renewcommand{\ocwlexmodule}[1]{\relax}
\newcommand{\parser}[1]{\application{#1_parser}}
\renewcommand{\ocwyaccmodule}[1]{\relax}
\newcommand{\thocwincludegraphics}[2]{\includegraphics[#1]{#2}}
\ifpdf
\newcommand{\thocwdefref}[1]{\textbf{\pageref{#1}}}%
\newcommand{\thocwuseref}[1]{\textrm{\pageref{#1}}}%
\renewcommand{\ocwrefindexentry}[5]%
{\item #1,\quad\let\ref\thocwdefref{#4}, used: \let\ref\thocwuseref{#5}}
\fi
\newcommand{\thocwmakebox}[4]{\makebox(#1,#2)[#3]{#4}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newenvironment{modules}[1]%
{\begin{list}{}%
{\setlength{\leftmargin}{3em}%
\setlength{\rightmargin}{2em}%
\setlength{\itemindent}{-1em}%
\setlength{\listparindent}{0pt}%
%%%\setlength{\itemsep}{0pt}%
\settowidth{\labelwidth}{\textbf{\ocwupperid{#1}:}}%
\renewcommand{\makelabel}[1]{\ocwupperid{##1:}}}}%
{\end{list}}
\newenvironment{JR}%
{\begin{dubious}\textit{JR sez' (regarding the Majorana Feynman rules):}}
{\textit{(JR's probably right, but I need to check myself \ldots)}
\end{dubious}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\DeclareMathOperator{\tr}{tr}
\newcommand{\dd}{\mathrm{d}}
\newcommand{\ii}{\mathrm{i}}
\newcommand{\ee}{\mathrm{e}}
\renewcommand{\Re}{\text{Re}}
\renewcommand{\Im}{\text{Im}}
\newcommand{\ketbra}[2]{\ket{#1}\!\bra{#2}}
\newcommand{\Ketbra}[2]{\Ket{#1}\!\Bra{#2}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\makeindex
\begin{document}
\begin{fmffile}{\jobname pics}
\fmfset{arrow_ang}{10}
\fmfset{curly_len}{2mm}
\fmfset{wiggly_len}{3mm}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\fmfcmd{%
numeric joindiameter;
joindiameter := 7thick;}
\fmfcmd{%
vardef sideways_at (expr d, p, frac) =
save len; len = length p;
(point frac*len of p) shifted ((d,0) rotated (90 + angle direction frac*len of p))
enddef;
secondarydef p sideways d =
for frac = 0 step 0.01 until 0.99:
sideways_at (d, p, frac) ..
endfor
sideways_at (d, p, 1)
enddef;
secondarydef p choptail d =
subpath (ypart (fullcircle scaled d shifted (point 0 of p) intersectiontimes p), infinity) of p
enddef;
secondarydef p choptip d =
reverse ((reverse p) choptail d)
enddef;
secondarydef p pointtail d =
fullcircle scaled d shifted (point 0 of p) intersectionpoint p
enddef;
secondarydef p pointtip d =
(reverse p) pointtail d
enddef;
secondarydef pa join pb =
pa choptip joindiameter .. pb choptail joindiameter
enddef;
vardef cyclejoin (expr p) =
subpath (0.5*length p, infinity) of p join subpath (0, 0.5*length p) of p .. cycle
enddef;}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\fmfcmd{%
style_def double_line_arrow expr p =
save pi, po;
path pi, po;
pi = reverse (p sideways thick);
po = p sideways -thick;
cdraw pi;
cdraw po;
cfill (arrow pi);
cfill (arrow po);
enddef;}
\fmfcmd{%
style_def double_line_arrow_beg expr p =
save pi, po, pc;
path pi, po, pc;
pc = p choptail 7thick;
pi = reverse (pc sideways thick);
po = pc sideways -thick;
cdraw pi .. p pointtail 5thick .. po;
cfill (arrow pi);
cfill (arrow po);
enddef;}
\fmfcmd{%
style_def double_line_arrow_end expr p =
save pi, po, pc;
path pi, po, pc;
pc = p choptip 7thick;
pi = reverse (pc sideways thick);
po = pc sideways -thick;
cdraw po .. p pointtip 5thick .. pi;
cfill (arrow pi);
cfill (arrow po);
enddef;}
\fmfcmd{%
style_def double_line_arrow_both expr p =
save pi, po, pc;
path pi, po, pc;
pc = p choptip 7thick choptail 7thick;
pi = reverse (pc sideways thick);
po = pc sideways -thick;
cdraw po .. p pointtip 5thick .. pi .. p pointtail 5thick .. cycle;
cfill (arrow pi);
cfill (arrow po);
enddef;}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\fmfcmd{vardef middir (expr p, ang) =
dir (angle direction length(p)/2 of p + ang)
enddef;}
\fmfcmd{style_def arrow_left expr p =
shrink (.7);
cfill (arrow p shifted (4thick * middir (p, 90)));
endshrink
enddef;}
\fmfcmd{style_def arrow_right expr p =
shrink (.7);
cfill (arrow p shifted (4thick * middir (p, -90)));
endshrink
enddef;}
\fmfcmd{style_def warrow_left expr p =
shrink (.7);
cfill (arrow p shifted (8thick * middir (p, 90)));
endshrink
enddef;}
\fmfcmd{style_def warrow_right expr p =
shrink (.7);
cfill (arrow p shifted (8thick * middir (p, -90)));
endshrink
enddef;}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newcommand{\threeexternal}[3]{%
\fmfsurround{d1,e1,d2,e2,d3,e3}%
\fmfv{label=$#1$,label.ang=0}{e1}%
\fmfv{label=$#2$,label.ang=180}{e2}%
\fmfv{label=$#3$,label.ang=0}{e3}}
\newcommand{\Threeexternal}[3]{%
\fmfsurround{d1,e1,d3,e3,d2,e2}%
\fmfv{label=$#1$,label.ang=0}{e1}%
\fmfv{label=$#2$,label.ang=0}{e2}%
\fmfv{label=$#3$,label.ang=180}{e3}}
\newcommand{\Fourexternal}[4]{%
\fmfsurround{d2,e2,d1,e1,d4,e4,d3,e3}%
\fmfv{label=$#1$,label.ang=180}{e1}%
\fmfv{label=$#2$,label.ang=0}{e2}%
\fmfv{label=$#3$,label.ang=0}{e3}%
\fmfv{label=$#4$,label.ang=180}{e4}}
\newcommand{\Fiveexternal}[5]{%
\fmfsurround{d2,e2,d1,e1,d5,e5,d4,e4,d3,e3}%
\fmfv{label=$#1$,label.ang=180}{e1}%
\fmfv{label=$#2$,label.ang=0}{e2}%
\fmfv{label=$#3$,label.ang=0}{e3}%
\fmfv{label=$#4$,label.ang=0}{e4}%
\fmfv{label=$#5$,label.ang=180}{e5}}
\newcommand{\twoincoming}{%
\fmfdot{v}%
\fmffreeze%
\fmf{warrow_right}{e1,v}%
\fmf{warrow_right}{e2,v}%
\fmf{warrow_right}{v,e3}}
\newcommand{\threeincoming}{%
\fmfdot{v}%
\fmffreeze%
\fmf{warrow_right}{e1,v}%
\fmf{warrow_right}{e2,v}%
\fmf{warrow_right}{e3,v}}
\newcommand{\threeoutgoing}{%
\fmfdot{v}%
\fmffreeze%
\fmf{warrow_right}{v,e1}%
\fmf{warrow_right}{v,e2}%
\fmf{warrow_right}{v,e3}}
\newcommand{\fouroutgoing}{%
\threeoutgoing%
\fmf{warrow_right}{v,e4}}
\newcommand{\fiveoutgoing}{%
\fouroutgoing%
\fmf{warrow_right}{v,e5}}
\newcommand{\setupthreegluons}{%
\fmftop{g3}
\fmfbottom{g1,g2}
\fmf{phantom}{v,g1}
\fmf{phantom}{v,g2}
\fmf{phantom}{v,g3}
\fmffreeze
\fmfipair{v,g[],a[],b[]}
\fmfiset{g1}{vloc (__g1)}
\fmfiset{g2}{vloc (__g2)}
\fmfiset{g3}{vloc (__g3)}
\fmfiset{v}{vloc (__v)}
\fmfiset{a1}{g1 shifted (-3thin,0)}
\fmfiset{b1}{g1 shifted (+1thin,-2thin)}
\fmfiset{a2}{g2 shifted (0,-3thin)}
\fmfiset{b2}{g2 shifted (0,+3thin)}
\fmfiset{a3}{g3 shifted (+1thin,+2thin)}
\fmfiset{b3}{g3 shifted (-3thin,0)}}
\begin{empfile}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\frontmatter
\title{
O'Mega:\\
Optimal~Monte-Carlo\\
Event~Generation~Amplitudes}
\author{%
Thorsten Ohl\thanks{%
\texttt{ohl@physik.uni-wuerzburg.de},
\texttt{http://physik.uni-wuerzburg.de/ohl}}\\
\hfil\\
Institut f\"ur Theoretische~Physik und Astrophysik\\
Julius-Maximilians-Universit\"at~W\"urzburg\\
Emil-Hilb-Weg 22, 97074~W\"urzburg, Germany\\
\hfil\\
J\"urgen Reuter\thanks{\texttt{juergen.reuter@desy.de}}\\
\hfil\\
DESY Theory Group,
Notkestr. 85, 22603 Hamburg, Germany\\
\hfil\\
Wolfgang Kilian${}^{c,}$\thanks{\texttt{kilian@physik.uni-siegen.de}}\\
\hfil\\
Theoretische Physik 1\\
Universit\"at Siegen\\
Walter-Flex-Str.~3, 57068 Siegen, Germany\\
\hfil\\
Christian Speckner${}^{d,}$\thanks{\texttt{cnspeckn@googlemail.com}}\\
\hfil\\
Physikalisches Institut\\
Albert-Ludwigs-Universit\"at Freiburg\\
Hermann-Herder-Str.~3, 79104 Freiburg, Germany\\
\hfil\\
with contributions from Christian Schwinn et al.}
\date{\textbf{unpublished draft, printed \timestamp}}
\maketitle
\begin{abstract}
\ldots
\end{abstract}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newpage
\begin{quote}
Copyright \textcopyright~1999-2012 by
\begin{itemize}
\item Wolfgang~Kilian ~\texttt{<kilian@hep.physik.uni-siegen.de>}
\item Thorsten~Ohl~\texttt{<ohl@physik.uni-wuerzburg.de>}
\item J\"urgen~Reuter~\texttt{<juergen.reuter@desy.de>}
\item Christian~Speckner~\texttt{<cnspeckn@googlemail.com>}
\end{itemize}
\end{quote}
\begin{quote}
WHIZARD is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2, or (at your option) any later
version.
\end{quote}
\begin{quote}
WHIZARD is distributed in the hope that it will be useful, but
\emph{without any warranty}; without even the implied warranty of
\emph{merchantability} or \emph{fitness for a particular purpose}.
See the GNU General Public License for more details.
\end{quote}
\begin{quote}
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
\end{quote}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section*{Revision Control}
\verbatiminput{RCS.info}
%%% \chapter*{Chapters}
%%% \bgroup
%%% \setcounter{tocdepth}{0}%
%%% \makeatletter\@input{\jobname.toc}\makeatother
%%% \egroup
\setcounter{tocdepth}{2}
\tableofcontents
\mainmatter
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Introduction}
\label{sec:intro}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Complexity}
\label{sec:complexity}
\begin{table}
\begin{center}
\begin{tabular}{r|r|r}
$n$ & $P(n)$& $F(n)$ \\\hline
4 & 3 & 3 \\
5 & 10 & 15 \\
6 & 25 & 105 \\
7 & 56 & 945 \\
8 & 119 & 10395 \\
9 & 246 & 135135 \\
10 & 501 & 2027025 \\
11 & 1012 & 34459425 \\
12 & 2035 & 654729075 \\
13 & 4082 & 13749310575 \\
14 & 8177 & 316234143225 \\
15 & 16368 & 7905853580625 \\
16 & 32751 & 213458046676875
\end{tabular}
\end{center}
\caption{\label{tab:P(n),F(n)}
The number of $\phi^3$ Feynman diagrams~$F(n)$ and independent
poles~$P(n)$.}
\end{table}
There are
\begin{equation}
P(n) = \frac{2^n-2}{2} - n = 2^{n-1} - n - 1
\end{equation}
independent internal momenta in a $n$-particle scattering
amplitude~\cite{ALPHA:1997}. This grows much slower than the
number
\begin{equation}
F(n) = (2n-5)!! = (2n-5)\cdot(2n-7)\cdot\ldots\cdot3\cdot1
\end{equation}
of tree Feynman diagrams in vanilla $\phi^3$ (see
table~\ref{tab:P(n),F(n)}). There are no known corresponding
expressions for theories with more than one particle type. However,
empirical evidence from numerical studies~\cite{ALPHA:1997,HELAC:2000}
as well as explicit counting results from O'Mega suggest
\begin{equation}
P^*(n) \propto 10^{n/2}
\end{equation}
while he factorial growth of the number of Feynman diagrams remains
unchecked, of course.
The number of independent momenta in an amplitude is a better measure
for the complexity of the amplitude than the number of Feynman
diagrams, since there can be substantial cancellations among the
latter. Therefore it should be possible to express the scattering
amplitude more compactly than by a sum over Feynman diagrams.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Ancestors}
\label{sec:ancestors}
Some of the ideas that O'Mega is based on can be traced back to
HELAS~\cite{HELAS}. HELAS builts Feynman amplitudes by recursively
forming off-shell `wave functions' from joining external lines with
other external lines or off-shell `wave functions'.
The program Madgraph~\cite{MADGRAPH:1994} automatically generates
Feynman diagrams and writes a Fortran program corresponding to their
sum. The amplitudes are calculated by calls to HELAS~\cite{HELAS}.
Madgraph uses one straightforward optimization: no statement is
written more than once. Since each statement corresponds to a
collection of trees, this optimization is very effective for up to
four particles in the final state. However, since the amplitudes are
given as a sum of Feynman diagrams, this optimization can, by design,
\emph{not} remove the factorial growth and is substantially weaker
than the algorithms of~\cite{ALPHA:1997,HELAC:2000} and the algorithm
of O'Mega for more particles in the final state.
Then ALPHA~\cite{ALPHA:1997} (see also the slightly modified
variant~\cite{HELAC:2000}) provided a numerical algorithm for
calculating scattering amplitudes and it could be shown empirically,
that the calculational costs are rising with a power instead of
factorially.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Architecture}
\label{sec:architecture}
\begin{figure}
\begin{center}
\includegraphics[width=\textwidth]{modules}
%includegraphics[height=.8\textheight]{modules}
\end{center}
\caption{\label{fig:modules}%
Module dependencies in O'Mega.}
%% The diamond shaped nodes are abstract signatures defininng functor
%% domains and co-domains. The rectangular boxes are modules and
%% functors and oval boxes are examples for applications.
\end{figure}
\subsection{General purpose libraries}
Functions that are not specific to O'Mega and could be part of the
O'Caml standard library
\begin{modules}{}
\item[ThoList] (mostly) simple convenience functions for lists that
are missing from the standard library module \ocwupperid{List}
(section~\ref{sec:tholist}, p.~\pageref{sec:tholist})
\item[Product] effcient tensor products for lists and sets
(section~\ref{sec:product}, p.~\pageref{sec:product})
\item[Combinatorics] combinatorical formulae, sets of subsets, etc.
(section~\ref{sec:combinatorics}, p.~\pageref{sec:combinatorics})
\end{modules}
\subsection{O'Mega}
The non-trivial algorithms that constitute O'Mega:
\begin{modules}{}
\item[DAG] Directed Acyclical Graphs
(section~\ref{sec:DAG}, p.~\pageref{sec:DAG})
\item[Topology] unusual enumerations of unflavored tree diagrams
(section~\ref{sec:topology}, p.~\pageref{sec:topology})
\item[Momentum] finite sums of external momenta
(section~\ref{sec:momentum}, p.~\pageref{sec:momentum})
\item[Fusion] off shell wave functions
(section~\ref{sec:fusion}, p.~\pageref{sec:fusion})
\item[Omega] functor constructing an application from a model and a
target
(section~\ref{sec:omega}, p.~\pageref{sec:omega})
\end{modules}
\subsection{Abstract interfaces}
The domains and co-domains of functors
(section~\ref{sec:coupling}, p.~\pageref{sec:coupling})
\begin{modules}{}
\item[Coupling] all possible couplings (not comprensive yet)
\item[Model] physical models
\item[Target] target programming languages
\end{modules}
\subsection{Models}
(section~\ref{sec:models}, p.~\pageref{sec:models})
\begin{modules}{}
\item[Modellib_SM.QED] Quantum Electrodynamics
\item[Modellib_SM.QCD] Quantum Chromodynamics (not complete yet)
\item[Modellib_SM.SM] Minimal Standard Model (not complete yet)
\end{modules}
etc.
\subsection{Targets}
Any programming language that supports arithmetic and a textual
representation of programs can be targeted by O'Caml. The
implementations translate the abstract expressions derived by
\ocwupperid{Fusion} to expressions in the target
(section~\ref{sec:targets}, p.~\pageref{sec:targets}).
\begin{modules}{}
\item[Targets.Fortran] Fortran95 language implementation, calling
subroutines
\end{modules}
Other targets could come in the future: \texttt{C}, \texttt{C++},
O'Caml itself, symbolic manipulation languages, etc.
\subsection{Applications}
(section~\ref{sec:omega}, p.~\pageref{sec:omega})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{The Big To Do Lists}
\label{sec:TODO}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Required}
All features required for leading order physics applications are in place.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Useful}
\begin{enumerate}
\item select allowed helicity combinations for massless fermions
\item Weyl-Van der Waerden spinors
\item speed up helicity sums by using discrete symmetries
\item general triple and quartic vector couplings
\item diagnostics: count corresponding Feynman diagrams
more efficiently for more than ten external lines
\item recognize potential cascade decays ($\tau$, $b$, etc.)
\begin{itemize}
\item warn the user to add additional
\item kill fusions (at runtime), that contribute to a cascade
\end{itemize}
\item complete standard model in $R_\xi$-gauge
\item groves (the simple method of cloned generations works)
\end{enumerate}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Future Features}
\begin{enumerate}
\item investigate if unpolarized squared matrix elements can be
calculated faster as traces of densitiy matrices. Unfortunately,
the answer apears to be \emph{no} for fermions and \emph{up to a
constant factor} for massive vectors. Since the number of fusions
in the amplitude grows like~$10^{n/2}$, the number of fusions in
the squared matrix element grows like~$10^n$. On the other hand,
there are $2^{\#\text{fermions}+\#\text{massless vectors}}
\cdot3^{\#\text{massive vectors}}$ terms in the helicity sum, which
grows \emph{slower} than~$10^{n/2}$. The constant factor is
probably also not favorable.
However, there will certainly be asymptotic gains for sums over
gauge (and other) multiplets, like color sums.
\item compile Feynman rules from Lagrangians
\item evaluate amplitues in O'Caml by compiling it to three address
code for a virtual machine
\begin{flushleft}
\ocwkw{type}~$\ocwlowerid{mem}~=~\ocwlowerid{scalar}~$\ocwbt{array}~$%
\times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$%
\times{}~\ocwlowerid{spinor}~$\ocwbt{array}~$%
\times{}~\ocwlowerid{vector}~$\ocwbt{array}\\
\ocwkw{type}~$\ocwlowerid{instr}~=$\\
\qquad|~$\ocwupperid{VSS}~$\ocwkw{of}~\ocwbt{int}~$%
\times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\
\qquad|~$\ocwupperid{SVS}~$\ocwkw{of}~\ocwbt{int}~$%
\times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\
\qquad|~$\ocwupperid{AVA}~$\ocwkw{of}~\ocwbt{int}~$%
\times{}~$\ocwbt{int}~$\times{}~$\ocwbt{int}\\
\qquad\ldots
\end{flushleft}
this could be as fast as~\cite{ALPHA:1997} or~\cite{HELAC:2000}.
\item a virtual machine will be useful for for other target as
well, because native code appears to become to large for most
compilers for more than ten external particles. Bytecode might
even be faster due to improved cache locality.
\item use the virtual machine in O'Giga
\end{enumerate}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\subsection{Science Fiction}
\begin{enumerate}
\item numerical and symbolical loop calculations with
\textsc{O'Tera: O'Mega Tool for Evaluating Renormalized Amplitudes}
\end{enumerate}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Tuples and Polytuples}
\label{sec:tuple}
\module{tuple}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Topologies}
\label{sec:topology}
\module{topology}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Directed Acyclical Graphs}
\label{sec:DAG}
\module{dAG}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Momenta}
\label{sec:momentum}
\module{momentum}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Cascades}
\label{sec:cascades}
\module{cascade_syntax}
\section{Lexer}
\lexer{cascade}
\section{Parser}
\parser{cascade}
\module{cascade}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Color}
\label{sec:color}
\module{color}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Fusions}
\label{sec:fusion}
\module{fusion}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Lorentz Representations, Couplings, Models and Targets}
\label{sec:coupling}
\signature{coupling}
\signature{model}
\signature{target}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Conserved Quantum Numbers}
\label{sec:charges}
\module{charges}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Colorization}
\label{sec:colorize}
\module{colorize}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Processes}
\label{sec:process}
\module{process}
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \chapter{Vertices}
%%% \label{sec:vertex}
%%% \begin{dubious}
%%% Temporarily disabled, until, we implement some conditional weaving\ldots
%%% \end{dubious}
%%% \module{vertex_syntax}
%%% \section{Lexer}
%%% The design of the lexer is not perfect yet. Currently, we have
%%% \verb+k+ and \verb+e+ with immediately following digits
%%% as reserved words, denoting momenta and
%%% polarization vectors respectively. Similarly for the
%%% $\gamma$-matrices: \verb+S+($=\mathbf{1}$), \verb+P+($=\gamma_5$),
%%% \verb+V+($=\gamma_\mu$), and \verb+A+($=\gamma_\mu\gamma_5$).
%%% \begin{dubious}
%%% There's no good idea for \verb+T+($=\sigma_{\mu\nu}$) and other
%%% tensors yet.
%%% \end{dubious}
%%% \lexer{vertex}
%%% \section{Parser}
%%% \parser{vertex}
%%% \module{vertex}
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \chapter{Models}
%%% \begin{dubious}
%%% Temporarily disabled, until, we implement some conditional weaving\ldots
%%% \end{dubious}
%%% \module{model_syntax}
%%% \section{Lexer}
%%% \lexer{model}
%%% \section{Parser}
%%% \parser{model}
%%% \section{Sample}
%%% {\small\verbatiminput{sample.omf}}
%%% \module{model_file}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Hardcoded Models}
\label{sec:models}
\module{modeltools}
\module{modellib_SM}
\module{modellib_BSM}
\module{modellib_MSSM}
\module{modellib_NMSSM}
\module{modellib_PSSSM}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Comphep Models}
\label{sec:comphep}
\module{comphep_syntax}
\section{Lexer}
\lexer{comphep}
\section{Parser}
\parser{comphep}
\module{comphep}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Hardcoded Targets}
\label{sec:targets}
\module{targets}
\module{targets_Kmatrix}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Phase Space}
\label{sec:phasespace}
\module{phasespace}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Whizard}
\label{sec:whizard}
Talk to~\cite{Kilian:WHIZARD}.
\module{whizard}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Applications}
\label{sec:omega}
\section{Sample}
{\small\verbatiminput{sample.prc}}
\module{omega}
%application{omega_Phi3}
%application{omega_Phi3h}
%application{omega_Phi4}
%application{omega_Phi4h}
\application{omega_QED}
%application{omega_QCD}
%application{omega_SM3}
%application{omega_SM3_ac}
\application{omega_SM}
\application{omega_SYM}
%application{omega_SM_ac}
%application{f90Maj_SM}
%application{f90Maj_SM4}
%application{omega_MSSM}
%application{omega_MSSM_g}
%application{omega_SM_Rxi}
%application{omega_SM_clones}
%application{omega_2HDM}
%application{omega_SMh}
%application{omega_SM4h}
%application{helas_QED}
%application{helas_QCD}
%application{helas_SM}
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \chapter{O'Giga: O'Mega Graphical Interface for Generation and Analysis}
%%% \label{sec:ogiga}
%%% {\itshape NB: The code in this chapter \emph{must} be compiled with
%%% \verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.}
%%% \begin{dubious}
%%% Keep in mind that \texttt{ocamlweb} doesn't work properly with
%%% O'Caml~3 yet. The colons in label declarations are typeset with
%%% erroneous white space.
%%% \end{dubious}
%%%
%%% \application{ogiga}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter*{Acknowledgements}
We thank Mauro Moretti for fruitful discussions of the ALPHA
algorithm~\cite{ALPHA:1997}, that inspired our solution of the double
counting problem.
We thank Wolfgang Kilian for providing the WHIZARD environment that
turns our numbers into real events with unit weight. Thanks to the
ECFA/DESY workshops and their participants for providing a showcase.
Thanks to Edward Boos for discussions in Kaluza-Klein gravitons.
This research is supported by Bundesministerium f\"ur Bildung und
Forschung, Germany, (05\,HT9RDA) and Deutsche Forschungsgemeinschaft
(MA\,676/6-1).
Thanks to the Caml and Objective Caml teams from INRIA for the
development and the lean and mean implementation of a programming
language that does not insult the programmer's intelligence.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{thebibliography}{10}
\bibitem{ALPHA:1997}
F. Caravaglios, M. Moretti, Z.{} Phys.{} \textbf{C74} (1997) 291.
\bibitem{HELAC:2000}
A. Kanaki, C. Papadopoulos, DEMO-HEP-2000/01, hep-ph/0002082,
February 2000.
\bibitem{Ler97}
Xavier Leroy,
\textit{The Objective Caml system, documentation and user's guide},
Technical Report, INRIA, 1997.
\bibitem{Okasaki:1998:book}
Chris Okasaki, \textit{Purely Functional Data Structures},
Cambridge University Press, 1998.
\bibitem{HELAS}
H. Murayama, I. Watanabe, K. Hagiwara, KEK Report 91-11,
January 1992.
\bibitem{MADGRAPH:1994}
T. Stelzer, W.F. Long,
Comput.{} Phys.{} Commun.{} \textbf{81} (1994) 357.
\bibitem{Denner:Majorana}
A. Denner, H. Eck, O. Hahn and J. K\"ublbeck,
Phys.{} Lett.{} \textbf{B291} (1992) 278;
Nucl.{} Phys.{} \textbf{B387} (1992) 467.
\bibitem{Barger/etal:1992:color}
V.~Barger, A.~L.~Stange, R.~J.~N.~Phillips,
Phys.~Rev.~\textbf{D45}, (1992) 1751.
\bibitem{Ohl:LOTR}
T. Ohl, \textit{Lord of the Rings},
(Computer algebra library for O'Caml, unpublished).
\bibitem{Ohl:bocages}
T. Ohl, \textit{Bocages},
(Feynman diagram library for O'Caml, unpublished).
\bibitem{Kilian:WHIZARD}
W. Kilian, \textit{\texttt{WHIZARD}}, University of Karlsruhe, 2000.
\bibitem{Boos/Ohl:groves}
E.\,E. Boos, T. Ohl,
Phys.\ Rev.\ Lett.\ \textbf{83} (1999) 480.
\bibitem{Han/Lykken/Zhang:1999:Kaluza-Klein}
T.~Han, J.~D.~Lykken and R.~Zhang,
%``On Kaluza-Klein states from large extra dimensions,''
Phys.{} Rev.{} \textbf{D59} (1999) 105006
[hep-ph/9811350].
%%CITATION = HEP-PH 9811350;%%
\bibitem{PTVF92}
William H. Press, Saul A. Teukolsky, William T. Vetterling,
Brian P. Flannery,
\textit{Numerical Recipes: The Art of Scientific Computing},
Second Edition, Cambridge University Press, 1992.
\bibitem{Cvi76}
P.~Cvitanovi\'c,
% author={Predrag Cvitanovi\'c},
% title={Group Theory for {Feynman} Diagrams in Non-{Abelian}
% Gauge Theories},
Phys.{} Rev.{} \textbf{D14} (1976) 1536.
%%%\bibitem{Kleiss/etal:Color-Monte-Carlo}
%%% \begin{dubious}
%%% ``\texttt{Kleiss/etal:Color-Monte-Carlo}''
%%% \end{dubious}
\end{thebibliography}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\appendix
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Revision Control}
\label{sec:RCS}
\module{rCS}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Autotools}
\label{sec:autotools}
\module{config}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Textual Options}
\label{sec:options}
\module{options}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Progress Reports}
\label{sec:progress}
\module{progress}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More on Filenames}
\label{sec:thoFilename}
\module{thoFilename}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Cache Files}
\label{sec:cache}
\module{cache}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More On Lists}
\label{sec:tholist}
\module{thoList}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More On Arrays}
\label{sec:thoarray}
\module{thoArray}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{More On Strings}
\label{sec:thostring}
\module{thoString}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Polymorphic Maps}
\label{sec:pmap}
From~\cite{Ohl:LOTR}.
\module{pmap}
+\module{partial}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Tries}
\label{sec:trie}
From~\cite{Okasaki:1998:book}, extended for~\cite{Ohl:LOTR}.
\module{trie}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Tensor Products}
\label{sec:product}
From~\cite{Ohl:LOTR}.
\module{product}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{(Fiber) Bundles}
\label{sec:bundle}
\module{bundle}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Power Sets}
\label{sec:powSet}
\module{powSet}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Combinatorics}
\label{sec:combinatorics}
\module{combinatorics}
+\module{permutation}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Partitions}
\label{sec:partition}
\module{partition}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Trees}
\label{sec:tree}
From~\cite{Ohl:bocages}:
Trees with one root admit a straightforward recursive definition
\begin{equation}
\label{eq:trees}
T(N,L) = L \cup N\times T(N,L)\times T(N,L)
\end{equation}
that is very well adapted to mathematical reasoning. Such
recursive definitions are useful because they
allow us to prove properties of elements by induction
\begin{multline}
\label{eq:tree-induction}
\forall l\in L: p(l) \land
(\forall n\in N: \forall t_1,t_2\in T(N,L): p(t_1) \land p(t_2)
\Rightarrow p(n\times t_1\times t_2)) \\
\Longrightarrow \forall t\in T(N,L): p(t)
\end{multline}
i.\,e.~establishing a property for all leaves and showing that a node
automatically satisfies the property if it is true for all children
proves the property for \emph{all} trees. This induction is of course
modelled after standard mathematical induction
\begin{equation}
p(1) \land (\forall n\in \mathbf{N}: p(n) \Rightarrow p(n+1))
\Longrightarrow \forall n\in \mathbf{N}: p(n)
\end{equation}
The recursive definition~(\ref{eq:trees}) is mirrored by the two tree
construction functions\footnote{To make the introduction more
accessible to non-experts, I avoid the `curried' notation for
functions with multiple arguments and use tuples instead. The actual
implementation takes advantage of curried functions, however. Experts
can read $\alpha\to\beta\to\gamma$ for $\alpha\times\beta\to\gamma$.}
\begin{subequations}
\begin{align}
\ocwlowerid{leaf}:\;& \nu\times\lambda \to(\nu,\lambda) T \\
\ocwlowerid{node}:\;& \nu\times(\nu,\lambda)T \times(\nu,\lambda)T
\to(\nu,\lambda)T
\end{align}
\end{subequations}
Renaming leaves and nodes leaves the structure of the tree invariant.
Therefore, morphisms~$L\to L'$ and~$N\to N'$ of the sets of leaves
and nodes induce natural homomorphisms~$T(N,L)\to T(N',L')$ of trees
\begin{equation}
\ocwlowerid{map}:\; (\nu\to\nu')\times(\lambda\to\lambda')
\times(\nu,\lambda)T \to(\nu',\lambda') T
\end{equation}
The homomorphisms constructed by \ocwlowerid{map} are trivial, but
ubiquitous. More interesting are the morphisms
\begin{equation}
\begin{aligned}
\ocwlowerid{fold}:\;& (\nu\times\lambda\to\alpha)
\times(\nu\times\alpha\times\alpha\to\alpha)
\times(\nu,\lambda)T \to\alpha \\
& (f_1,f_2,l\in L) \mapsto f_1(l) \\
& (f_1,f_2,(n,t_1,t_2)) \mapsto
f_2(n,\ocwlowerid{fold}(f_1,f_2,t_1),
\ocwlowerid{fold}(f_1,f_2,t_2))
\end{aligned}
\end{equation}
and
\begin{equation}
\begin{aligned}
\ocwlowerid{fan}:\;& (\nu\times\lambda\to\{\alpha\})
\times(\nu\times\alpha\times\alpha\to\{\alpha\})
\times(\nu,\lambda)T \to\{\alpha\} \\
& (f_1,f_2,l\in L) \mapsto f_1(l) \\
& (f_1,f_2,(n,t_1,t_2)) \mapsto
f_2(n, \ocwlowerid{fold}(f_1,f_2,t_1)
\otimes\ocwlowerid{fold}(f_1,f_2,t_2))
\end{aligned}
\end{equation}
where the tensor product notation means that~$f_2$ is applied to all
combinations of list members in the argument:
\begin{equation}
\phi(\{x\}\otimes \{y\})
= \left\{ \phi(x,y) | x\in\{x\} \land y\in\{y\} \right\}
\end{equation}
But note that due to the recursive nature of trees, \ocwlowerid{fan} is
\emph{not} a morphism from $T(N,L)$ to $T(N\otimes N,L)$.\par
If we identify singleton sets with their members, \ocwlowerid{fold} could be
viewed as a special case of \ocwlowerid{fan}, but that is probably more
confusing than helpful. Also, using the special
case~$\alpha=(\nu',\lambda')T$, the homomorphism \ocwlowerid{map} can be
expressed in terms of \ocwlowerid{fold} and the constructors
\begin{equation}
\begin{aligned}
\ocwlowerid{map}:\;& (\nu\to\nu')\times(\lambda\to\lambda')
\times(\nu,\lambda)T \to(\nu',\lambda')T \\
&(f,g,t) \mapsto
\ocwlowerid{fold} (\ocwlowerid{leaf}\circ (f\times g),
\ocwlowerid{node}\circ (f\times\ocwlowerid{id}
\times\ocwlowerid{id}), t)
\end{aligned}
\end{equation}
\ocwlowerid{fold} is much more versatile than \ocwlowerid{map}, because it can be used
with constructors for other tree representations to translate among
different representations. The target type can also be a mathematical
expression. This is used extensively below for evaluating Feynman
diagrams.\par
Using \ocwlowerid{fan} with~$\alpha=(\nu',\lambda')T$ can be used to construct
a multitude of homomorphic trees. In fact, below it will be used
extensively to construct all Feynman
diagrams~$\{(\nu,\{p_1,\ldots,p_n\})T\}$ of a given
topology~$t\in (\emptyset,\{1,\ldots,n\})T$.
\begin{dubious}
The physicist in me guesses that there is another morphism of trees
that is related to \ocwlowerid{fan} like a Lie-algebra is related to the
it's Lie-group. I have not been able to pin it down, but I guess that it
is a generalization of \ocwlowerid{grow} below.
\end{dubious}
\module{tree}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Dependency Trees}
\label{sec:tree2}
\module{tree2}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Consistency Checks}
\label{sec:count}
\application{count}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Complex Numbers}
\label{sec:complex}
\module{complex}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Algebra}
\label{sec:algebra}
\module{algebra}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Simple Linear Algebra}
\label{sec:linalg}
\module{linalg}
%application{test_linalg}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Talk To The WHiZard \ldots}
\label{sec:whizard_tool}
Talk to~\cite{Kilian:WHIZARD}.
\begin{dubious}
Temporarily disabled, until, we implement some conditional weaving\ldots
\end{dubious}
%application{whizard_tool}
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \chapter{Widget Library and Class Hierarchy for O'Giga}
%%% \label{sec:thogtk}
%%% {\itshape NB: The code in this chapter \emph{must} be compiled with
%%% \verb+-labels+, since \verb+lablgtk+ doesn't appear to work in classic mode.}
%%% \begin{dubious}
%%% Keep in mind that \texttt{ocamlweb} doesn't work properly with
%%% O'Caml~3 yet. The colons in label declarations are typeset with
%%% erroneous white space.
%%% \end{dubious}
%%%
%%% \section{Architecture}
%%% In \texttt{lablgtk}, O'Caml objects are typically constructed in
%%% parallel to constructors for \texttt{GTK+} widgets. The objects
%%% provide inheritance and all that, while the constructors implement the
%%% semantics.
%%%
%%% \subsection{Inheritance vs.~Aggregation}
%%% We have two mechanisms for creating new widgets: inheritance and
%%% aggregation. Inheritance makes it easy to extend a given widget with
%%% new methods or to combine orthogonal widgets (\emph{multiple
%%% inheritance}). Aggregation is more suitable for combining
%%% non-orthogonal widgets (e.\,g.~multiple instances of the same widget).
%%%
%%% The problem with inheritance in \texttt{lablgtk} is, that it is a
%%% \emph{bad} idea to implement the semantics in the objects. In a
%%% multi-level inheritance hierarchy, O'Caml can evaluate class functions
%%% more than once. Since functions accessing \texttt{GTK+} change the
%%% state of \texttt{GTK+}, we could accidentally violate invariants.
%%% Therefore inheritance forces us to use the two-tiered approach of
%%% \texttt{lablgtk} ourselves. It is not really complicated, but tedious
%%% and it appears to be a good idea to use aggregation whenever in doubt.
%%%
%%% Nevertheless, there are examples (like
%%% \ocwupperid{ThoGButton.mutable\_button} below, where just one new
%%% method is added), that cry out for inheritance for the benefit of the
%%% application developer.
%%%
%%% \module{thoGWindow}
%%% \module{thoGButton}
%%% \module{thoGMenu}
%%% \module{thoGDraw}
%%%
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% \chapter{O'Mega Virtual Machine}
%%% \label{sec:ovm}
%%% \module{oVM}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{\texttt{Fortran} Libraries}
\label{sec:fortran}
\input{omegalib}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{raggedright}
\ifpdf
\chapter{Index}
\let\origtwocolumn\twocolumn
\def\twocolumn[#1]{\origtwocolumn}%
This index has been generated automatically and might not be
100\%ly accurate. In particular, hyperlinks have been observed to
be off by one page.
\fi
\input{index.tex}
\end{raggedright}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\end{empfile}
\end{fmffile}
\end{document}
\endinput
Local Variables:
mode:latex
indent-tabs-mode:nil
page-delimiter:"^%%%%%.*\n"
End:
Index: trunk/src/omega/src/cascade.mli
===================================================================
--- trunk/src/omega/src/cascade.mli (revision 4104)
+++ trunk/src/omega/src/cascade.mli (revision 4105)
@@ -1,75 +1,83 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
module type T =
sig
type flavor
type p
type t
val of_string_list : int -> string list -> t
val to_string : t -> string
(* An opaque type that describes the set of all constraints on an amplitude
and how to construct it from a cascade description. *)
type selectors
val to_selectors : t -> selectors
(* Don't throw anything away: *)
val no_cascades : selectors
-(* [select_wf s is_timelike f p ps] returns [true] iff either the flavor [f] and
- momentum [p] match or \emph{all} combinations of the momenta in [ps]
- are compatible, i.\,e.~$\pm\sum p_i\leq q$ *)
+(* [select_wf s is_timelike f p ps] returns [true] iff either
+ \begin{itemize}
+ \item the flavor [f] and momentum [p] match the selection [s] or
+ \item \emph{all} combinations of the momenta in [ps]
+ are compatible, i.\,e.~$\pm\sum p_i\leq q$.
+ \end{itemize}
+ The latter test is only required in theories with quartic
+ or higher vertices, where [ps] will be the list of all
+ incoming momenta in a fusion. [is_timelike] is required
+ to determine, whether particles and anti-particles should
+ be distinct. *)
val select_wf : selectors -> (p -> bool) -> flavor -> p -> p list -> bool
(* [select_p s p ps] same as [select_wf s f p ps], but ignores the flavor [f] *)
val select_p : selectors -> p -> p list -> bool
(* [on_shell s p] *)
val on_shell : selectors -> flavor -> p -> bool
(* [is_gauss s p] *)
val is_gauss : selectors -> flavor -> p -> bool
(* [partition s] returns a partition of the external particles that can not
be reordered without violating the cascade constraints. *)
val partition : selectors -> int list list
(* Diagnostics: *)
val description : selectors -> string option
end
module Make (M : Model.T) (P : Momentum.T) :
T with type flavor = M.flavor and type p = P.t
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/thoList.mli
===================================================================
--- trunk/src/omega/src/thoList.mli (revision 4104)
+++ trunk/src/omega/src/thoList.mli (revision 4105)
@@ -1,129 +1,129 @@
(* $Id$
Copyright (C) 1999-2013 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <cnspeckn@googlemail.com>
WHIZARD is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
WHIZARD is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *)
(* [splitn n l = (hdn l, tln l)], but more efficient. *)
val hdn : int -> 'a list -> 'a list
val tln : int -> 'a list -> 'a list
val splitn : int -> 'a list -> 'a list * 'a list
(* [chop n l] chops [l] into pieces of size [n] (except for the last
one, which contains th remainder). *)
val chopn : int -> 'a list -> 'a list list
(* [of_subarray n m a] is $[\ocwlowerid{a.}(\ocwlowerid{n});
\ocwlowerid{a.}(\ocwlowerid{n}+1);\ldots;
\ocwlowerid{a.}(\ocwlowerid{m})]$. Values of~[n] and~[m]
out of bounds are silently shifted towards these bounds. *)
val of_subarray : int -> int -> 'a array -> 'a list
(* [range s n m] is $[\ocwlowerid{n}; \ocwlowerid{n}+\ocwlowerid{s};
\ocwlowerid{n}+2\ocwlowerid{s};\ldots;
\ocwlowerid{m} - ((\ocwlowerid{m}-\ocwlowerid{n})\mod s)]$ *)
val range : ?stride:int -> int -> int -> int list
(* [enumerate s n [a1;a2;...] is [(n,a1); (n+s,a2); ...] *)
val enumerate : ?stride:int -> int -> 'a list -> (int * 'a) list
(* Compress identical elements in a sorted list. Identity
is determined using the polymorphic equality function
[Pervasives.(=)]. *)
val uniq : 'a list -> 'a list
(* Test if all members of a list are structurally identical
(actually [homogeneous l] and [List.length (uniq l) <= 1]
are equivalent, but the former is more efficient if a mismatch
comes early). *)
val homogeneous : 'a list -> bool
(* [compare cmp l1 l2] compare two lists [l1] and [l2] according to
[cmp]. [cmp] defaults to the polymorphic [Pervasives.compare]. *)
val compare : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> int
(* Collect and count identical elements in a list. Identity
is determined using the polymorphic equality function
[Pervasives.(=)]. [classify] does not assume that the list
is sorted. However, it is~$O(n)$ for sorted lists and~$O(n^2)$
in the worst case. *)
val classify : 'a list -> (int * 'a) list
(* Collect the second factors with a common first factor in lists. *)
val factorize : ('a * 'b) list -> ('a * 'b list) list
(* [flatmap f] is equivalent to $\ocwlowerid{flatten} \circ
(\ocwlowerid{map}\;\ocwlowerid{f})$, but more efficient,
because no intermediate lists are built. Unfortunately, it is
not tail recursive. *)
val flatmap : ('a -> 'b list) -> 'a list -> 'b list
(* [rev_flatmap f] is equivalent to $\ocwlowerid{flatten} \circ
(\ocwlowerid{rev\_map}\;(\ocwlowerid{rev}\circ\ocwlowerid{f}))
= \ocwlowerid{rev}\circ(\ocwlowerid{flatmap}\;\ocwlowerid{f})$,
but more efficient, because no intermediate lists are built.
It is tail recursive. *)
val rev_flatmap : ('a -> 'b list) -> 'a list -> 'b list
val clone : int -> 'a -> 'a list
val multiply : int -> 'a list -> 'a list
(* \begin{dubious}
Invent other names to avoid confusions with [List.fold_left2]
and [List.fold_right2].
\end{dubious} *)
val fold_right2 : ('a -> 'b -> 'b) -> 'a list list -> 'b -> 'b
val fold_left2 : ('b -> 'a -> 'b) -> 'b -> 'a list list -> 'b
(* [iteri f n [a;b;c]] evaluates [f n a], [f (n+1) b] and [f (n+2) c]. *)
val iteri : (int -> 'a -> unit) -> int -> 'a list -> unit
val mapi : (int -> 'a -> 'b) -> int -> 'a list -> 'b list
(* [iteri2 f n m [[aa;ab];[ba;bb]]] evaluates [f n m aa], [f n (m+1) ab],
[f (n+1) m ba] and [f (n+1) (m+1) bb].
NB: the nested lists need not be rectangular. *)
val iteri2 : (int -> int -> 'a -> unit) -> int -> int -> 'a list list -> unit
(* Transpose a \emph{rectangular} list of lists like a matrix. *)
val transpose : 'a list list -> 'a list list
(* [partitioned_sort cmp index_sets list] sorts the sublists of [list] specified
by the [index_sets] and the complement of their union. \textbf{NB:} the sorting
follows to order in the lists in [index_sets]. \textbf{NB:} the indices are
0-based. *)
val partitioned_sort : ('a -> 'a -> int) -> int list list -> 'a list -> 'a list
exception Overlapping_indices
exception Out_of_bounds
(* [ariadne_sort cmp list] sorts [list] according to [cmp]
(default [Pervasives.compare]) keeping track of the original order
- by a 0-based list of infices. *)
+ by a 0-based list of indices. *)
val ariadne_sort : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list * int list
(* [ariadne_unsort (ariadne_sort cmp list)] returns [list]. *)
val ariadne_unsort : 'a list * int list -> 'a list
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)

File Metadata

Mime Type
text/x-diff
Expires
Tue, Nov 19, 3:41 PM (1 d, 19 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
3805001
Default Alt Text
(173 KB)

Event Timeline