Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
grew
libcaml-grew
Commits
c7435ab3
Commit
c7435ab3
authored
Apr 16, 2017
by
Bruno Guillaume
Browse files
add “to_json” functions
parent
3f1cd9c1
Changes
15
Hide whitespace changes
Inline
Side-by-side
_tags
View file @
c7435ab3
true: package(unix, conll, dep2pict, camomile, cairo2, log)
true: package(unix, conll, dep2pict, camomile, cairo2, log
, yojson
)
true: bin_annot
src/grew_edge.ml
View file @
c7435ab3
...
...
@@ -77,6 +77,18 @@ module Label_cst = struct
|
Neg
l
->
"^"
^
(
List_
.
to_string
(
Label
.
to_string
?
domain
)
"|"
l
)
|
Regexp
(
_
,
re
)
->
"re
\"
"
^
re
^
"
\"
"
let
to_json
?
domain
=
function
|
Pos
l
->
`Assoc
[
"pos"
,
`List
(
List
.
map
(
fun
lab
->
`String
(
Label
.
to_string
?
domain
lab
))
l
)
]
|
Neg
l
->
`Assoc
[
"neg"
,
`List
(
List
.
map
(
fun
lab
->
`String
(
Label
.
to_string
?
domain
lab
))
l
)
]
|
Regexp
(
_
,
re
)
->
`Assoc
[
"regexp"
,
`String
re
]
let
all
=
Neg
[]
let
match_
?
domain
cst
g_label
=
match
cst
with
...
...
@@ -130,6 +142,12 @@ module P_edge = struct
let
get_id
t
=
t
.
id
let
to_json
?
domain
t
=
`Assoc
[
(
"edge_id"
,
`String
t
.
id
);
(
"label_cst"
,
Label_cst
.
to_json
?
domain
t
.
label_cst
)
]
let
build
?
domain
(
ast_edge
,
loc
)
=
{
id
=
(
match
ast_edge
.
Ast
.
edge_id
with
Some
s
->
s
|
None
->
fresh_name
()
);
label_cst
=
Label_cst
.
build
~
loc
?
domain
ast_edge
.
Ast
.
edge_label_cst
...
...
src/grew_edge.mli
View file @
c7435ab3
...
...
@@ -42,6 +42,7 @@ module Label_cst : sig
|
Regexp
of
(
Str
.
regexp
*
string
)
val
to_string
:
?
domain
:
Domain
.
t
->
t
->
string
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
val
all
:
t
val
match_
:
?
domain
:
Domain
.
t
->
t
->
Label
.
t
->
bool
val
build
:
?
loc
:
Loc
.
t
->
?
domain
:
Domain
.
t
->
Ast
.
edge_label_cst
->
t
...
...
@@ -74,6 +75,8 @@ module P_edge: sig
(* [all] is the joker pattern edge *)
val
all
:
t
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
val
get_id
:
t
->
string
val
to_string
:
?
domain
:
Domain
.
t
->
t
->
string
...
...
src/grew_fs.ml
View file @
c7435ab3
...
...
@@ -98,6 +98,16 @@ module P_feature = struct
printf
"in_param=[%s]
\n
"
(
String
.
concat
","
(
List
.
map
string_of_int
in_param
));
printf
"%!"
let
to_json
?
domain
(
feature_name
,
{
cst
})
=
`Assoc
[
(
"feature_name"
,
`String
feature_name
);
(
match
cst
with
|
Absent
->
(
"absent"
,
`Null
)
|
Equal
val_list
->
(
"equal"
,
`List
(
List
.
map
(
fun
x
->
`String
(
string_of_value
x
))
val_list
))
|
Different
val_list
->
(
"different"
,
`List
(
List
.
map
(
fun
x
->
`String
(
string_of_value
x
))
val_list
))
)
]
let
get_name
=
fst
let
compare
feat1
feat2
=
Pervasives
.
compare
(
get_name
feat1
)
(
get_name
feat2
)
...
...
@@ -368,6 +378,8 @@ module P_fs = struct
let
empty
=
[]
let
to_json
?
domain
t
=
`List
(
List
.
map
(
P_feature
.
to_json
?
domain
)
t
)
let
check_position
?
param
position
t
=
try
match
List
.
assoc
"position"
t
with
...
...
src/grew_fs.mli
View file @
c7435ab3
...
...
@@ -73,6 +73,8 @@ end (* module G_fs *)
module
P_fs
:
sig
type
t
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
val
empty
:
t
val
build
:
?
domain
:
Domain
.
t
->
?
pat_vars
:
string
list
->
Ast
.
feature
list
->
t
...
...
src/grew_graph.ml
View file @
c7435ab3
...
...
@@ -40,6 +40,17 @@ module P_graph = struct
let
pid_name_list
t
=
Pid_map
.
fold
(
fun
_
node
acc
->
(
P_node
.
get_name
node
)
::
acc
)
t
[]
let
to_json
?
domain
t
=
`List
(
Pid_map
.
fold
(
fun
pid
p_node
acc
->
(
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"node"
,
P_node
.
to_json
?
domain
p_node
)
])
::
acc
)
t
[]
)
(* -------------------------------------------------------------------------------- *)
let
map_add_edge
map
id_src
label
id_tar
=
let
node_src
=
...
...
src/grew_graph.mli
View file @
c7435ab3
...
...
@@ -45,6 +45,8 @@ module P_graph: sig
val
empty
:
t
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
val
find
:
Pid
.
t
->
t
->
P_node
.
t
val
roots
:
t
->
Pid
.
t
list
...
...
src/grew_grs.ml
View file @
c7435ab3
...
...
@@ -159,6 +159,13 @@ module Modul = struct
loc
:
Loc
.
t
;
}
let
to_json
?
domain
t
=
`Assoc
[
(
"module_name"
,
`String
t
.
name
);
(
"confluent"
,
`Bool
t
.
confluent
);
(
"rules"
,
`List
(
List
.
map
(
Rule
.
to_json
?
domain
)
t
.
rules
));
]
let
check
t
=
(* check for duplicate rules *)
let
rec
loop
already_defined
=
function
...
...
@@ -196,6 +203,8 @@ module Grs = struct
ast
:
Ast
.
grs
;
}
let
to_json
t
=
`List
(
List
.
map
Modul
.
to_json
t
.
modules
)
let
get_modules
t
=
t
.
modules
let
get_ast
t
=
t
.
ast
let
get_filename
t
=
t
.
filename
...
...
src/grew_grs.mli
View file @
c7435ab3
...
...
@@ -76,6 +76,8 @@ module Modul: sig
confluent
:
bool
;
loc
:
Loc
.
t
;
}
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
end
(* module Modul *)
(* ================================================================================ *)
...
...
@@ -111,4 +113,6 @@ module Grs: sig
val
filter_iter
:
(
string
->
Rule
.
t
->
unit
)
->
t
->
unit
(* val modules_of_sequence: t -> string -> Modul.t list*)
val
to_json
:
t
->
Yojson
.
Basic
.
json
end
(* module Grs *)
src/grew_node.ml
View file @
c7435ab3
...
...
@@ -129,6 +129,22 @@ module P_node = struct
loc
:
Loc
.
t
option
;
}
let
to_json
?
domain
t
=
let
json_next
=
`List
(
Massoc_pid
.
fold
(
fun
acc
pid
p_edge
->
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"label"
,
P_edge
.
to_json
?
domain
p_edge
);
]
::
acc
)
[]
t
.
next
)
in
`Assoc
[
(
"node_name"
,
`String
t
.
name
);
(
"fs"
,
P_fs
.
to_json
?
domain
t
.
fs
);
(
"next"
,
json_next
)
]
let
get_name
t
=
t
.
name
let
get_fs
t
=
t
.
fs
let
get_next
t
=
t
.
next
...
...
src/grew_node.mli
View file @
c7435ab3
...
...
@@ -86,6 +86,8 @@ module P_node: sig
val
empty
:
t
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
val
get_name
:
t
->
Id
.
name
val
get_fs
:
t
->
P_fs
.
t
val
get_next
:
t
->
P_edge
.
t
Massoc_pid
.
t
...
...
src/grew_rule.ml
View file @
c7435ab3
...
...
@@ -88,23 +88,125 @@ module Rule = struct
|
Cst_in
of
Pid
.
t
*
Label_cst
.
t
|
Feature_eq
of
Pid
.
t
*
string
*
Pid
.
t
*
string
|
Feature_diseq
of
Pid
.
t
*
string
*
Pid
.
t
*
string
(* *)
|
Feature_cst
of
Pid
.
t
*
string
*
string
|
Feature_diff_cst
of
Pid
.
t
*
string
*
string
(* *)
|
Feature_float
of
Pid
.
t
*
string
*
float
|
Feature_diff_float
of
Pid
.
t
*
string
*
float
(* *)
|
Feature_re
of
Pid
.
t
*
string
*
string
(* *)
|
Feature_ineq
of
Ast
.
ineq
*
Pid
.
t
*
string
*
Pid
.
t
*
string
|
Feature_ineq_cst
of
Ast
.
ineq
*
Pid
.
t
*
string
*
float
(* *)
|
Filter
of
Pid
.
t
*
P_fs
.
t
(* used when a without impose a fs on a node defined by the match basic *)
(* *)
|
Prec
of
Pid
.
t
*
Pid
.
t
|
Lprec
of
Pid
.
t
*
Pid
.
t
let
const_to_json
?
domain
=
function
|
Cst_out
(
pid
,
label_cst
)
->
`Assoc
[
"cst_out"
,
Label_cst
.
to_json
?
domain
label_cst
]
|
Cst_in
(
pid
,
label_cst
)
->
`Assoc
[
"cst_in"
,
Label_cst
.
to_json
?
domain
label_cst
]
|
Feature_eq
(
pid1
,
fn1
,
pid2
,
fn2
)
->
`Assoc
[
"features_eq"
,
`Assoc
[
(
"id1"
,
`String
(
Pid
.
to_string
pid1
));
(
"feature_name_1"
,
`String
fn1
);
(
"id2"
,
`String
(
Pid
.
to_string
pid2
));
(
"feature_name_2"
,
`String
fn2
);
]
]
|
Feature_diseq
(
pid1
,
fn1
,
pid2
,
fn2
)
->
`Assoc
[
"features_diseq"
,
`Assoc
[
(
"id1"
,
`String
(
Pid
.
to_string
pid1
));
(
"feature_name_1"
,
`String
fn1
);
(
"id2"
,
`String
(
Pid
.
to_string
pid2
));
(
"feature_name_2"
,
`String
fn2
);
]
]
|
Feature_cst
(
pid
,
fn
,
value
)
->
`Assoc
[
"feature_eq_cst"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name_"
,
`String
fn
);
(
"value"
,
`String
value
);
]
]
|
Feature_diff_cst
(
pid
,
fn
,
value
)
->
`Assoc
[
"feature_diseq_cst"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name_"
,
`String
fn
);
(
"value"
,
`String
value
);
]
]
|
Feature_float
(
pid
,
fn
,
value
)
->
`Assoc
[
"feature_eq_float"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name_"
,
`String
fn
);
(
"value"
,
`String
(
string_of_float
value
));
]
]
|
Feature_diff_float
(
pid
,
fn
,
value
)
->
`Assoc
[
"feature_diff_float"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name"
,
`String
fn
);
(
"value"
,
`String
(
string_of_float
value
));
]
]
|
Feature_re
(
pid
,
fn
,
regexp
)
->
`Assoc
[
"feature_eq_regexp"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name"
,
`String
fn
);
(
"regexp"
,
`String
regexp
);
]
]
|
Feature_ineq
(
ineq
,
pid1
,
fn1
,
pid2
,
fn2
)
->
`Assoc
[
"features_ineq"
,
`Assoc
[
(
"ineq"
,
`String
(
Ast
.
string_of_ineq
ineq
));
(
"id1"
,
`String
(
Pid
.
to_string
pid1
));
(
"feature_name_1"
,
`String
fn1
);
(
"id2"
,
`String
(
Pid
.
to_string
pid2
));
(
"feature_name_2"
,
`String
fn2
);
]
]
|
Feature_ineq_cst
(
ineq
,
pid
,
fn
,
value
)
->
`Assoc
[
"feature_ineq_cst"
,
`Assoc
[
(
"ineq"
,
`String
(
Ast
.
string_of_ineq
ineq
));
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"feature_name"
,
`String
fn
);
(
"value"
,
`String
(
string_of_float
value
));
]
]
|
Filter
(
pid
,
p_fs
)
->
`Assoc
[
"filter"
,
`Assoc
[
(
"id"
,
`String
(
Pid
.
to_string
pid
));
(
"fs"
,
P_fs
.
to_json
?
domain
p_fs
);
]
]
|
Prec
(
pid1
,
pid2
)
->
`Assoc
[
"immediate_prec"
,
`Assoc
[
(
"id1"
,
`String
(
Pid
.
to_string
pid1
));
(
"id2"
,
`String
(
Pid
.
to_string
pid2
));
]
]
|
Lprec
(
pid1
,
pid2
)
->
`Assoc
[
"large_prec"
,
`Assoc
[
(
"id1"
,
`String
(
Pid
.
to_string
pid1
));
(
"id2"
,
`String
(
Pid
.
to_string
pid2
));
]
]
let
build_pos_constraint
?
domain
pos_table
const
=
let
pid_of_name
loc
node_name
=
Pid
.
Pos
(
Id
.
build
~
loc
node_name
pos_table
)
in
match
const
with
...
...
@@ -161,6 +263,12 @@ module Rule = struct
constraints
:
const
list
;
}
let
basic_to_json
?
domain
basic
=
`Assoc
[
(
"graph"
,
P_graph
.
to_json
?
domain
basic
.
graph
);
(
"constraints"
,
`List
(
List
.
map
(
const_to_json
?
domain
)
basic
.
constraints
));
]
let
build_pos_basic
?
domain
?
pat_vars
?
(
locals
=
[
||
])
basic_ast
=
let
(
graph
,
pos_table
)
=
P_graph
.
build
?
domain
?
pat_vars
basic_ast
.
Ast
.
pat_nodes
basic_ast
.
Ast
.
pat_edges
in
...
...
@@ -275,6 +383,15 @@ module Rule = struct
let
is_filter
t
=
t
.
commands
=
[]
let
to_json
?
domain
t
=
match
t
.
param
with
|
None
->
`Assoc
[
(
"rule_name"
,
`String
t
.
name
);
(
"match"
,
basic_to_json
?
domain
(
fst
t
.
pattern
));
(
"without"
,
`List
(
List
.
map
(
basic_to_json
?
domain
)
(
snd
t
.
pattern
)));
]
|
Some
_
->
Error
.
build
"Rule.to_json undefined for parametrized rules"
(* ====================================================================== *)
let
to_dep
?
domain
t
=
let
pos_basic
=
fst
t
.
pattern
in
...
...
src/grew_rule.mli
View file @
c7435ab3
...
...
@@ -78,6 +78,8 @@ module Rule : sig
(** [is_filter t] returns [true] iff the rule [t] is a filter rule. *)
val
is_filter
:
t
->
bool
val
to_json
:
?
domain
:
Domain
.
t
->
t
->
Yojson
.
Basic
.
json
(** [to_dep t] returns a string in the [dep] language describing the match basic of the rule *)
val
to_dep
:
?
domain
:
Domain
.
t
->
t
->
string
...
...
src/libgrew.ml
View file @
c7435ab3
...
...
@@ -263,6 +263,10 @@ module Grs = struct
)
()
let
get_domain
grs
=
Grew_grs
.
Grs
.
get_domain
grs
let
to_json
t
=
let
json
=
Grew_grs
.
Grs
.
to_json
t
in
Yojson
.
Basic
.
pretty_to_string
json
end
(* ==================================================================================================== *)
...
...
src/libgrew.mli
View file @
c7435ab3
...
...
@@ -123,6 +123,8 @@ module Grs: sig
val
build_html_doc
:
?
corpus
:
bool
->
string
->
t
->
unit
val
get_domain
:
t
->
Domain
.
t
option
val
to_json
:
t
->
string
end
(* ==================================================================================================== *)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment