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
cduce
cduce
Commits
41e26c72
Commit
41e26c72
authored
May 13, 2011
by
Jérôme Maloberti
Browse files
Add suffix in services as an attribute.
parent
02ac63de
Changes
1
Hide whitespace changes
Inline
Side-by-side
types/types.ml
View file @
41e26c72
...
...
@@ -1824,12 +1824,16 @@ end
module
Service
=
struct
type
service_attributs
=
{
mutable
suffix
:
bool
}
let
prepare
t
=
let
t
=
Print
.
uniq
t
in
let
t
=
Print
.
prepare
t
in
Print
.
assign_name
t
;
t
;;
let
trace
msg
=
output_string
stderr
(
msg
^
"
\n
"
);
flush
stderr
;;
let
print_to_string
f
=
let
b
=
Buffer
.
create
1024
in
let
ppf
=
Format
.
formatter_of_buffer
b
in
...
...
@@ -1847,12 +1851,12 @@ struct
|
"String"
->
TString
(
name
)
|
"Float"
->
TFloat
(
name
)
|
"Bool"
->
TBool
(
name
)
|
_
->
TUnit
;;
|
_
->
assert
false
;;
let
rec
convert
(
s
:
Print
.
nd
)
name
=
match
s
.
Print
.
state
with
|
`Named
n
->
output_string
stderr
(
"debug:convert "
^
(
U
.
to_string
n
)
^
"
\n
"
)
;
convert_real
name
s
.
Print
.
def
|
`Named
n
->
trace
(
"debug:convert "
^
(
U
.
to_string
n
))
;
convert_real
name
s
.
Print
.
def
|
`GlobalName
n
->
get_gtype
n
name
|
_
->
convert_real
name
s
.
Print
.
def
and
convert_real
name
def
=
...
...
@@ -1869,7 +1873,15 @@ struct
|
Print
.
Name
n
->
assert
false
|
Print
.
Char
c
->
assert
false
|
Print
.
Regexp
r
->
convert_regexp
name
r
|
Print
.
Xml
(
tag
,
attr
,
t
)
->
convert
t
(
convert_tag
tag
)
|
Print
.
Xml
(
tag
,
attr
,
t
)
->
let
flags
=
{
suffix
=
false
}
in
(
convert_attrs
flags
attr
;
let
res
=
convert
t
(
convert_tag
tag
)
in
if
flags
.
suffix
then
TSuffix
(
true
,
res
)
else
res
)
|
_
->
assert
false
and
convert_regexp
name
=
function
|
Pretty
.
Seq
(
r1
,
r2
)
->
...
...
@@ -1885,7 +1897,35 @@ struct
and
convert_tag
=
function
|
`Tag
s
->
print_to_string
s
|
`Type
t
->
assert
false
;;
|
`Type
t
->
assert
false
and
convert_attrs
flags
=
trace
"convert_attrs"
;
function
|
{
Print
.
state
=
`Marked
|
`Expand
|
`None
;
def
=
[
Print
.
Record
(
r
,
some
,
none
)
]
}
->
convert_record
flags
(
r
,
some
,
none
)
|
{
Print
.
state
=
`Named
n
;
def
=
[
Print
.
Record
(
r
,
some
,
none
)
]
}
->
trace
(
"debug:convert_attrs:Named "
^
(
U
.
to_string
n
));
convert_record
flags
(
r
,
some
,
none
)
(* convert_real name s.Print.def *)
(* | `GlobalName n -> get_gtype n name *)
|
_
->
trace
"convert_attrs:_"
;
()
and
convert_record
flags
(
r
,
some
,
none
)
=
List
.
iter
(
fun
(
l
,
(
o
,
t
))
->
(* let opt = if o then "?" else "" in *)
let
attr_label
=
Label
.
string_of_attr
l
in
trace
(
"convert_record:"
^
attr_label
);
match
attr_label
with
|
"suffix"
->
flags
.
suffix
<-
true
|
_
->
output_string
stderr
(
"Bad attribute name:"
^
attr_label
^
"
\n
"
)
(* Label.print_attr l opt (do_print_slot 0) t *)
)
(
LabelMap
.
get
r
);
if
not
none
then
output_string
stderr
" (+others)"
;
if
some
then
output_string
stderr
" .."
;;
let
clear
()
=
Print
.
count_name
:=
0
;
...
...
@@ -1899,6 +1939,10 @@ struct
ret
;;
let
to_string
t
=
let
bool_to_string
=
function
|
true
->
"true"
|
false
->
"false"
in
let
rec
aux
=
function
|
TInt
n
->
"TInt("
^
n
^
")"
|
TFloat
n
->
"TFloat("
^
n
^
")"
...
...
@@ -1909,6 +1953,7 @@ struct
|
TSet
e
->
"TSet("
^
(
aux
e
)
^
")"
|
TUnit
->
"TUnit()"
|
TSum
(
e1
,
e2
)
->
"TSum("
^
(
aux
e1
)
^
","
^
(
aux
e2
)
^
")"
|
TSuffix
(
b
,
e
)
->
"TSuffix("
^
(
bool_to_string
b
)
^
","
^
(
aux
e
)
^
")"
|
_
->
" unknown "
in
aux
t
;;
end
...
...
Write
Preview
Markdown
is supported
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