Re: [Caml-list] Width subtyping

[Jacques Garrigue <garrigue@math.nagoya-u.ac.jp>]

From: Dave Benjamin <dave@ramenlabs.com>

> Heavier in terms of efficiency, or syntax? If you mean the latter, I 
> wonder if a camlp4 syntax extension might help ease the burden; perhaps 
> something like:
> 
>    #{x=5; y=6}
> 
> could be translated to:
> 
>    object method x = 5 method y = 6 end
> 
> and then you could benefit from a lightweight syntax and still get the 
> static type checking.

This is already possible with pa_oo, which you can get from the same
place as pa_polymap:

http://www.math.nagoya-u.ac.jp/~garrigue/code/ocaml.html

Also, concerning the typing of pa_polymap, the "weakness" is intended,
otherwise you wouldn't be able to add new fields to an existing value
(using the with notation).
If you just want to create values without allowing modifications, here
is a modified of pa_polymap.ml which gives them closed types. (It
still needs the original Polymap module.)

Concerning efficiency, since pa_polymap is based on the Map module,
you cannot expect it to be more efficient than the pa_oo based approach,
neither in terms of data size or runtime speed. It only probably wins
for generated code size, as classes are big.

Of course, both are much worse than real records. But whether it
matters or not depends much on what you use them for in your program.

        Jacques Garrigue

(*
   To compile:
     ocamlc -I +camlp4 -c -pp camlp4orf pa_polymap.ml
     ocamlc -c polymap.ml
   To use:
     ocaml dynlink.cma camlp4o.cma pa_polymap.cmo polymap.cmo
   or
     ocamlc -pp 'camlp4o -I . pa_polymap.cmo'
*)

open StdLabels
open Camlp4.PreCast
module Pcaml = Syntax

let next =
  let n = ref 0 in
  fun () -> incr n; string_of_int !n

let add _loc org (s,e) tv =
  <:expr< Polymap.add (Obj.magic `$s$) (Obj.magic ($e$ : $tv$))
            ($org$ : Polymap.t [> `$s$ of $tv$ ]) >>

let test_key_eq =
  let test strm =
    match Stream.npeek 2 strm with
      [(UIDENT _|LIDENT _), _; KEYWORD "=", _] -> ()
    | _ -> raise Stream.Failure
  in
  Gram.Entry.of_parser "test_key_eq" test

let upper_bound _loc e l =
  match l with
    [] -> e
  | s::l ->
     let typ = List.fold_left ~init:<:ctyp< `$s$ of _ >> l
       ~f:(fun t s -> <:ctyp< `$s$ of _ | $t$ >>)
     in <:expr< ($e$ : Polymap.t [< $typ$ ]) >>

EXTEND Pcaml.Gram
  GLOBAL: Pcaml.expr;
  Pcaml.expr: LEVEL "." [
    [ e = SELF; "."; "`"; s = Pcaml.a_ident ->
      let tv = <:ctyp< '$"pm_"^next()$ >> in
      <:expr<
        (Obj.magic
           (Polymap.find (Obj.magic `$s$) ($e$ : Polymap.t [> `$s$ of $tv$ ]))
        : $tv$)
      >> ]
  ];
  Pcaml.expr: LEVEL "simple" [
    [ "`"; "{"; "}" -> <:expr< Polymap.empty >>
    | "`"; "{"; test_key_eq; lel = lbl_expr_list; "}" ->
        let (e, tl) = lel <:expr< Polymap.empty >> in
        upper_bound _loc e tl
    | "`"; "{"; e = Pcaml.expr LEVEL "."; "with"; lel = lbl_expr_list;
      "}" -> fst (lel e) ]
  ];
  lbl_expr_list: [
    [ fields = LIST1 field SEP ";" ->
        let tl = List.map fields ~f:(fun _ -> <:ctyp< '$"pm_"^next()$ >>) in
        fun org ->
          (match fields with
            [s,e] -> add _loc org (s,e) (List.hd tl)
          | _ ->
            List.fold_left2 ~init:org fields tl ~f:(add _loc)),
          List.map fst fields ]
  ];
  field: [[ s = Pcaml.a_ident; "="; e = Pcaml.expr LEVEL "top"  -> (s,e) ]];
END;;