caml-list - the Caml user's mailing list
 help / color / mirror / Atom feed
* [Caml-list] Wanted: GADT examples: string length, counting module x
@ 2012-03-22  6:01 oleg
  2012-03-22  9:04 ` Gabriel Scherer
  2012-03-22 16:58 ` [Caml-list] " Goswin von Brederlow
  0 siblings, 2 replies; 8+ messages in thread
From: oleg @ 2012-03-22  6:01 UTC (permalink / raw)
  To: goswin-v-b; +Cc: caml-list


Somehow typed tagless interpreters (embeddings of a typed language)
and length-parameterized lists with the append function are the most
popular examples of GADTs. Neither of them seem to be particularly
good or compelling examples. One can write typed interpreters in the
final-tagless style, with no GADTs. Writing append function whose type
says the length of the resulting list is the sum of the lengths of the
argument lists is cute. However, this example does not go too far, as
one discovers when trying to write List.filter for
length-parameterized lists.

The ML2010 talk on GADT emulation specifically used a different
illustrating example: a sort of generic programming, or implementing
N-morphic functions:
 http://okmij.org/ftp/ML/first-class-modules/first-class-modules-talk-notes.pdf

Polymorphic functions must operate uniformly on their arguments, which
means they can't use a specific efficient operation if the argument
happens to be of a convenient type (like int of float
array). N-morphic functions can take such an advantage.

The running example of the talk combined value and the shape
information in the same data type:

type 'a sif = Int of (int,'a) eq * int
            | Flo of (float,'a) eq * float

val add_sif : 'a sif ->  'a sif -> 'a sif

Shape may well be separated from the value:

type 'a shape = Int of (int,'a) eq
              | Flo of (float,'a) eq 

val add_sif : 'a shape -> 'a -> 'a -> 'a

and so we pass values to add_sif without `boxing' and wrapping.






^ permalink raw reply	[flat|nested] 8+ messages in thread
* [Caml-list] Wanted: GADT examples: string length, counting module x
@ 2012-03-12 11:30 Goswin von Brederlow
  2012-03-19 14:43 ` Gabriel Scherer
  0 siblings, 1 reply; 8+ messages in thread
From: Goswin von Brederlow @ 2012-03-12 11:30 UTC (permalink / raw)
  To: caml-list

Hi,

yesterday I compiled ocaml 3.13 and played around a bit with the GDAT
syntax but wasn't overly successfull. Or at least I had higher hopes for
it. So it is time to invoke the internet to come up with a better
example. :)

1) How do I write a GADT that encodes the length of a string or array?
   How do I use that to create a string or array?
   How do I specify a function that takes a string or array of a fixed length?
   Bonus: How do I specify a function that takes a string or array of a
          certain length or longer?

2) How do I write a GADT that counts an int module x? Say for an offset
   into a byte stream to safeguard when access is aligned and when
   unaligned.
   Again with an example that creates a value and a function that uses
   it.
   Bonus: Have one function that only allows aligned access and one that
          picks the right aligned/unaligned function to use depending on
          the type.

Below I've included an example for checking aligned access (1/2/4/8 byte
aligned). First using GADT and second using old style phantom types. The
second looks much longer because it includes the signature needed to
make the type (...) off private. The t1/t2/t4/t8 types are just aliases
to make the type of the other functions shorter.

One thing I couldn't manage is to write a "bind" function with GADTs or
bind takeX to a string unless I specify the full type. "takeX s" always
switches to '_a types and then gets bound to a specific type on the
first use and fail on the second use.

On the plus side of GADTs is that you do not need a private type (and
therefore the module signature) to make them work.

MfG
        Goswin

