Lexer/Parser for basis sets

.gitignore

@@ -0,0 +1,3 @@
+_build/
+*.byte
+*.native

Angular_momentum.ml

@@ -0,0 +1,37 @@
+exception AngularMomentumError of char
+
+type t =
+  | S | P | D | F | G | H | I | J | K | L | M | N | O
+
+let of_char = function
+  | 's' | 'S' -> S
+  | 'p' | 'P' -> P
+  | 'd' | 'D' -> D
+  | 'f' | 'F' -> F
+  | 'g' | 'G' -> G
+  | 'h' | 'H' -> H
+  | 'i' | 'I' -> I
+  | 'j' | 'J' -> J
+  | 'k' | 'K' -> K
+  | 'l' | 'L' -> L
+  | 'm' | 'M' -> M
+  | 'n' | 'N' -> N
+  | 'o' | 'O' -> O
+  | c -> raise (AngularMomentumError c)
+
+let to_string = function
+  | S -> "S"
+  | P -> "P"
+  | D -> "D"
+  | F -> "F"
+  | G -> "G"
+  | H -> "H"
+  | I -> "I"
+  | J -> "J"
+  | K -> "K"
+  | L -> "L"
+  | M -> "M"
+  | N -> "N"
+  | O -> "O"
+
+

Angular_momentum.mli

@@ -0,0 +1,4 @@
+exception AngularMomentumError of char
+type t = S | P | D | F | G | H | I | J | K | L | M | N | O
+val of_char : char -> t
+val to_string : t -> string

Basis.ml

@@ -0,0 +1,35 @@
+type primitive = {
+    exponent: float ;
+    coefficient: float
+    }
+
+type contracted_shell = Angular_momentum.t * (primitive array)
+
+type gaussian_basis_set = string * (contracted_shell array)
+
+
+let string_of_primitive ?id prim =
+  match id with
+  | None -> (string_of_float prim.exponent)^" "^(string_of_float prim.coefficient)
+  | Some i -> (string_of_int i)^" "^(string_of_float prim.exponent)^" "^(string_of_float prim.coefficient)
+
+
+let string_of_contracted_shell (angular_momentum, prim_array) =
+  let n = 
+    Array.length prim_array
+  in
+  Printf.sprintf "%s %d\n%s"
+    (Angular_momentum.to_string angular_momentum) n
+    (Array.init n (fun i -> string_of_primitive ~id:(i+1) prim_array.(i))
+     |> Array.to_list
+     |> String.concat "\n")
+
+
+let string_of_contracted_shell_array a =
+  Array.map string_of_contracted_shell a
+  |> Array.to_list
+  |> String.concat "\n"
+
+let to_string (name, contracted_shell_array) =
+  Printf.sprintf "%s\n%s" name (string_of_contracted_shell_array contracted_shell_array)
+

Basis_lexer.mll

@@ -0,0 +1,31 @@
+{
+exception SyntaxError of string
+
+open Basis_parser
+
+let eol = ['\n']
+let white = [' ' '\t']+
+let element   = ['A'-'Z' 'a'-'z']+ white? eol
+let ang_mom  = ['S' 'P' 'D' 'F' 'G' 'H' 'I' 'J' 'K' 'L' 'M' 'N' 'O' 
+                's' 'p' 'd' 'f' 'g' 'h' 'i' 'j' 'k' 'l' 'm' 'n' 'o' ]
+               white
+let integer  = ['0'-'9']+ 
+let real = '-'? integer '.' integer (['e' 'E'] '-'? integer)? 
+
+
+rule read_all_rule  = parse
+  | eol            { EOL }
+  | white          { SPACE }
+  | ang_mom as a   { ANG_MOM (a.[0]) }
+  | element as e   { ELEMENT (String.trim e) }
+  | integer as i   { INTEGER (int_of_string i) }
+  | real    as f   { FLOAT (float_of_string f) }
+  | eof            { EOF }
+
+
+{
+  let rec read_all lexbuf =
+     match read_all_rule lexbuf with
+     | SPACE -> read_all_rule lexbuf
+     | x -> x
+}

Basis_parser.mly

@@ -0,0 +1,46 @@
+%{
+
+%}
+
+%token <string> ELEMENT
+%token <char> ANG_MOM
+%token <int> INTEGER
+%token <float> FLOAT
+%token SPACE
+%token EOL
+%token EOF
+
+%start input
+%type <Basis.gaussian_basis_set> input
+
+%% /* Grammar rules and actions follow */
+
+input:
+  | basis { $1 }
+  | EOL input { $2 }
+
+basis:
+  | element shell_array EOL { ($1, $2) }
+  | element shell_array EOF { ($1, $2) }
+
+element:
+  | ELEMENT { $1 }
+
+shell_array:
+  | shell_list { Array.of_list @@ List.rev $1 }
+
+shell_list:
+  | { [] }
+  | shell_list shell { $2 :: $1 }
+
+shell:
+  | ANG_MOM INTEGER EOL primitive_list { (Angular_momentum.of_char $1, Array.of_list @@ List.rev $4 ) } 
+
+primitive_list: 
+  | { [] }
+  | primitive_list primitive { $2 :: $1 }
+
+primitive: 
+  | INTEGER FLOAT FLOAT EOL { Basis.{exponent=$2 ; coefficient=$3 } }
+
+

Makefile

@@ -0,0 +1,41 @@
+.NOPARALLEL:
+
+LIBS=
+PKGS=
+OCAMLCFLAGS="-g"
+OCAMLBUILD=ocamlbuild -use-menhir -j 0 -cflags $(OCAMLCFLAGS) -lflags $(OCAMLCFLAGS) 
+MLLFILES=$(wildcard *.mll) 
+MLYFILES=$(wildcard *.mly) 
+MLFILES=$(wildcard *.ml) 
+MLIFILES=$(wildcard *.mli) 
+ALL_TESTS=$(patsubst %.ml,%.byte,$(wildcard test_*.ml))
+ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) 
+
+.PHONY: default 
+
+default: $(ALL_EXE) 
+tests: $(ALL_TESTS) 
+
+qpackage.odocl: $(MLIFILES)
+	ls $(MLIFILES) | sed "s/\.mli//" > qpackage.odocl
+
+doc: qpackage.odocl
+	$(OCAMLBUILD) qpackage.docdir/index.html -use-ocamlfind  $(PKGS) 
+
+%.inferred.mli: $(MLFILES)
+	$(OCAMLBUILD) $*.inferred.mli -use-ocamlfind  $(PKGS) 
+	mv _build/$*.inferred.mli .
+
+%.byte: $(MLFILES) $(MLIFILES) $(MLLFILES) $(MLYFILES)
+	rm -f -- $*
+	$(OCAMLBUILD) $*.byte  -use-ocamlfind  $(PKGS)
+	ln -s $*.byte $*
+
+%.native: $(MLFILES) $(MLIFILES) $(MLLFILES) $(MLYFILES)
+	rm -f -- $*
+	$(OCAMLBUILD) $*.native -use-ocamlfind $(PKGS)
+	ln -s $*.native $*
+
+clean: 
+	rm -rf _build $(ALL_EXE) $(ALL_TESTS) *.native *.byte
+

_tags

@@ -0,0 +1 @@
+true: package(re)