blob: a04a562b7f41b69a326b212c17aba83dfa9c67a1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
//#OPTIONS: CPP
/*
Runtime inspection of Haskell data.
The code generator can emit calls to these functions
*/
/*
function h$verify_rep_int64(x, y) {
}
function h$verify_rep_word64(x, y) {
}
*/
/*
an int rep is an integer in range [-2^31..2^31-1]
(for Word# values, the value is treated as unsigned by the RTS. From
JavaScript it still looks signed.
)
*/
function h$verify_rep_int(x) {
if(typeof x === 'number' &&
(x|0) === x
) return;
throw new Error("invalid int rep " + h$show_val(x));
}
/*
function h$verify_rep_word(x, y) {
}
*/
/*
a long rep is two integers in rage [-2^31..2^31-1]
*/
function h$verify_rep_long(x, y) {
if(typeof x === 'number' &&
typeof y === 'number' &&
(x|0) === x &&
(y|0) === y
) return;
throw new Error("invalid long rep " + h$show_val(x) + " " + h$show_val(y));
}
/*
function h$verify_rep_float(x) {
}
*/
function h$verify_rep_double(x) {
if(typeof x === 'number') return;
throw new Error("invalid double rep " + h$show_val(x));
}
/*
an array rep is a JavaScript array. The elements are other
array reps or heap objects.
*/
function h$verify_rep_arr(x) {
if(h$verify_rep_is_arr(x)) return;
throw new Error("invalid array rep " + h$show_val(x));
}
function h$verify_rep_is_arr(x) {
// XXX check the elements?
return (typeof x === 'object'
&& x
&& Array.isArray(x)
// XXX enable this check
// && x.__ghcjsArray === true
);
}
function h$verify_rep_rtsobj(x) {
// unspecified unlifted value
}
/*
an rts object rep is one of the known RTS object types
*/
function h$verify_rep_is_rtsobj(o) {
return (o instanceof h$MVar ||
o instanceof h$MutVar ||
o instanceof h$TVar ||
o instanceof h$Transaction ||
o instanceof h$Thread ||
o instanceof h$Weak ||
o instanceof h$StableName ||
h$verify_rep_is_bytearray(o) ||
h$verify_rep_is_arr(o));
}
function h$verify_rep_is_bytearray(o) {
return (typeof o === 'object' &&
o &&
typeof o.buf === 'object' &&
o.buf &&
o.buf instanceof ArrayBuffer &&
typeof o.len === 'number');
}
/*
a heap object rep is either an object or an unboxed heap object
unboxed heap objects store evaluated values of type 'number' or 'boolean'
without wrapping them in a normal heap object. this is only done for
data types with a single constructor and a single field of an appropriate type
*/
function h$verify_rep_heapobj(o) {
// possibly an unlifted rts object
// XXX: we should do a different check for these
if(h$verify_rep_is_rtsobj(o)) return;
// unboxed rep
if(typeof o === 'number' || typeof o === 'boolean') return;
// boxed rep
if(typeof o === 'object' &&
o &&
typeof o.f === 'function' &&
typeof o.f.a === 'number' &&
(typeof o.m === 'number' || (typeof o.m === 'object' && o.m))
) return;
throw new Error("invalid heapobj rep " + h$show_val(o));
}
/*
an addr rep is a data object and an integer offset
*/
function h$verify_rep_addr(v, o) {
if(typeof o === 'number' &&
(o|0) === o &&
// o >= 0 && // XXX we could treat it as unsigned, should we?
typeof v === 'object'
) return;
throw new Error("invalid addr rep " + h$show_val(v) + " " + o);
}
/*
v must be a value of type tc that can be matched
*/
function h$verify_match_alg(tc, v) {
if(typeof v === 'boolean') {
if(tc === "ghc-prim:GHC.Types.Bool") return;
throw new Error("invalid pattern match boolean rep " + tc);
} else if(typeof v === 'number') {
// h$log("h$verify_match_alg number: " + tc);
return;
} else if(typeof v === 'object') {
// h$log("verify_match_alg_obj: " + tc);
if(!(typeof v.f === 'function' &&
typeof v.f.a === 'number' &&
typeof v.f.t === 'number' &&
v.f.t === 2 /// con
)) {
throw new Error("not a data constructor " + tc + ": " + h$show_val(v));
}
// XXX add check for the type
return;
}
throw new Error("invalid pattern match rep " + tc + ": " + h$show_val(v));
}
/*
debug show object
*/
function h$show_val(o) {
if(typeof o === 'undefined') return '<undefined>'
if(o === null) return '<null>'
if(typeof o !== 'object') return '[' + (typeof o) + ': ' + o + ']'
return '' + o + ' [' + o.constructor.name + '] ' + h$collectProps(o);
}
|
