Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Mutable references and arrays #126

Merged
merged 6 commits into from
Dec 20, 2024
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
160 changes: 160 additions & 0 deletions lib/Mutable.fram
Original file line number Diff line number Diff line change
@@ -0,0 +1,160 @@
(* This file is part of DBL, released under MIT license.
* See LICENSE for details.
*)

import List
ppolesiuk marked this conversation as resolved.
Show resolved Hide resolved

data RefEx = RefEx of
{ Ref : effect -> type -> type
, Array : effect -> type -> type
, ConstArray : type -> type
}

pub data ArrayElem E T = { set : T ->[E] Unit }

pub let RefEx { Ref, Array, ConstArray } =
(extern dbl_abstrType : Unit ->[IO] RefEx) ()

let unsafeGetArray {E, type T} =
extern dbl_arrayGet : Array E T -> Int ->[E] T

let unsafeGetConstArray {type T} =
extern dbl_arrayGet : ConstArray T -> Int ->[] T

let unsafeSetArray {E, type T} =
extern dbl_arraySet : Array E T -> Int -> T ->[E] Unit

let unsafeMakeArray {E, type T} =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

While we are using ocaml for evaluation, we might want to restrict length of arrays, to one we are allowed to create in ocaml (Sys.max_array_length).

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That's a good point. But what should we do when the user tries to create too large array?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In a discussion @ppolesiuk suggested that we could take an approach similar to OCaml and expose the maximum array length for when the programmer requires this kind of assurance. I think this is reasonable, given that oversized allocations are uncommon and recovery from out of memory situations is rarely needed/desirable (at least for such a high level language). However, perhaps we still want to check the size somewhere, to display a custom error instead of OCaml's.

extern dbl_mkArray : Int ->[E] Array E T

pub method length {E, self : Array E _} =
(extern dbl_arrayLength : Array E _ -> Int) self

pub method length {self : ConstArray _} =
(extern dbl_arrayLength : ConstArray _ -> Int) self

pub method get {E, type T, self : Ref E T} =
(extern dbl_refGet : Ref E T ->[E] T) self

