5.14. C/C++ typings

Start ocaml section to src/flx_ctypes.mli[1 /1 ]
     1: # 4 "./lpsrc/flx_ctypes.ipk"
     2: 
     3: type cexpr_t =
     4: [
     5:   | `Ce_atom of string
     6:   | `Ce_postfix of string * cexpr_t
     7:   | `Ce_prefix of string  * cexpr_t
     8:   | `Ce_infix of string * cexpr_t * cexpr_t
     9: 
    10:   | `Ce_call of cexpr_t * cexpr_t list
    11:   | `Ce_array of cexpr_t * cexpr_t
    12:   | `Ce_new of cexpr_t list * string * cexpr_t list
    13:   | `Ce_cast of string * cexpr_t
    14:   | `Ce_cond of cexpr_t * cexpr_t * cexpr_t
    15:   | `Ce_expr of string * string
    16: ]
    17: 
    18: 
    19: (* These are constructors for C terms representing
    20:    actual C types. This includes incomplete types,
    21:    functions and arrays (which have real types,
    22:    even though there are no corresponding first class values).
    23: 
    24:   Note there are no refernce types, and no const types.
    25: *)
    26: 
    27: type ctype_t =
    28: [
    29:   | `Ct_base of string
    30:   | `Ct_ptr of ctype_t
    31:   | `Ct_cptr of ctype_t
    32:   | `Ct_vptr of ctype_t
    33:   | `Ct_cvptr of ctype_t
    34:   | `Ct_ptm of string * ctype_t
    35:   | `Ct_cptm of string * ctype_t
    36:   | `Ct_vptm of string * ctype_t
    37:   | `Ct_cvptm of string * ctype_t
    38:   | `Ct_array of int * ctype_t
    39:   | `Ct_varray of ctype_t
    40:   | `Ct_fun of ctype_t * ctype_t list
    41:   | `Ct_vfun of ctype_t * ctype_t list
    42:     (* argument list must not be empty for varags *)
    43: ]
    44: 
    45: (* The decl type is the type term used in a declaration,
    46:   it is not a type, but the combination of a type
    47:   and an access modifier. For example:
    48: 
    49:   int const * const x;
    50: 
    51:   declares x to be const lvalue
    52:   of type pointer-const to int
    53: *)
    54: 
    55: type cdecl_type_t =
    56: [
    57:   | `Cdt_value of ctype_t
    58:   | `Cdt_const of ctype_t
    59:   | `Cdt_volatile of ctype_t
    60:   | `Cdt_const_volatile of ctype_t
    61:   | `Cdt_ref of ctype_t
    62:   | `Cdt_cref of ctype_t
    63:   | `Cdt_vref of ctype_t
    64:   | `Cdt_cvref of ctype_t
    65: ]
    66: 
End ocaml section to src/flx_ctypes.mli[1]
Start ocaml section to src/flx_ctype.mli[1 /1 ]
     1: # 71 "./lpsrc/flx_ctypes.ipk"
     2: open Flx_ctypes
     3: 
     4: val string_of_ctype: ctype_t -> string
     5: val string_of_cdecl_type: string -> cdecl_type_t -> string
     6: 
End ocaml section to src/flx_ctype.mli[1]
Start ocaml section to src/flx_ctype.ml[1 /1 ]
     1: # 78 "./lpsrc/flx_ctypes.ipk"
     2: open Flx_ctypes
     3: 
     4: (* suffixes apply first, then dereferences so
     5:   int *t[2]
     6: 
     7: is an array of 2 pointers, brackets are needed
     8: for a pointer to an array of 2 ints:
     9: 
    10:   int ( *t )[2]
    11: 
    12: Lower value in table indicates higher precedence.
    13: *)
    14: 
    15: let prec = function
    16: | `Ct_base _ -> 0
    17: | `Ct_array _
    18: | `Ct_varray _
    19: | `Ct_fun _
    20: | `Ct_vfun _ -> 1
    21: | `Ct_ptr _
    22: | `Ct_cptr _
    23: | `Ct_vptr _
    24: | `Ct_cvptr _
    25: | `Ct_ptm _
    26: | `Ct_cptm _
    27: | `Ct_vptm _
    28: | `Ct_cvptm _ -> 2
    29: 
    30: let rec plist ps =
    31:   String.concat ", "
    32:   (
    33:     List.map (fun t -> aux t "" ) ps
    34:   )
    35: 
    36: 
    37: and aux (t:ctype_t) s =
    38:   let br s = "(" ^ s ^ ")" in
    39:   match t with
    40:   | `Ct_base x ->
    41:     if String.length x = 0
    42:     then s
    43:     else if String.length s = 0 then x
    44:     else x ^ " " ^ s
    45: 
    46:   | `Ct_ptr t -> aux t ("*"^s)
    47:   | `Ct_cptr t -> aux t (" const*"^s)
    48:   | `Ct_vptr t -> aux t (" volatile*"^s)
    49:   | `Ct_cvptr t -> aux t (" const volatile*"^s)
    50: 
    51:   | `Ct_ptm (k,t) -> aux t (k ^ "::*" ^ s)
    52:   | `Ct_cptm (k,t) -> aux t ("const "^ k ^ "::*" ^ s)
    53:   | `Ct_vptm (k,t) -> aux t ("volatile " ^ k ^ "::*"^ s)
    54:   | `Ct_cvptm (k,t) -> aux t ("const volatile " ^ k ^ "::*" ^ s)
    55: 
    56:   | `Ct_array (i,t) -> aux t (br s ^ "["^string_of_int i^"]" )
    57:   | `Ct_varray t -> aux t (br s ^ "[]")
    58:   | `Ct_fun (t,ps) ->
    59:     let args =  plist ps in
    60:     aux t (br s ^ "(" ^ args ^ ")" )
    61: 
    62:   | `Ct_vfun (t,ps) ->
    63:     let args = plist ps ^ ", ..." in
    64:     aux t (br s ^ "(" ^ args ^ ")")
    65: 
    66: let string_of_ctype t = aux t ""
    67: 
    68: let string_of_cdecl_type n t =
    69:   match t with
    70:   | `Cdt_value t -> aux t n
    71:   | `Cdt_const t -> aux t ("const " ^ n)
    72:   | `Cdt_volatile t -> aux t ("volatile " ^n)
    73:   | `Cdt_const_volatile t -> aux t ("const volatile " ^n)
    74:   | `Cdt_ref t -> aux t ("& " ^ n)
    75:   | `Cdt_cref t -> aux t ("const &" ^n)
    76:   | `Cdt_vref t -> aux t ("volatile &"^n)
    77:   | `Cdt_cvref t -> aux t ("const volatile &"^n)
    78: 
End ocaml section to src/flx_ctype.ml[1]
Start ocaml section to src/flx_cexpr.mli[1 /1 ]
     1: # 157 "./lpsrc/flx_ctypes.ipk"
     2: open Flx_ast
     3: open Flx_ctypes
     4: 
     5: val string_of_cexpr : cexpr_t -> string
     6: val sc : prec_t -> cexpr_t -> string
     7: val ce : prec_t -> string -> cexpr_t
     8: 
     9: val ce_atom : string -> cexpr_t
    10: val ce_postfix : string -> cexpr_t -> cexpr_t
    11: val ce_prefix : string -> cexpr_t -> cexpr_t
    12: val ce_infix : string -> cexpr_t -> cexpr_t -> cexpr_t
    13: val ce_call : cexpr_t -> cexpr_t list -> cexpr_t
    14: val ce_array : cexpr_t -> cexpr_t -> cexpr_t
    15: val ce_new : cexpr_t list -> string -> cexpr_t list -> cexpr_t
    16: val ce_cast : string -> cexpr_t -> cexpr_t
    17: val ce_cond : cexpr_t -> cexpr_t -> cexpr_t -> cexpr_t
    18: val ce_expr : prec_t -> string -> cexpr_t
    19: val ce_top : string -> cexpr_t
    20: val ce_dot : cexpr_t -> string -> cexpr_t
    21: val ce_arrow : cexpr_t -> string -> cexpr_t
    22: exception Unknown_prec of prec_t
    23: 
    24: val genprec: string -> prec_t -> string * prec_t
    25: 
End ocaml section to src/flx_cexpr.mli[1]
Start ocaml section to src/flx_cexpr.ml[1 /1 ]
     1: # 183 "./lpsrc/flx_ctypes.ipk"
     2: open Flx_ctypes
     3: exception Unknown_prec of string
     4: 
     5: let iter = List.iter
     6: let map = List.map
     7: let find = Hashtbl.find
     8: let strcat = String.concat
     9: let add = Hashtbl.add
    10: 
    11: let precedence = [
    12: "atom";
    13: "primary";
    14: "postfix";
    15: "unary";
    16: "cast";
    17: "pm";
    18: "mult";
    19: "add";
    20: "shift";
    21: "rel";
    22: "eq";
    23: "band";
    24: "bxor";
    25: "bor";
    26: "and";
    27: "xor";
    28: "or";
    29: "cond";
    30: "assign";
    31: "comma";
    32: "expr"
    33: ]
    34: 
    35: let postfix_cops = [
    36:   "++","postfix";
    37:   "--","postfix";
    38: ]
    39: 
    40: let prefix_cops = [
    41:   "~","primary";
    42:   "+","unary";
    43:   "-","unary";
    44:   "!","unary";
    45:   "&","unary";
    46:   "*","unary";
    47:   "++","unary";
    48:   "--","unary";
    49:   "sizeof","unary";
    50: ]
    51: 
    52: let infix_cops = [
    53:   "+","add";
    54:   "-","add";
    55:   "*","mult";
    56:   "/","mult";
    57:   "%","mult";
    58:   "<<","shift";
    59:   ">>","shift";
    60: 
    61:   "&","band";
    62:   "|","bor";
    63:   "^","bxor";
    64: 
    65:   "&&","and";
    66:   "||","or";
    67: 
    68:   "+=","assign";
    69:   "-=","assign";
    70:   "*=","assign";
    71:   "/=","assign";
    72:   "%=","assign";
    73:   "<<=","assign";
    74:   ">>=","assign";
    75:   "&=","assign";
    76:   "|=","assign";
    77:   "^=","assign";
    78: 
    79:   "<","rel";
    80:   ">","rel";
    81:   ">=","rel";
    82:   "<=","rel";
    83:   "==","eq";
    84:   "!=","eq";
    85: 
    86:   ".","postfix";
    87:   "->","postfix";
    88:   ".*","pm";
    89:   "->*","pm";
    90:   ",","comma";
    91: ]
    92: ;;
    93: 
    94: let remaps = [
    95:   "$1++",("$1:postfix ++ ","postfix");
    96:   "$1--",("$1:postfix -- ","postfix");
    97: 
    98:   "~$1",("~$1:unary","unary");
    99:   "+$1",("+ $1:unary","unary");
   100:   "-$1",("- $1:unary","unary");
   101:   "!$1",("!$1:unary","unary");
   102:   "&$1",("& $1:unary","unary");
   103:   "*$1",("*$1:unary","unary");
   104:   "++$1",("++ $1:unary","unary");
   105:   "--$1",("-- $1:unary","unary");
   106:   "$1+$2",("$1:add + $2:mult","add");
   107:   "$1-$2",("$1:add - $2:mult","add");
   108:   "$1*$2",("$1:mult * $2:pm","mult");
   109:   "$1/$2",("$1:mult / $2:pm","mult");
   110:   "$1%$2",("$1:mult % $2:pm","mult");
   111: 
   112:   "$1<<$2",("$1:shift << $2:band","shift");
   113:   "$1>>$2",("$1:shift >> $2:band","shift");
   114:   "$1&$2",("$1:band & $2:bor","band");
   115:   "$1|$2",("$1:bor | $2:bxor","bor");
   116:   "$1^$2",("$1:bxor ^ $2:and","bxor");
   117:   "$1&&$2",("$1:and &&  $2:or","and");
   118:   "$1||$2",("$1:or || $2:cond","or");
   119: 
   120:   "$1+=$2",("$1:cond += $2:assign","assign");
   121:   "$1-=$2",("$1:cond -= $2:assign","assign");
   122:   "$1*=$2",("$1:cond *= $2:assign","assign");
   123:   "$1/=$2",("$1:cond /= $2:assign","assign");
   124:   "$1%=$2",("$1:cond %= $2:assign","assign");
   125:   "$1<<=$2",("$1:cond <<= $2:assign","assign");
   126:   "$1>>=$2",("$1:cond >>= $2:assign","assign");
   127:   "$1&=$2",("$1:cond &= $2:assign","assign");
   128:   "$1|=$2",("$1:cond |= $2:assign","assign");
   129:   "$1^=$2",("$1:cond ^= $2:assign","assign");
   130: 
   131:   "$1<$2",("$1:rel < $2:shift","rel");
   132:   "$1>$2",("$1:rel > $2:shift","rel");
   133:   "$1>=$2",("$1:rel >= $2:shift","rel");
   134:   "$1<=$2",("$1:rel <= $2:shift","rel");
   135:   "$1==$2",("$1:eq == $2:rel","eq");
   136:   "$1!=$2",("$1:eq != $2:rel","eq");
   137: 
   138:   "$1($2)",("$1:postfix($2:assign)","postfix");
   139:   "$1[$2]",("$1:postfix[$2:expr]","postfix");
   140:   "$1->$2",("$1:postfix->$2:atom","postfix");
   141:   "$1.*$2",("$1:pm.*$2:cast","pm");
   142:   "$1->*$2",("$1:pm->*$2:cast","pm");
   143:   "$1:comma,$2:comma",("$1,$2","comma");
   144: ]
   145: ;;
   146: 
   147: let prec = Hashtbl.create 17
   148: let infix = Hashtbl.create 31
   149: let prefix = Hashtbl.create 17
   150: let postfix = Hashtbl.create 17
   151: let prec_remap = Hashtbl.create 31
   152: let seq = ref 0
   153: ;;
   154: let find_prec p =
   155:   try Hashtbl.find prec p
   156:   with Not_found ->
   157:     raise (Unknown_prec p)
   158: ;;
   159: 
   160: iter (fun x -> add prec x !seq; incr seq; incr seq) precedence;
   161: iter (fun (n,p) -> add infix n (find_prec p)) infix_cops;
   162: iter (fun (n,p) -> add prefix n (find_prec p)) prefix_cops;
   163: iter (fun (n,p) -> add postfix n (find_prec p)) postfix_cops;
   164: iter (fun (k,v) -> add prec_remap k v) remaps
   165: ;;
   166: 
   167: let pr cop =
   168:  match cop with
   169:   | `Ce_atom _ -> 0
   170:   | `Ce_postfix (s,_) -> find postfix s
   171:   | `Ce_prefix (s,_) -> find prefix s
   172:   | `Ce_infix (s,_,_) -> find infix s
   173: 
   174:   | `Ce_call _
   175:   | `Ce_array _ -> find_prec "postfix"
   176: 
   177:   | `Ce_new _ -> find_prec "unary"
   178:   | `Ce_cast _ -> find_prec "cast"
   179:   | `Ce_cond _ -> find_prec "cond"
   180:   | `Ce_expr (p,_) -> find_prec p
   181: 
   182: let commaprec = find_prec "comma"
   183: let rec comma es = "(" ^ strcat ", " (map (cep commaprec) es) ^ ")"
   184: and comma_opt = function | [] -> "" | ps -> comma ps
   185: 
   186: (* we need brackets if the binding looseness is higher
   187: than or equal to the context.
   188: 
   189: But due associativity, (x+y)+z = x+y+z, and we make that
   190: happen by making the context of the LHS subexpression
   191: slightly higher.
   192: *)
   193: and cep cp e =
   194:   let ep = pr e in
   195:   let rce e = cep ep e and lce e = cep (ep+1) e in
   196:   let need_brackets = ep > cp in
   197:   (if need_brackets then "(" else "")
   198:   ^
   199:   begin match e with
   200:     | `Ce_atom s ->  s
   201:     | `Ce_postfix (s,e) -> rce e ^ s
   202:     | `Ce_prefix (s,e) -> s ^ rce e
   203:     | `Ce_infix (s,e1,e2) -> lce e1 ^ s ^ rce e2
   204: 
   205:     | `Ce_call (f,es) -> rce f ^comma es
   206:     | `Ce_array (f,e) -> rce f ^ "["^lce e^"]"
   207:     | `Ce_new (ps,cls,args) ->
   208:       "new" ^ comma_opt ps ^ " " ^ cls ^ " " ^ comma_opt args
   209:     | `Ce_cast (cast,e) -> "("^cast^")" ^ rce e
   210:     | `Ce_cond (e,e1,e2) -> lce e ^ "?" ^ rce e1 ^ ":" ^ rce e2
   211:     | `Ce_expr (_, s) -> s
   212:   end
   213:   ^
   214:   (if need_brackets then ")" else "")
   215: 
   216: let ce_atom s = `Ce_atom s
   217: let ce_postfix o e = `Ce_postfix (o,e)
   218: let ce_prefix o e = `Ce_prefix (o,e)
   219: let ce_infix o a b = `Ce_infix (o,a,b)
   220: let ce_call a b = `Ce_call (a,b)
   221: let ce_array a b = `Ce_array (a,b)
   222: let ce_new p c a = `Ce_new (p,c,a)
   223: let ce_cast s e = `Ce_cast (s,e)
   224: let ce_cond c a b = `Ce_cond (c,a,b)
   225: let ce_expr p s = `Ce_expr (p,s)
   226: let ce_top s = ce_expr "expr" s
   227: let ce_dot e s = ce_infix "." e (ce_atom s)
   228: let ce_arrow e s = ce_infix "->" e (ce_atom s)
   229: 
   230: let string_of_cexpr e = cep 1000 e
   231: let sc p e = cep (find_prec p) e
   232: let ce p s = ce_expr p s
   233: 
   234: let genprec ct prec =
   235:   try Hashtbl.find prec_remap ct
   236:   with Not_found -> ct,prec
   237: 
End ocaml section to src/flx_cexpr.ml[1]