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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
(* Interface to Perl from OCaml.
Copyright (C) 2003 Merjis Ltd.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU General Public License
along with this library; see the file COPYING. If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
$Id: perl.ml,v 1.16 2008-03-01 13:02:21 rich Exp $
*)
type sv
type av
type hv
exception Perl_failure of string
(* Initialization. This must happen first, otherwise other parts of the
* program will segfault because of a missing interpreter.
*)
external c_init : unit -> unit = "perl4caml_init"
let () =
Callback.register_exception "perl4caml_perl_failure" (Perl_failure "");
c_init (); (* Initialise C code. *)
()
external int_of_sv : sv -> int = "perl4caml_int_of_sv"
external sv_of_int : int -> sv = "perl4caml_sv_of_int"
external float_of_sv : sv -> float = "perl4caml_float_of_sv"
external sv_of_float : float -> sv = "perl4caml_sv_of_float"
external string_of_sv : sv -> string = "perl4caml_string_of_sv"
external sv_of_string : string -> sv = "perl4caml_sv_of_string"
external sv_is_true : sv -> bool = "perl4caml_sv_is_true"
external sv_undef : unit -> sv = "perl4caml_sv_undef"
external sv_is_undef : sv -> bool = "perl4caml_sv_is_undef"
external sv_yes : unit -> sv = "perl4caml_sv_yes"
external sv_no : unit -> sv = "perl4caml_sv_no"
let sv_true () = sv_of_int 1
let sv_false () = sv_of_int 0
let bool_of_sv = sv_is_true
let sv_of_bool b = if b then sv_true () else sv_false ()
type sv_t = SVt_NULL
| SVt_IV
| SVt_NV
| SVt_PV
| SVt_RV
| SVt_PVAV
| SVt_PVHV
| SVt_PVCV
| SVt_PVGV
| SVt_PVMG
external sv_type : sv -> sv_t = "perl4caml_sv_type"
let string_of_sv_t = function
SVt_NULL -> "SVt_NULL"
| SVt_IV -> "SVt_IV"
| SVt_NV -> "SVt_NV"
| SVt_PV -> "SVt_PV"
| SVt_RV -> "SVt_RV"
| SVt_PVAV -> "SVt_PVAV"
| SVt_PVHV -> "SVt_PVHV"
| SVt_PVCV -> "SVt_PVCV"
| SVt_PVGV -> "SVt_PVGV"
| SVt_PVMG -> "SVt_PVMG"
external reftype : sv -> sv_t = "perl4caml_reftype"
external address_of_sv : sv -> Nativeint.t = "perl4caml_address_of_sv"
external address_of_av : av -> Nativeint.t = "perl4caml_address_of_av"
external address_of_hv : hv -> Nativeint.t = "perl4caml_address_of_hv"
external scalarref : sv -> sv = "perl4caml_scalarref"
external arrayref : av -> sv = "perl4caml_arrayref"
external hashref : hv -> sv = "perl4caml_hashref"
external deref : sv -> sv = "perl4caml_deref"
external deref_array : sv -> av = "perl4caml_deref_array"
external deref_hash : sv -> hv = "perl4caml_deref_hash"
external av_empty : unit -> av = "perl4caml_av_empty"
external av_of_sv_list : sv list -> av = "perl4caml_av_of_sv_list"
external av_push : av -> sv -> unit = "perl4caml_av_push"
external av_pop : av -> sv = "perl4caml_av_pop"
external av_shift : av -> sv = "perl4caml_av_shift"
external av_unshift : av -> sv -> unit = "perl4caml_av_unshift"
external av_length : av -> int = "perl4caml_av_length"
external av_set : av -> int -> sv -> unit = "perl4caml_av_set"
external av_get : av -> int -> sv = "perl4caml_av_get"
external av_clear : av -> unit = "perl4caml_av_clear"
external av_undef : av -> unit = "perl4caml_av_undef"
external av_extend : av -> int -> unit = "perl4caml_av_extend"
let av_map f av =
let list = ref [] in
for i = 0 to av_length av - 1 do
list := f (av_get av i) :: !list
done;
List.rev !list
let list_of_av av =
let list = ref [] in
for i = 0 to av_length av - 1 do
list := av_get av i :: !list
done;
List.rev !list
let av_of_string_list strs =
av_of_sv_list (List.map sv_of_string strs)
external hv_empty : unit -> hv = "perl4caml_hv_empty"
external hv_set : hv -> string -> sv -> unit = "perl4caml_hv_set"
external hv_get : hv -> string -> sv = "perl4caml_hv_get"
external hv_exists : hv -> string -> bool = "perl4caml_hv_exists"
external hv_delete : hv -> string -> unit = "perl4caml_hv_delete"
external hv_clear : hv -> unit = "perl4caml_hv_clear"
external hv_undef : hv -> unit = "perl4caml_hv_undef"
type he
external hv_iterinit : hv -> Int32.t = "perl4caml_hv_iterinit"
external hv_iternext : hv -> he = "perl4caml_hv_iternext"
external hv_iterkey : he -> string = "perl4caml_hv_iterkey"
external hv_iterval : hv -> he -> sv = "perl4caml_hv_iterval"
external hv_iternextsv : hv -> string * sv = "perl4caml_hv_iternextsv"
let hv_of_assoc xs =
let hv = hv_empty () in
List.iter (fun (k, v) -> hv_set hv k v) xs;
hv
let assoc_of_hv hv =
ignore (hv_iterinit hv);
(* Someone please rewrite this to make it tail-rec! - Rich. XXX *)
let rec loop acc =
try
let k, v = hv_iternextsv hv in
loop ((k, v) :: acc)
with
Not_found -> acc
in
loop []
let hv_keys hv =
ignore (hv_iterinit hv);
(* Someone please rewrite this to make it tail-rec! - Rich. XXX *)
let rec loop acc =
try
let he = hv_iternext hv in
let k = hv_iterkey he in
loop (k :: acc)
with
Not_found -> acc
in
loop []
let hv_values hv =
ignore (hv_iterinit hv);
(* Someone please rewrite this to make it tail-rec! - Rich. XXX *)
let rec loop acc =
try
let he = hv_iternext hv in
let v = hv_iterval hv he in
loop (v :: acc)
with
Not_found -> acc
in
loop []
external get_sv : ?create:bool -> string -> sv = "perl4caml_get_sv"
external get_av : ?create:bool -> string -> av = "perl4caml_get_av"
external get_hv : ?create:bool -> string -> hv = "perl4caml_get_hv"
external call : ?sv:sv -> ?fn:string -> sv list -> sv
= "perl4caml_call"
external call_array : ?sv:sv -> ?fn:string -> sv list -> sv list
= "perl4caml_call_array"
external call_void : ?sv:sv -> ?fn:string -> sv list -> unit
= "perl4caml_call_void"
external eval : string -> sv
= "perl4caml_eval"
external call_method : sv -> string -> sv list -> sv
= "perl4caml_call_method"
external call_method_array : sv -> string -> sv list -> sv list
= "perl4caml_call_method_array"
external call_method_void : sv -> string -> sv list -> unit
= "perl4caml_call_method_void"
external call_class_method : string -> string -> sv list -> sv
= "perl4caml_call_class_method"
external call_class_method_array : string -> string -> sv list -> sv list
= "perl4caml_call_class_method_array"
external call_class_method_void : string -> string -> sv list -> unit
= "perl4caml_call_class_method_void"
|
