filesystem functions

examples/readWriteFile.eff

@@ -0,0 +1,17 @@
+let w_file = #Open_out "file.eff" ;;
+
+#Write_file (w_file, "Hello\n") ;;
+#Write_file (w_file, "Hi\n") ;;
+#Write_file (w_file, "How are you?\n") ;;
+#Write_file (w_file, "How are you?\n") ;;
+
+#Close_out w_file;;
+
+let r_file = #Open_in "file.eff" ;;
+#Print ( #Read_line r_file );;
+#Print ( #Read_line r_file );;
+#Print ( #Read_line r_file );;
+#Print ( #Read_line r_file );;
+
+#Close_in r_file;;
+

pervasives.eff

@@ -7,6 +7,20 @@ external ( < ) : 'a -> 'a -> bool = "<"
 
 effect Print : string -> unit
 effect Read : unit -> string
+
+(*********** files effects *********)
+effect Open_in : string -> in_channel
+effect Open_out : string -> out_channel
+
+effect Close_in : in_channel -> unit
+effect Close_out : out_channel -> unit
+
+effect Write_file : (out_channel * string) -> unit
+effect Read_file : string -> string
+
+effect Read_line : in_channel -> string
+(***********************************)
+
 effect Raise : string -> empty
 effect Random_int : int -> int
 effect Random_float: float -> float
@@ -61,6 +75,10 @@ external ( ^ ) : string -> string -> string = "^"
 
 external string_length : string -> int = "string_length"
 
+external trim : string -> string = "trim"
+
+external split_on_char : char -> string -> string list = "split_on_char"
+
 external to_string : 'a -> string  = "to_string"
 
 type 'a option = None | Some of 'a

src/runtime/eval.ml

@@ -175,6 +175,85 @@ let rec top_handle = function
       let str = read_line () in
       let str_v = V.Const (Const.of_string str) in
       top_handle (k str_v)
+
+
+  | V.Call ("Read_file", v, k) ->
+      let filename =  V.to_str v in
+ 	 let channel = open_in filename in
+ 	 let text = ref "" in
+ 	 (
+ 	 try
+ 	    while true do
+ 	      text := !text  ^ (input_line channel) ^ "\n"   (* Gather text into a single string. *)
+ 	    done; 
+ 	    close_in channel;
+ 	    top_handle (k (V.Const (Const.of_string !text)))   (* This is only for typechecking. *)
+ 	 with End_of_file ->
+ 	     close_in channel;
+ 	     top_handle (k (V.Const (Const.of_string !text)))
+ 	 )
+
+  (*  effect Open_in : string -> in_channel *)
+  | V.Call ("Open_in", v , k) ->
+      let filename =  V.to_str v in
+ 	 let channel = open_in filename in
+ 	 (
+	 try
+ 		top_handle (k (V.Const (Const.of_in_channel channel) ))
+ 	 with e ->                      (* some unexpected exception occurs *)
+ 		close_in channel;
+ 		top_handle (k (V.Const (Const.of_in_channel channel) ))
+ 	 )
+  (* effect effect Open_out : string -> out_channel *)
+  | V.Call ("Open_out", v , k) ->
+      let filename =  V.to_str v in
+ 	 let channel = open_out filename in
+ 	 (
+	 try
+ 		top_handle (k (V.Const (Const.of_out_channel channel) ))
+ 	 with e ->                      (* some unexpected exception occurs *)
+ 		close_out channel;
+ 		top_handle (k (V.Const (Const.of_out_channel channel) ))
+ 	 )
+
+  (* effect  effect Close_in : in_channel -> unit *)
+  | V.Call ("Close_in", v , k) ->
+      let channel =  V.to_in_channel v in
+ 	 close_in channel;
+      top_handle (k V.unit_value)
+
+  (*  effect Close_out : out_channel -> unit *)
+  | V.Call ("Close_out", v , k) ->
+      let channel =  V.to_out_channel v in
+ 	 close_out channel;
+      top_handle (k V.unit_value)
+
+  (* effect Write_file : (out_channel * string) -> unit *)
+  | V.Call ("Write_file", v , k) ->
+      let channel = V.to_out_channel (V.first v) in
+ 	 let text =  V.to_str (V.second v) in
+ 	 (
+	 try
+ 		output_string channel text;
+ 		flush channel;
+ 		top_handle (k V.unit_value)
+ 	 with End_of_file ->              (* some unexpected exception occurs *)
+ 		close_out channel;
+ 		top_handle (k V.unit_value)
+ 	 )
+  (* effect Read_line : in_channel -> string  *) 
+  | V.Call ("Read_line", v, k) ->
+      let channel =  V.to_in_channel v in
+ 	 let text = ref "" in
+ 	 (
+ 	 try
+ 	     text := !text  ^ (input_line channel) ^ "\n";   (* Gather text into a single string. *)
+ 	   	top_handle (k (V.Const (Const.of_string !text)))   (* This is only for typechecking. *)
+ 	 with End_of_file ->
+ 	     close_in channel;
+ 	     top_handle (k (V.Const (Const.of_string !text)))
+ 	 ) 
+
   | V.Call (eff, v, k) ->
       Error.runtime "uncaught effect %t %t." (Value.print_effect eff)
         (Value.print_value v)