pub method get {E, type T, `onError, self : Array E T} (n : Int) =
if n >= 0 && n < self.length then
unsafeGetArray {E} self n
else
`onError ()

pub method get {type T, `onError, self : ConstArray T} (n : Int) =
if n >= 0 && n < self.length then
unsafeGetConstArray self n
else
`onError ()

pub method set {E, type T, self : Ref E T} =
(extern dbl_refSet : Ref E T -> T ->[E] Unit) self

pub method set {E, type T, self : Array E T} (n : Int) v =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Naming this method set has a funny consequence for the (:=) operator.

> (a := 3) 42;;
: Unit
= <ctor>
> a.get 3;;
: Int
= 42

This is pretty unintuitive. We could rename the method that (:=) desugars to, rename this method on arrays, or remove it altogether (then we still have at for modification).

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe rename this method to setAt?

if n >= 0 && n < self.length then unsafeSetArray {E} self n v

pub method at {E, self : Array E _} n =
ArrayElem { E, set = self.set n }

pub method fn (:=) = set

pub method iteri {E, self : Array E _} f =
let rec loop (i : Int) =
if i >= self.length then ()
else (
f i (unsafeGetArray {E} self i);
loop (i + 1))
in
loop 0

pub method iteri {self : ConstArray _} f =
let rec loop (i : Int) =
if i >= self.length then ()
else (
f i (unsafeGetConstArray self i);
loop (i + 1))
in
loop 0

pub method iter {E, self : Array E _} f =
self.iteri (fn _ => f)

pub method iter {self : ConstArray _} f =
self.iteri (fn _ => f)

pub method clone {E, type T, self : Array E T} =
let arr = unsafeMakeArray {E} self.length in
self.iteri (unsafeSetArray {E} arr);
arr

let unsafeFreeze {E, type T} (arr : Array E T) =
(extern dbl_magic : Array E T -> ConstArray T) arr

pub method freeze {E, self : Array E _} =
unsafeFreeze {E} self.clone

pub method toList {E, self : Array E _} =
let rec loop (n : Int) acc =
if n == 0 then acc
else (
let n = n - 1 in
let acc = unsafeGetArray {E} self n :: acc in
loop n acc)
in loop self.length []

pub method toList {self : ConstArray _} =
let rec loop (n : Int) acc =
if n == 0 then acc
else (
let n = n - 1 in
let acc = unsafeGetConstArray self n :: acc in
loop n acc)
in loop self.length []

abstr data Mut (effect E) = Mut

pub method ref {E, type T, self : Mut E} =
extern dbl_ref : T ->[E] Ref E T

pub method pureInitArray {E, self : Mut E} (n : Int) (f : _ ->[E] _) =
if n <= 0 then unsafeMakeArray {E} 0
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think we should "raise" some sort of an error if user tries to create array with negative length, because that's a mistake and i think user should know that he's making it.
Maybe use standard `re and let user handle it himself

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I thought about it, and the decision was hard. Should we allow function f to also call pureInitArray, in order to create matrices? If yes, it should be able to raise some effects in f. However, this implementation will behave incorrectly if we allow function f to do some non-linear effects, like backtracking, and therefore I restricted its effect to just [E].

In order to allow f to raise some effects, we have to make sure that these effects are linear. For a moment, I thought that we could have some standard RE effect signature in Prelude like the following.

data RE (effect E) =
  { raise : {type T, ?msg : String } -> Unit ->[E] T }

However, its not true that all instances of this effect are linear. Having re : RE StdRE, we can write:

let badRE = RE {effect=[StdRE, BT], raise = re.raise }

to have the instance of RE with nonlinear effect (it contains backtracking).

else (
let arr = unsafeMakeArray {E} n
let rec loop (i : Int) =
if i < n then (
unsafeSetArray {E} arr i (f i);
loop (i + 1))
in
loop 0;
arr)

pub let pureInitConstArray n (f : _ ->[] _) =
unsafeFreeze {E=[]} (Mut {effect=[]} >.pureInitArray n f)

pub method toArray {E, `mut : Mut E, self : List _} =
ppolesiuk marked this conversation as resolved.
Show resolved Hide resolved
let arr = unsafeMakeArray {E} self.length in
self.iteri (unsafeSetArray {E} arr);
arr

pub method toConstArray {self : List _} =
unsafeFreeze {E=[]} (self.toArray {`mut = Mut {effect=[]}})

pub method initArray {E, self : Mut E} n f =
(List.init n f).toArray {`mut=self}

pub let initConstArray n f =
(List.init n f).toConstArray

pub method makeArray {E, self : Mut E} n v =
self.pureInitArray n (fn _ => v)

pub let ioMut = Mut {effect=IO}

pub let hMut (f : {E : effect} -> Mut E ->[E] _) =
handle {effect=E} _ = () in
f {E} Mut

pub let hMutArray (f : {E : effect} -> Mut E ->[E] Array E _) =
handle {effect=E} _ = () in
unsafeFreeze {E} (f {E} Mut)
29 changes: 26 additions & 3 deletions src/Eval/External.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,8 @@ open Value
(** External functions *)
(* ========================================================================= *)

let pure_fun f = VFn (fun v cont -> cont (f v))

let unit_fun f = VFn (fun v cont -> cont (f ()))

let int_fun f = VFn (fun v cont ->
Expand All @@ -26,8 +28,21 @@ let list_chr_fun f = VFn (fun v cont ->
| _ -> failwith "Runtime error!" in
cont (f @@ parse_list v))

let ref_fun f = VFn (fun v cont ->
match v with
| VRef r -> cont (f r)
| _ -> failwith "Runtime error!")

let array_fun f = VFn (fun v cont ->
match v with
| VArray a -> cont (f a)
| _ -> failwith "Runtime error!")

let v_unit = VCtor(0, [])

(** Empty constructor with some abstract types *)
let v_abstr = VCtor(0, [])

let of_bool b =
VCtor((if b then 1 else 0), [])

Expand Down Expand Up @@ -56,7 +71,8 @@ let int64_cmpop op = int64_fun2 (fun x y -> of_bool (op x y))
let str_cmpop op = str_fun (fun s1 -> str_fun (fun s2 -> of_bool (op s1 s2)))

let extern_map =
[ "dbl_negInt", int_unop ( ~- );
[ "dbl_magic", pure_fun Fun.id;
"dbl_negInt", int_unop ( ~- );
"dbl_addInt", int_binop ( + );
"dbl_subInt", int_binop ( - );
"dbl_mulInt", int_binop ( * );
Expand Down Expand Up @@ -114,6 +130,13 @@ let extern_map =
"dbl_intToInt64", int_fun (fun n -> VNum64 (Int64.of_int n));
"dbl_int64ToInt", int64_fun (fun n -> VNum (Int64.to_int n));
"dbl_int64ToString", int64_fun (fun n -> VStr (Int64.to_string n));
"dbl_abstrType", unit_fun (fun () -> v_abstr);
"dbl_ref", pure_fun (fun x -> VRef (ref x));
"dbl_refGet", ref_fun (!);
"dbl_refSet", ref_fun (fun r -> pure_fun (fun v -> r := v; v_unit));
"dbl_mkArray", int_fun (fun n -> VArray(Array.make n v_unit));
"dbl_arrayGet", array_fun (fun a -> int_fun (fun n -> a.(n)));
"dbl_arraySet", array_fun (fun a -> int_fun (fun n -> pure_fun (fun v ->
a.(n) <- v; v_unit)));
"dbl_arrayLength", array_fun (fun a -> VNum (Array.length a));
] |> List.to_seq |> Hashtbl.of_seq


9 changes: 8 additions & 1 deletion src/Eval/Value.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,12 @@ type value =
| VLabel of UID.t
(** Runtime label of control operator *)

| VRef of value ref
(** Mutable reference *)

| VArray of value array
(** Mutable arrays *)

(** CPS Computations *)
and 'v comp = ('v -> ans) -> ans

Expand All @@ -44,4 +50,5 @@ let to_string (v : value) =
| VFn _ -> "<fun>"
| VCtor _ -> "<ctor>"
| VLabel _ -> "<label>"

| VRef _ -> "<ref>"
| VArray _ -> "<array>"