Re: [Caml-list] creating GADTs

[Reed Wilson <cedilla@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 2689 bytes --]

Again, thanks for all the assistance.

The warning and Match_failure in your post are what I expected in my
program, but I didn't receive either. The print_samplerate function just
returns the wrong answer. I tested it on 4.00.0 Win 32- and 64-bit, Linux
64-bit, and 4.01.0+dev6_2012-07-30 Linux 64-bit.

Even in the toplevel it runs fine:

# let print_samplerate : type id chan. (id,chan) frame_t -> unit = function
| {header_id = MPEG1; header_samplerate = S48000} -> Printf.printf
"M1_S48000\n"
| {header_id = MPEG1; header_samplerate = S44100} -> Printf.printf
"M1_S44100\n"
| {header_id = MPEG2; header_samplerate = S24000} -> Printf.printf
"M2_S24000\n"
| {header_id = MPEG2; header_samplerate = S22050} -> Printf.printf
"M2_S22050\n"
;;
val print_samplerate : ('id, 'chan) frame_t -> unit = <fun>

# let test_frame = frame_of_sr_id_chan (samplerate_of_int 3) (mpeg_of_int
0, channel_mode_of_int 0);;
val test_frame : (mpeg_tag_t, channel_tag_t) frame_t =
  {header_id = MPEG1; header_crc = true; header_samplerate = S22050;
   header_channel_mode = Channel_mono; side_bits = Bits_1_mono <abstr>}

# print_samplerate test_frame;;
M1_S44100
- : unit = ()


The exact file I ran is attached (hopefully -- are attachments good on this
list?), and it prints "M1_S44100" with no errors or warnings on all my
computers, even though I think it should give an exception or otherwise
fail. Does it do something different on yours?

Thanks,
Reed

On Sat, Aug 4, 2012 at 4:45 PM, Gabriel Scherer
<gabriel.scherer@gmail.com>wrote:

> > I was happy to notice that this did not complain about being
> > incomplete, correctly seeing that the samplerates can only be used
> > with a matching header_id;
> >
> > However, if I then I make an invalid frame using the *_of_int functions:
> >
> > let test_frame = frame_of_sr_id_chan (samplerate_of_int 3)
> > (mpeg_of_int 0, channel_mode_of_int 0);;
> > print_samplerate test_frame;;
>
> Here is what I observe on my machine:
>
> # let print_samplerate : type id chan. (id,chan) frame_t -> unit = function
> [...]
> Warning 8: this pattern-matching is not exhaustive.
> Here is an example of a value that is not matched:
> {header_id=MPEG2; header_samplerate=S48000}
>
> # let test_frame = frame_of_sr_id_chan (samplerate_of_int 3)
> (mpeg_of_int 0, channel_mode_of_int 0);;
>   val test_frame : (mpeg_tag_t, channel_tag_t) frame_t =
>   {header_id = MPEG1; header_crc = true; header_samplerate = S22050;
>    header_channel_mode = Channel_mono; side_bits = Bits_1_mono <abstr>}
>
> # print_samplerate test_frame;;
> Exception: Match_failure ("//toplevel//", 43, -733).
>

-- 
ç

[-- Attachment #1.2: Type: text/html, Size: 3470 bytes --]

[-- Attachment #2: typetest2.ml --]
[-- Type: application/octet-stream, Size: 2708 bytes --]

type mpeg_tag_t = [ `Mpeg1 | `Mpeg2 ];;

type _ mpeg_t =
| MPEG1 : [< mpeg_tag_t > `Mpeg1] mpeg_t
| MPEG2 : [< mpeg_tag_t > `Mpeg2] mpeg_t
;;

type _ samplerate_t =
| S48000 : [< mpeg_tag_t > `Mpeg1] samplerate_t
| S44100 : [< mpeg_tag_t > `Mpeg1] samplerate_t
| S24000 : [< mpeg_tag_t > `Mpeg2] samplerate_t
| S22050 : [< mpeg_tag_t > `Mpeg2] samplerate_t
;;

type channel_tag_t = [ `Mono | `Stereo ];;

type _ channel_t =
| Channel_mono : [< channel_tag_t > `Mono] channel_t
| Channel_stereo : [< channel_tag_t > `Stereo] channel_t
;;

type (_,_) side_bits_t =
| Bits_1_mono : (int * int) -> ([`Mpeg1], [`Mono]) side_bits_t
| Bits_1_stereo : (int * int * int * int) -> ([`Mpeg1], [`Stereo]) side_bits_t
| Bits_2_mono : int -> ([`Mpeg2], [`Mono]) side_bits_t
| Bits_2_stereo : (int * int) -> ([`Mpeg2], [`Stereo]) side_bits_t
;;

type ('id,'chan) frame_t = {
header_id : 'id mpeg_t;
header_crc : bool;
header_samplerate : 'id samplerate_t;
header_channel_mode : 'chan channel_t;
side_bits : ('id,'chan) side_bits_t;
};;

let mpeg_of_int = function
| 0 -> MPEG1
| 1 -> MPEG2
| _ -> failwith "Bad"
;;

let samplerate_of_int = function
| 0 -> S48000
| 1 -> S44100
| 2 -> S24000
| 3 -> S22050
| _ -> failwith "Bad"
;;

let channel_mode_of_int = function
| 0 -> Channel_mono
| 1 -> Channel_stereo
| _ -> failwith "Bad"
;;





let frame_of_sr_id_chan : type id chan. id samplerate_t -> id mpeg_t * chan channel_t -> (id,chan) frame_t = fun sr -> function
| (MPEG1, Channel_mono) -> {header_id = MPEG1; header_crc = true; header_samplerate = sr; header_channel_mode = Channel_mono; side_bits = Bits_1_mono (1,1)}
| (MPEG1, Channel_stereo) -> {header_id = MPEG1; header_crc = true; header_samplerate = sr; header_channel_mode = Channel_stereo; side_bits = Bits_1_stereo (1,1,1,1)}
| (MPEG2, Channel_mono) -> {header_id = MPEG2; header_crc = true; header_samplerate = sr; header_channel_mode = Channel_mono; side_bits = Bits_2_mono (1)}
| (MPEG2, Channel_stereo) -> {header_id = MPEG2; header_crc = true; header_samplerate = sr; header_channel_mode = Channel_stereo; side_bits = Bits_2_stereo (1,1)}
;;
 
let print_samplerate : type id chan. (id,chan) frame_t -> unit = function
| {header_id = MPEG1; header_samplerate = S48000} -> Printf.printf "M1_S48000\n"
| {header_id = MPEG1; header_samplerate = S44100} -> Printf.printf "M1_S44100\n"
| {header_id = MPEG2; header_samplerate = S24000} -> Printf.printf "M2_S24000\n"
| {header_id = MPEG2; header_samplerate = S22050} -> Printf.printf "M2_S22050\n"
;;

let test_frame = frame_of_sr_id_chan (samplerate_of_int 3) (mpeg_of_int 0, channel_mode_of_int 0);;
print_samplerate test_frame;;