[Caml-list] revised syntax and immediate objects

[Caml-list] revised syntax and immediate objects

[Jonathan Roewen]

Hi,

What is the syntax for immediate objects in ocaml when using revised syntax?

I was reading the camlp4 tutorial from the caml site, and the section
on objects just directs users to use camlp4o pr_r.cmo to dump an
example in revised syntax.

The snippet of input code is thus:

let obj a b c = object method a : int = a method b : string = b method
c : string option = c end;;

The output from camlp4o pr_r.cmo gives:

value obj a b c =<pr_r: not impl: expr; tag = 25>;

I'd like to try make a camlp4 syntax extension that uses immediate
objects, and this isn't helping ;-)

Jonathan

Re: [Caml-list] revised syntax and immediate objects

[Martin Jambon]

On Wed, 5 Jul 2006, Jonathan Roewen wrote:

> Hi,
>
> What is the syntax for immediate objects in ocaml when using revised syntax?
>
> I was reading the camlp4 tutorial from the caml site, and the section
> on objects just directs users to use camlp4o pr_r.cmo to dump an
> example in revised syntax.
>
> The snippet of input code is thus:
>
> let obj a b c = object method a : int = a method b : string = b method
> c : string option = c end;;
>
> The output from camlp4o pr_r.cmo gives:
>
> value obj a b c =<pr_r: not impl: expr; tag = 25>;
>
> I'd like to try make a camlp4 syntax extension that uses immediate
> objects, and this isn't helping ;-)

As far as I can tell, the syntax is the same as in class_expr:

$ cat toto.ml
Ocaml.revised := true
--
value o = object method hello = print_endline "Hello"; end
;

o#hello
;

$ ocamlscript toto.ml
Hello


Martin

--
Martin Jambon, PhD
http://martin.jambon.free.fr

Sandy: "Don't you have to be stupid somewhere else?"
Patrick: "Not until four."

Re: [Caml-list] revised syntax and immediate objects

[Matt Gushee]

Jonathan Roewen wrote:

 > What is the syntax for immediate objects in ocaml when using revised 
syntax?

Not sure offhand, but ...

 > I'd like to try make a camlp4 syntax extension that uses immediate
 > objects,

I've done that. I'll show you the key section of the code below, and I 
can send you the complete file if you like. It may not be 100% correct, 
but I've been using it in an application and so far it works. I don't 
know if I can *explain* it, though ... I wrote it several months ago, 
and I'm coming to think that CamlP4, like Perl, is a write-only language ;-)

[BTW, *_si in function names means "structure item", and *_csi means 
"class structure item"]


let object_body loc decls =
   let sub_objects =
     let sos =
       List.fold_right
         ( fun idat lst ->
           match idat.sub_obj with
           | None -> lst
           | Some so -> so::lst )
         decls [] in
     <:class_str_item< declare $list:sos$ end >>
   and accessors =
     let accs =
       List.fold_right
         ( fun idat lst ->
           match idat.setter with
           | None -> idat.getter :: lst
           | Some se -> idat.getter :: se :: lst )
         decls [] in
     <:class_str_item< declare $list:accs$ end >> in
   (sub_objects, accessors)

let subconf_csi loc key decls =
   let sub_objects, accessors = object_body loc decls
   and pself = <:patt< self >>
   and inheritance =
     <:class_str_item<
       inherit sub_config data defaults path as super
     >> in
   let obj_expr =
     MLast.ExObj
       (loc, Some pself, [inheritance; sub_objects; accessors]) in
   let keylist_expr = <:expr< [$str:key$] >> in
   let path_bind_expr =
     <:expr<
       let path = path @ $keylist_expr$ in $obj_expr$
     >>
   and oname = key ^ "_" in
   Some <:class_str_item< value $lid:oname$ = $path_bind_expr$ >>

let rootconf_si loc cname decls =
   let sub_objects, accessors = object_body loc decls
   and pself = <:patt< self >>
   and inheritance =
     <:class_str_item<
       inherit root_config srcs dest data defaults as super
     >> in
   let oe =
     MLast.ExObj
       (loc, Some pself, [inheritance; sub_objects; accessors]) in
   <:str_item<
       value $lid:cname$ srcs dest =
         let data = Dict.create ()
         and path = [] in $oe$
   >>

