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
aed31864
Commit
aed31864
authored
Jul 10, 2007
by
Pietro Abate
Browse files
[r2005-02-25 14:46:38 by afrisch] float
Original author: afrisch Date: 2005-02-25 14:46:39+00:00
parent
1d31f2a0
Changes
5
Hide whitespace changes
Inline
Side-by-side
runtime/print_xml.ml
View file @
aed31864
...
...
@@ -16,8 +16,9 @@ let false_literal = U.mk "false"
(* @raise exn_print_xml in case of failure. Rationale: schema printing is
* the last attempt to print a value, others have already failed *)
let
rec
schema_value
?
(
recurs
=
true
)
~
wds
v
=
match
v
with
let
rec
schema_value
?
(
recurs
=
true
)
~
wds
v
=
match
v
with
|
Abstract
(
"float"
,
f
)
->
wds
(
U
.
mk
(
string_of_float
(
Obj
.
magic
f
:
float
)))
|
Record
_
as
v
->
(
try
wds
(
Schema_builtin
.
string_of_time_type
(
Value
.
get_fields
v
))
...
...
runtime/value.ml
View file @
aed31864
...
...
@@ -265,6 +265,8 @@ let rec print ppf v =
(
Utf8
.
get_idx
i
)
(
Utf8
.
get_idx
j
)
(
Utf8
.
get_str
s
)
print
q
|
Concat
(
x
,
y
)
->
Format
.
fprintf
ppf
"<concat:%a;%a>"
print
x
print
y
|
Abstract
(
"float"
,
o
)
->
Format
.
fprintf
ppf
"%f"
(
Obj
.
magic
o
:
float
)
|
Abstract
(
s
,_
)
->
Format
.
fprintf
ppf
"<abstract=%s>"
s
|
Absent
->
...
...
@@ -643,3 +645,6 @@ let print_utf8 v =
print_string
(
U
.
get_str
v
);
flush
stdout
let
float
n
=
Abstract
(
Builtin_defs
.
float_abs
,
Obj
.
repr
n
)
runtime/value.mli
View file @
aed31864
...
...
@@ -80,6 +80,7 @@ val concat : t -> t -> t
val
flatten
:
t
->
t
val
append
:
t
->
t
->
t
val
float
:
float
->
t
val
get_string_latin1
:
t
->
string
val
get_string_utf8
:
t
->
U
.
t
*
t
...
...
schema/schema_builtin.ml
View file @
aed31864
...
...
@@ -16,7 +16,7 @@ open Schema_types
let
xsd
=
Schema_xml
.
xsd
let
add_xsd_prefix
s
=
(
xsd
,
Utf8
.
mk
s
)
let
unsupported
=
[
"decimal"
;
"float"
;
"double"
;
"NOTATION"
;
"QName"
]
let
unsupported
=
[
"NOTATION"
;
"QName"
]
let
is_empty
s
=
Utf8
.
equal
s
(
Utf8
.
mk
""
)
...
...
@@ -138,6 +138,11 @@ let validate_integer s =
try
Value
.
Integer
(
Intervals
.
V
.
mk
s
)
with
Failure
_
->
simple_type_error
"integer"
let
validate_decimal
s
=
let
s
=
Utf8
.
get_str
s
in
try
Value
.
float
(
float_of_string
s
)
with
Failure
_
->
simple_type_error
"decimal"
let
strip_decimal_RE
=
Pcre
.
regexp
"
\\
..*$"
let
parse_date
=
...
...
@@ -475,6 +480,13 @@ let _ =
primitive
"gDay"
gDay_type
validate_gDay
let
_
=
primitive
"gMonth"
gMonth_type
validate_gMonth
let
decimal
=
primitive
"decimal"
Builtin_defs
.
float
validate_decimal
let
_
=
alias
"float"
decimal
;
alias
"double"
decimal
let
_
=
List
.
iter
(
fun
n
->
alias
n
string
)
unsupported
...
...
types/builtin.ml
View file @
aed31864
...
...
@@ -83,6 +83,11 @@ let exn_int_of =
Value
.
Pair
(
Value
.
Atom
(
Atoms
.
V
.
mk_ascii
"Invalid_argument"
)
,
Value
.
string_latin1
"int_of"
))
let
exn_float_of
=
Value
.
CDuceExn
(
Value
.
Pair
(
Value
.
Atom
(
Atoms
.
V
.
mk_ascii
"Invalid_argument"
)
,
Value
.
string_latin1
"float_of"
))
let
eval_load_file
~
utf8
e
=
Location
.
protect_op
"load_file"
;
...
...
@@ -307,3 +312,12 @@ unary_op_gen "flatten"
register_fun
"raise"
any
Types
.
empty
(
fun
v
->
raise
(
Value
.
CDuceExn
v
));;
(* Float *)
register_fun
"float_of"
string
float
(
fun
v
->
let
(
s
,_
)
=
Value
.
get_string_utf8
v
in
try
Value
.
float
(
float_of_string
(
U
.
get_str
s
))
with
Failure
_
->
raise
exn_float_of
);;
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