File: build/library_io.ml (return to index)



Statistics:  
kind coverage
binding 25 / 25 (100 %)
sequence 19 / 21 (90 %)
for 0 / 0 (- %)
if/then 2 / 4 (50 %)
try 15 / 15 (100 %)
while 0 / 0 (- %)
match/function 33 / 57 (57 %)
kind coverage
class expression 0 / 0 (- %)
class initializer 0 / 0 (- %)
class method 0 / 0 (- %)
class value 0 / 0 (- %)
toplevel expression 0 / 0 (- %)
lazy operator 0 / 0 (- %)



Source:

fold all unfold all
000001| (**
000002| This program is free software; you can redistribute it and / or modify
000003| it under the terms of the GNU General Public License as published by
000004| the Free Software Foundation; version 3 of the License.
000005|  
000006| This program is distributed in the hope that it will be useful,
000007| but WITHOUT ANY WARRANTY; without even the implied warranty of
000008| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
000009| GNU General Public License for more details.
000010|  
000011| I / O library implementation
000012|  
000013| @author Tony BenBrahim < tony.benbrahim at gmail.com >
000014|  
000015| *)
000016|  
000017| open Environment
000018| open Ast
000019| open Expression
000020| open RuntimeError
000021| open Unix
000022|  
000023| exception EIOPassthrough of string
000024|  
000025| type channelType = OutChannel of out_channel | InChannel of in_channel * (string * bool)
000026|  
000027| (**
000028| Entry point for library initialization
000029| @return a list of exported functions
000030| *)
000031| let initialize env =
000032|         (*[2]*)let env = Environment.declare_variable_and_value env "File" (RMapValue(Hashtbl.create 10, MapSubtype))
000033|         in (*[2]*)let env = Environment.declare_variable_and_value env "Directory" (RMapValue(Hashtbl.create 10, MapSubtype))
000034|         in (*[2]*)let descriptors = Hashtbl.create 10 in
000035|         (*[2]*)let get_descriptor handle command =
000036|                 ((*[76]*)try
000037|                         (*[76]*)Hashtbl.find descriptors handle
000038|                 with
000039|                 | Not_found -> (*[0]*)raise (EIOPassthrough("invalid handle for "^command)))
000040|         in (*[2]*)let try_read ch =
000041|                 (
000042|                         (*[26]*)try
000043|                                 ((*[26]*)input_line ch, false)
000044|                         with
000045|                         | End_of_file -> ((*[4]*)"", true)
000046|                 )
000047|         in ((*[2]*)[
000048|                 {
000049|                         name = ["print"];
000050|                         args = ["values..."];
000051|                         num_args = 1;
000052|                         vararg = true;
000053|                         code = fun env ->
000054|                                                 match env.stackframes.(0).(1) with
000055|                                                 | RMapValue(t, ArraySubtype) ->
000056|                                                                 (*[296]*)List.iter (fun value ->
000057|                                                                                                 (*[888]*)print_string (string_of_value value)) (list_of_array (RMapValue(t, ArraySubtype)))
000058|                                                 | _ -> (*[0]*)raise (RuntimeError.LibraryError "expected vararg for first parameter of print")
000059|                 };
000060|                 {
000061|                         name = ["println"];
000062|                         args = ["values..."];
000063|                         num_args = 1;
000064|                         vararg = true;
000065|                         code = fun env ->
000066|                                                 match env.stackframes.(0).(1) with
000067|                                                 | RMapValue(t, ArraySubtype) ->
000068|                                                                 (*[380]*)List.iter (fun value ->
000069|                                                                                                 (*[602]*)print_string (string_of_value value)) (list_of_array (RMapValue(t, ArraySubtype)));
000070|                                                                 (*[380]*)print_newline()
000071|                                                 | _ -> (*[0]*)raise (RuntimeError.LibraryError "expected vararg for first parameter of println")
000072|                 };
000073|                 {
000074|                         name =["readln"];
000075|                         args =[];
000076|                         num_args = 0;
000077|                         vararg = false;
000078|                         code = fun env ->
000079|                                                 (*[0]*)raise (CFReturn(RStringValue(read_line())))
000080|                 };
000081|                 {
000082|                         name =["File";"openForWriting"];
000083|                         args =["handle"; "filename"];
000084|                         num_args = 2;
000085|                         vararg = false;
000086|                         code = fun env ->
000087|                                                 (*[4]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000088|                                                 (*[4]*)let filename = string_of_value (env.stackframes.(0).(2)) in
000089|                                                 (*[4]*)try
000090|                                                         (*[4]*)if Hashtbl.mem descriptors handle then
000091|                                                                 (*[0]*)raise (EIOPassthrough("handle "^handle^" is already opened in call to openForWriting"))
000092|                                                         else
000093|                                                                 (*[4]*)let ch = open_out filename in
000094|                                                                 (*[4]*)Hashtbl.add descriptors handle (OutChannel(ch), filename)
000095|                                                 with
000096|                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000097|                                                 | _ -> (*[0]*)raise (LibraryError ("error opening file "^filename^" in openFileForWriting"))
000098|                 };
000099|                 {
000100|                         name =["File";"openForReading"];
000101|                         args =["handle"; "filename"];
000102|                         num_args = 2;
000103|                         vararg = false;
000104|                         code = fun env ->
000105|                                                 (*[4]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000106|                                                 (*[4]*)let filename = string_of_value (env.stackframes.(0).(2)) in
000107|                                                 (*[4]*)try
000108|                                                         (*[4]*)if Hashtbl.mem descriptors handle then
000109|                                                                 (*[0]*)raise (EIOPassthrough("handle "^handle^" is already opened in call to openForReading"))
000110|                                                         else
000111|                                                                 (*[4]*)let ch = open_in filename in
000112|                                                                 (*[4]*)Hashtbl.add descriptors handle (InChannel(ch, (try_read ch)), filename)
000113|                                                 with
000114|                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000115|                                                 | _ -> (*[0]*)raise (LibraryError ("error opening file "^filename^" in openFileForReading"))
000116|                 };
000117|                 {
000118|                         name =["File";"close"];
000119|                         args =["handle"];
000120|                         num_args = 1;
000121|                         vararg = false;
000122|                         code = fun env ->
000123|                                                 (*[8]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000124|                                                 (*[8]*)let (c, _ ) = get_descriptor handle "closeFile" in
000125|                                                 (*[8]*)try
000126|                                                         (match c with
000127|                                                                 | OutChannel(ch) -> (*[4]*)close_out ch
000128|                                                                 | InChannel(ch, _) -> (*[4]*)close_in ch);
000129|                                                         (*[8]*)Hashtbl.remove descriptors handle
000130|                                                 with
000131|                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000132|                                                 | Sys_error msg -> (*[0]*)raise (LibraryError ("System error on closeFile:" ^ msg ))
000133|                 };
000134|                 {
000135|                         name =["File";"write"];
000136|                         args =["handle"; "values..."];
000137|                         num_args = 2;
000138|                         vararg = true;
000139|                         code = fun env ->
000140|                                                 (*[2]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000141|                                                 (*[2]*)let (c, filename) = get_descriptor handle "write" in
000142|                                                 match c with
000143|                                                 | OutChannel(ch) ->
000144|                                                                 ( (*[2]*)try
000145|                                                                         (*[2]*)let _ = List.map (fun el -> (*[2]*)output_string ch (string_of_value el))
000146|                                                                                         (list_of_array (env.stackframes.(0).(2))) in (*[2]*)()
000147|                                                                 with
000148|                                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000149|                                                                 | _ -> (*[0]*)raise (LibraryError ("error writing file "^filename^" in write")))
000150|                                                 | InChannel(ch, _) -> (*[0]*)raise (LibraryError ("invalid handle in call to write. Handle "^handle^" was opened for reading "^filename))
000151|                 };
000152|                 {
000153|                         name =["File";"writeln"];
000154|                         args =["handle"; "values..."];
000155|                         num_args = 2;
000156|                         vararg = true;
000157|                         code = fun env ->
000158|                                                 (*[22]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000159|                                                 (*[22]*)let (c, filename) = get_descriptor handle "writeln" in
000160|                                                 match c with
000161|                                                 | OutChannel(ch) ->
000162|                                                                 ((*[22]*)try
000163|                                                                         (*[22]*)let _ = List.map (fun el -> (*[22]*)output_string ch (string_of_value el))
000164|                                                                                         (list_of_array (env.stackframes.(0).(2))) in
000165|                                                                         (*[22]*)output_string ch ( "\n")
000166|                                                                 with
000167|                                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000168|                                                                 | _ -> (*[0]*)raise (LibraryError ("error writing file "^filename^" in writeln")))
000169|                                                 | InChannel(ch, _) -> (*[0]*)raise (LibraryError ("invalid handle in call to write. Handle "^handle^" was opened for reading "^filename))
000170|                 };
000171|                 {
000172|                         name =["File";"readln"];
000173|                         args =["handle"];
000174|                         num_args = 1;
000175|                         vararg = false;
000176|                         code = fun env ->
000177|                                                 (*[22]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000178|                                                 (*[22]*)let (c, filename) = get_descriptor handle "readln" in
000179|                                                 match c with
000180|                                                 | OutChannel(ch) -> (*[0]*)raise (EIOPassthrough ("invalid handle in call to readln. Handle "^handle^" was opened for writing "^filename))
000181|                                                 | InChannel(ch, (_, true)) -> (*[0]*)raise (EIOPassthrough ("End of file reached for handle "^handle^" in call to readln"))
000182|                                                 | InChannel(ch, (data, false)) ->
000183|                                                                 ( (*[22]*)try
000184|                                                                         (*[22]*)Hashtbl.replace descriptors handle (InChannel(ch, (try_read ch)), filename)
000185|                                                                 with
000186|                                                                 | EIOPassthrough(msg) -> (*[0]*)raise (LibraryError msg)
000187|                                                                 | _ -> (*[0]*)raise (LibraryError ("error reading file "^filename^" in readln")));
000188|                                                                 (*[22]*)raise (CFReturn(RStringValue(data)))
000189|                 };
000190|                 {
000191|                         name =["File";"eof"];
000192|                         args =["handle"];
000193|                         num_args = 1;
000194|                         vararg = false;
000195|                         code = fun env ->
000196|                                                 (*[22]*)let handle = string_of_value (env.stackframes.(0).(1)) in
000197|                                                 (*[22]*)let (c, filename) = get_descriptor handle "eof" in
000198|                                                 match c with
000199|                                                 | OutChannel(ch) -> (*[0]*)raise (EIOPassthrough("invalid handle in call to eof. Handle "^handle^" was opened for writing "^filename))
000200|                                                 | InChannel(ch, (_, eof)) -> (*[22]*)raise (CFReturn(RBooleanValue(eof)))
000201|                 };
000202|                 {
000203|                         name =["File";"exists"];
000204|                         args =["filename"];
000205|                         num_args = 1;
000206|                         vararg = false;
000207|                         code = fun env ->
000208|                                                 (*[8]*)let filename = string_of_value (env.stackframes.(0).(1)) in
000209|                                                 (*[8]*)raise (CFReturn(RBooleanValue (Sys.file_exists filename)))
000210|                 };
000211|                 {
000212|                         name =["File";"delete"];
000213|                         args =["name"];
000214|                         num_args = 1;
000215|                         vararg = false;
000216|                         code = fun env ->
000217|                                                 (*[6]*)let name = string_of_value (env.stackframes.(0).(1)) in
000218|                                                 (*[6]*)try
000219|                                                         (*[6]*)unlink name;
000220|                                                         (*[4]*)raise (CFReturn(RBooleanValue(true)))
000221|                                                 with
000222|                                                 | _ -> (*[6]*)raise (CFReturn(RBooleanValue(false)))
000223|                 
000224|                 };
000225|                 {
000226|                         name =["File";"rename"];
000227|                         args =["fromname";"toname"];
000228|                         num_args = 2;
000229|                         vararg = false;
000230|                         code = fun env ->
000231|                                                 (*[2]*)let fromname = string_of_value (env.stackframes.(0).(1)) in
000232|                                                 (*[2]*)let toname = string_of_value (env.stackframes.(0).(2)) in
000233|                                                 (*[2]*)try
000234|                                                         (*[2]*)rename fromname toname;
000235|                                                         (*[2]*)raise (CFReturn(RBooleanValue(true)))
000236|                                                 with
000237|                                                 | _ -> (*[2]*)raise (CFReturn(RBooleanValue(false)))
000238|                 };
000239|                 {
000240|                         name =["Directory";"create"];
000241|                         args =["name"];
000242|                         num_args = 1;
000243|                         vararg = false;
000244|                         code = fun env ->
000245|                                                 (*[8]*)let name = string_of_value (env.stackframes.(0).(1)) in
000246|                                                 (*[8]*)try
000247|                                                         (*[8]*)mkdir name 0o777;
000248|                                                         (*[8]*)raise (CFReturn(RBooleanValue(true)))
000249|                                                 with
000250|                                                 | CFReturn _ as e -> (*[8]*)raise e
000251|                                                 | _ -> (*[0]*)raise (CFReturn(RBooleanValue(false)))
000252|                 };
000253|                 {
000254|                         name =["Directory";"delete"];
000255|                         args =["name"];
000256|                         num_args = 1;
000257|                         vararg = false;
000258|                         code = fun env ->
000259|                                                 (*[8]*)let name = string_of_value (env.stackframes.(0).(1)) in
000260|                                                 (*[8]*)try
000261|                                                         (*[8]*)rmdir name;
000262|                                                         (*[8]*)raise (CFReturn(RBooleanValue(true)))
000263|                                                 with
000264|                                                 | CFReturn _ as e -> (*[8]*)raise e
000265|                                                 | _ -> (*[0]*)raise (CFReturn(RBooleanValue(false)))
000266|                 };
000267|                 {
000268|                         name =["Directory";"list"];
000269|                         args =["name"];
000270|                         num_args = 1;
000271|                         vararg = false;
000272|                         code = fun env ->
000273|                                                 (*[2]*)let name = string_of_value (env.stackframes.(0).(1)) in
000274|                                                 (*[2]*)let arr = (try
000275|                                                                 (*[2]*)let handle = opendir name in
000276|                                                                 (*[2]*)let h = Hashtbl.create 10
000277|                                                                 in (*[2]*)let rec loop cnt =
000278|                                                                         (*[8]*)try
000279|                                                                                 (*[8]*)Hashtbl.add h (string_of_int cnt) (RStringValue(readdir handle));
000280|                                                                                 (*[6]*)loop (cnt + 1)
000281|                                                                         with
000282|                                                                         | End_of_file -> (*[2]*)closedir handle; (*[2]*)cnt
000283|                                                                         | _ -> (*[0]*)closedir handle; (*[0]*)raise (CFReturn(RVoid))
000284|                                                                 in (*[2]*)Hashtbl.add h "length" (RIntegerValue(loop 0));
000285|                                                                 (*[2]*)h
000286|                                                         with
000287|                                                         | _ -> (*[0]*)raise (CFReturn(RVoid)))
000288|                                                 in (*[2]*)raise (CFReturn(RMapValue(arr, ArraySubtype)));
000289|                 };
000290|                 {
000291|                         name =["Directory";"exists"];
000292|                         args =["name"];
000293|                         num_args = 1;
000294|                         vararg = false;
000295|                         code = fun env ->
000296|                                                 (*[6]*)let name = string_of_value (env.stackframes.(0).(1)) in
000297|                                                 (*[6]*)raise (CFReturn(RBooleanValue((try
000298|                                                                                         (*[6]*)Sys.is_directory name
000299|                                                                                 with
000300|                                                                                 | _ -> (*[2]*)raise (CFReturn(RBooleanValue(false)))))))
000301|                 };
000302|                 ], env)

Legend:
   some code - line containing no point
   some code - line containing only visited points
   some code - line containing only unvisited points
   some code - line containing both visited and unvisited points