Commit 2441d233 authored by Bruno Guillaume's avatar Bruno Guillaume

Implement to_json

parent 1eb9b2fd
......@@ -481,6 +481,15 @@ module New_ast = struct
type grs = decl list
let rec strat_to_json = function
| Ref name -> `Assoc [("Ref", `String name)]
| Pick s -> `Assoc [("Pick", strat_to_json s)]
| Alt l -> `Assoc [("Alt", `List (List.map strat_to_json l))]
| Seq l -> `Assoc [("Seq", `List (List.map strat_to_json l))]
| Iter s -> `Assoc [("Iter", strat_to_json s)]
| If (s, s1, s2) -> `Assoc [("If", strat_to_json s); ("Then", strat_to_json s1); ("Else", strat_to_json s2)]
| Try s -> `Assoc [("Try", strat_to_json s)]
let strat_list grs =
let rec loop pref = function
[] -> []
......
......@@ -264,6 +264,8 @@ module New_ast : sig
type grs = decl list
val strat_to_json: strat -> Yojson.Basic.json
val strat_list: grs -> string list
val convert: Ast.grs -> grs
......
......@@ -36,6 +36,8 @@ module Label_domain = struct
Array.iter (function label -> Printf.printf " - %s\n" label) label_array;
Printf.printf "==================================\n%!"
let to_json (labels,_) = `List (List.map (fun x -> `String x) (Array.to_list labels))
(** The [default] style value *)
let default = { text="UNSET"; bottom=false; color=None; bgcolor=None; line=Solid }
......@@ -120,6 +122,15 @@ module Feature_domain = struct
) t;
Printf.printf "==================================\n%!"
let to_json t =
`Assoc (
List.map (function
| Ast.Closed (fn, values) -> (fn, `List (List.map (fun x -> `String x) values))
| Ast.Open fn -> (fn, `String "Open")
| Ast.Num fn -> (fn, `String "Num")
) t
)
let get_name = function
| Ast.Closed (fn, _) -> fn
| Ast.Open fn -> fn
......@@ -219,6 +230,11 @@ module Domain = struct
| Some Label ld -> Label_domain.dump ld
| Some Feature fd -> Feature_domain.dump fd
let to_json = function
| Both (ld, fd) -> `Assoc [("Label_domain", Label_domain.to_json ld); ("feature_domain", `Null);]
| Label ld -> `Assoc [("Label_domain", Label_domain.to_json ld)]
| Feature fd -> `Assoc [("feature_domain", `Null);]
let build ld fd = Both (ld, fd)
let build_features_only fd = Feature fd
......
......@@ -51,6 +51,8 @@ module Domain : sig
val dump: t option -> unit
val to_json: t -> Yojson.Basic.json
val build: Label_domain.t -> Feature_domain.t -> t
val build_features_only: Feature_domain.t -> t
val build_labels_only: Label_domain.t -> t
......
......@@ -487,6 +487,24 @@ module Grs = struct
ast: New_ast.grs;
}
let rec decl_to_json = function
| Rule r -> Rule.to_json r
| Strategy (name, strat) -> `Assoc [("strat_name", `String name); ("strat_def", New_ast.strat_to_json strat)]
| Package (name, decl_list) -> `Assoc [("package_name", `String name); "decls", `List (List.map decl_to_json decl_list)]
let to_json t =
match t.domain with
| None -> `Assoc [
"filename", `String t.filename;
"decls", `List (List.map decl_to_json t.decls)
]
| Some dom -> `Assoc [
"domain", Domain.to_json dom;
"filename", `String t.filename;
"decls", `List (List.map decl_to_json t.decls)
]
let get_strat_list grs = Grew_ast.New_ast.strat_list grs.ast
let rec dump_decl indent = function
......
......@@ -117,6 +117,7 @@ module Grs : sig
val dump: t -> unit
val to_json: t -> Yojson.Basic.json
val domain: t -> Domain.t option
val simple_rewrite: t -> string -> G_graph.t -> G_graph.t list
......
......@@ -252,7 +252,7 @@ module Parser = struct
try
Global.new_string ();
let lexbuf = Lexing.from_string desc in
let strategy = parse_handle (Grew_parser.strat_desc Grew_lexer.global) lexbuf in
let strategy = parse_handle (Grew_parser.strat_alone Grew_lexer.global) lexbuf in
strategy
with Sys_error msg -> Error.parse "[Grew_loader.Parser.strategy] %s" msg
......
......@@ -128,7 +128,7 @@ let localize t = (t,get_loc ())
%start <Grew_ast.Ast.domain> domain
%start <Grew_ast.New_ast.grs> new_grs
%start <Grew_ast.New_ast.strat> strat_desc
%start <Grew_ast.New_ast.strat> strat_alone
/* parsing of the string representation of the constituent representation of Sequoia */
/* EX: "( (SENT (NP (NC Amélioration) (PP (P de) (NP (DET la) (NC sécurité))))))" */
......@@ -744,4 +744,7 @@ strat_desc:
| TRY LPAREN s=strat_desc RPAREN { New_ast.Try s }
| ONF LPAREN s=strat_desc RPAREN { New_ast.Pick (New_ast.Iter s) }
| EMPTY { New_ast.Seq [] }
strat_alone:
| s = strat_desc EOF { s }
%%
......@@ -297,7 +297,9 @@ module Grs = struct
Grew_grs.Grs.domain grs
) ()
let to_json _ = failwith "TODO Grs.to_json"
let to_json t =
let json = Grew_grs.Grs.to_json t in
Yojson.Basic.pretty_to_string json
let get_strat_list grs =
handle ~name:"Grs.get_strat_list"
......
Markdown is supported
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