src/runtime/external.ml

@@ -1,5 +1,7 @@
 module V = Value
 
+let from_char c = V.Const (Const.of_char c)
+
 let from_bool b = V.Const (Const.of_boolean b)
 
 let from_int n = V.Const (Const.of_integer n)
@@ -10,6 +12,8 @@ let from_float f = V.Const (Const.of_float f)
 
 let from_fun f = V.Closure f
 
+let value_list b = V.Value (Tuple b)
+
 let value_bool b = V.Value (from_bool b)
 
 let value_int n = V.Value (from_int n)
@@ -158,10 +162,19 @@ let arithmetic_operations =
   ; ("/.", float_float_to_float ( /. )) ]
 
 
+let string_string_to_list f =
+	let ff v1 v2 =  value_list (List.map from_str (f (V.to_char v1) (V.to_str v2))) in
+	binary_closure ff
+
+
 let string_operations =
   [ ("^", binary_closure (fun v1 v2 -> value_str (V.to_str v1 ^ V.to_str v2)))
-  ; ( "string_length"
-    , from_fun (fun v -> value_int (String.length (V.to_str v))) ) ]
+  ; ( "string_length", from_fun (fun v -> value_int (String.length (V.to_str v))) ) 
+  ; ( "trim", from_fun (fun v -> value_str (String.trim (V.to_str v))) ) 
+  ; ( "split_on_char", string_string_to_list String.split_on_char)
+  ]
+
+
 
 
 let conversion_functions =

src/runtime/value.ml

@@ -14,6 +14,27 @@ let unit_value = Tuple []
 
 let unit_result = Value unit_value
 
+let first = function
+  | Tuple (x::xs) -> x
+  | _ -> Error.runtime "tuple's first value expected."
+
+let second = function
+  | Tuple (x::y::xs)-> y
+  | _ -> Error.runtime "tuple's second value expected."
+
+let to_in_channel = function
+   | Const (Const.In_channel b) -> b
+   | _ -> Error.runtime "A in_channel value expected."
+
+let to_out_channel = function
+ | Const (Const.Out_channel b) -> b
+ | _ -> Error.runtime "A out_channel value expected."
+
+
+let to_char = function
+  | Const Const.Char b -> b
+  | _ -> Error.runtime "A char value expected."
+
 let to_bool = function
   | Const Const.Boolean b -> b
   | _ -> Error.runtime "A boolean value expected."

src/runtime/value.mli

@@ -14,6 +14,14 @@ val unit_value : value
 
 val unit_result : result
 
