How to generate recursive list in OCaml

Question

I would like to implement analog of Haskell cycle function.

If I pass list elements explicitly it seems trivial:

let cycle a b c =
  let rec l = a::b::c::l in
  l

cycle 1 2 3 generates recursive list 1, 2, 3, 1...

But, how to generate recursive list on basis of another regular list?

let cycle lst = ...

Usage

cycle [1;2;3]

Answer 1

It seems the only way to make such recursive list is by using Obj module.

Copy the list and make it recursive

let cycle lst = match lst with
  | [] -> []
  | _ ->
    let rec get_last_cell = function
      | [] -> assert false
      | _::[] as last -> last
      | _::tl -> (get_last_cell tl)
    in
    let new_lst = List.map (fun x -> x) lst in
    let last_cell = get_last_cell new_lst in
    Obj.set_field (Obj.repr last_cell) 1 (Obj.repr new_lst);
    new_lst

Create recursive list and then insert new cons cells

let cycle lst = match lst with
  | [] -> []
  | hd::tl ->
      let rec loop cell lst =
        match lst with
        | [] -> ()
        | hd::tl ->
            let new_cell = [hd] in
            let new_cell_obj = Obj.repr new_cell in
            let cell_obj = Obj.repr cell in
            Obj.set_field new_cell_obj 1 (Obj.field cell_obj 1);
            Obj.set_field cell_obj 1 new_cell_obj;
            loop new_cell tl
      in
      let rec cyc_lst = hd::cyc_lst in
      loop cyc_lst tl;
      cyc_lst

The idea is pretty straightforward:

1. Create recursive list cyc_lst with only one element.
2. Insert one or more new cons cells immediately before tail of cyc_lst.

Example

cycle [1;2]

1. Create recursive list cyc_lst. It is represented in memory as a self-recursive cons cell

   let rec cyc_lst = hd::cyc_lst
   
   .--------.
   |        | 
   |  +---+-|-+
   `->| 1 | * |
      +---+---+
   

2. Create new_cell using 2 as the only element

   let new_cell = [hd]
   
      cell            new_cell
   .--------.
   |        |
   |  +---+-|-+      +---+---+
   `->| 1 | * |      | 2 | X |
      +---+---+      +---+---+
   

3. Set new_cell tail pointer to first cell

   Obj.set_field new_cell_obj 1 (Obj.field cell_obj 1)
   
      cell            new_cell
   .--------.--------------.
   |        |              |
   |  +---+-|-+      +---+-|-+
   `->| 1 | * |      | 2 | * |
      +---+---+      +---+---+
   

4. Set cell tail pointer to new_cell

   Obj.set_field cell_obj 1 new_cell_obj
   
      cell            new_cell
   .-----------------------.
   |                       |
   |  +---+---+      +---+-|-+
   `->| 1 | *------->| 2 | * |
      +---+---+      +---+---+
   

I hope GC is ok with such list manipulations. Let me know if it is not.

Answer 2

In an eager language like ML, you need to use streams. For example

# let cycle = Stream.from (fun n -> Some (List.nth [1;2;3] (n mod 3)));;
val cycle : int Stream.t = <abstr>
# Stream.npeek 10 cycle;;
- : int list = [1; 2; 3; 1; 2; 3; 1; 2; 3; 1]

Answer 3

As far as I can see, OCaml doesn't lend itself to this kind of coding unless you want to descend into the unsafe parts of the language.

Sticking to the safe parts of the language (but using extensions from Chapter 7), here is a (not very impressive) version of cycle that works for lists up to length 3:

let cycle = function
    | [] -> []
    | [x] -> let rec res = x :: res in res
    | [x; y] -> let rec res = x :: q and q = y :: res in res
    | [x; y; z] -> let rec res = x :: t and t = y :: v and v = z :: res in res
    | _ -> failwith "list too long"

It's easy to see how to extend this to any desired fixed length, but not to arbitrary length.

Here's a session with the function:

# #use "cyc.ml";;
val cycle : 'a list -> 'a list = <fun>
# cycle [1;2;3];;
- : int list =
[1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1;
 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2;
 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3;
 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1;
 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2;
 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; ...]

This is the best I can do, at any rate. I hope it's helpful.

Answer 4

You can define it like so also

# let cycle items =
    let buf = ref [] in
    let rec next i =
      if !buf = [] then buf := items;
      match !buf with
        | h :: t -> (buf := t; Some h)
        | [] -> None in
    Stream.from next;;
val cycle : 'a list -> 'a Stream.t = <fun>

utop # let test = cycle [1; 2; 3];;
val test : int Stream.t = <abstr> 
utop # Stream.npeek 10 test;;
- : int list = [1; 2; 3; 1; 2; 3; 1; 2; 3; 1]

This is from:

http://ocaml.org/tutorials/streams.html

Answer 5

You need streams as in another answer, or lazy lists:

type 'a llist = LNil | LCons of 'a * 'a llist Lazy.t
let cycle = function
| [] -> invalid_arg "cycle: empty list"
| hd::tl ->
  let rec result =
    LCons (hd, lazy (aux tl))
  and aux = function
    | [] -> result
    | x::xs -> LCons (x, lazy (aux xs)) in
  result