PS: Other simple examples that show the power of GADTs are welcome too.
----------------------------------------------------------------------
(* Declare GADT type *)
type z
type u
type _ t =
  | Zero : ((z * u) * (z * u * u * u) * (z * u * u * u * u * u * u * u)) t
  | Succ : (('a * 'b) * ('c * 'd * 'e * 'f) * ('g * 'h * 'i * 'j * 'k * 'l * 'm 
* 'n)) t -> (('b * 'a) * ('d * 'e * 'f * 'c) * ('h * 'i * 'j * 'k * 'l * 'm * 'n
 * 'g)) t

(* start of stream *)
let zero = (Zero, 0)

(* advance by 1, 2, 4 or 8 *)
let succ1 x = Succ x
let succ2 x = succ1 (succ1 x)
let succ4 x = succ2 (succ2 x)
let succ8 x = x

(* take 1, 2, 4 or 8 bytes with alignment restriction *)
let take1 : type a b c d e f g h i j k l m n. string -> (((a * b) * (c * d * e *
 f) * (g * h * i * j * k * l * m * n)) t * int) -> ((((b * a) * (d * e * f * c) 
* (h * i * j * k * l * m * n * g)) t * int) * string) = fun s (t, x) -> ((succ1 
t, x+1), String.sub s x 1)
let take2 : type c d e f g h i j k l m n. string -> (((z * u) * (c * d * e * f) 
* (g * h * i * j * k * l * m * n)) t * int) -> ((((z * u) * (e * f * c * d) * (i
 * j * k * l * m * n * g * h)) t * int) * string) = fun s (t, x) -> ((succ2 t, x
+2), String.sub s x 2)
let take4 : type g h i j k l m n. string -> (((z * u) * (z * u * u * u) * (g * h
 * i * j * k * l * m * n)) t * int) -> ((((z * u) * (z * u * u * u) * (k * l * m
 * n * g * h * i * j)) t * int) * string) = fun s (t, x) -> ((succ4 t, x+4), Str
ing.sub s x 4)
let take8 : string -> (((z * u) * (z * u * u * u) * (z * u * u * u * u * u * u *
 u)) t * int) -> ((((z * u) * (z * u * u * u) * (z * u * u * u * u * u * u * u))
 t * int) * string) = fun s (t, x) -> ((succ8 t, x+8), String.sub s x 8)

(* Test string *)
let s = "aabbccccdddddddd"

(* extract things from string *)
let foo () =
  let (off, a) = take1 s zero in
  let (off, b) = take1 s off in
  let (off, c) = take2 s off in
  let (off, d) = take4 s off in
  let (off, e) = take8 s off in
  Printf.printf "%s %s %s %s %s\n" a b c d e

(* using take2/4/8 with an offset that isn't aligned gives a compile
   time type error:
let bad () =
  let (off, a) = take1 s zero in
  take8 s off
 *)

----------------------------------------------------------------------
module M : sig
  (* Types for aligned unaligned tracking *)
  type z
  type u
  (* The type of an offset into a stream *)
  type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off = private int
  (* Start of the stream *)
  val zero : (z, u, z, u, u, u, z, u, u, u, u, u, u, u) off
  (* Coercion to integer, same as (x :> int) *)
  val get : ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> int
  (* Advance the position by 1, 2, 4 or 8 *)
  val succ : ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ('b , 'a, 'd, 'e, 'f, 'c, 'h, 'i, 'j, 'k, 'l, 'm, 'n, 'g) off
  val succ2 : ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ('a , 'b, 'e, 'f, 'c, 'd, 'i, 'j, 'k, 'l, 'm, 'n, 'g, 'h) off
  val succ4 : ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ('a , 'b, 'c, 'd, 'e, 'f, 'k, 'l, 'm, 'n, 'g, 'h, 'i, 'j) off
  val succ8 : ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ('a , 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off
  (* Aliases for shorter type names *)
  type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t1 = ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> (('b, 'a, 'd, 'e, 'f, 'c, 'h, 'i, 'j, 'k, 'l, 'm, 'n, 'g) off * string)
  type ('c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t2 = (z, u, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ((z, u, 'e, 'f, 'c, 'd, 'i, 'j, 'k, 'l, 'm, 'n, 'g, 'h) off * string)
  type ('g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t4 = (z, u, z, u, u, u, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ((z, u, z, u, u, u, 'k, 'l, 'm, 'n, 'g, 'h, 'i, 'j) off * string)
  type t8 = (z, u, z, u, u, u, z, u, u, u, u, u, u, u) off -> ((z, u, z, u, u, u, z, u, u, u, u, u, u, u) off * string)
  (* Take 1, 2, 4 or 8 byte with alignment restriction *)
  val take1 : string -> ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t1
  val take2 : string -> ('c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t2
  val take4 : string -> ('g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t4
  val take8 : string -> t8
  (* Bind all take functions to a string for easier use *)
  val bind : string -> (('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t1 * ('c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t2 * ('g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t4 * t8)
end = struct
  (* Types for aligned unaligned tracking *)
  type z
  type u
  (* The type of an offset into a stream *)
  type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off = int
  (* Start of the stream *)
  let zero = 0
  (* Coercion to integer, same as (x :> int) *)
  let get x = x
  (* Advance the position by 1, 2, 4 or 8 *)
  let succ x = x + 1
  let succ2 x = succ (succ x)
  let succ4 x = succ2 (succ2 x)
  let succ8 x = succ4 (succ4 x)
  (* Aliases for shorter type names *)
  type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t1 = ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> (('b, 'a, 'd, 'e, 'f, 'c, 'h, 'i, 'j, 'k, 'l, 'm, 'n, 'g) off * string)
  type ('c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t2 = (z, u, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ((z, u, 'e, 'f, 'c, 'd, 'i, 'j, 'k, 'l, 'm, 'n, 'g, 'h) off * string)
  type ('g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) t4 = (z, u, z, u, u, u, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n) off -> ((z, u, z, u, u, u, 'k, 'l, 'm, 'n, 'g, 'h, 'i, 'j) off * string)
  type t8 = (z, u, z, u, u, u, z, u, u, u, u, u, u, u) off -> ((z, u, z, u, u, u, z, u, u, u, u, u, u, u) off * string)
  (* Take 1, 2, 4 or 8 byte with alignment restriction *)
  let take1 = fun s x -> (succ x, String.sub s (get x) 1);;
  let take2 = fun s x -> (succ2 x, String.sub s (get x) 2);;
  let take4 = fun s x -> (succ4 x, String.sub s (get x) 4);;
  let take8 = fun s x -> (succ8 x, String.sub s (get x) 8);;
  (* Bind all take functions to a string for easier use *)
  let bind s = (take1 s, take2 s, take4 s, take8 s)
end
open M
  
(* Test string *)
let s = "aabbccccdddddddd"
let (t1, t2, t4, t8) = bind s
  
(* extract things from string *)
let foo () =
  let (off, a) = t1 zero in
  let (off, b) = t1 off in
  let (off, c) = t2 off in
  let (off, d) = t4 off in
  let (off, e) = t8 off in
  Printf.printf "%s %s %s %s %s\n" a b c d e

(* using take2/4/8 with an offset that isn't aligned gives a compile
   time type error:
let bad () =
  let (off, a) = take1 s zero in
  take8 s off
 *)

^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2012-03-22 16:58 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-03-22  6:01 [Caml-list] Wanted: GADT examples: string length, counting module x oleg
2012-03-22  9:04 ` Gabriel Scherer
2012-03-22 16:58 ` [Caml-list] " Goswin von Brederlow
  -- strict thread matches above, loose matches on Subject: below --
2012-03-12 11:30 [Caml-list] " Goswin von Brederlow
2012-03-19 14:43 ` Gabriel Scherer
2012-03-19 16:13   ` Jesper Louis Andersen
2012-03-19 16:22     ` Raoul Duke
2012-03-21  9:48       ` Goswin von Brederlow

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).