+val first : value -> value
+val second : value -> value
+
+val to_out_channel : value -> out_channel
+val to_in_channel : value -> in_channel
+
+val to_char : value -> char
+
 val to_bool : value -> bool
 
 val to_int : value -> int

src/typing/infer.ml

@@ -43,6 +43,9 @@ let ty_of_const = function
   | Const.String _ -> Type.string_ty
   | Const.Boolean _ -> Type.bool_ty
   | Const.Float _ -> Type.float_ty
+  | Const.Out_channel _ -> Type.out_channel_ty
+  | Const.In_channel _ -> Type.in_channel_ty
+  | Const.Char _ -> Type.char_ty
 
 
 (* [infer_pattern cstr pp] infers the type of pattern [pp]. It returns the list of

src/typing/tctx.ml

@@ -10,7 +10,10 @@ type tydef =
 type tyctx = (OldUtils.tyname, Type.ty_param list * tydef) OldUtils.assoc
 
 let initial : tyctx =
-  [ ("bool", ([], Inline T.bool_ty))
+  [ ("in_channel", ([], Inline T.in_channel_ty))
+  ; ("out_channel", ([], Inline T.out_channel_ty))
+  ; ("char", ([], Inline T.char_ty))
+  ; ("bool", ([], Inline T.bool_ty))
   ; ("unit", ([], Inline T.unit_ty))
   ; ("int", ([], Inline T.int_ty))
   ; ("string", ([], Inline T.string_ty))

src/typing/type.ml

@@ -23,8 +23,14 @@ and handler_ty =
 (* This type is used when type checking is turned off. Its name
    is syntactically incorrect so that the programmer cannot accidentally
    define it. *)
+
+let in_channel_ty = Basic "in_channel"
+let out_channel_ty = Basic "out_channel"
+
 let universal_ty = Basic "_"
 
+let char_ty = Basic "char"
+
 let int_ty = Basic "int"
 
 let string_ty = Basic "string"

src/utils/const.ml

@@ -1,4 +1,17 @@
-type t = Integer of int | String of string | Boolean of bool | Float of float
+type t =
+  | Char of char
+  | Integer of int
+  | String of string
+  | Boolean of bool
+  | Float of float
+  | In_channel of in_channel
+  | Out_channel of out_channel
+
+
+let of_in_channel n = In_channel n
+let of_out_channel n = Out_channel n
+
+let of_char c = Char c
 
 let of_integer n = Integer n
 
@@ -14,10 +27,13 @@ let of_false = of_boolean false
 
 let print c ppf =
   match c with
+  | Char k -> Format.fprintf ppf "%c" k
   | Integer k -> Format.fprintf ppf "%d" k
   | String s -> Format.fprintf ppf "%S" s
   | Boolean b -> Format.fprintf ppf "%B" b
   | Float f -> Format.fprintf ppf "%F" f
+  | In_channel f -> Format.fprintf ppf "<In channel>"
+  | Out_channel f -> Format.fprintf ppf "<Out channel>" 
 
 
 let compare c1 c2 =
@@ -32,6 +48,7 @@ let compare c1 c2 =
   | String s1, String s2 -> cmp s1 s2
   | Boolean b1, Boolean b2 -> cmp b1 b2
   | Float x1, Float x2 -> cmp x1 x2
+  | Char x1, Char x2 -> cmp x1 x2
   | _ -> Error.runtime "Incomparable constants %t and %t" (print c1) (print c2)
 
 

src/utils/const.mli

@@ -1,8 +1,16 @@
 type t = private
+  | Char of char
   | Integer of int
   | String of string
   | Boolean of bool
   | Float of float
+  | In_channel of in_channel
+  | Out_channel of out_channel
+
+val of_in_channel : in_channel -> t
+val of_out_channel : out_channel -> t
+
+val of_char : char -> t
 
 val of_integer : int -> t