let main_si loc cname decls =
   write_example decls;
   let os = <:str_item< open Rascl >>
   and oc = <:str_item< open ConfigObject >>
   and od = <:str_item< open Dict >>
   and defcreate = <:str_item< value defaults = create () >>
   and defsetup0 = top_doin_expr loc [] decls in
   let defsetup = <:str_item< $exp:defsetup0$ >>
   and cl = rootconf_si loc cname decls in
   let all = [os; oc; od; defcreate; defsetup; cl] in
   <:str_item< declare $list:all$ end >>



-- 
Matt Gushee
: Bantam - lightweight file manager : matt.gushee.net/software/bantam/ :
: RASCL's A Simple Configuration Language :     matt.gushee.net/rascl/ :

Re: [Caml-list] revised syntax and immediate objects

[Jonathan Roewen]

>  > I'd like to try make a camlp4 syntax extension that uses immediate
>  > objects,
>
> I've done that. I'll show you the key section of the code below, and I
> can send you the complete file if you like. It may not be 100% correct,
> but I've been using it in an application and so far it works. I don't
> know if I can *explain* it, though ... I wrote it several months ago,
> and I'm coming to think that CamlP4, like Perl, is a write-only language ;-)

Hmm, I'm getting an error trying to use class_str_item (ocaml 3.09.2):

# #use "topfind";;
# #camlp4o;;
# #require "camlp4.extend";;
# open Pcaml;;
# let gen_method loc field =
    let obj = "obj" in
    <:class_str_item< method $lid:field$ = $lid:obj$#$lid:field$; >>;;
Unbound quotation: "class_str_item";;

(The rhs of the expression is temporary, just for testing)

Also, I similarly get similar error for "class_expr".

Re: [Caml-list] revised syntax and immediate objects

[Matt Gushee]

Jonathan Roewen wrote:

> Hmm, I'm getting an error trying to use class_str_item (ocaml 3.09.2):
> 
> # #use "topfind";;
> # #camlp4o;;
> # #require "camlp4.extend";;
> # open Pcaml;;
> # let gen_method loc field =
>    let obj = "obj" in
>    <:class_str_item< method $lid:field$ = $lid:obj$#$lid:field$; >>;;
> Unbound quotation: "class_str_item";;

You also need to load q_Mlast.cmo.

-- 
Matt Gushee
: Bantam - lightweight file manager : matt.gushee.net/software/bantam/ :
: RASCL's A Simple Configuration Language :     matt.gushee.net/rascl/ :

Re: [Caml-list] revised syntax and immediate objects

[Nicolas Pouillard]

On 7/4/06, Jonathan Roewen <jonathan.roewen@gmail.com> wrote:
> Hi,
Hi,

>
> What is the syntax for immediate objects in ocaml when using revised syntax?
Yes, it's the same with mandatory semi-colons to separate class structure items.

The grammar rule: "object"; opt_class_self_patt; class_structure; "end"

>
> I was reading the camlp4 tutorial from the caml site, and the section
> on objects just directs users to use camlp4o pr_r.cmo to dump an
> example in revised syntax.
>
> The snippet of input code is thus:
>
> let obj a b c = object method a : int = a method b : string = b method
> c : string option = c end;;
>
> The output from camlp4o pr_r.cmo gives:
>
> value obj a b c =<pr_r: not impl: expr; tag = 25>;

Yes, you're facing a programming style driven by laziness, this case
is not implemented. Of course the new version of Camlp4 already in the
official development CVS no more follow this programming way.

Here is the result:

$ camlp4o -printer OCamlr -str 'let obj a b c = object method a : int
= a method b : string = b method c : string option = c end'
value obj a b c =
  object
    method a : int = a;
    method b : string = b;
    method c : option string = c;
  end;

>
> I'd like to try make a camlp4 syntax extension that uses immediate
> objects, and this isn't helping ;-)

I hope the new version will be more pleasant to use :)

-- 
Nicolas Pouillard

Re: [Caml-list] revised syntax and immediate objects

[Nicolas Pouillard]

