jyapayne/flitter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add poc files

Browse source
This commit is contained in:
Joey Yakimowich-Payne 2018-05-26 10:55:38 +09:00
commit fa600b98f7
220 changed files with 45679 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

498
commons/ocaml.ml Normal file
View file

@ -0,0 +1,498 @@
(*
* Yoann Padioleau
*
* Copyright (C) 2009-2012 Facebook
*
* Most of the code in this file was inspired by code by Gazagnaire.
* Here is the original copyright:
*
* Copyright (c) 2009 Thomas Gazagnaire <thomas@gazagnaire.com>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
open Common
(*****************************************************************************)
(* Purpose *)
(*****************************************************************************)
(*
* OCaml hacks to support reflection.
*
* OCaml does not support reflection, and it's a good thing: we love
* strong type-checking that forbids too clever hacks like 'eval', or
* run-time reflection; it's too much power for you, you will misuse
* it. At the same time it's sometimes useful. So at least we could make
* it possible to still reflect on the type definitions or values in
* OCaml source code. We can do it by processing ML source code and
* emitting ML source code containing under the form of regular ML
* value or functions meta-information about information in other
* source code files. It's a little bit a poor's man reflection mechanism,
* because it's more manual, but it's for the best. Metaprogramming had
* to be painful, because it is dangerous!
*
* Example:
*
* TODO
*
* In some sense we reimplement what is in the OCaml compiler, which
* contains the full AST of OCaml source code. But the OCaml compiler
* and its AST are too big, too scary for many tasks that would be satisfied
* by a restricted but simpler AST.
*
* Camlp4 is obviously also a solution to this problem, but it has a
* learning curve, and it's a slightly different world than the pure
* regular OCaml world. So this module, and ocamltarzan together can
* reduce the problem by taking the best of camlp4, while still
* avoiding it.
*
*
*
* The support is partial. We support only the OCaml constructions
* we found the most useful for programming stuff like
* stub generators.
*
* less? not all OCaml so call it miniml.ml ? or reflection.ml ?
*
*
* Notes: 2 worlds
* - the type level world,
* - the data level world
*
* Then there is whether the code is generated on the fly, or output somewhere
* to be compiled and linked again (so 2 steps process, more manual, but
* arguably less complicated magic)
*
* different level of (meta)programming:
*
* - programming in OCaml on OCaml values (classic)
* - programming in OCaml on Sexp.t value of value
* - programming in OCaml on Sexp.t value of type description
* - programming in OCaml on OCaml.v value of value
* - programming in OCaml on OCaml.t value of type description
*
* Depending on what you have to do, some levels are more suited than other.
* For instance to do a show, to pretty print value, then sexp is good,
* because really you just want to write code that handle 2 cases,
* atoms and list. That's really what pretty printing is all about. You
* could write a pretty printer for Ocaml.v, but it will need to handle
* 10 cases. Now if you want to write a code generator for python, or an ORM,
* then Ocaml.v is better than sexp, because in sexp you lost some valuable
* information (that you may have to reverse engineer, like whether
* a Sexp.List corresponds to a field, or a sum, or wether something is
* null or an empty list, or wether it's an int or float, etc).
*
* Another way to do (meta)programming is:
* - programming in Camlp4 on OCaml ast
* - writing camlmix code to generate code.
*
* notes:
* - sexp value or sexp of type description, not as precise, but easier to
* write really generic code that do not need to have more information
* about the sexp nodes (such as wether it's a field, a constuctor, etc)
* - miniml value or type, not as precise that the regular type,
* but more precise than sexp, and allow write some generic code.
* - ocaml value (not type as you cant program at type level),
* precise type checking, but can be tedious to write generic
* code like generic visitors or pickler/unpicklers
*
* This file is working with ocamltarzan/pa/pa_type.ml (and so indirectly
* it is working with camlp4).
*
* Note that can even generate sexp_of_x for miniML :) really
* reflexive tower here
*
* Note that even if this module helps a programmer to avoid
* using directly camlp4 to auto generate some code, it can
* not solve all the tasks.
*
* history:
* - Thought about it when wanting to do the ast_php.ml to be
* transformed into a .adsl declaration to be able to generate
* corresponding python classes using astgen.py.
* - Thought about a miniMLType and miniMLValue, and then realize
* that that was maybe what code in the ocaml-orm-sqlite
* was doing (type-of et value-of), except I wanted the
* ocamltarzan style of meta-programming instead of the camlp4 one.
*
*
* Alternatives:
* - camlp4
* obviously camlp4 has access to the full AST of OCaml, but
* that is one pb, that's too much. We often want only to do
* analysis on the type
* - type-conv
* good, but force to use camlp4. Can use the generic sexplib
* and then work on the generated sexp, but as explained below,
* is will be on the value.
* - use lib-sexp (just the sexp library part, not the camlp4 support part)
* but not enough info. Even if usually
* can reverse engineer the sexp to rediscover the type,
* you will reverse engineer a value; what you want
* is the sexp representation of the type! not a value of this type.
* Also lib-sexp autogenerated code can be hard to understand, especially
* if the type definition is complex. A good side effect of ocaml.ml
* is that it provides an intermediate step :) So even if you
* could pretty print value from your def to sexp directly, you could
* also use transform your value into a Ocaml.v, then use
* the somehow more readable function that translate a v into a sexp,
* and same when wanting to read a value from a sexp, by using
* again Ocaml.v as an intermediate. It's nevertheless obviously
* less efficient.
*
* - zephyr, or thrift ?
* - F# ?
* - Lisp/Scheme ?
* - .Net interoperability
*
*)
(*****************************************************************************)
(* Types *)
(*****************************************************************************)
(* src:
* - orm-sqlite/value/value.ml
* (itself a fork of http://xenbits.xen.org/xapi/xen-api-libs.hg?file/7a17b2ab5cfc/rpc-light/rpc.ml)
* - orm-sqlite/type-of/type.ml
*
* update: Gazagnaire made a paper about that.
*
* modifications:
* - slightly renamed the types and rearrange order of constructors. Could
* have use nested modules to allow to reuse Int in different contexts,
* but I actually prefer to prefix the values with the V, so when debugging
* stuff, it's clearer that what you are looking are values, not types
* (even if the ocaml toplevel would prefix the value with a V. or T.,
* but sexp would not)
* - Changed Int of int option
* - Introduced List, Apply, Poly
* - debugging support (using sexp :) )
*)
(* OCaml type definitions *)
type t =
| Unit
| Bool | Float | Char | String | Int
| Tuple of t list
| Dict of (string * [`RW|`RO] * t) list
| Sum of (string * t list) list
| Var of string
| Poly of string
| Arrow of t * t
| Apply of string * t
(* special cases of Apply *)
| Option of t
| List of t
(* todo? split in another type, because here it's the left part,
* whereas before is the right part of a type definition. Also
* have not the polymorphic args to some defs like ('a, 'b) Hashbtbl
* | Rec of string * t
* | Ext of string * t
*
* | Enum of t (* ??? *)
*)
| TTODO of string
(* with tarzan *)
(* OCaml values (a restricted form of expressions) *)
type v =
| VUnit
| VBool of bool | VFloat of float | VInt of int (* was int64 *)
| VChar of char | VString of string
| VTuple of v list
| VDict of (string * v) list
| VSum of string * v list
| VVar of (string * int64)
| VArrow of string
(* special cases *)
| VNone | VSome of v
| VList of v list
| VRef of v
(*
| VEnum of v list (* ??? *)
| VRec of (string * int64) * v
| VExt of (string * int64) * v
*)
| VTODO of string
(* with tarzan *)
(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
(* the generated code can use that if he wants *)
let (_htype: (string, t) Hashtbl.t) =
Hashtbl.create 101
let (add_new_type: string -> t -> unit) = fun s t ->
Hashtbl.add _htype s t
let (get_type: string -> t) = fun s ->
Hashtbl.find _htype s
(* for generated code that want to transform and in and out of a v or t *)
let vof_unit () =
VUnit
let vof_int x =
VInt ((*Int64.of_int*) x)
let vof_float x =
VFloat ((*Int64.of_int*) x)
let vof_string x =
VString x
let vof_bool b =
VBool b
let vof_list ofa x =
VList (List.map ofa x)
let vof_option ofa x =
match x with
| None -> VNone
| Some x -> VSome (ofa x)
let vof_ref ofa x =
match x with
| {contents = x } -> VRef (ofa x)
let vof_either _of_a _of_b =
function
| Left v1 -> let v1 = _of_a v1 in VSum (("Left", [ v1 ]))
| Right v1 -> let v1 = _of_b v1 in VSum (("Right", [ v1 ]))
let vof_either3 _of_a _of_b _of_c =
function
| Left3 v1 -> let v1 = _of_a v1 in VSum (("Left3", [ v1 ]))
| Middle3 v1 -> let v1 = _of_b v1 in VSum (("Middle3", [ v1 ]))
| Right3 v1 -> let v1 = _of_c v1 in VSum (("Right3", [ v1 ]))
let int_ofv = function
| VInt x -> x
| _ -> failwith "ofv: was expecting a VInt"
let float_ofv = function
| VFloat x -> x
| _ -> failwith "ofv: was expecting a VFloat"
let string_ofv = function
| VString x -> x
| _ -> failwith "ofv: was expecting a VString"
let unit_ofv = function
| VUnit -> ()
| _ -> failwith "ofv: was expecting a VUnit"
let list_ofv a__of_sexp sexp = match sexp with
| VList lst ->
let rev_lst = List.rev_map a__of_sexp lst in
List.rev rev_lst
| _ -> failwith "list_ofv: VLlist needed"
let option_ofv a__of_sexp sexp = match sexp with
| VNone -> None
| VSome x -> Some (a__of_sexp x)
| _ -> failwith "option_ofv: VNone or VSome needed"
(*****************************************************************************)
(* Format pretty printers *)
(*****************************************************************************)
let add_sep xs =
xs +> List.map (fun x -> Right x) +> Common2.join_gen (Left ())
(*
* OCaml value pretty printer. A similar functionnality is provided by
* the OCaml toplevel interpreter ('/usr/bin/ocaml') but
* sometimes it is useful to print values from a regular command
* line program. You don't always want to run the ocaml interpreter (or
* customized interpreter built by ocamlmktop), and type an expression
* in to get the printed value.
*
* The v_of_xxx generated code by ocamltarzan is
* the first part to make this possible. The function below
* is the second part.
*
* The '@[', '@,', etc are Format printf tags. See the doc of the Format
* module in the OCaml manual to understand their meaning. Mainly,
* @[ and @] open and close a pretty print box, and '@ ' and '@,'
* are to give breaking hints to the pretty printer.
*
* The output can be copy pasted in ML code directly, which can be
* useful when you want to pattern match over complex ocaml value.
*)
let string_of_v v =
Common2.format_to_string (fun () ->
let ppf = Format.printf in
let rec aux v =
match v with
| VUnit -> ppf "()"
| VBool v1 ->
if v1
then ppf "true"
else ppf "false"
| VFloat v1 -> ppf "%f" v1
| VChar v1 -> ppf "'%c'" v1
| VString v1 -> ppf "\"%s\"" v1
| VInt i -> ppf "%d" i
| VTuple xs ->
ppf "(@[";
xs +> add_sep +> List.iter (function
| Left _ -> ppf ",@ ";
| Right v -> aux v
);
ppf "@])";
| VDict xs ->
ppf "{@[";
xs +> List.iter (fun (s, v) ->
(* less: could open a box there too? *)
ppf "@,%s=" s;
aux v;
ppf ";@ ";
);
ppf "@]}";
| VSum ((s, xs)) ->
(match xs with
| [] -> ppf "%s" s
| y::ys ->
ppf "@[<hov 2>%s(@," s;
xs +> add_sep +> List.iter (function
| Left _ -> ppf ",@ ";
| Right v -> aux v
);
ppf "@])";
)
| VVar (s, i64) -> ppf "%s_%d" s (Int64.to_int i64)
| VArrow v1 -> failwith "Arrow TODO"
| VNone -> ppf "None";
| VSome v -> ppf "Some(@["; aux v; ppf "@])";
| VRef v -> ppf "Ref(@["; aux v; ppf "@])";
| VList xs ->
ppf "[@[<hov>";
xs +> add_sep +> List.iter (function
| Left _ -> ppf ";@ ";
| Right v -> aux v
);
ppf "@]]";
| VTODO v1 -> ppf "VTODO"
in
aux v
)
(*****************************************************************************)
(* Mapper Visitor *)
(*****************************************************************************)
let map_of_unit x = ()
let map_of_bool x = x
let map_of_float x = x
let map_of_char x = x
let map_of_string (s:string) = s
let map_of_ref aref x = x (* dont go into ref *)
let map_of_option v_of_a v =
match v with
| None -> None
| Some x -> Some (v_of_a x)
let map_of_list of_a xs =
List.map of_a xs
let map_of_int x = x
let map_of_int64 x = x
let map_of_either _of_a _of_b =
function
| Left v1 -> let v1 = _of_a v1 in Left ((v1))
| Right v1 -> let v1 = _of_b v1 in Right ((v1))
let map_of_either3 _of_a _of_b _of_c =
function
| Left3 v1 -> let v1 = _of_a v1 in Left3 ((v1))
| Middle3 v1 -> let v1 = _of_b v1 in Middle3 ((v1))
| Right3 v1 -> let v1 = _of_c v1 in Right3 ((v1))
(* this is subtle ... *)
let rec (map_v: f:( k:(v -> v) -> v -> v) -> v -> v) =
fun ~f x ->
let rec map_v v =
(* generated by ocamltarzan with: camlp4o -o /tmp/yyy.ml -I pa/ pa_type_conv.cmo pa_map.cmo pr_o.cmo /tmp/xxx.ml *)
let rec k x =
match x with
| VUnit -> VUnit
| VBool v1 -> let v1 = map_of_bool v1 in VBool ((v1))
| VFloat v1 -> let v1 = map_of_float v1 in VFloat ((v1))
| VChar v1 -> let v1 = map_of_char v1 in VChar ((v1))
| VString v1 -> let v1 = map_of_string v1 in VString ((v1))
| VInt v1 -> let v1 = map_of_int v1 in VInt ((v1))
| VTuple v1 -> let v1 = map_of_list map_v v1 in VTuple ((v1))
| VDict v1 ->
let v1 =
map_of_list
(fun (v1, v2) ->
let v1 = map_of_string v1 and v2 = map_v v2 in (v1, v2))
v1
in VDict ((v1))
| VSum ((v1, v2)) ->
let v1 = map_of_string v1
and v2 = map_of_list map_v v2
in VSum ((v1, v2))
| VVar v1 ->
let v1 =
(match v1 with
| (v1, v2) ->
let v1 = map_of_string v1 and v2 = map_of_int64 v2 in (v1, v2))
in VVar ((v1))
| VArrow v1 -> let v1 = map_of_string v1 in VArrow ((v1))
| VNone -> VNone
| VSome v1 -> let v1 = map_v v1 in VSome ((v1))
| VRef v1 -> let v1 = map_v v1 in VRef ((v1))
| VList v1 -> let v1 = map_of_list map_v v1 in VList ((v1))
| VTODO v1 -> let v1 = map_of_string v1 in VTODO ((v1))
in
f ~k v
in
map_v x
(*****************************************************************************)
(* Iterator Visitor *)
(*****************************************************************************)
let v_unit x = ()
let v_bool x = ()
let v_int x = ()
let v_string (s:string) = ()
let v_ref aref x = () (* dont go into ref *)
let v_option v_of_a v =
match v with
| None -> ()
| Some x -> v_of_a x
let v_list of_a xs =
List.iter of_a xs
let v_either of_a of_b x =
match x with
| Left a -> of_a a
| Right b -> of_b b
let v_either3 of_a of_b of_c x =
match x with
| Left3 a -> of_a a
| Middle3 b -> of_b b
| Right3 c -> of_c c