schemeocaml

Idiomatic way to translate Scheme set-car! and set-cdr! into OCaml?


I have a Scheme program that I want to port to OCaml, and it uses lots of set-car! and set-cdr! inside helper functions.

For nested mutable lists, do I need to make their types like x ref list ref list ref or something? Or are there better approaches to translate Scheme programs to OCaml?

For example how to convert something like this to OCaml?

(define foo 
  (lambda (a b c) 
    (begin 
      (set-car! (car a) (cons b (caar a))) 
      (set-cdr! (car a) (cons c (cdar a))) 
      a)))

(define bar
  (lambda (f a b c d)
    (let ((a2 (foo a b c)))
      (begin 
        (set-car! a2 d) 
        (f a2)))))

Solution

  • The list type in OCaml is immutable: the user is supposed to build a new list instead of trying to mutate the list in place, which the type system would forbid, and the List module definition doesn't support.

    However, there is a way to perform in place modification of a list, by abusing the in memory representation of data used by the OCaml runtime.

    The code provided below gives you a sketch of an implementation, as well as some simple functions to check that it behave as expected in this simple setting.

    You should keep in mind that we are bending the rules here, and it is possible that:

    module O = Obj
    module F = Format
    
    let details fmt a =
      let o = O.repr a in
      match O.is_block o with
      | true ->
        F.fprintf fmt "block: size : %d, tag : %d"
        (O.size o) @@ O.tag o
      | false ->
        F.fprintf fmt "int : %d" (O.magic o :> int)
    
    let pp_int_list = F.(pp_print_list ~pp_sep:pp_print_space pp_print_int)
    
    let l = [1]
    
    let _ = 
      F.printf "list : %a@. head : %a@. tail : %a@." 
      details l details (List.hd l) details (List.tl l)
    
    let set_car (l : 'a list) (v : 'a) =
      let o = O.repr l in
      match l with
      | [] -> failwith "cannot set empty list"
      | _  -> O.set_field o 0 (O.repr v)
    
    let set_cdr (l : 'a list) (v : 'a list) =
      let o = O.repr l in
      match l with
      | [] -> failwith "cannot set empty list"
      | _  -> O.set_field o 1 (O.repr v)
    
    let _ =
      set_car l 2;
      F.(printf "list l = %a@." pp_int_list l);
      set_cdr l [2];
      F.(printf "list l = %a@."  pp_int_list l);
      (* recursive data
      set_cdr l l;
      F.(printf "list l = %a@."  pp_int_list l)
      *)
    
    

    The proper OCaml way of doing this would be to define a mutable list type, such as:

    module MList = struct
    
      exception EmptyList
    
      type 'a t =
          RNil
        | RCons of 'a rcons
      and 'a rcons = {mutable h: 'a; mutable t : 'a t}
    
      let car = function
          RNil     -> raise EmptyList
        | RCons rc -> rc.h
    
      let cdr = function 
          RNil     -> raise EmptyList
        | RCons rc -> rc.t
    
      let caar l = car (car l)
      let cadr l = car (cdr l)
      let cdar l = cdr (car l)
      let cons h t = RCons {h;t}
    
      let set_car (l : 'a t) (v : 'a) = 
        match l with
          RNil     -> raise EmptyList
        | RCons rc -> rc.h <- v
    
      let set_cdr (l : 'a t) (v: 'a t) =
        match l with
          RNil     -> raise EmptyList
        | RCons rc -> rc.t <- v
    
    
    end
    
    

    The functions given as examples would be then written thusly:

    
    module E = struct
    
      include MList
    
      let foo a b c =
        set_car (car a) @@ cons b (caar a);
        set_cdr (car a) @@ cons c (cdar a);
        a
    
      let bar f a b c d =
        let a2 = foo a b c in
        set_car a2 d;
        f a2
    end
    
    

    Please observe the inferred signatures of these modules:

    
    module MList :
      sig
        exception EmptyList
        type 'a t = RNil | RCons of 'a rcons
        and 'a rcons = { mutable h : 'a; mutable t : 'a t; }
        val car : 'a t -> 'a
        val cdr : 'a t -> 'a t
        val caar : 'a t t -> 'a
        val cadr : 'a t -> 'a
        val cdar : 'a t t -> 'a t
        val cons : 'a -> 'a t -> 'a t
        val set_car : 'a t -> 'a -> unit
        val set_cdr : 'a t -> 'a t -> unit
      end
    module E :
      sig
        exception EmptyList
        type 'a t = 'a MList.t = RNil | RCons of 'a rcons
        and 'a rcons = 'a MList.rcons = { mutable h : 'a; mutable t : 'a t; }
        val car : 'a t -> 'a
        val cdr : 'a t -> 'a t
        val caar : 'a t t -> 'a
        val cadr : 'a t -> 'a
        val cdar : 'a t t -> 'a t
        val cons : 'a -> 'a t -> 'a t
        val set_car : 'a t -> 'a -> unit
        val set_cdr : 'a t -> 'a t -> unit
        val foo : 'a t t t -> 'a -> 'a t -> 'a t t t
        val bar : ('a t t t -> 'b) -> 'a t t t -> 'a -> 'a t -> 'a t t -> 'b
      end