[-- Attachment #1: Type: text/plain, Size: 4539 bytes --]

On 7/5/06, Matt Gushee <matt@gushee.net> wrote:
> Jonathan Roewen wrote:
>
>  > What is the syntax for immediate objects in ocaml when using revised
> syntax?
>
> Not sure offhand, but ...
>
>  > I'd like to try make a camlp4 syntax extension that uses immediate
>  > objects,
>
> I've done that. I'll show you the key section of the code below, and I
> can send you the complete file if you like. It may not be 100% correct,
> but I've been using it in an application and so far it works. I don't
> know if I can *explain* it, though ... I wrote it several months ago,
> and I'm coming to think that CamlP4, like Perl, is a write-only language ;-)
>
> [BTW, *_si in function names means "structure item", and *_csi means
> "class structure item"]
>

Let me use this piece of code to show Camlp4 changes:

>
> let object_body loc decls =

let object_body _loc decls =

>    let sub_objects =
>      let sos =
>        List.fold_right
>          ( fun idat lst ->
>            match idat.sub_obj with
>            | None -> lst
>            | Some so -> so::lst )
>          decls [] in
>      <:class_str_item< declare $list:sos$ end >>

let sub_objects =
  List.fold_right
     (fun idat lst ->
         match idat.sub_obj with
         | None -> lst
         | Some so -> <:class_str_item< $so$; $lst$ >>)
      decls <:class_str_item<>>

>    and accessors =
>      let accs =
>        List.fold_right
>          ( fun idat lst ->
>            match idat.setter with
>            | None -> idat.getter :: lst
>            | Some se -> idat.getter :: se :: lst )
>          decls [] in
>      <:class_str_item< declare $list:accs$ end >> in

and accessors =
  List.fold_right
     (fun idat lst ->
         match idat.setter with
         | None -> <:class_str_item< $idat.getter$; $lst$ >>
         | Some so -> <:class_str_item< $idat.getter$; $se$; $lst$ >>)
      decls <:class_str_item<>> in

 (sub_objects, accessors)

>    (sub_objects, accessors)
>
> let subconf_csi loc key decls =
>    let sub_objects, accessors = object_body loc decls
>    and pself = <:patt< self >>
>    and inheritance =
>      <:class_str_item<
>        inherit sub_config data defaults path as super
>      >> in
>    let obj_expr =
>      MLast.ExObj
>        (loc, Some pself, [inheritance; sub_objects; accessors]) in
>    let keylist_expr = <:expr< [$str:key$] >> in
>    let path_bind_expr =
>      <:expr<
>        let path = path @ $keylist_expr$ in $obj_expr$
>      >>
>    and oname = key ^ "_" in
>    Some <:class_str_item< value $lid:oname$ = $path_bind_expr$ >>

let subconf_csi _loc key decls =
   let sub_objects, accessors = object_body loc decls in
      <:class_str_item<
            value $lid:oname$ =
                let path = path @ [$str:key$] in
                object (self)
                    inherit sub_config data defaults path as super;
                    $sub_objects$;
                    $accessors$;
                end >>

>
> let rootconf_si loc cname decls =
>    let sub_objects, accessors = object_body loc decls
>    and pself = <:patt< self >>
>    and inheritance =
>      <:class_str_item<
>        inherit root_config srcs dest data defaults as super
>      >> in
>    let oe =
>      MLast.ExObj
>        (loc, Some pself, [inheritance; sub_objects; accessors]) in
>    <:str_item<
>        value $lid:cname$ srcs dest =
>          let data = Dict.create ()
>          and path = [] in $oe$
>    >>

let rootconf_si _loc cname decls =
    let sub_objects, accessors = object_body loc decls in
    <:str_item<
        value $lid:cname$ srcs dest =
          let data = Dict.create ()
          and path = [] in
          object (self)
             inherit root_config srcs dest data defaults as super;
             $sub_objects$;
             $accessors$;
          end
    >>


>
> let main_si loc cname decls =
>    write_example decls;
>    let os = <:str_item< open Rascl >>
>    and oc = <:str_item< open ConfigObject >>
>    and od = <:str_item< open Dict >>
>    and defcreate = <:str_item< value defaults = create () >>
>    and defsetup0 = top_doin_expr loc [] decls in
>    let defsetup = <:str_item< $exp:defsetup0$ >>
>    and cl = rootconf_si loc cname decls in
>    let all = [os; oc; od; defcreate; defsetup; cl] in
>    <:str_item< declare $list:all$ end >>
>

let main_si _loc cname decls =
<:str_item<
    open Rascl;
    open ConfigObject;
    open Dict;
    value defaults = create ();
    $exp:top_doin_expr _loc [] decls$;
    $rootconf_si loc cname decls$ >>

-- 
Nicolas Pouillard

[-- Attachment #2: without-quotations.ml --]
[-- Type: text/plain, Size: 4337 bytes --]

let object_body _loc decls =
  let sub_objects =
    List.fold_right
      (fun idat lst ->
         match idat.sub_obj with
         | None -> lst
         | Some so -> Ast.CrSem (_loc, so, lst))
      decls (Ast.CrNil _loc)
  and accessors =
    List.fold_right
      (fun idat lst ->
         match idat.setter with
         | None -> Ast.CrSem (_loc, idat.getter, lst)
         | Some so ->
             Ast.CrSem (_loc, idat.getter, Ast.CrSem (_loc, se, lst)))
      decls (Ast.CrNil _loc)
  in (sub_objects, accessors)
let subconf_csi _loc key decls =
  let (sub_objects, accessors) = object_body loc decls
  in
    Ast.CrVal (_loc, oname, Ast.BFalse,
      Ast.ExLet (_loc, Ast.BFalse,
        Ast.BiEq (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "path")),
          Ast.ExApp (_loc,
            Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdLid (_loc, "@")),
              Ast.ExId (_loc, Ast.IdLid (_loc, "path"))),
            Ast.ExApp (_loc,
              Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")),
                Ast.ExStr (_loc, key)),
              Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))))),
        Ast.ExObj (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "self")),
          Ast.CrSem (_loc,
            Ast.CrInh (_loc,
              Ast.CeApp (_loc,
                Ast.CeApp (_loc,
                  Ast.CeApp (_loc,
                    Ast.CeCon (_loc, Ast.BFalse,
                      Ast.IdLid (_loc, "sub_config"), Ast.TyNil _loc),
                    Ast.ExId (_loc, Ast.IdLid (_loc, "data"))),
                  Ast.ExId (_loc, Ast.IdLid (_loc, "defaults"))),
                Ast.ExId (_loc, Ast.IdLid (_loc, "path"))),
              "super"),
            Ast.CrSem (_loc, sub_objects, accessors)))))
