-
Notifications
You must be signed in to change notification settings - Fork 95
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #771 from yallop/fix-ctypes-top
Reduce ctypes.top implementation to a single module.
- Loading branch information
Showing
3 changed files
with
45 additions
and
155 deletions.
There are no files selected for viewing
This file was deleted.
Oops, something went wrong.
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,51 +1,55 @@ | ||
| (* Adapted from Anil Madhavapeddy's ocaml-uri package. *) | ||
|
|
||
| let printers = [ "Ctypes_printers.format_typ"; | ||
| "Ctypes_printers.format_fn"; | ||
| "Ctypes_printers.format_sint"; | ||
| "Ctypes_printers.format_long"; | ||
| "Ctypes_printers.format_llong"; | ||
| "Ctypes_printers.format_uchar"; | ||
| "Ctypes_printers.format_uint8"; | ||
| "Ctypes_printers.format_uint16"; | ||
| "Ctypes_printers.format_uint32"; | ||
| "Ctypes_printers.format_uint64"; | ||
| "Ctypes_printers.format_size_t"; | ||
| "Ctypes_printers.format_ushort"; | ||
| "Ctypes_printers.format_uint"; | ||
| "Ctypes_printers.format_ulong"; | ||
| "Ctypes_printers.format_ullong"; | ||
| "Ctypes_printers.format_pointer"; | ||
| "Ctypes_printers.format_struct"; | ||
| "Ctypes_printers.format_union"; | ||
| "Ctypes_printers.format_array"; | ||
| "Ctypes_printers.format_ocaml"; | ||
| "Ctypes_printers.format_clock_t"; | ||
| "Ctypes_printers.format_dev_t"; | ||
| "Ctypes_printers.format_ino_t"; | ||
| "Ctypes_printers.format_mode_t"; | ||
| "Ctypes_printers.format_nlink_t"; | ||
| "Ctypes_printers.format_off_t"; | ||
| "Ctypes_printers.format_pid_t"; | ||
| "Ctypes_printers.format_size_t"; | ||
| "Ctypes_printers.format_ssize_t"; | ||
| "Ctypes_printers.format_time_t"; | ||
| "Ctypes_printers.format_useconds_t"; | ||
| "Ctypes_printers.format_ldouble"; | ||
| "Ctypes_printers.format_complexld";] | ||
|
|
||
| let printers = [ "fun fmt -> Ctypes.format_typ fmt"; | ||
| "fun fmt -> Ctypes.format_fn fmt"; | ||
| "Signed.SInt.pp"; | ||
| "Signed.Long.pp"; | ||
| "Signed.LLong.pp"; | ||
| "Unsigned.UChar.pp"; | ||
| "Unsigned.UInt8.pp"; | ||
| "Unsigned.UInt16.pp"; | ||
| "Unsigned.UInt32.pp"; | ||
| "Unsigned.UInt64.pp"; | ||
| "Unsigned.Size_t.pp"; | ||
| "Unsigned.UShort.pp"; | ||
| "Unsigned.UInt.pp"; | ||
| "Unsigned.ULong.pp"; | ||
| "Unsigned.ULLong.pp"; | ||
| "fun fmt v -> let open Ctypes in | ||
| let typ = ptr (reference_type v) in | ||
| Format.fprintf fmt \"(%a) %a\" (fun fmt -> format_typ fmt) typ (format typ) v"; | ||
| "fun fmt v -> Ctypes.(format (reference_type (addr v)) fmt v)"; | ||
| "fun fmt v -> Ctypes.(format (reference_type (addr v)) fmt v)"; | ||
| "fun fmt v -> Ctypes.(format CArray.(array (length v) (reference_type (start v))) fmt v)"; | ||
| "fun fmt (Ctypes_static.OCamlRef (_, _, ty) as v) -> Ctypes.format (Ctypes_static.OCaml ty) fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.clock_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.dev_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.ino_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.mode_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.nlink_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.off_t fmt v"; | ||
| "fun fmt v -> Ctypes.format PosixTypes.pid_t fmt v"; | ||
| "PosixTypes.Ssize.pp"; | ||
| "PosixTypes.Time.pp"; | ||
| "Ctypes.format PosixTypes.useconds_t"; | ||
| "(fun fmt v -> Format.fprintf fmt \"<ldouble %s>\" | ||
| (LDouble.to_string v))"; | ||
| "(fun fmt v -> Format.fprintf fmt \"<complexld %s + %si>\" | ||
| (LDouble.to_string (ComplexL.re v)) (LDouble.to_string (ComplexL.im v)))"; | ||
|
|
||
| ] | ||
|
|
||
| let eval_string | ||
| ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = | ||
| let lexbuf = Lexing.from_string str in | ||
| let phrase = !Toploop.parse_toplevel_phrase lexbuf in | ||
| Toploop.execute_phrase print_outcome err_formatter phrase | ||
|
|
||
| let rec install_printers = function | ||
| | [] -> true | ||
| | printer :: printers -> | ||
| let cmd = Printf.sprintf "#install_printer %s;;" printer in | ||
| eval_string cmd && install_printers printers | ||
| let install_printer printer = | ||
| begin | ||
| ignore (eval_string (Printf.sprintf "let _printer = (%s);;" printer)); | ||
| ignore (eval_string "#install_printer _printer;;") | ||
| end | ||
|
|
||
| let () = | ||
| if not (install_printers printers) then | ||
| Format.eprintf "Problem installing ctypes-printers@." | ||
| let () = List.iter install_printer printers |