My working unpac space for OCaml projects in development
Add more JavaScript built-in objects
New built-ins:
- JSON: parse and stringify with full JSON support
- Number: Constructor, isNaN, isFinite, isInteger, isSafeInteger,
toFixed, toExponential, toPrecision, all numeric constants
- Boolean: Constructor and prototype methods
- Function: call, apply, bind, toString
- Error: All error types (Error, TypeError, ReferenceError,
SyntaxError, RangeError, URIError, EvalError)
🤖 Generated with [Claude Code](https://claude.com/claude-code)
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+963
+74
lib/quickjs/builtins/boolean.ml
+74
lib/quickjs/builtins/boolean.ml
···
1
+
(** JavaScript Boolean built-in object.
2
+
3
+
Implements Boolean as specified in ECMA-262. *)
4
+
5
+
open Quickjs_runtime.Value
6
+
7
+
(** Boolean.prototype.toString() *)
8
+
let to_string_method this _args =
9
+
match this with
10
+
| Bool true -> String "true"
11
+
| Bool false -> String "false"
12
+
| Object { data = Data_none; _ } ->
13
+
(match get_property (match this with Object o -> o | _ -> failwith "not object") "[[PrimitiveValue]]" with
14
+
| Some (Bool true) -> String "true"
15
+
| Some (Bool false) -> String "false"
16
+
| _ -> String "false")
17
+
| _ -> String (if to_boolean this then "true" else "false")
18
+
19
+
(** Boolean.prototype.valueOf() *)
20
+
let value_of this _args =
21
+
match this with
22
+
| Bool _ -> this
23
+
| Object { data = Data_none; _ } ->
24
+
(match get_property (match this with Object o -> o | _ -> failwith "not object") "[[PrimitiveValue]]" with
25
+
| Some (Bool _ as v) -> v
26
+
| _ -> Bool false)
27
+
| _ -> Bool (to_boolean this)
28
+
29
+
(** Create Boolean constructor and prototype *)
30
+
let create () =
31
+
let proto = make_object () in
32
+
33
+
(* Boolean.prototype methods *)
34
+
let add_proto_method name length func =
35
+
let fn = make_native_function name length func in
36
+
match fn with
37
+
| Object obj ->
38
+
Hashtbl.add proto.properties name
39
+
{ value = Object obj;
40
+
flags = { writable = true; enumerable = false; configurable = true };
41
+
getter = None; setter = None }
42
+
| _ -> ()
43
+
in
44
+
45
+
add_proto_method "toString" 0 to_string_method;
46
+
add_proto_method "valueOf" 0 value_of;
47
+
48
+
(* Boolean constructor *)
49
+
let boolean_ctor _this args =
50
+
match args with
51
+
| [] -> Bool false
52
+
| v :: _ -> Bool (to_boolean v)
53
+
in
54
+
55
+
let ctor = make_object () in
56
+
let ctor_fn = make_native_function "Boolean" 1 boolean_ctor in
57
+
(match ctor_fn with
58
+
| Object obj ->
59
+
ctor.data <- obj.data;
60
+
ctor.class_id <- Class_function
61
+
| _ -> ());
62
+
63
+
(* Link prototype *)
64
+
Hashtbl.add ctor.properties "prototype"
65
+
{ value = Object proto;
66
+
flags = { writable = false; enumerable = false; configurable = false };
67
+
getter = None; setter = None };
68
+
69
+
Hashtbl.add proto.properties "constructor"
70
+
{ value = Object ctor;
71
+
flags = { writable = true; enumerable = false; configurable = true };
72
+
getter = None; setter = None };
73
+
74
+
(Object ctor, Object proto)
+102
lib/quickjs/builtins/error.ml
+102
lib/quickjs/builtins/error.ml
···
1
+
(** JavaScript Error built-in object.
2
+
3
+
Implements Error and its subtypes as specified in ECMA-262. *)
4
+
5
+
open Quickjs_runtime.Value
6
+
7
+
(** Error.prototype.toString() *)
8
+
let to_string_method this _args =
9
+
match this with
10
+
| Object obj ->
11
+
let name = match get_property obj "name" with
12
+
| Some (String s) -> s
13
+
| Some v -> to_string v
14
+
| None -> "Error"
15
+
in
16
+
let message = match get_property obj "message" with
17
+
| Some (String s) -> s
18
+
| Some v -> to_string v
19
+
| None -> ""
20
+
in
21
+
if message = "" then String name
22
+
else String (name ^ ": " ^ message)
23
+
| _ -> String "Error"
24
+
25
+
(** Create an error object *)
26
+
let make_error name message =
27
+
let obj = make_object ~class_id:Class_error
28
+
~data:(Data_error { name; message; stack = "" }) () in
29
+
ignore (set_property obj "name" (String name));
30
+
ignore (set_property obj "message" (String message));
31
+
Object obj
32
+
33
+
(** Create Error constructor *)
34
+
let create_error_constructor name =
35
+
let proto = make_object () in
36
+
37
+
(* Error.prototype.name *)
38
+
Hashtbl.add proto.properties "name"
39
+
{ value = String name;
40
+
flags = { writable = true; enumerable = false; configurable = true };
41
+
getter = None; setter = None };
42
+
43
+
(* Error.prototype.message *)
44
+
Hashtbl.add proto.properties "message"
45
+
{ value = String "";
46
+
flags = { writable = true; enumerable = false; configurable = true };
47
+
getter = None; setter = None };
48
+
49
+
(* Error.prototype.toString *)
50
+
let ts = make_native_function "toString" 0 to_string_method in
51
+
(match ts with
52
+
| Object obj ->
53
+
Hashtbl.add proto.properties "toString"
54
+
{ value = Object obj;
55
+
flags = { writable = true; enumerable = false; configurable = true };
56
+
getter = None; setter = None }
57
+
| _ -> ());
58
+
59
+
(* Constructor *)
60
+
let ctor_func _this args =
61
+
let message = match List.nth_opt args 0 with
62
+
| Some Undefined | None -> ""
63
+
| Some v -> to_string v
64
+
in
65
+
make_error name message
66
+
in
67
+
68
+
let ctor = make_object () in
69
+
let ctor_fn = make_native_function name 1 ctor_func in
70
+
(match ctor_fn with
71
+
| Object obj ->
72
+
ctor.data <- obj.data;
73
+
ctor.class_id <- Class_function
74
+
| _ -> ());
75
+
76
+
(* Link prototype *)
77
+
Hashtbl.add ctor.properties "prototype"
78
+
{ value = Object proto;
79
+
flags = { writable = false; enumerable = false; configurable = false };
80
+
getter = None; setter = None };
81
+
82
+
Hashtbl.add proto.properties "constructor"
83
+
{ value = Object ctor;
84
+
flags = { writable = true; enumerable = false; configurable = true };
85
+
getter = None; setter = None };
86
+
87
+
(Object ctor, Object proto)
88
+
89
+
(** Create all Error constructors *)
90
+
let create () =
91
+
let error_ctor, error_proto = create_error_constructor "Error" in
92
+
let type_error_ctor, _ = create_error_constructor "TypeError" in
93
+
let reference_error_ctor, _ = create_error_constructor "ReferenceError" in
94
+
let syntax_error_ctor, _ = create_error_constructor "SyntaxError" in
95
+
let range_error_ctor, _ = create_error_constructor "RangeError" in
96
+
let uri_error_ctor, _ = create_error_constructor "URIError" in
97
+
let eval_error_ctor, _ = create_error_constructor "EvalError" in
98
+
(* Note: AggregateError requires special handling for the errors array *)
99
+
100
+
(error_ctor, error_proto,
101
+
type_error_ctor, reference_error_ctor, syntax_error_ctor,
102
+
range_error_ctor, uri_error_ctor, eval_error_ctor)
+142
lib/quickjs/builtins/function.ml
+142
lib/quickjs/builtins/function.ml
···
1
+
(** JavaScript Function built-in object.
2
+
3
+
Implements Function methods as specified in ECMA-262. *)
4
+
5
+
open Quickjs_runtime.Value
6
+
7
+
(** Function.prototype.call(thisArg, ...args) *)
8
+
let call this args =
9
+
match this with
10
+
| Object { data = Data_native_function { func; _ }; _ } ->
11
+
let this_arg = match args with
12
+
| [] -> Undefined
13
+
| this_arg :: _ -> this_arg
14
+
in
15
+
let call_args = match args with
16
+
| [] | [_] -> []
17
+
| _ :: rest -> rest
18
+
in
19
+
func this_arg call_args
20
+
| _ -> Undefined
21
+
22
+
(** Function.prototype.apply(thisArg, argsArray) *)
23
+
let apply this args =
24
+
match this with
25
+
| Object { data = Data_native_function { func; _ }; _ } ->
26
+
let this_arg = match List.nth_opt args 0 with
27
+
| Some v -> v
28
+
| None -> Undefined
29
+
in
30
+
let call_args = match List.nth_opt args 1 with
31
+
| Some (Object { data = Data_array arr; _ }) ->
32
+
Array.to_list !arr
33
+
| _ -> []
34
+
in
35
+
func this_arg call_args
36
+
| _ -> Undefined
37
+
38
+
(** Function.prototype.bind(thisArg, ...args) *)
39
+
let bind this args =
40
+
match this with
41
+
| Object ({ data = Data_native_function { func; name; _ }; _ } as original) ->
42
+
let this_arg = match args with
43
+
| [] -> Undefined
44
+
| this_arg :: _ -> this_arg
45
+
in
46
+
let bound_args = match args with
47
+
| [] | [_] -> [||]
48
+
| _ :: rest -> Array.of_list rest
49
+
in
50
+
let _bound_func _actual_this actual_args =
51
+
let all_args = Array.to_list bound_args @ actual_args in
52
+
func this_arg all_args
53
+
in
54
+
let bound = make_object ~class_id:Class_bound_function
55
+
~data:(Data_bound_function {
56
+
target = Object original;
57
+
this_arg;
58
+
bound_args;
59
+
}) () in
60
+
(* Set name to "bound <name>" *)
61
+
ignore (set_property bound "name" (String ("bound " ^ name)));
62
+
Object bound
63
+
| Object ({ data = Data_function _; _ } as original) ->
64
+
let this_arg = match args with
65
+
| [] -> Undefined
66
+
| this_arg :: _ -> this_arg
67
+
in
68
+
let bound_args = match args with
69
+
| [] | [_] -> [||]
70
+
| _ :: rest -> Array.of_list rest
71
+
in
72
+
let bound = make_object ~class_id:Class_bound_function
73
+
~data:(Data_bound_function {
74
+
target = Object original;
75
+
this_arg;
76
+
bound_args;
77
+
}) () in
78
+
Object bound
79
+
| _ -> Undefined
80
+
81
+
(** Function.prototype.toString() *)
82
+
let to_string_method this _args =
83
+
match this with
84
+
| Object { data = Data_native_function { name; _ }; _ } ->
85
+
String ("function " ^ name ^ "() { [native code] }")
86
+
| Object { data = Data_function _; _ } ->
87
+
String "function () { [bytecode] }"
88
+
| Object { data = Data_bound_function _; _ } ->
89
+
String "function () { [bound] }"
90
+
| _ -> String "[object Function]"
91
+
92
+
(** Function.prototype.length *)
93
+
(* This is typically a property, not a method *)
94
+
95
+
(** Create Function constructor and prototype *)
96
+
let create () =
97
+
let proto = make_object () in
98
+
99
+
(* Function.prototype methods *)
100
+
let add_proto_method name length func =
101
+
let fn = make_native_function name length func in
102
+
match fn with
103
+
| Object obj ->
104
+
Hashtbl.add proto.properties name
105
+
{ value = Object obj;
106
+
flags = { writable = true; enumerable = false; configurable = true };
107
+
getter = None; setter = None }
108
+
| _ -> ()
109
+
in
110
+
111
+
add_proto_method "call" 1 call;
112
+
add_proto_method "apply" 2 apply;
113
+
add_proto_method "bind" 1 bind;
114
+
add_proto_method "toString" 0 to_string_method;
115
+
116
+
(* Function constructor - creating functions from strings *)
117
+
let function_ctor _this _args =
118
+
(* For now, just return an empty function *)
119
+
(* Full implementation would require parsing and compiling the function body *)
120
+
make_native_function "anonymous" 0 (fun _this _args -> Undefined)
121
+
in
122
+
123
+
let ctor = make_object () in
124
+
let ctor_fn = make_native_function "Function" 1 function_ctor in
125
+
(match ctor_fn with
126
+
| Object obj ->
127
+
ctor.data <- obj.data;
128
+
ctor.class_id <- Class_function
129
+
| _ -> ());
130
+
131
+
(* Link prototype *)
132
+
Hashtbl.add ctor.properties "prototype"
133
+
{ value = Object proto;
134
+
flags = { writable = false; enumerable = false; configurable = false };
135
+
getter = None; setter = None };
136
+
137
+
Hashtbl.add proto.properties "constructor"
138
+
{ value = Object ctor;
139
+
flags = { writable = true; enumerable = false; configurable = true };
140
+
getter = None; setter = None };
141
+
142
+
(Object ctor, Object proto)
+94
lib/quickjs/builtins/init.ml
+94
lib/quickjs/builtins/init.ml
···
57
57
getter = None; setter = None }
58
58
| _ -> ());
59
59
60
+
(* Add Number constructor *)
61
+
let number_ctor, _number_proto = Number.create () in
62
+
(match number_ctor with
63
+
| Object ctor ->
64
+
Hashtbl.add global.properties "Number"
65
+
{ value = Object ctor;
66
+
flags = { writable = true; enumerable = false; configurable = true };
67
+
getter = None; setter = None }
68
+
| _ -> ());
69
+
70
+
(* Add Boolean constructor *)
71
+
let boolean_ctor, _boolean_proto = Boolean.create () in
72
+
(match boolean_ctor with
73
+
| Object ctor ->
74
+
Hashtbl.add global.properties "Boolean"
75
+
{ value = Object ctor;
76
+
flags = { writable = true; enumerable = false; configurable = true };
77
+
getter = None; setter = None }
78
+
| _ -> ());
79
+
80
+
(* Add JSON object *)
81
+
let json = Json.create () in
82
+
(match json with
83
+
| Object j ->
84
+
Hashtbl.add global.properties "JSON"
85
+
{ value = Object j;
86
+
flags = { writable = true; enumerable = false; configurable = true };
87
+
getter = None; setter = None }
88
+
| _ -> ());
89
+
90
+
(* Add Function constructor *)
91
+
let function_ctor, _function_proto = Function.create () in
92
+
(match function_ctor with
93
+
| Object ctor ->
94
+
Hashtbl.add global.properties "Function"
95
+
{ value = Object ctor;
96
+
flags = { writable = true; enumerable = false; configurable = true };
97
+
getter = None; setter = None }
98
+
| _ -> ());
99
+
100
+
(* Add Error constructors *)
101
+
let error_ctor, _error_proto,
102
+
type_error_ctor, reference_error_ctor, syntax_error_ctor,
103
+
range_error_ctor, uri_error_ctor, eval_error_ctor = Error.create () in
104
+
(match error_ctor with
105
+
| Object ctor ->
106
+
Hashtbl.add global.properties "Error"
107
+
{ value = Object ctor;
108
+
flags = { writable = true; enumerable = false; configurable = true };
109
+
getter = None; setter = None }
110
+
| _ -> ());
111
+
(match type_error_ctor with
112
+
| Object ctor ->
113
+
Hashtbl.add global.properties "TypeError"
114
+
{ value = Object ctor;
115
+
flags = { writable = true; enumerable = false; configurable = true };
116
+
getter = None; setter = None }
117
+
| _ -> ());
118
+
(match reference_error_ctor with
119
+
| Object ctor ->
120
+
Hashtbl.add global.properties "ReferenceError"
121
+
{ value = Object ctor;
122
+
flags = { writable = true; enumerable = false; configurable = true };
123
+
getter = None; setter = None }
124
+
| _ -> ());
125
+
(match syntax_error_ctor with
126
+
| Object ctor ->
127
+
Hashtbl.add global.properties "SyntaxError"
128
+
{ value = Object ctor;
129
+
flags = { writable = true; enumerable = false; configurable = true };
130
+
getter = None; setter = None }
131
+
| _ -> ());
132
+
(match range_error_ctor with
133
+
| Object ctor ->
134
+
Hashtbl.add global.properties "RangeError"
135
+
{ value = Object ctor;
136
+
flags = { writable = true; enumerable = false; configurable = true };
137
+
getter = None; setter = None }
138
+
| _ -> ());
139
+
(match uri_error_ctor with
140
+
| Object ctor ->
141
+
Hashtbl.add global.properties "URIError"
142
+
{ value = Object ctor;
143
+
flags = { writable = true; enumerable = false; configurable = true };
144
+
getter = None; setter = None }
145
+
| _ -> ());
146
+
(match eval_error_ctor with
147
+
| Object ctor ->
148
+
Hashtbl.add global.properties "EvalError"
149
+
{ value = Object ctor;
150
+
flags = { writable = true; enumerable = false; configurable = true };
151
+
getter = None; setter = None }
152
+
| _ -> ());
153
+
60
154
(* Add isNaN global function *)
61
155
let is_nan = make_native_function "isNaN" 1 (fun _this args ->
62
156
match args with
+330
lib/quickjs/builtins/json.ml
+330
lib/quickjs/builtins/json.ml
···
1
+
(** JavaScript JSON built-in object.
2
+
3
+
Implements JSON.parse and JSON.stringify as specified in ECMA-262. *)
4
+
5
+
open Quickjs_runtime.Value
6
+
7
+
(** JSON parsing state *)
8
+
type json_state = {
9
+
text : string;
10
+
mutable pos : int;
11
+
len : int;
12
+
}
13
+
14
+
(** Skip whitespace *)
15
+
let skip_whitespace st =
16
+
while st.pos < st.len &&
17
+
(st.text.[st.pos] = ' ' || st.text.[st.pos] = '\t' ||
18
+
st.text.[st.pos] = '\n' || st.text.[st.pos] = '\r') do
19
+
st.pos <- st.pos + 1
20
+
done
21
+
22
+
(** Peek current character *)
23
+
let peek st =
24
+
if st.pos < st.len then Some st.text.[st.pos]
25
+
else None
26
+
27
+
(** Advance and return current character *)
28
+
let advance st =
29
+
if st.pos < st.len then begin
30
+
let c = st.text.[st.pos] in
31
+
st.pos <- st.pos + 1;
32
+
Some c
33
+
end else None
34
+
35
+
(** Expect a specific character *)
36
+
let expect st c =
37
+
skip_whitespace st;
38
+
match peek st with
39
+
| Some ch when ch = c ->
40
+
st.pos <- st.pos + 1;
41
+
true
42
+
| _ -> false
43
+
44
+
(** Parse a JSON string *)
45
+
let parse_string st =
46
+
if not (expect st '"') then None
47
+
else begin
48
+
let buf = Buffer.create 64 in
49
+
let rec loop () =
50
+
match advance st with
51
+
| None -> None (* Unterminated string *)
52
+
| Some '"' -> Some (Buffer.contents buf)
53
+
| Some '\\' ->
54
+
(match advance st with
55
+
| Some '"' -> Buffer.add_char buf '"'; loop ()
56
+
| Some '\\' -> Buffer.add_char buf '\\'; loop ()
57
+
| Some '/' -> Buffer.add_char buf '/'; loop ()
58
+
| Some 'b' -> Buffer.add_char buf '\b'; loop ()
59
+
| Some 'f' -> Buffer.add_char buf '\x0C'; loop ()
60
+
| Some 'n' -> Buffer.add_char buf '\n'; loop ()
61
+
| Some 'r' -> Buffer.add_char buf '\r'; loop ()
62
+
| Some 't' -> Buffer.add_char buf '\t'; loop ()
63
+
| Some 'u' ->
64
+
(* Parse 4 hex digits *)
65
+
if st.pos + 4 <= st.len then begin
66
+
let hex = String.sub st.text st.pos 4 in
67
+
st.pos <- st.pos + 4;
68
+
try
69
+
let code = int_of_string ("0x" ^ hex) in
70
+
if code < 128 then
71
+
Buffer.add_char buf (Char.chr code)
72
+
else if code < 0x800 then begin
73
+
Buffer.add_char buf (Char.chr (0xC0 lor (code lsr 6)));
74
+
Buffer.add_char buf (Char.chr (0x80 lor (code land 0x3F)))
75
+
end else begin
76
+
Buffer.add_char buf (Char.chr (0xE0 lor (code lsr 12)));
77
+
Buffer.add_char buf (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
78
+
Buffer.add_char buf (Char.chr (0x80 lor (code land 0x3F)))
79
+
end;
80
+
loop ()
81
+
with _ -> None
82
+
end else None
83
+
| _ -> None) (* Invalid escape *)
84
+
| Some c ->
85
+
Buffer.add_char buf c;
86
+
loop ()
87
+
in
88
+
loop ()
89
+
end
90
+
91
+
(** Parse a JSON number *)
92
+
let parse_number st =
93
+
let start = st.pos in
94
+
(* Optional minus sign *)
95
+
if st.pos < st.len && st.text.[st.pos] = '-' then
96
+
st.pos <- st.pos + 1;
97
+
(* Integer part *)
98
+
if st.pos < st.len && st.text.[st.pos] = '0' then
99
+
st.pos <- st.pos + 1
100
+
else begin
101
+
while st.pos < st.len && st.text.[st.pos] >= '0' && st.text.[st.pos] <= '9' do
102
+
st.pos <- st.pos + 1
103
+
done
104
+
end;
105
+
(* Fractional part *)
106
+
if st.pos < st.len && st.text.[st.pos] = '.' then begin
107
+
st.pos <- st.pos + 1;
108
+
while st.pos < st.len && st.text.[st.pos] >= '0' && st.text.[st.pos] <= '9' do
109
+
st.pos <- st.pos + 1
110
+
done
111
+
end;
112
+
(* Exponent *)
113
+
if st.pos < st.len && (st.text.[st.pos] = 'e' || st.text.[st.pos] = 'E') then begin
114
+
st.pos <- st.pos + 1;
115
+
if st.pos < st.len && (st.text.[st.pos] = '+' || st.text.[st.pos] = '-') then
116
+
st.pos <- st.pos + 1;
117
+
while st.pos < st.len && st.text.[st.pos] >= '0' && st.text.[st.pos] <= '9' do
118
+
st.pos <- st.pos + 1
119
+
done
120
+
end;
121
+
let num_str = String.sub st.text start (st.pos - start) in
122
+
try Some (Float.of_string num_str)
123
+
with _ -> None
124
+
125
+
(** Parse a JSON value *)
126
+
let rec parse_value st =
127
+
skip_whitespace st;
128
+
match peek st with
129
+
| None -> None
130
+
| Some '"' ->
131
+
(match parse_string st with
132
+
| Some s -> Some (String s)
133
+
| None -> None)
134
+
| Some 'n' ->
135
+
if st.pos + 4 <= st.len && String.sub st.text st.pos 4 = "null" then begin
136
+
st.pos <- st.pos + 4;
137
+
Some Null
138
+
end else None
139
+
| Some 't' ->
140
+
if st.pos + 4 <= st.len && String.sub st.text st.pos 4 = "true" then begin
141
+
st.pos <- st.pos + 4;
142
+
Some (Bool true)
143
+
end else None
144
+
| Some 'f' ->
145
+
if st.pos + 5 <= st.len && String.sub st.text st.pos 5 = "false" then begin
146
+
st.pos <- st.pos + 5;
147
+
Some (Bool false)
148
+
end else None
149
+
| Some '[' -> parse_array st
150
+
| Some '{' -> parse_object st
151
+
| Some c when c = '-' || (c >= '0' && c <= '9') ->
152
+
(match parse_number st with
153
+
| Some n -> Some (Float n)
154
+
| None -> None)
155
+
| _ -> None
156
+
157
+
(** Parse a JSON array *)
158
+
and parse_array st =
159
+
if not (expect st '[') then None
160
+
else begin
161
+
skip_whitespace st;
162
+
if expect st ']' then Some (make_array [])
163
+
else begin
164
+
let rec parse_elements acc =
165
+
match parse_value st with
166
+
| None -> None
167
+
| Some v ->
168
+
let acc = v :: acc in
169
+
skip_whitespace st;
170
+
if expect st ']' then Some (make_array (List.rev acc))
171
+
else if expect st ',' then parse_elements acc
172
+
else None
173
+
in
174
+
parse_elements []
175
+
end
176
+
end
177
+
178
+
(** Parse a JSON object *)
179
+
and parse_object st =
180
+
if not (expect st '{') then None
181
+
else begin
182
+
skip_whitespace st;
183
+
if expect st '}' then Some (Object (make_object ()))
184
+
else begin
185
+
let obj = make_object () in
186
+
let rec parse_members () =
187
+
skip_whitespace st;
188
+
match parse_string st with
189
+
| None -> None
190
+
| Some key ->
191
+
skip_whitespace st;
192
+
if not (expect st ':') then None
193
+
else begin
194
+
match parse_value st with
195
+
| None -> None
196
+
| Some value ->
197
+
ignore (set_property obj key value);
198
+
skip_whitespace st;
199
+
if expect st '}' then Some (Object obj)
200
+
else if expect st ',' then parse_members ()
201
+
else None
202
+
end
203
+
in
204
+
parse_members ()
205
+
end
206
+
end
207
+
208
+
(** JSON.parse(text, reviver?) *)
209
+
let parse _this args =
210
+
let text = match List.nth_opt args 0 with
211
+
| Some v -> to_string v
212
+
| None -> ""
213
+
in
214
+
let st = { text; pos = 0; len = String.length text } in
215
+
match parse_value st with
216
+
| None -> Undefined (* Should throw SyntaxError *)
217
+
| Some v ->
218
+
skip_whitespace st;
219
+
if st.pos < st.len then Undefined (* Trailing characters *)
220
+
else v
221
+
222
+
(** Stringify a value to JSON *)
223
+
let rec stringify_value buf v depth =
224
+
match v with
225
+
| Undefined -> Buffer.add_string buf "null" (* undefined becomes null *)
226
+
| Null -> Buffer.add_string buf "null"
227
+
| Bool true -> Buffer.add_string buf "true"
228
+
| Bool false -> Buffer.add_string buf "false"
229
+
| Int i -> Buffer.add_string buf (Int32.to_string i)
230
+
| Float f ->
231
+
if Float.is_nan f || Float.is_infinite f then
232
+
Buffer.add_string buf "null"
233
+
else
234
+
Buffer.add_string buf (string_of_float f)
235
+
| String s -> stringify_string buf s
236
+
| Symbol _ -> () (* Symbols are ignored *)
237
+
| BigInt _ -> () (* BigInts throw TypeError, we'll skip for now *)
238
+
| Object obj ->
239
+
(match obj.class_id with
240
+
| Class_array ->
241
+
(match obj.data with
242
+
| Data_array arr ->
243
+
Buffer.add_char buf '[';
244
+
Array.iteri (fun i elem ->
245
+
if i > 0 then Buffer.add_char buf ',';
246
+
stringify_value buf elem (depth + 1)
247
+
) !arr;
248
+
Buffer.add_char buf ']'
249
+
| _ -> Buffer.add_string buf "[]")
250
+
| Class_function | Class_bound_function ->
251
+
() (* Functions are ignored, result is undefined *)
252
+
| _ ->
253
+
Buffer.add_char buf '{';
254
+
let first = ref true in
255
+
Hashtbl.iter (fun key prop ->
256
+
if prop.flags.enumerable then begin
257
+
match prop.value with
258
+
| Symbol _ | Object { class_id = Class_function; _ }
259
+
| Object { class_id = Class_bound_function; _ } -> () (* Skip *)
260
+
| _ ->
261
+
if not !first then Buffer.add_char buf ',';
262
+
first := false;
263
+
stringify_string buf key;
264
+
Buffer.add_char buf ':';
265
+
stringify_value buf prop.value (depth + 1)
266
+
end
267
+
) obj.properties;
268
+
Buffer.add_char buf '}')
269
+
| Exception _ -> Buffer.add_string buf "null"
270
+
| Uninitialized -> Buffer.add_string buf "null"
271
+
272
+
(** Stringify a string with proper escaping *)
273
+
and stringify_string buf s =
274
+
Buffer.add_char buf '"';
275
+
String.iter (fun c ->
276
+
match c with
277
+
| '"' -> Buffer.add_string buf "\\\""
278
+
| '\\' -> Buffer.add_string buf "\\\\"
279
+
| '\b' -> Buffer.add_string buf "\\b"
280
+
| '\x0C' -> Buffer.add_string buf "\\f"
281
+
| '\n' -> Buffer.add_string buf "\\n"
282
+
| '\r' -> Buffer.add_string buf "\\r"
283
+
| '\t' -> Buffer.add_string buf "\\t"
284
+
| c when Char.code c < 32 ->
285
+
Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))
286
+
| c -> Buffer.add_char buf c
287
+
) s;
288
+
Buffer.add_char buf '"'
289
+
290
+
(** JSON.stringify(value, replacer?, space?) *)
291
+
let stringify _this args =
292
+
let value = match List.nth_opt args 0 with
293
+
| Some v -> v
294
+
| None -> Undefined
295
+
in
296
+
(* TODO: Handle replacer and space parameters *)
297
+
match value with
298
+
| Undefined | Symbol _ -> Undefined
299
+
| Object { class_id = Class_function; _ }
300
+
| Object { class_id = Class_bound_function; _ } -> Undefined
301
+
| _ ->
302
+
let buf = Buffer.create 256 in
303
+
stringify_value buf value 0;
304
+
String (Buffer.contents buf)
305
+
306
+
(** Create the JSON object *)
307
+
let create () =
308
+
let json = make_object () in
309
+
310
+
let add_method name length func =
311
+
let fn = make_native_function name length func in
312
+
match fn with
313
+
| Object obj ->
314
+
Hashtbl.add json.properties name
315
+
{ value = Object obj;
316
+
flags = { writable = true; enumerable = false; configurable = true };
317
+
getter = None; setter = None }
318
+
| _ -> ()
319
+
in
320
+
321
+
add_method "parse" 2 parse;
322
+
add_method "stringify" 3 stringify;
323
+
324
+
(* Add @@toStringTag *)
325
+
Hashtbl.add json.properties "@@toStringTag"
326
+
{ value = String "JSON";
327
+
flags = { writable = false; enumerable = false; configurable = true };
328
+
getter = None; setter = None };
329
+
330
+
Object json
+221
lib/quickjs/builtins/number.ml
+221
lib/quickjs/builtins/number.ml
···
1
+
(** JavaScript Number built-in object.
2
+
3
+
Implements Number methods as specified in ECMA-262. *)
4
+
5
+
open Quickjs_runtime.Value
6
+
7
+
(** Number.isNaN(value) *)
8
+
let is_nan _this args =
9
+
match args with
10
+
| Float f :: _ -> Bool (Float.is_nan f)
11
+
| Int _ :: _ -> Bool false
12
+
| _ -> Bool false
13
+
14
+
(** Number.isFinite(value) *)
15
+
let is_finite _this args =
16
+
match args with
17
+
| Float f :: _ -> Bool (not (Float.is_nan f) && not (Float.is_infinite f))
18
+
| Int _ :: _ -> Bool true
19
+
| _ -> Bool false
20
+
21
+
(** Number.isInteger(value) *)
22
+
let is_integer _this args =
23
+
match args with
24
+
| Int _ :: _ -> Bool true
25
+
| Float f :: _ ->
26
+
Bool (not (Float.is_nan f) && not (Float.is_infinite f) && Float.trunc f = f)
27
+
| _ -> Bool false
28
+
29
+
(** Number.isSafeInteger(value) *)
30
+
let is_safe_integer _this args =
31
+
match args with
32
+
| Int _ :: _ -> Bool true
33
+
| Float f :: _ ->
34
+
let max_safe = 9007199254740991.0 in (* 2^53 - 1 *)
35
+
Bool (not (Float.is_nan f) && Float.trunc f = f &&
36
+
Float.abs f <= max_safe)
37
+
| _ -> Bool false
38
+
39
+
(** Number.parseFloat(string) *)
40
+
let parse_float _this args =
41
+
let s = match List.nth_opt args 0 with
42
+
| Some v -> to_string v |> String.trim
43
+
| None -> ""
44
+
in
45
+
try Float (Float.of_string s)
46
+
with _ -> Float Float.nan
47
+
48
+
(** Number.parseInt(string, radix?) *)
49
+
let parse_int _this args =
50
+
let s = match List.nth_opt args 0 with
51
+
| Some v -> to_string v |> String.trim
52
+
| None -> ""
53
+
in
54
+
let _radix = match List.nth_opt args 1 with
55
+
| Some Undefined | None -> 10
56
+
| Some v -> int_of_float (to_float v)
57
+
in
58
+
try
59
+
if String.length s >= 2 then
60
+
let prefix = String.sub s 0 2 in
61
+
if prefix = "0x" || prefix = "0X" then
62
+
Int (Int32.of_string s)
63
+
else
64
+
Int (Int32.of_string s)
65
+
else
66
+
Int (Int32.of_string s)
67
+
with _ -> Float Float.nan
68
+
69
+
(** Number.prototype.toFixed(digits) *)
70
+
let to_fixed this args =
71
+
let n = to_float this in
72
+
let digits = match List.nth_opt args 0 with
73
+
| Some v -> max 0 (min 100 (int_of_float (to_float v)))
74
+
| None -> 0
75
+
in
76
+
String (Printf.sprintf "%.*f" digits n)
77
+
78
+
(** Number.prototype.toExponential(digits) *)
79
+
let to_exponential this args =
80
+
let n = to_float this in
81
+
let digits = match List.nth_opt args 0 with
82
+
| Some Undefined | None -> 6
83
+
| Some v -> max 0 (min 100 (int_of_float (to_float v)))
84
+
in
85
+
String (Printf.sprintf "%.*e" digits n)
86
+
87
+
(** Number.prototype.toPrecision(precision) *)
88
+
let to_precision this args =
89
+
let n = to_float this in
90
+
match List.nth_opt args 0 with
91
+
| Some Undefined | None -> String (to_string (Float n))
92
+
| Some v ->
93
+
let prec = max 1 (min 100 (int_of_float (to_float v))) in
94
+
String (Printf.sprintf "%.*g" prec n)
95
+
96
+
(** Number.prototype.toString(radix?) *)
97
+
let to_string_method this args =
98
+
let n = to_float this in
99
+
let radix = match List.nth_opt args 0 with
100
+
| Some Undefined | None -> 10
101
+
| Some v -> int_of_float (to_float v)
102
+
in
103
+
if radix < 2 || radix > 36 then
104
+
Float Float.nan (* Should throw RangeError *)
105
+
else if radix = 10 then
106
+
String (to_string (Float n))
107
+
else begin
108
+
(* Simple conversion for common radices *)
109
+
let i = Int32.to_int (to_int32 (Float n)) in
110
+
let rec convert n =
111
+
if n = 0 then ""
112
+
else
113
+
let digit = abs (n mod radix) in
114
+
let c = if digit < 10 then Char.chr (digit + Char.code '0')
115
+
else Char.chr (digit - 10 + Char.code 'a') in
116
+
convert (n / radix) ^ String.make 1 c
117
+
in
118
+
let s = if i = 0 then "0" else convert i in
119
+
let s = if n < 0.0 then "-" ^ s else s in
120
+
String s
121
+
end
122
+
123
+
(** Number.prototype.valueOf() *)
124
+
let value_of this _args =
125
+
match this with
126
+
| Int _ | Float _ -> this
127
+
| Object { data = Data_none; _ } ->
128
+
(match get_property (match this with Object o -> o | _ -> failwith "not object") "[[PrimitiveValue]]" with
129
+
| Some (Int _ as v) | Some (Float _ as v) -> v
130
+
| _ -> Float Float.nan)
131
+
| _ -> Float Float.nan
132
+
133
+
(** Create Number constructor and prototype *)
134
+
let create () =
135
+
let proto = make_object () in
136
+
137
+
(* Number.prototype methods *)
138
+
let add_proto_method name length func =
139
+
let fn = make_native_function name length func in
140
+
match fn with
141
+
| Object obj ->
142
+
Hashtbl.add proto.properties name
143
+
{ value = Object obj;
144
+
flags = { writable = true; enumerable = false; configurable = true };
145
+
getter = None; setter = None }
146
+
| _ -> ()
147
+
in
148
+
149
+
add_proto_method "toFixed" 1 to_fixed;
150
+
add_proto_method "toExponential" 1 to_exponential;
151
+
add_proto_method "toPrecision" 1 to_precision;
152
+
add_proto_method "toString" 1 to_string_method;
153
+
add_proto_method "valueOf" 0 value_of;
154
+
155
+
(* Number constructor *)
156
+
let number_ctor _this args =
157
+
match args with
158
+
| [] -> Int 0l
159
+
| v :: _ -> to_number v
160
+
in
161
+
162
+
let ctor = make_object () in
163
+
let ctor_fn = make_native_function "Number" 1 number_ctor in
164
+
(match ctor_fn with
165
+
| Object obj ->
166
+
ctor.data <- obj.data;
167
+
ctor.class_id <- Class_function
168
+
| _ -> ());
169
+
170
+
(* Static methods *)
171
+
let add_static_method name length func =
172
+
let fn = make_native_function name length func in
173
+
match fn with
174
+
| Object obj ->
175
+
Hashtbl.add ctor.properties name
176
+
{ value = Object obj;
177
+
flags = { writable = true; enumerable = false; configurable = true };
178
+
getter = None; setter = None }
179
+
| _ -> ()
180
+
in
181
+
182
+
add_static_method "isNaN" 1 is_nan;
183
+
add_static_method "isFinite" 1 is_finite;
184
+
add_static_method "isInteger" 1 is_integer;
185
+
add_static_method "isSafeInteger" 1 is_safe_integer;
186
+
add_static_method "parseFloat" 1 parse_float;
187
+
add_static_method "parseInt" 2 parse_int;
188
+
189
+
(* Static constants *)
190
+
let add_const name value =
191
+
Hashtbl.add ctor.properties name
192
+
{ value = Float value;
193
+
flags = { writable = false; enumerable = false; configurable = false };
194
+
getter = None; setter = None }
195
+
in
196
+
197
+
add_const "EPSILON" (Float.pow 2.0 (-52.0));
198
+
add_const "MAX_VALUE" Float.max_float;
199
+
add_const "MIN_VALUE" Float.min_float;
200
+
add_const "MAX_SAFE_INTEGER" 9007199254740991.0;
201
+
add_const "MIN_SAFE_INTEGER" (-9007199254740991.0);
202
+
add_const "POSITIVE_INFINITY" Float.infinity;
203
+
add_const "NEGATIVE_INFINITY" Float.neg_infinity;
204
+
205
+
Hashtbl.add ctor.properties "NaN"
206
+
{ value = Float Float.nan;
207
+
flags = { writable = false; enumerable = false; configurable = false };
208
+
getter = None; setter = None };
209
+
210
+
(* Link prototype *)
211
+
Hashtbl.add ctor.properties "prototype"
212
+
{ value = Object proto;
213
+
flags = { writable = false; enumerable = false; configurable = false };
214
+
getter = None; setter = None };
215
+
216
+
Hashtbl.add proto.properties "constructor"
217
+
{ value = Object ctor;
218
+
flags = { writable = true; enumerable = false; configurable = true };
219
+
getter = None; setter = None };
220
+
221
+
(Object ctor, Object proto)