let rootconf_si _loc cname decls =
  let (sub_objects, accessors) = object_body loc decls
  in
    Ast.StVal (_loc, Ast.BFalse,
      Ast.BiEq (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, cname)),
        Ast.ExFun (_loc,
          Ast.McArr (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "srcs")),
            Ast.ExNil _loc,
            Ast.ExFun (_loc,
              Ast.McArr (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "dest")),
                Ast.ExNil _loc,
                Ast.ExLet (_loc, Ast.BFalse,
                  Ast.BiAnd (_loc,
                    Ast.BiEq (_loc,
                      Ast.PaId (_loc, Ast.IdLid (_loc, "data")),
                      Ast.ExApp (_loc,
                        Ast.ExId (_loc,
                          Ast.IdAcc (_loc, Ast.IdUid (_loc, "Dict"),
                            Ast.IdLid (_loc, "create"))),
                        Ast.ExId (_loc, Ast.IdUid (_loc, "()")))),
                    Ast.BiEq (_loc,
                      Ast.PaId (_loc, Ast.IdLid (_loc, "path")),
                      Ast.ExId (_loc, Ast.IdUid (_loc, "[]")))),
                  Ast.ExObj (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "self")),
                    Ast.CrSem (_loc,
                      Ast.CrInh (_loc,
                        Ast.CeApp (_loc,
                          Ast.CeApp (_loc,
                            Ast.CeApp (_loc,
                              Ast.CeApp (_loc,
                                Ast.CeCon (_loc, Ast.BFalse,
                                  Ast.IdLid (_loc, "root_config"),
                                  Ast.TyNil _loc),
                                Ast.ExId (_loc, Ast.IdLid (_loc, "srcs"))),
                              Ast.ExId (_loc, Ast.IdLid (_loc, "dest"))),
                            Ast.ExId (_loc, Ast.IdLid (_loc, "data"))),
                          Ast.ExId (_loc, Ast.IdLid (_loc, "defaults"))),
                        "super"),
                      Ast.CrSem (_loc, sub_objects, accessors))))))))))
let main_si _loc cname decls =
  Ast.StSem (_loc, Ast.StOpn (_loc, Ast.IdUid (_loc, "Rascl")),
    Ast.StSem (_loc, Ast.StOpn (_loc, Ast.IdUid (_loc, "ConfigObject")),
      Ast.StSem (_loc, Ast.StOpn (_loc, Ast.IdUid (_loc, "Dict")),
        Ast.StSem (_loc,
          Ast.StVal (_loc, Ast.BFalse,
            Ast.BiEq (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, "defaults")),
              Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdLid (_loc, "create")),
                Ast.ExId (_loc, Ast.IdUid (_loc, "()"))))),
          Ast.StSem (_loc, Ast.StExp (_loc, top_doin_expr _loc [] decls),
            rootconf_si loc cname decls)))))