Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 00d6bb9fa4015d784fa097f489b8621d392078f6
|
From: Jérémie D. <Ba...@us...> - 2010-02-23 00:40:21
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "krobot".
The branch, master has been updated
via 00d6bb9fa4015d784fa097f489b8621d392078f6 (commit)
via 6957a1aa373af9614710b18c193c3d062d61d14e (commit)
via 57ed3996de596341ae3996edf376de366d39eb2f (commit)
from 6945591b460b0b5106b07685b69b78d6407cacf1 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 00d6bb9fa4015d784fa097f489b8621d392078f6
Author: Jérémie Dimino <je...@di...>
Date: Tue Feb 23 01:34:29 2010 +0100
typo
commit 6957a1aa373af9614710b18c193c3d062d61d14e
Author: Jérémie Dimino <je...@di...>
Date: Tue Feb 23 01:15:05 2010 +0100
remove lowlevel ax12 commands form safe commands
commit 57ed3996de596341ae3996edf376de366d39eb2f
Author: Jérémie Dimino <je...@di...>
Date: Tue Feb 23 01:11:00 2010 +0100
renaming
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/clients/script.ml b/PC_Mainboard/clients/script.ml
index e6d4844..c376e68 100644
--- a/PC_Mainboard/clients/script.ml
+++ b/PC_Mainboard/clients/script.ml
@@ -202,8 +202,6 @@ let () =
and pos = int "pos"
and speed = int ~default:50 "speed"
and timeout = int ~default:100 "timeout"
- and reg = int "reg"
- and value = int "value"
and now = keyword ~default:`Now "mode" [("now", `Now); ("action", `Action)] in
register "ax12-goto" (f4 id pos speed now)
@@ -214,20 +212,6 @@ let () =
Krobot_unsafe.AX12.ping krobot id timeout >>= function
| 0 -> logger [textf "ax12-ping[%d] reply: " id; fg lred; text "timeout"]
| _ -> logger [textf "ax12-ping[%d] reply: " id; fg lgreen; text "success"]);
- register "ax12-read8" (f3 id reg timeout)
- (fun logger krobot id reg timeout ->
- lwt x = Krobot_unsafe.AX12.read8 krobot id reg timeout in
- logger [textf "ax12-read8[%d] reply: %d" id x]);
- register "ax12-read16" (f3 id reg timeout)
- (fun logger krobot id reg timeout ->
- lwt x = Krobot_unsafe.AX12.read16 krobot id reg timeout in
- logger [textf "ax12-read16[%d] reply: %d" id x]);
- register "ax12-write8" (f3 id reg value)
- (fun logger krobot id reg value ->
- Krobot_unsafe.AX12.write8 krobot id reg value);
- register "ax12-write16" (f3 id reg value)
- (fun logger krobot id reg value ->
- Krobot_unsafe.AX12.write16 krobot id reg value);
register "ax12-get-pos" (f2 id timeout)
(fun logger krobot id timeout ->
lwt x = Krobot_unsafe.AX12.get_position krobot id timeout in
@@ -251,12 +235,6 @@ let () =
lwt () = logger [textf "ax12[%d] cw-angle-limit = %d" id stats.Types.ax12_cw_angle_limit] in
lwt () = logger [textf "ax12[%d] ccw-angle-limit = %d" id stats.Types.ax12_ccw_angle_limit] in
return ());
- register "ax12-write-reg8" (f3 id reg value)
- (fun logger krobot id reg value ->
- Krobot_unsafe.AX12.write_register8 krobot id reg value);
- register "ax12-write-reg16" (f3 id reg value)
- (fun logger krobot id reg value ->
- Krobot_unsafe.AX12.write_register16 krobot id reg value);
register "ax12-action" (f1 (int ~default:254 "id"))
(fun logger krobot id ->
Krobot_unsafe.AX12.action krobot id)
diff --git a/PC_Mainboard/driver/driver.ml b/PC_Mainboard/driver/driver.ml
index 06ef21d..6e1170c 100644
--- a/PC_Mainboard/driver/driver.ml
+++ b/PC_Mainboard/driver/driver.ml
@@ -39,7 +39,7 @@ struct
OL_method Get : int = fun dev -> return dev.data
let rec loop dev =
- lwt data = Commands.Compass.get dev.card in
+ lwt data = USB_commands.Compass.get dev.card in
if data <> dev.data then begin
dev.data <- data;
lwt () = value dev data in
@@ -50,7 +50,7 @@ struct
loop dev
let make card path =
- lwt data = Commands.Compass.get card in
+ lwt data = USB_commands.Compass.get card in
let dev = {
obus = OBus_object.make path;
card = card;
@@ -112,7 +112,7 @@ struct
OL_method Get : bool array = fun dev -> return dev.data
let rec loop dev =
- lwt data = Commands.Logic_sensors.get_state dev.card in
+ lwt data = USB_commands.Logic_sensors.get_state dev.card in
if data <> dev.data then begin
dev.data <- data;
lwt () = value dev data in
@@ -156,17 +156,17 @@ struct
OL_signal Value : int array
OL_method Get : int array = fun dev -> return dev.data
OL_method GetCalibration : int -> int array = fun dev num ->
- Commands.Range_finders.get_calibration dev.card num
+ USB_commands.Range_finders.get_calibration dev.card num
OL_method CalibrationStart : int -> bool -> unit = fun dev num skip_meas ->
- Commands.Range_finders.calibration_start dev.card num skip_meas
+ USB_commands.Range_finders.calibration_start dev.card num skip_meas
OL_method CalibrationStop : unit = fun dev ->
- Commands.Range_finders.calibration_stop dev.card
+ USB_commands.Range_finders.calibration_stop dev.card
OL_method CalibrationContinue : unit = fun dev ->
- Commands.Range_finders.calibration_continue dev.card
+ USB_commands.Range_finders.calibration_continue dev.card
let rec loop dev =
- lwt data = Commands.Range_finders.get_state dev.card in
+ lwt data = USB_commands.Range_finders.get_state dev.card in
if data <> dev.data then begin
dev.data <- data;
lwt () = value dev data in
@@ -279,9 +279,9 @@ struct
dev.move_state <- Ms_moving(if dist > 0 then `Forward else `Backward);
lwt () =
if dist > 0 then
- Commands.Motor.forward dev.card dist speed acc
+ USB_commands.Motor.forward dev.card dist speed acc
else
- Commands.Motor.backward dev.card (-dist) speed acc
+ USB_commands.Motor.backward dev.card (-dist) speed acc
and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
@@ -303,9 +303,9 @@ struct
dev.move_state <- Ms_moving `Turn;
lwt () =
if angle > 0 then
- Commands.Motor.right dev.card angle speed acc
+ USB_commands.Motor.right dev.card angle speed acc
else
- Commands.Motor.left dev.card (-angle) speed acc
+ USB_commands.Motor.left dev.card (-angle) speed acc
and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
@@ -323,7 +323,7 @@ struct
| Ms_static ->
reset_speed dev;
dev.move_state <- Ms_moving `Goto;
- lwt () = Commands.Motor.goto dev.card ~x ~y ~velocity:speed ~acceleration:acc ~mode ~bypass_distance and _ = Lwt_event.next dev.traj_completed in
+ lwt () = USB_commands.Motor.goto dev.card ~x ~y ~velocity:speed ~acceleration:acc ~mode ~bypass_distance and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
`Stopped
@@ -354,7 +354,7 @@ struct
let stop_motors dev motor mode =
lwt () = Log.info_f "motor: stopping(motor=%s, mode=%s)" (string_of_motor motor) (string_of_stop_mode mode) in
stop_move dev;
- Commands.Motor.traj_stop dev.card motor mode
+ USB_commands.Motor.traj_stop dev.card motor mode
let set_speed dev motor speed acc =
lwt () = Log.info_f "motor: set_speed(motor=%s, speed=%d, acc=%d)" (string_of_motor motor) speed acc in
@@ -371,11 +371,11 @@ struct
lwt () =
if acc <> dev.acceleration then begin
dev.acceleration <- acc;
- Commands.Motor.traj_new_velocity dev.card motor abs_speed acc dir
+ USB_commands.Motor.traj_new_velocity dev.card motor abs_speed acc dir
end else
- Commands.Motor.traj_change_velocity dev.card motor abs_speed dir
+ USB_commands.Motor.traj_change_velocity dev.card motor abs_speed dir
in
- lwt () = Commands.Motor.traj_start dev.card motor in
+ lwt () = USB_commands.Motor.traj_start dev.card motor in
(* Stop motors after a small delay *)
if motor = `Both || motor = `Left then begin
cancel dev.stop_lthread;
@@ -539,19 +539,19 @@ struct
return `Present
OL_method GetFirmwareBuild : string = fun dev ->
- Commands.get_firmware_build (get_card dev)
+ USB_commands.Common.get_firmware_build (get_card dev)
OL_method GetBoardInfo : string = fun dev ->
- Commands.get_board_info (get_card dev)
+ USB_commands.Common.get_board_info (get_card dev)
OL_method Bootloader : unit = fun dev ->
- Commands.bootloader (get_card dev)
+ USB_commands.Common.bootloader (get_card dev)
OL_method Reset : unit = fun dev ->
- Commands.reset (get_card dev)
+ USB_commands.Common.reset (get_card dev)
OL_method Test : unit = fun dev ->
- Commands.test (get_card dev)
+ USB_commands.Common.test (get_card dev)
OL_signal StateChanged : Types.card_state
@@ -671,7 +671,7 @@ lwt () =
ignore begin
monitor_card ~name:"interace" ~vendor_id:PcInterface.usb_vid ~product_id:PcInterface.usb_pid_robot_interface ~set:set_card_interface
(fun card ->
- lwt () = Commands.Motor.enable card `Both in
+ lwt () = USB_commands.Motor.enable card `Both in
lwt () = Compass.OBus.export bus =|< Compass.make card ["fr"; "krobot"; "Devices"; "Compass"]
and () = AX12.OBus.export bus =|< AX12.make card ["fr"; "krobot"; "Devices"; "AX12"] in
return ())
@@ -696,7 +696,7 @@ lwt () =
ignore begin
monitor_card ~name:"motor" ~vendor_id:PcInterface.usb_vid ~product_id:PcInterface.usb_pid_motor_controller ~set:set_card_motor
(fun card ->
- lwt () = Commands.Motor.enable card `Both and () = Commands.Motor.traj_init card in
+ lwt () = USB_commands.Motor.enable card `Both and () = USB_commands.Motor.traj_init card in
lwt () = Motors.OBus.export bus =|< Motors.make card ["fr"; "krobot"; "Devices"; "Motors"] in
return ())
(fun () ->
diff --git a/PC_Mainboard/generators/gen_dbus_exports.ml b/PC_Mainboard/generators/gen_dbus_exports.ml
new file mode 100644
index 0000000..f3b0531
--- /dev/null
+++ b/PC_Mainboard/generators/gen_dbus_exports.ml
@@ -0,0 +1,87 @@
+(*
+ * gen_dbus_exports.ml
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let rec print_apply cmd args =
+ printf "(fun dev ";
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s " (Name.lid name)
+ | Cst _ ->
+ ())
+ args;
+ printf "-> %s" cmd;
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf " %s" (Name.lid name)
+ | Cst _ ->
+ ())
+ args;
+ printf ")\n"
+
+let rec print path indent = function
+ | Request req ->
+ printf "%sOL_method %s : " indent (Name.caml_case req.req_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ req.req_args;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) -> (name, typ)
+ | Cst _ -> failwith "constants are not allowed in replies")
+ req.req_repl
+ in
+ let () =
+ match repl with
+ | [] ->
+ printf "unit"
+ | (name, typ) :: rest ->
+ printf "%s" typ.caml_type;
+ List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
+ in
+ printf " = ";
+ print_apply (sprintf "USB_commands.%s%s (Get.get dev)" path (Name.lid req.req_name)) req.req_args
+
+ | Command cmd ->
+ printf "%sOL_method %s : " indent (Name.caml_case cmd.cmd_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ cmd.cmd_args;
+ printf "unit = ";
+ print_apply (sprintf "USB_commands.%s%s (Get.get dev)" path (Name.lid cmd.cmd_name)) cmd.cmd_args
+
+ | Module(name, items) ->
+ printf "%smodule %s(M : Object.S)(Get : sig val get : M.t -> Card.t end)(Name : OBus_interface.Name) = struct\n"
+ indent (Name.uid name);
+ printf "%s include M.MakeInterface(Name)\n" indent;
+ List.iter (print (path ^ Name.uid name ^ ".") (indent ^ " ")) items;
+ printf "%send\n" indent
+
+ | Enum enum ->
+ printf "%stype %s = Types.%s with obus\n" indent (Name.lid enum.enum_name) (Name.lid enum.enum_name)
+
+ | Record record ->
+ printf "%stype %s = Types.%s with obus\n" indent (Name.lid record.rec_name) (Name.lid record.rec_name)
+
+let () =
+ printf "open OBus_pervasives\n";
+ List.iter (print "" "") interface
diff --git a/PC_Mainboard/generators/gen_dbus_imports.ml b/PC_Mainboard/generators/gen_dbus_imports.ml
new file mode 100644
index 0000000..6db0ef4
--- /dev/null
+++ b/PC_Mainboard/generators/gen_dbus_imports.ml
@@ -0,0 +1,76 @@
+(*
+ * gen_dbus_imports.ml
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let rec print indent = function
+ | Request req ->
+ printf "%sOP_method %s : " indent (Name.caml_case req.req_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ req.req_args;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) -> (name, typ)
+ | Cst _ -> failwith "constants are not allowed in replies")
+ req.req_repl
+ in
+ let () =
+ match repl with
+ | [] ->
+ printf "unit"
+ | (name, typ) :: rest ->
+ printf "%s" typ.caml_type;
+ List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
+ in
+ printf "\n"
+
+ | Command cmd ->
+ printf "%sOP_method %s : " indent (Name.caml_case cmd.cmd_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ cmd.cmd_args;
+ printf "unit\n";
+
+ | Module(name, items) ->
+ printf "%smodule %s = struct\n" indent (Name.uid name);
+ printf "%s include MakeDevice(struct let name = \"%s\" end)\n" indent (Name.caml_case name);
+ List.iter (print (indent ^ " ")) items;
+ printf "%send\n" indent
+
+ | Enum enum ->
+ printf "%stype %s = Types.%s with obus\n" indent (Name.lid enum.enum_name) (Name.lid enum.enum_name)
+
+ | Record record ->
+ printf "%stype %s = Types.%s with obus\n" indent (Name.lid record.rec_name) (Name.lid record.rec_name)
+
+let () =
+ print_string "\
+open OBus_pervasives
+module MakeDevice(Name : sig val name : string end) =
+ OBus_interface.MakeCustom
+ (struct
+ type proxy = Krobot.t
+ let get krobot = OBus_proxy.make (Krobot.peer krobot) [\"fr\"; \"krobot\"; \"Devices\"; Name.name]
+ end)
+ (struct
+ let name = \"fr.krobot.Device.\" ^ Name.name
+ end)
+";
+ List.iter (print "") interface
diff --git a/PC_Mainboard/generators/gen_script_commands.ml b/PC_Mainboard/generators/gen_script_commands.ml
new file mode 100644
index 0000000..036f42f
--- /dev/null
+++ b/PC_Mainboard/generators/gen_script_commands.ml
@@ -0,0 +1,64 @@
+(*
+ * gen_script_commands.ml
+ * ----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let print_common prefix path name args =
+ printf " register \"unsafe-%s%s\" (f%d" prefix name
+ (List.fold_left (fun n arg -> match arg with
+ | Arg _ -> n + 1
+ | Cst _ -> n) 0 args);
+ List.iter (function
+ | Arg(name, { caml_type = "int" }) ->
+ printf " (int \"%s\")" name
+ | Arg(name, { caml_type = "bool" }) ->
+ printf " (keyword \"%s\" [(\"false\", false); (\"true\", true)])" name
+ | Arg(name, { caml_type = caml_type }) ->
+ printf " (__type_%s \"%s\")" caml_type name
+ | Cst _ ->
+ ()) args;
+ printf ")\n";
+ printf " (fun logger krobot";
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " %s" (Name.lid name)
+ | Cst _ ->
+ ()) args;
+ printf " ->\n";
+ printf " lwt _ = Krobot_unsafe.%s%s krobot" path (Name.lid name);
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " %s" (Name.lid name)
+ | Cst _ ->
+ ()) args;
+ printf " in\n";
+ printf " Lwt.return ());\n"
+
+let rec print prefix path = function
+ | Request req ->
+ print_common prefix path req.req_name req.req_args
+ | Command cmd ->
+ print_common prefix path cmd.cmd_name cmd.cmd_args
+ | Enum enum ->
+ printf " let __type_%s name = keyword name [" (Name.lid enum.enum_name);
+ List.iter (fun (name, code) ->
+ printf "(\"%s\", `%s);" name (Name.uid name))
+ enum.enum_keys;
+ printf "] in\n"
+ | Record _ ->
+ ()
+ | Module(name, items) ->
+ List.iter (print (prefix ^ String.lowercase name ^ "-") (path ^ Name.uid name ^ ".")) items
+
+let () =
+ printf "open Script_commands\n";
+ printf "let register () =\n";
+ List.iter (print "" "") (List.filter (function Module _ -> true | _ -> false) interface);
+ printf " ()"
diff --git a/PC_Mainboard/generators/gen_usb_commands.ml b/PC_Mainboard/generators/gen_usb_commands.ml
new file mode 100644
index 0000000..af190a9
--- /dev/null
+++ b/PC_Mainboard/generators/gen_usb_commands.ml
@@ -0,0 +1,105 @@
+(*
+ * gen_usb_commands.ml
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* Generate implementation for all USB commands used by the driver *)
+
+open Printf
+open Interface
+
+let print_common indent name args =
+ printf "%slet %s card" indent (Name.lid name);
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " ~%s" (Name.lid name)
+ | Cst _ ->
+ ()) args;
+ printf " =\n";
+ printf "%s let data = Card.make_buffer () in\n" indent;
+ if args <> [] then begin
+ printf "%s let writer = RW.writer data in\n" indent;
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s %s;\n" indent (typ.writer (Name.lid name))
+ | Cst(typ, value) ->
+ printf "%s %s;\n" indent (typ.writer (string_of_int value)))
+ args
+ end
+
+let rec print indent = function
+ | Request req ->
+ print_common indent req.req_name req.req_args;
+ printf "%s lwt data = Card.send_request card %d data in\n" indent req.req_code;
+ if req.req_repl <> [] then begin
+ printf "%s let reader = RW.reader data in\n" indent;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) ->
+ (Name.lid name, typ)
+ | Cst _ ->
+ failwith "constant are not allowed in replies")
+ req.req_repl
+ in
+ List.iter
+ (fun (name, typ) ->
+ printf "%s let %s = %s in\n" indent name typ.reader)
+ repl;
+ printf "%s return (%s)\n" indent (String.concat ", " (List.map fst repl))
+ end else
+ printf "%s return ()\n" indent
+ | Command cmd ->
+ print_common indent cmd.cmd_name cmd.cmd_args;
+ printf "%s Card.send_command card %d data\n" indent cmd.cmd_code
+ | Enum enum ->
+ printf "%slet put_%s writer value =\n" indent (Name.lid enum.enum_name);
+ printf "%s let code = match value with\n" indent;
+ List.iter
+ (fun (name, code) ->
+ printf "%s | `%s -> %d\n" indent (Name.uid name) code)
+ enum.enum_keys;
+ printf "%s in\n" indent;
+ printf "%s %s\n" indent (enum.enum_type.writer "code");
+
+ printf "%slet get_%s reader =\n" indent (Name.lid enum.enum_name);
+ printf "%s match %s with\n" indent enum.enum_type.reader;
+ List.iter
+ (fun (name, code) ->
+ printf "%s | %d -> `%s\n" indent code (Name.uid name))
+ enum.enum_keys;
+ printf "%s | n -> Printf.ksprintf failwith \"invalid value for '%s': %%d\" n\n" indent enum.enum_name
+ | Record record ->
+ printf "%slet put_%s writer value =\n" indent (Name.lid record.rec_name);
+ List.iter
+ (fun (name, typ) ->
+ printf "%s %s;\n" indent (typ.writer ("value.Types." ^ record.rec_prefix ^ Name.lid name)))
+ record.rec_args;
+ printf "%s ()\n" indent;
+
+ printf "%slet get_%s reader =\n" indent (Name.lid record.rec_name);
+ List.iter
+ (fun (name, typ) ->
+ printf "%s let %s = %s in\n" indent (Name.lid name) typ.reader)
+ record.rec_args;
+ printf "%s { %s }\n" indent
+ (String.concat "; "
+ (List.map
+ (fun (name, typ) ->
+ let name = Name.lid name in
+ sprintf "Types.%s%s = %s" record.rec_prefix (Name.lid name) name)
+ record.rec_args))
+ | Module(name, items) ->
+ printf "%smodule %s = struct\n" indent (Name.uid name);
+ List.iter (print (indent ^ " ")) items;
+ printf "%send\n" indent
+
+let () =
+ printf "open Lwt\n";
+ printf "open RW\n";
+ List.iter (print "") interface
diff --git a/PC_Mainboard/interface/gen_dbus_exports.ml b/PC_Mainboard/interface/gen_dbus_exports.ml
deleted file mode 100644
index a4e192b..0000000
--- a/PC_Mainboard/interface/gen_dbus_exports.ml
+++ /dev/null
@@ -1,99 +0,0 @@
-(*
- * gen_dbus_exports.ml
- * -------------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Printf
-open Interface
-
-let rec print_apply cmd args =
- printf "(fun dev ";
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s " (Utils.caml_lid name)
- | Cst _ ->
- ())
- args;
- printf "-> %s" cmd;
- List.iter
- (function
- | Arg(name, typ) ->
- printf " %s" (Utils.caml_lid name)
- | Cst _ ->
- ())
- args;
- printf ")\n"
-
-let rec print path indent = function
- | Request req ->
- printf "%sOL_method %s : " indent (Utils.caml_case req.req_name);
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s -> " typ.caml_type
- | Cst _ ->
- ())
- req.req_args;
- let repl =
- List.map
- (function
- | Arg(name, typ) -> (name, typ)
- | Cst _ -> failwith "constants are not allowed in replies")
- req.req_repl
- in
- let () =
- match repl with
- | [] ->
- printf "unit"
- | (name, typ) :: rest ->
- printf "%s" typ.caml_type;
- List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
- in
- printf " = ";
- print_apply (sprintf "Commands.%s%s (Get.get dev)" path (Utils.caml_lid req.req_name)) req.req_args
-
- | Command cmd ->
- printf "%sOL_method %s : " indent (Utils.caml_case cmd.cmd_name);
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s -> " typ.caml_type
- | Cst _ ->
- ())
- cmd.cmd_args;
- printf "unit = ";
- print_apply (sprintf "Commands.%s%s (Get.get dev)" path (Utils.caml_lid cmd.cmd_name)) cmd.cmd_args
-
- | Module(name, items) ->
- printf "%smodule %s(M : Object.S)(Get : sig val get : M.t -> Card.t end)(Name : OBus_interface.Name) = struct\n"
- indent (Utils.caml_uid name);
- printf "%s include M.MakeInterface(Name)\n" indent;
- List.iter (print (path ^ Utils.caml_uid name ^ ".") (indent ^ " ")) items;
- printf "%send\n" indent
-
- | _ ->
- ()
-
-let rec split_top = function
- | [] ->
- ([], [])
- | Module _ as item :: items ->
- let modules, items = split_top items in
- (item :: modules, items)
- | item :: items ->
- let modules, items = split_top items in
- (modules, item :: items)
-
-let () =
- let modules, items = split_top interface in
- printf "open OBus_pervasives\n";
- printf "module Common(M : Object.S)(Get : sig val get : M.t -> Card.t end)(Name : OBus_interface.Name) = struct\n";
- printf " include M.MakeInterface(Name)\n";
- List.iter (print "" " ") items;
- printf "end\n";
- List.iter (print "" "") modules
diff --git a/PC_Mainboard/interface/gen_dbus_imports.ml b/PC_Mainboard/interface/gen_dbus_imports.ml
deleted file mode 100644
index 098e686..0000000
--- a/PC_Mainboard/interface/gen_dbus_imports.ml
+++ /dev/null
@@ -1,73 +0,0 @@
-(*
- * gen_dbus_imports.ml
- * -------------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Printf
-open Interface
-
-let rec print indent = function
- | Request req ->
- printf "%sOP_method %s : " indent (Utils.caml_case req.req_name);
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s -> " typ.caml_type
- | Cst _ ->
- ())
- req.req_args;
- let repl =
- List.map
- (function
- | Arg(name, typ) -> (name, typ)
- | Cst _ -> failwith "constants are not allowed in replies")
- req.req_repl
- in
- let () =
- match repl with
- | [] ->
- printf "unit"
- | (name, typ) :: rest ->
- printf "%s" typ.caml_type;
- List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
- in
- printf "\n"
-
- | Command cmd ->
- printf "%sOP_method %s : " indent (Utils.caml_case cmd.cmd_name);
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s -> " typ.caml_type
- | Cst _ ->
- ())
- cmd.cmd_args;
- printf "unit\n";
-
- | Module(name, items) ->
- printf "%smodule %s = struct\n" indent (Utils.caml_uid name);
- printf "%s include MakeDevice(struct let name = \"%s\" end)\n" indent (Utils.caml_case name);
- List.iter (print (indent ^ " ")) items;
- printf "%send\n" indent
-
- | _ ->
- ()
-
-let () =
- print_string "\
-open OBus_pervasives
-module MakeDevice(Name : sig val name : string end) =
- OBus_interface.MakeCustom
- (struct
- type proxy = Krobot.t
- let get krobot = OBus_proxy.make (Krobot.peer krobot) [\"fr\"; \"krobot\"; \"Devices\"; Name.name]
- end)
- (struct
- let name = \"fr.krobot.Device.\" ^ Name.name
- end)
-";
- List.iter (print "") (List.filter (function Module _ -> true | _ -> false) interface)
diff --git a/PC_Mainboard/interface/gen_script_commands.ml b/PC_Mainboard/interface/gen_script_commands.ml
deleted file mode 100644
index c78c853..0000000
--- a/PC_Mainboard/interface/gen_script_commands.ml
+++ /dev/null
@@ -1,67 +0,0 @@
-(*
- * gen_script_commands.ml
- * ----------------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Printf
-open Interface
-
-let print_common prefix path name args =
- printf " register \"unsafe-%s%s\" (f%d" prefix name
- (List.fold_left (fun n arg -> match arg with
- | Arg _ -> n + 1
- | Cst _ -> n) 0 args);
- List.iter (function
- | Arg(name, { caml_type = "int" }) ->
- printf " (int \"%s\")" name
- | Arg(name, { caml_type = "bool" }) ->
- printf " (keyword \"%s\" [(\"false\", false); (\"true\", true)])" name
- | Arg(name, { caml_type = caml_type }) ->
- if try String.sub caml_type 0 6 = "Types." with _ -> false then
- printf " (__type_%s \"%s\")" (String.sub caml_type 6 (String.length caml_type - 6)) name
- else
- printf " (prout \"caca\")"
- | Cst _ ->
- ()) args;
- printf ")\n";
- printf " (fun logger krobot";
- List.iter (function
- | Arg(name, typ) ->
- printf " %s" (Utils.caml_lid name)
- | Cst _ ->
- ()) args;
- printf " ->\n";
- printf " lwt _ = Krobot_unsafe.%s%s krobot" path (Utils.caml_lid name);
- List.iter (function
- | Arg(name, typ) ->
- printf " %s" (Utils.caml_lid name)
- | Cst _ ->
- ()) args;
- printf " in\n";
- printf " Lwt.return ());\n"
-
-let rec print prefix path = function
- | Request req ->
- print_common prefix path req.req_name req.req_args
- | Command cmd ->
- print_common prefix path cmd.cmd_name cmd.cmd_args
- | Enum enum ->
- printf " let __type_%s name = keyword name [" (Utils.caml_lid enum.enm_name);
- List.iter (fun (name, code) ->
- printf "(\"%s\", `%s);" name (Utils.caml_uid name))
- enum.enm_keys;
- printf "] in\n"
- | Record _ ->
- ()
- | Module(name, items) ->
- List.iter (print (prefix ^ String.lowercase name ^ "-") (path ^ Utils.caml_uid name ^ ".")) items
-
-let () =
- printf "open Script_commands\n";
- printf "let register () =\n";
- List.iter (print "" "") (List.filter (function Module _ -> true | _ -> false) interface);
- printf " ()"
diff --git a/PC_Mainboard/interface/gen_usb_commands_impl.ml b/PC_Mainboard/interface/gen_usb_commands_impl.ml
deleted file mode 100644
index 97ef956..0000000
--- a/PC_Mainboard/interface/gen_usb_commands_impl.ml
+++ /dev/null
@@ -1,120 +0,0 @@
-(*
- * gen_usb_commands_impl.ml
- * ------------------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-(* Generate implementation for all USB commands used by the driver *)
-
-open Printf
-open Interface
-
-let print_common indent name args =
- printf "%slet %s card" indent (Utils.caml_lid name);
- List.iter (function
- | Arg(name, typ) ->
- printf " ~%s" (Utils.caml_lid name)
- | Cst _ ->
- ()) args;
- printf " =\n";
- printf "%s let data = Card.make_buffer () in\n" indent;
- if args <> [] then begin
- printf "%s let writer = RW.writer data in\n" indent;
- List.iter
- (function
- | Arg(name, typ) ->
- printf "%s %s;\n" indent (typ.writer (Utils.caml_lid name))
- | Cst(typ, value) ->
- printf "%s %s;\n" indent (typ.writer (string_of_int value)))
- args
- end
-
-let rec print indent = function
- | Request req ->
- print_common indent req.req_name req.req_args;
- printf "%s lwt data = Card.send_request card %d data in\n" indent req.req_code;
- if req.req_repl <> [] then begin
- printf "%s let reader = RW.reader data in\n" indent;
- let repl =
- List.map
- (function
- | Arg(name, typ) ->
- (Utils.caml_lid name, typ)
- | Cst _ ->
- failwith "constant are not allowed in replies")
- req.req_repl
- in
- List.iter
- (fun (name, typ) ->
- printf "%s let %s = %s in\n" indent name typ.reader)
- repl;
- printf "%s return (%s)\n" indent (String.concat ", " (List.map fst repl))
- end else
- printf "return ()\n"
- | Command cmd ->
- print_common indent cmd.cmd_name cmd.cmd_args;
- printf "%s Card.send_command card %d data\n" indent cmd.cmd_code
- | Enum enum ->
- if not enum.enm_extern then
- printf "%stype %s = [ %s ]\n"
- indent (Utils.caml_lid enum.enm_name)
- (String.concat " | "
- (List.map
- (fun (name, code) -> "`" ^ Utils.caml_uid name)
- enum.enm_keys));
-
- printf "%slet put_%s writer value =\n" indent (Utils.caml_lid enum.enm_name);
- printf "%s let code = match value with\n" indent;
- List.iter
- (fun (name, code) ->
- printf "%s | `%s -> %d\n" indent (Utils.caml_uid name) code)
- enum.enm_keys;
- printf "%s in\n" indent;
- printf "%s %s\n" indent (enum.enm_ctyp.writer "code");
-
- printf "%slet get_%s reader =\n" indent (Utils.caml_lid enum.enm_name);
- printf "%s match %s with\n" indent enum.enm_ctyp.reader;
- List.iter
- (fun (name, code) ->
- printf "%s | %d -> `%s\n" indent code (Utils.caml_uid name))
- enum.enm_keys;
- printf "%s | n -> Printf.ksprintf failwith \"invalid value for '%s': %%d\" n\n" indent enum.enm_name
- | Record record ->
- if not record.rec_extern then
- printf "%stype %s = { %s }\n"
- indent (Utils.caml_lid record.rec_name)
- (String.concat "; "
- (List.map
- (fun (name, typ) -> sprintf "%s : %s" (Utils.caml_lid name) typ.caml_type)
- record.rec_args));
-
- printf "%slet put_%s writer value =\n" indent (Utils.caml_lid record.rec_name);
- List.iter
- (fun (name, typ) ->
- printf "%s %s;\n" indent (typ.writer ("value." ^ record.rec_prefix ^ Utils.caml_lid name)))
- record.rec_args;
- printf "%s ()\n" indent;
-
- printf "%slet get_%s reader =\n" indent (Utils.caml_lid record.rec_name);
- List.iter
- (fun (name, typ) ->
- printf "%s let %s = %s in\n" indent (Utils.caml_lid name) typ.reader)
- record.rec_args;
- printf "%s { %s }\n" indent
- (String.concat "; "
- (List.map
- (fun (name, typ) ->
- let name = Utils.caml_lid name in
- sprintf "%s = %s" (record.rec_prefix ^ name) name)
- record.rec_args))
- | Module(name, items) ->
- printf "%smodule %s = struct\n" indent (Utils.caml_uid name);
- List.iter (print (indent ^ " ")) items;
- printf "%send\n" indent
-
-let () =
- printf "open Lwt\n";
- List.iter (print "") interface
diff --git a/PC_Mainboard/interface/gen_usb_commands_intf.ml b/PC_Mainboard/interface/gen_usb_commands_intf.ml
deleted file mode 100644
index 972402a..0000000
--- a/PC_Mainboard/interface/gen_usb_commands_intf.ml
+++ /dev/null
@@ -1,70 +0,0 @@
-(*
- * gen_usb_commands_intf.ml
- * ------------------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-(* Generate interface for all USB commands used by the driver *)
-
-open Printf
-open Interface
-
-let print_common indent name args =
- printf "%sval %s : Card.t -> " indent (Utils.caml_lid name);
- List.iter (function
- | Arg(name, typ) ->
- printf "%s : %s -> " (Utils.caml_lid name) typ.caml_type
- | Cst _ ->
- ()) args
-
-let print_repl = function
- | Arg(name, typ) ->
- printf "%s" typ.caml_type
- | Cst _ ->
- failwith "constant are not allowed in replies"
-
-let rec print indent = function
- | Request req ->
- print_common indent req.req_name req.req_args;
- begin
- match req.req_repl with
- | [] ->
- printf "unit Lwt.t\n"
- | [arg] ->
- print_repl arg;
- printf " Lwt.t\n"
- | arg :: args ->
- printf "(";
- print_repl arg;
- List.iter (fun arg -> printf " * "; print_repl arg) args;
- printf ") Lwt.t\n"
- end
- | Command cmd ->
- print_common indent cmd.cmd_name cmd.cmd_args;
- printf "unit Lwt.t\n";
- | Enum enum ->
- if not enum.enm_extern then
- printf "%stype %s = [ %s ]\n"
- indent (Utils.caml_lid enum.enm_name)
- (String.concat " | "
- (List.map
- (fun (name, code) -> "`" ^ Utils.caml_uid name)
- enum.enm_keys));
- | Record record ->
- if not record.rec_extern then
- printf "%stype %s = { %s }\n"
- indent (Utils.caml_lid record.rec_name)
- (String.concat "; "
- (List.map
- (fun (name, typ) -> sprintf "%s : %s" (Utils.caml_lid name) typ.caml_type)
- record.rec_args))
- | Module(name, items) ->
- printf "%smodule %s : sig\n" indent (Utils.caml_uid name);
- List.iter (print (indent ^ " ")) items;
- printf "%send\n" indent
-
-let () =
- List.iter (print "") interface
diff --git a/PC_Mainboard/interface/interface.ml b/PC_Mainboard/interface/interface.ml
index a0bd652..9bf3bd3 100644
--- a/PC_Mainboard/interface/interface.ml
+++ b/PC_Mainboard/interface/interface.ml
@@ -7,27 +7,34 @@
* This file is a part of [kro]bot.
*)
-(* USB commands description *)
-
open Printf
(* +-----------------------------------------------------------------+
- | Types |
+ | Ast |
+-----------------------------------------------------------------+ *)
(* Description of a type *)
-type ctyp = {
+type typ = {
caml_type : string;
+ (* The caml type used *)
+
writer : string -> string;
+ (* [writer expr] represents an expression writing [expr], using the
+ current writer, named "writer". *)
reader : string;
+ (* [reader] represents an expression reading a value of the give
+ type, using the reader "reader" *)
}
+(* An argument *)
type arg =
- | Arg of string * ctyp
- (* [Arg(name, type)] *)
- | Cst of ctyp * int
- (* [Cst(type, value)] *)
+ | Arg of string * typ
+ (* [Arg(name, typ)] is a normal argument, with name [name] and
+ type [typ] *)
+ | Cst of typ * int
+ (* [Cst(typ, value)] is an integer constant. *)
+(* A request, which expect a reply: *)
type request = {
req_name : string;
(* The request name, which will be used for function naming *)
@@ -42,6 +49,7 @@ type request = {
(* Returned values *)
}
+(* A command, which does not expect a reply *)
type command = {
cmd_name : string;
cmd_code : int;
@@ -49,16 +57,14 @@ type command = {
}
type enum = {
- enm_name : string;
- enm_ctyp : ctyp;
- enm_keys : (string * int) list;
- enm_extern : bool;
+ enum_name : string;
+ enum_type : typ;
+ enum_keys : (string * int) list;
}
type record = {
rec_name : string;
- rec_args : (string * ctyp) list;
- rec_extern : bool;
+ rec_args : (string * typ) list;
rec_prefix : string;
}
@@ -88,19 +94,17 @@ let command ~name ~code ?(args=[]) () =
cmd_args = args;
}
-let enum ~name ~ctyp ~keys ?(extern=false) () =
+let enum ~name ~typ ~keys () =
Enum{
- enm_name = name;
- enm_ctyp = ctyp;
- enm_keys = keys;
- enm_extern = extern;
+ enum_name = name;
+ enum_type = typ;
+ enum_keys = keys;
}
-let record ~name ~args ?(extern=false) ?(prefix="") () =
+let record ~name ~args ?(prefix="") () =
Record{
rec_name = name;
rec_args = args;
- rec_extern = extern;
rec_prefix = prefix;
}
@@ -110,50 +114,50 @@ let record ~name ~args ?(extern=false) ?(prefix="") () =
let bool = {
caml_type = "bool";
- writer = sprintf "RW.put_uint8 writer (if %s then 1 else 0)";
- reader = "RW.get_uint8 reader <> 0";
+ writer = sprintf "put_uint8 writer (if %s then 1 else 0)";
+ reader = "get_uint8 reader <> 0";
}
let uint8 = {
caml_type = "int";
- writer = sprintf "RW.put_uint8 writer %s";
- reader = "RW.get_uint8 reader";
+ writer = sprintf "put_uint8 writer %s";
+ reader = "get_uint8 reader";
}
let sint8 = {
caml_type = "int";
- writer = sprintf "RW.put_sint8 writer %s";
- reader = "RW.get_sint8 reader";
+ writer = sprintf "put_sint8 writer %s";
+ reader = "get_sint8 reader";
}
let uint16 = {
caml_type = "int";
- writer = sprintf "RW.put_uint16 writer %s";
- reader = "RW.get_uint16 reader";
+ writer = sprintf "put_uint16 writer %s";
+ reader = "get_uint16 reader";
}
let sint16 = {
caml_type = "int";
- writer = sprintf "RW.put_sint16 writer %s";
- reader = "RW.get_sint16 reader";
+ writer = sprintf "put_sint16 writer %s";
+ reader = "get_sint16 reader";
}
let uint32 = {
caml_type = "int";
- writer = sprintf "RW.put_uint32 writer %s";
- reader = "RW.get_uint32 reader";
+ writer = sprintf "put_uint32 writer %s";
+ reader = "get_uint32 reader";
}
let sint32 = {
caml_type = "int";
- writer = sprintf "RW.put_sint32 writer %s";
- reader = "RW.get_sint32 reader";
+ writer = sprintf "put_sint32 writer %s";
+ reader = "get_sint32 reader";
}
let string = {
caml_type = "string";
- writer = sprintf "RW.put_string writer %s";
- reader = "RW.get_string reader";
+ writer = sprintf "put_string writer %s";
+ reader = "get_string reader";
}
let array size typ = {
@@ -168,16 +172,8 @@ let bool_array size typ = {
reader = sprintf "let _x = %s in Array.init %d (fun i -> _x land (1 lsl i) <> 0)" typ.reader size;
}
-let extern name =
- let name = Utils.caml_lid name in
- {
- caml_type = "Types." ^ name;
- writer = sprintf "put_%s writer %s" name;
- reader = sprintf "get_%s reader" name;
- }
-
-let local name =
- let name = Utils.caml_lid name in
+let typ name =
+ let name = Name.lid name in
{
caml_type = name;
writer = sprintf "put_%s writer %s" name;
@@ -189,28 +185,30 @@ let local name =
+-----------------------------------------------------------------+ *)
let interface = [
- request
- ~name:"get-firmware-build"
- ~code:PcInterface.get_firmware_build
- ~repl:[Arg("date", string)]
- ();
- request
- ~name:"get-board-info"
- ~code:PcInterface.get_board_info
- ~repl:[Arg("info", string)]
- ();
- command
- ~name:"bootloader"
- ~code:PcInterface.cmd_bootloader
- ();
- command
- ~name:"reset"
- ~code:PcInterface.cmd_reset
- ();
- command
- ~name:"test"
- ~code:PcInterface.cmd_test
- ();
+ Module("common", [
+ request
+ ~name:"get-firmware-build"
+ ~code:PcInterface.get_firmware_build
+ ~repl:[Arg("date", string)]
+ ();
+ request
+ ~name:"get-board-info"
+ ~code:PcInterface.get_board_info
+ ~repl:[Arg("info", string)]
+ ();
+ command
+ ~name:"bootloader"
+ ~code:PcInterface.cmd_bootloader
+ ();
+ command
+ ~name:"reset"
+ ~code:PcInterface.cmd_reset
+ ();
+ command
+ ~name:"test"
+ ~code:PcInterface.cmd_test
+ ();
+ ]);
Module("compass", [
request
@@ -223,15 +221,13 @@ let interface = [
Module("AX12", [
enum
~name:"exec-mode"
- ~extern:true
- ~ctyp:uint8
+ ~typ:uint8
~keys:[("now", PcInterface.ax12_exec_now);
("action", PcInterface.ax12_exec_action)]
();
record
~name:"ax12-stats"
- ~extern:true
- ~prefix:"Types.ax12_"
+ ~prefix:"ax12_"
~args:[("position", uint16);
("velocity", uint16);
("torque", uint16);
@@ -247,7 +243,7 @@ let interface = [
Arg("id", uint8);
Arg("position", uint16);
Arg("velocity", uint16);
- Arg("mode", extern "exec-mode")]
+ Arg("mode", typ "exec-mode")]
();
request
~name:"ping"
@@ -343,7 +339,7 @@ let interface = [
~args:[Cst(uint8, PcInterface.ax12_get_load);
Arg("id", uint8);
Arg("timeout", uint8)]
- ~repl:[Arg("stats", extern "ax12-stats")]
+ ~repl:[Arg("stats", typ "ax12-stats")]
();
request
~name:"action"
@@ -398,24 +394,21 @@ let interface = [
Module("motor", [
enum
~name:"motor"
- ~ctyp:uint8
- ~extern:true
+ ~typ:uint8
~keys:[("left", PcInterface.motor_left);
("both", PcInterface.motor_both);
("right", PcInterface.motor_right)]
();
enum
~name:"stop-mode"
- ~ctyp:uint16
- ~extern:true
+ ~typ:uint16
~keys:[("off", PcInterface.traj_stop_motor_off);
("abrupt", PcInterface.traj_stop_abrupt);
("smooth", PcInterface.traj_stop_smooth)]
();
enum
~name:"direction"
- ~ctyp:sint8
- ~extern:true
+ ~typ:sint8
~keys:[("forward", 1);
("backward", -1)]
();
@@ -453,8 +446,7 @@ let interface = [
();
enum
~name:"goto-mode"
- ~ctyp:uint8
- ~extern:true
+ ~typ:uint8
~keys:[("straight", 0);
("curve-right", 1);
("curve-left", 2)]
@@ -467,31 +459,31 @@ let interface = [
Arg("y", sint16);
Arg("velocity", sint16);
Arg("acceleration", sint16);
- Arg("mode", extern "goto-mode");
+ Arg("mode", typ "goto-mode");
Arg("bypass-distance", sint16)]
();
command
~name:"traj-new-velocity"
~code:PcInterface.cmd_traj
~args:[Cst(uint8, PcInterface.traj_new_velocity);
- Arg("motor", extern "motor");
+ Arg("motor", typ "motor");
Arg("velocity", sint16);
Arg("acceleration", sint16);
- Arg("direction", extern "direction")]
+ Arg("direction", typ "direction")]
();
command
~name:"traj-change-velocity"
~code:PcInterface.cmd_traj
~args:[Cst(uint8, PcInterface.traj_change_velocity);
- Arg("motor", extern "motor");
+ Arg("motor", typ "motor");
Arg("velocity", sint16);
- Arg("direction", extern "direction")]
+ Arg("direction", typ "direction")]
();
command
~name:"traj-start"
~code:PcInterface.cmd_traj
~args:[Cst(uint8, PcInterface.traj_start);
- Arg("motor", extern "motor")]
+ Arg("motor", typ "motor")]
();
command
~name:"traj-init"
@@ -502,20 +494,20 @@ let interface = [
~name:"traj-stop"
~code:PcInterface.cmd_traj
~args:[Cst(uint8, PcInterface.traj_init);
- Arg("motor", extern "motor");
- Arg("mode", extern "stop-mode")]
+ Arg("motor", typ "motor");
+ Arg("mode", typ "stop-mode")]
();
command
~name:"enable"
~code:PcInterface.cmd_motor
~args:[Cst(uint8, PcInterface.motor_enable);
- Arg("motor", extern "motor")]
+ Arg("motor", typ "motor")]
();
command
~name:"disable"
~code:PcInterface.cmd_motor
~args:[Cst(uint8, PcInterface.motor_disable);
- Arg("motor", extern "motor")]
+ Arg("motor", typ "motor")]
();
]);
]
diff --git a/PC_Mainboard/interface/name.ml b/PC_Mainboard/interface/name.ml
new file mode 100644
index 0000000..a058784
--- /dev/null
+++ b/PC_Mainboard/interface/name.ml
@@ -0,0 +1,47 @@
+(*
+ * name.ml
+ * -------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+let lid str =
+ let str = String.copy str in
+ str.[0] <- Char.lowercase str.[0];
+ for i = 0 to String.length str - 1 do
+ if str.[i] = '-' then str.[i] <- '_'
+ done;
+ str
+
+let uid str =
+ let str = String.copy str in
+ str.[0] <- Char.uppercase str.[0];
+ for i = 0 to String.length str - 1 do
+ if str.[i] = '-' then str.[i] <- '_'
+ done;
+ str
+
+let caml_case str =
+ let len = String.length str in
+ let buf = Buffer.create len in
+ let rec loop i =
+ if i = len then
+ Buffer.contents buf
+ else
+ if str.[i] = '-' || str.[i] = '_' then
+ capitalize (i + 1)
+ else begin
+ Buffer.add_char buf str.[i];
+ loop (i + 1)
+ end
+ and capitalize i =
+ if i = len then
+ Buffer.contents buf
+ else begin
+ Buffer.add_char buf (Char.uppercase str.[i]);
+ loop (i + 1)
+ end
+ in
+ capitalize 0
diff --git a/PC_Mainboard/interface/name.mli b/PC_Mainboard/interface/name.mli
new file mode 100644
index 0000000..0d6aa1c
--- /dev/null
+++ b/PC_Mainboard/interface/name.mli
@@ -0,0 +1,28 @@
+(*
+ * name.mli
+ * --------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(** Name conversion *)
+
+val lid : string -> string
+ (** Convert a string into a valid caml lower identifier.
+
+ exmaple: [caml_lid "get-board-info" = "get_board_info"]
+ *)
+
+val uid : string -> string
+ (** Convert a string into a valid caml upper identifier.
+
+ exmaple: [caml_uid "get-board-info" = "Get_board_info"]
+ *)
+
+val caml_case : string -> string
+ (** Returns the caml-case version of the given string:
+
+ example: [caml_case "get-board-info" = "GetBoardInfo"]
+ *)
diff --git a/PC_Mainboard/interface/utils.ml b/PC_Mainboard/interface/utils.ml
deleted file mode 100644
index 5975e8e..0000000
--- a/PC_Mainboard/interface/utils.ml
+++ /dev/null
@@ -1,47 +0,0 @@
-(*
- * utils.ml
- * --------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-let caml_lid str =
- let str = String.copy str in
- str.[0] <- Char.lowercase str.[0];
- for i = 0 to String.length str - 1 do
- if str.[i] = '-' then str.[i] <- '_'
- done;
- str
-
-let caml_uid str =
- let str = String.copy str in
- str.[0] <- Char.uppercase str.[0];
- for i = 0 to String.length str - 1 do
- if str.[i] = '-' then str.[i] <- '_'
- done;
- str
-
-let caml_case str =
- let len = String.length str in
- let buf = Buffer.create len in
- let rec loop i =
- if i = len then
- Buffer.contents buf
- else
- if str.[i] = '-' || str.[i] = '_' then
- capitalize (i + 1)
- else begin
- Buffer.add_char buf str.[i];
- loop (i + 1)
- end
- and capitalize i =
- if i = len then
- Buffer.contents buf
- else begin
- Buffer.add_char buf (Char.uppercase str.[i]);
- loop (i + 1)
- end
- in
- capitalize 0
diff --git a/PC_Mainboard/interface/utils.mli b/PC_Mainboard/interface/utils.mli
deleted file mode 100644
index 023f8df..0000000
--- a/PC_Mainboard/interface/utils.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(*
- * utils.mli
- * ---------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-val caml_lid : string -> string
- (** Convert a string into a valid caml lower identifier.
-
- exmaple: [caml_lid "get-board-info" = "get_board_info"]
- *)
-
-val caml_uid : string -> string
- (** Convert a string into a valid caml upper identifier.
-
- exmaple: [caml_uid "get-board-info" = "Get_board_info"]
- *)
-
-val caml_case : string -> string
- (** Returns the caml-case version of the given string:
-
- example: [caml_case "get-board-info" = "GetBoardInfo"]
- *)
diff --git a/PC_Mainboard/myocamlbuild.ml b/PC_Mainboard/myocamlbuild.ml
index 87f09e9..3cedd3f 100644
--- a/PC_Mainboard/myocamlbuild.ml
+++ b/PC_Mainboard/myocamlbuild.ml
@@ -147,33 +147,33 @@ let _ =
Options.ocamldoc := S[A"ocamlfind"; A"ocamldoc"; A"-hide-warnings"]
| After_rules ->
+
(* +---------------------------------------------------------+
| Autogenerated files |
+---------------------------------------------------------+ *)
+ (* Geenrate the caml implementation file PcInteface.ml from
+ PcInterface.h. It replace all [#define] by let-bindings. *)
rule "krobot's protocol" ~dep:"common/PcInterface.h" ~prod:"common/PcInterface.ml"
(fun _ _ ->
Cmd(Sh"awk '$1 == \"#define\" && $3 != \"\" { print \"let \" tolower($2) \" = \" $3 }' common/PcInterface.h > common/PcInterface.ml"));
- rule "USB commands, impl" ~dep:"interface/gen_usb_commands_impl.best" ~prod:"driver/commands.ml"
- (fun _ _ ->
- Cmd(Sh"./interface/gen_usb_commands_impl.best > driver/commands.ml"));
+ Pathname.define_context "generators" ["interface"];
- rule "USB commands, intf" ~dep:"interface/gen_usb_commands_intf.best" ~prod:"driver/commands.mli"
- (fun _ _ ->
- Cmd(Sh"./interface/gen_usb_commands_intf.best > driver/commands.mli"));
-
- rule "DBus exports" ~dep:"interface/gen_dbus_exports.best" ~prod:"driver/dBus_exports.ml"
- (fun _ _ ->
- Cmd(Sh"./interface/gen_dbus_exports.best > driver/dBus_exports.ml"));
+ (* Pairs of [(generator, production)]: *)
+ let generated_files = [
+ ("gen_usb_commands", "driver/USB_commands.ml");
+ ("gen_dbus_exports", "driver/DBus_exports.ml");
+ ("gen_dbus_imports", "lib_krobot/krobot_unsafe.ml");
+ ("gen_script_commands", "clients/script_unsafe.ml");
+ ] in
- rule "DBus imports" ~dep:"interface/gen_dbus_imports.best" ~prod:"lib_krobot/krobot_unsafe.ml"
- (fun _ _ ->
- Cmd(Sh"./interface/gen_dbus_imports.best > lib_krobot/krobot_unsafe.ml"));
-
- rule "Script commands" ~dep:"interface/gen_script_commands.best" ~prod:"clients/script_unsafe.ml"
- (fun _ _ ->
- Cmd(Sh"./interface/gen_script_commands.best > clients/script_unsafe.ml"));
+ List.iter
+ (fun (generator, production) ->
+ let generator = sprintf "generators/%s.best" generator in
+ rule (sprintf "generation of '%s'" production) ~dep:generator ~prod:production
+ (fun _ _ -> Cmd(Sh(sprintf "./%s > %s" generator production))))
+ generated_files;
(* +---------------------------------------------------------+
| Virtual targets |
hooks/post-receive
--
krobot
|
