Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

More improvements to the SMAPI and the ocaml code gen

  • Loading branch information...
commit 182d8bbd892e9849a62381d5e6e542eba681fcc5 1 parent 252a20a
@djs55 authored
Showing with 23 additions and 18 deletions.
  1. +12 −11 ocaml.ml
  2. +11 −7 smapiv2.ml
View
23 ocaml.ml
@@ -16,7 +16,8 @@ let string_of_ts ts = String.concat "\n" (List.concat (List.map lines_of_t ts))
open Printf
-let rec typeof env =
+let rec typeof ?(expand_aliases=false) env =
+ let typeof env = typeof ~expand_aliases env in
let open Type in function
| Basic Int64 -> "int64"
| Basic String -> "string"
@@ -35,14 +36,16 @@ let rec typeof env =
if not(List.mem_assoc x env)
then failwith (Printf.sprintf "Unable to find ident: %s" x)
else List.assoc x env in
- typeof env ident.Ident.ty
+ if expand_aliases
+ then typeof env ident.Ident.ty
+ else String.concat "." ident.Ident.name
| Unit -> "()"
| Option t -> sprintf "%s option" (typeof env t)
| Pair (a, b) -> sprintf "(%s * %s)" (typeof env a) (typeof env b)
let type_decl env t =
[
- Line (sprintf "type %s = %s" t.TyDecl.name (typeof env t.TyDecl.ty));
+ Line (sprintf "type %s = %s with rpc" t.TyDecl.name (typeof ~expand_aliases:true env t.TyDecl.ty));
Line (sprintf "(** %s *)" t.TyDecl.description);
]
@@ -88,16 +91,14 @@ let exn_decl env e =
]
let rpc_of_interface env i =
- let type_of_arg a = Line (sprintf "type %s = %s with rpc" a.Arg.name (typeof env a.Arg.ty)) in
- let field_of_arg a = Line (sprintf "%s: %s;" a.Arg.name a.Arg.name) in
+ let field_of_arg a = Line (sprintf "%s: %s;" a.Arg.name (typeof env a.Arg.ty)) in
let of_method m =
[
Line (sprintf "module %s = struct" (String.capitalize m.Method.name));
Block [
- Line "module Inputs = struct";
+ Line "module In = struct";
Block ([
- ] @ (List.map type_of_arg m.Method.inputs
- ) @ [
+ ] @ [
Line "type t = {";
Block (List.map field_of_arg m.Method.inputs);
Line "} with rpc";
@@ -105,7 +106,7 @@ let rpc_of_interface env i =
Line "end";
];
Block [
- Line "module Outputs = struct";
+ Line "module Out = struct";
Block [
match m.Method.outputs with
| [ x ] ->
@@ -164,9 +165,9 @@ let server_of_interface env i =
[
Line (sprintf "| \"%s.%s\", [ args ] ->" i.Interface.name m.Method.name);
Block [
- Line (sprintf "let request = %s.%s.Inputs.t_of_rpc args in" i.Interface.name (String.capitalize m.Method.name));
+ Line (sprintf "let request = %s.%s.In.t_of_rpc args in" i.Interface.name (String.capitalize m.Method.name));
Line (sprintf "let response = Impl.%s request" (String.capitalize m.Method.name));
- Line (sprintf "%s.%s.Outputs.to_rpc response" i.Interface.name (String.capitalize m.Method.name));
+ Line (sprintf "%s.%s.Out.to_rpc response" i.Interface.name (String.capitalize m.Method.name));
];
Line (sprintf "| \"%s.%s\", args -> failwith \"wrong number of arguments\""
i.Interface.name m.Method.name
View
18 smapiv2.ml
@@ -1,7 +1,7 @@
open Types
let api =
- let vdi_info =
+ let vdi_info_decl =
Type.(Struct(
( "vdi", Name "vdi", "The unique id of this VDI" ),
[ "content_id", Name "content_id", "The unique id of the VDI contents. If two VDIs have the same content_id then they must have the same data inside";
@@ -19,6 +19,7 @@ let api =
"sm_config", Dict(String, Basic String), "Backend-specific parameters";
]
)) in
+ let vdi_info = Type.Name "vdi_info" in
let sr = {
Arg.name = "sr";
ty = Type.(Basic String);
@@ -29,11 +30,12 @@ let api =
ty = Type.(Basic String);
description = "The Virtual Disk Image to operate on";
} in
- let attach_info =
+ let attach_info_decl =
Type.(Struct(
( "params", Basic String, "The xenstore backend params key"),
[ "xenstore_data", Dict(String, Basic String), "Additional xenstore backend device keys" ]
)) in
+ let attach_info = Type.Name "attach_info" in
let vdi_info' = {
Arg.name = "vdi_info";
(* ty = vdi_info; *)
@@ -104,8 +106,12 @@ let api =
}; {
TyDecl.name = "vdi_info";
description = "All per-VDI properties";
- ty = vdi_info
- };
+ ty = vdi_info_decl
+ }; {
+ TyDecl.name = "attach_info";
+ description = "Configuration for blkback";
+ ty = attach_info_decl
+ }
];
interfaces =
[
@@ -269,9 +275,7 @@ let api =
];
outputs = [
{ Arg.name = "device";
- ty = Type.(Struct(("params", Basic String, "blkback params key"), [
- "xenstore_data", Dict(String, Basic String), "additional backend configuration for xenstore-data/"
- ]));
+ ty = attach_info;
description = "backend device configuration";
}
];
Please sign in to comment.
Something went wrong with that request. Please try again.