Commit 6261fa28 authored by Thorsten Wißmann's avatar Thorsten Wißmann
Browse files

Advanced tree parsing and ontology printing

parent 39cd3579
......@@ -26,7 +26,10 @@ type axiom =
| EQUIVALENTCLASSES of class_exp list
| DISJOINTCLASSES of class_exp list
type ontology = axiom list
type prefix = string * string (* prefix name to long substitution *)
type prefixes = prefix list
type ontology = string * (axiom list) (* ontology uri and axioms *)
(* actual content *)
let dummy = "remove this as soon there are any useful declarations"
......@@ -69,4 +72,11 @@ let string_of_axiom ax =
| EQUIVALENTCLASSES la -> String.concat " ≡ " (L.map soc la)
| DISJOINTCLASSES la -> String.concat " ⊍ " (L.map soc la)
let string_of_prefix (short,u) = "Prefix "^short^" ↦ "^u
let string_of_ontology (name,axioms) =
"Ontology " ^ name ^ " {\n"^(
String.concat "\n" (L.map string_of_axiom axioms)
)^"}\n"
......@@ -22,7 +22,12 @@ type axiom =
| EQUIVALENTCLASSES of class_exp list
| DISJOINTCLASSES of class_exp list
type ontology = axiom list
type prefix = string * string (* prefix name to long substitution *)
type prefixes = prefix list
type ontology = string * (axiom list) (* ontology uri and axioms *)
val string_of_prefix : prefix -> string
val string_of_ontology : ontology -> string
val string_of_axiom : axiom -> string
val string_of_class_exp : class_exp -> string
......@@ -16,6 +16,9 @@ type 'a tree =
| Leaf of 'a
| Node of (('a tree) list)
type 'a intree = (* tree carrying values in leafes and inner nodes *)
| INode of 'a * ('a intree list)
type 'a annotated = 'a * annotation
(* implementation *)
......@@ -112,13 +115,28 @@ let tree_of_tokens lst : string annotated tree =
Node forest
let string_of_tree str_of_a atree : string =
let indent str = " "^str in
let rec lines_of_tree t = match t with
| (Leaf a) -> [str_of_a a]
| (Node lst) -> L.map indent (L.concat (L.map lines_of_tree lst))
let rec lines_of_tree t =
let firstchild = ref true in
let indent str =
if !firstchild
then (firstchild := false; "---+"^str)
else " |"^str
in
match t with
| (Leaf a) -> ["-" ^ str_of_a a]
| (Node lst) -> (L.map indent (L.concat (L.map lines_of_tree lst)))
in
String.concat "\n" (lines_of_tree atree)
let string_of_intree str_of_a atree : string =
let rec lines_of_tree (INode (a,lst)) =
let indent str = " |"^str in
("--+ "^str_of_a a)::
(L.map indent (L.concat (L.map lines_of_tree lst)))
in
String.concat "\n" (lines_of_tree atree)
let filter_whitespace =
(* only keep those strings that aren't whitespace only *)
L.filter (fun (s,_) -> not (string_match (regexp "[ ]*$") s 0))
......@@ -127,9 +145,55 @@ let tree_of_string str =
let lns = stream_map filter_comment (line_stream_of_string str) in
tree_of_tokens (filter_whitespace (tokens_of_string_stream lns))
let ontology_of_tree tree = []
let ensure_node (t: string annotated tree) : string annotated tree list =
match t with
| (Leaf (s,a)) -> raise (ParseError (a, "Expected \"(\" but got "^s))
| (Node lst) -> lst
let rec intree_list_of_tree tree =
let nextINode (stream: 'a tree Stream.t): ('a intree option) =
match peek stream with
| Some (Node lst) -> None
| Some (Leaf a) ->
junk stream;
let lst = match peek stream with
| None
| Some (Leaf _) -> []
| Some (Node lst) -> (
junk stream;
intree_list_of_tree (Node lst)
)
in Some (INode (a,lst))
| None -> None
in
match tree with
| (Leaf a) -> [INode (a,[])]
| (Node lst) ->
let rec intree_list_of_tree_stream stream =
match nextINode stream with
| Some n -> (n::(intree_list_of_tree_stream stream))
| None -> []
in
intree_list_of_tree_stream (Stream.of_list lst)
let rec tree_of_intree it =
let tree_list_of_intree (INode (x,lst)) =
(Leaf x)::(L.map tree_of_intree lst)
in
Node (tree_list_of_intree it)
let parse_intree_list (strAnIts: string annotated intree list) =
let prefixes = ref [] in
let ontos = ref [] in
foreach_l strAnIts (fun f -> match f with
| INode (("Prefix", _), lst) -> ()
| INode (("Ontology", _), lst) -> ()
| INode ((n, a), _) -> raise (ParseError (a,(
"Unknown toplevel element \""^n^"\""))));
(!prefixes, !ontos)
let parse str =
let tree = tree_of_string str in
ontology_of_tree tree
let itlist = intree_list_of_tree tree in
parse_intree_list itlist
......@@ -7,10 +7,15 @@ exception OWLParseError of string
type 'a annotated = 'a * annotation
type 'a tree =
type 'a tree = (* tree carrying values only in leafes *)
| Leaf of 'a
| Node of (('a tree) list)
type 'a intree = (* tree carrying values in leafes and inner nodes *)
| INode of 'a * ('a intree list)
val intree_list_of_tree : 'a tree -> 'a intree list
val tree_of_intree : 'a intree -> 'a tree
val list_of_stream : 'a Stream.t -> 'a list
val string_of_annotation : annotation -> string
......@@ -22,9 +27,10 @@ val filter_whitespace : string annotated list -> string annotated list
val tokens_of_string_stream : string Stream.t-> string annotated list
val tree_of_tokens : string annotated list -> string annotated tree
val string_of_tree : ('a -> string) -> 'a tree -> string
val string_of_intree : ('a -> string) -> 'a intree -> string
val tree_of_string : string -> string annotated tree
val parse : string -> OWL.ontology
val ontology_of_tree : string annotated tree -> OWL.ontology
val parse : string -> OWL.prefixes * OWL.ontology list
val parse_intree_list : string annotated intree list -> OWL.prefixes * (OWL.ontology list)
......@@ -16,7 +16,20 @@ let string_of_stdin (): string =
let owlcat () =
let content = string_of_stdin () in
let t = OWLFP.tree_of_string content in
(*
let t = OWLFP.Node (L.map OWLFP.tree_of_intree
(OWLFP.intree_list_of_tree t)) in
*)
let ts = OWLFP.intree_list_of_tree t in
let show sometree =
(OWLFP.string_of_intree (OWLFP.string_of_annotated id) sometree)
in
let ast = String.concat "\n" (L.map show ts) in
let _ = ast in
print_endline ast
(*
print_endline (OWLFP.string_of_tree (OWLFP.string_of_annotated id) t)
*)
let rec
printUsage () =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment