Add poc files
This commit is contained in:
Joey Yakimowich-Payne
parent
30da2412e3
commit
fa600b98f7
220 changed files with 45679 additions and 0 deletions
227
lang_c/parsing/visitor_c.ml
Normal file
227
lang_c/parsing/visitor_c.ml
Normal file
|
|
@ -0,0 +1,227 @@
|
|||
(* Yoann Padioleau
|
||||
*
|
||||
* Copyright (C) 2014 Facebook
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU General Public License (GPL)
|
||||
* version 2 as published by the Free Software Foundation.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* file license.txt for more details.
|
||||
*)
|
||||
|
||||
open Ocaml
|
||||
open Ast_c
|
||||
|
||||
(*****************************************************************************)
|
||||
(* Prelude *)
|
||||
(*****************************************************************************)
|
||||
|
||||
(*****************************************************************************)
|
||||
(* Types *)
|
||||
(*****************************************************************************)
|
||||
|
||||
(* hooks *)
|
||||
type visitor_in = {
|
||||
kexpr: Ast_c.expr vin;
|
||||
kinfo: Ast_cpp.tok vin;
|
||||
}
|
||||
and visitor_out = any -> unit
|
||||
and 'a vin = ('a -> unit) * visitor_out -> 'a -> unit
|
||||
|
||||
module Ast_cpp = struct
|
||||
let v_assignOp _ = ()
|
||||
let v_fixOp _ = ()
|
||||
let v_unaryOp _ = ()
|
||||
let v_binaryOp _ = ()
|
||||
end
|
||||
|
||||
let default_visitor = {
|
||||
kinfo = (fun (k,_) x -> k x);
|
||||
kexpr = (fun (k,_) x -> k x);
|
||||
}
|
||||
|
||||
let (mk_visitor: visitor_in -> visitor_out) = fun vin ->
|
||||
|
||||
let rec v_info x =
|
||||
let k _ = () in
|
||||
vin.kinfo (k, all_functions) x
|
||||
|
||||
and v_wrap:'a. ('a -> unit) -> 'a wrap -> unit =
|
||||
fun _of_a (v1, v2) ->
|
||||
let v1 = _of_a v1 and v2 = v_info v2 in ()
|
||||
|
||||
and v_name v = v_wrap v_string v
|
||||
|
||||
and v_type_ =
|
||||
function
|
||||
| TBase v1 -> let v1 = v_name v1 in ()
|
||||
| TPointer v1 -> let v1 = v_type_ v1 in ()
|
||||
| TArray ((v1, v2)) ->
|
||||
let v1 = v_option v_const_expr v1 and v2 = v_type_ v2 in ()
|
||||
| TFunction v1 -> let v1 = v_function_type v1 in ()
|
||||
| TStructName ((v1, v2)) ->
|
||||
let v1 = v_struct_kind v1 and v2 = v_name v2 in ()
|
||||
| TEnumName v1 -> let v1 = v_name v1 in ()
|
||||
| TTypeName v1 -> let v1 = v_name v1 in ()
|
||||
|
||||
and v_function_type (v1, v2) =
|
||||
let v1 = v_type_ v1 and v2 = v_list v_parameter v2 in ()
|
||||
and v_parameter { p_type = v_p_type; p_name = v_p_name } =
|
||||
let arg = v_type_ v_p_type in let arg = v_option v_name v_p_name in ()
|
||||
and v_struct_kind = function | Struct -> () | Union -> ()
|
||||
and v_const_expr v = v_expr v
|
||||
and v_expr x =
|
||||
let k x = match x with
|
||||
| Int v1 -> let v1 = v_wrap v_string v1 in ()
|
||||
| Float v1 -> let v1 = v_wrap v_string v1 in ()
|
||||
| String v1 -> let v1 = v_wrap v_string v1 in ()
|
||||
| Char v1 -> let v1 = v_wrap v_string v1 in ()
|
||||
| Id v1 -> let v1 = v_name v1 in ()
|
||||
| Call ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_argument v2 in ()
|
||||
| Assign ((v1, v2, v3)) ->
|
||||
let v1 = v_wrap Ast_cpp.v_assignOp v1
|
||||
and v2 = v_expr v2
|
||||
and v3 = v_expr v3
|
||||
in ()
|
||||
| ArrayAccess ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_expr v2 in ()
|
||||
| RecordPtAccess ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_name v2 in ()
|
||||
| Cast ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in ()
|
||||
| Postfix ((v1, v2)) ->
|
||||
let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_fixOp v2 in ()
|
||||
| Infix ((v1, v2)) ->
|
||||
let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_fixOp v2 in ()
|
||||
| Unary ((v1, v2)) ->
|
||||
let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_unaryOp v2 in ()
|
||||
| Binary ((v1, v2, v3)) ->
|
||||
let v1 = v_expr v1
|
||||
and v2 = v_wrap Ast_cpp.v_binaryOp v2
|
||||
and v3 = v_expr v3
|
||||
in ()
|
||||
| CondExpr ((v1, v2, v3)) ->
|
||||
let v1 = v_expr v1 and v2 = v_expr v2 and v3 = v_expr v3 in ()
|
||||
| Sequence ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_expr v2 in ()
|
||||
| SizeOf v1 -> let v1 = Ocaml.v_either v_expr v_type_ v1 in ()
|
||||
| ArrayInit v1 ->
|
||||
let v1 =
|
||||
v_list
|
||||
(fun (v1, v2) ->
|
||||
let v1 = v_option v_expr v1 and v2 = v_expr v2 in ())
|
||||
v1
|
||||
in ()
|
||||
| RecordInit v1 ->
|
||||
let v1 =
|
||||
v_list (fun (v1, v2) -> let v1 = v_name v1 and v2 = v_expr v2 in ())
|
||||
v1
|
||||
in ()
|
||||
| GccConstructor ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in ()
|
||||
in
|
||||
vin.kexpr (k, all_functions) x
|
||||
and v_argument v = v_expr v
|
||||
|
||||
and v_stmt =
|
||||
function
|
||||
| ExprSt v1 -> let v1 = v_expr v1 in ()
|
||||
| Block v1 -> let v1 = v_list v_stmt v1 in ()
|
||||
| If ((v1, v2, v3)) ->
|
||||
let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in ()
|
||||
| Switch ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_case v2 in ()
|
||||
| While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in ()
|
||||
| DoWhile ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in ()
|
||||
| For ((v1, v2, v3, v4)) ->
|
||||
let v1 = v_option v_expr v1
|
||||
and v2 = v_option v_expr v2
|
||||
and v3 = v_option v_expr v3
|
||||
and v4 = v_stmt v4
|
||||
in ()
|
||||
| Return v1 -> let v1 = v_option v_expr v1 in ()
|
||||
| Continue -> ()
|
||||
| Break -> ()
|
||||
| Label ((v1, v2)) -> let v1 = v_name v1 and v2 = v_stmt v2 in ()
|
||||
| Goto v1 -> let v1 = v_name v1 in ()
|
||||
| Vars v1 -> let v1 = v_list v_var_decl v1 in ()
|
||||
| Asm v1 -> let v1 = v_list v_expr v1 in ()
|
||||
|
||||
and v_case =
|
||||
function
|
||||
| Case ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_stmt v2 in ()
|
||||
| Default v1 -> let v1 = v_list v_stmt v1 in ()
|
||||
and
|
||||
v_var_decl {
|
||||
v_name = v_v_name;
|
||||
v_type = v_v_type;
|
||||
v_storage = v_v_storage;
|
||||
v_init = v_v_init
|
||||
} =
|
||||
let arg = v_name v_v_name in
|
||||
let arg = v_type_ v_v_type in
|
||||
let arg = v_storage v_v_storage in
|
||||
let arg = v_option v_initialiser v_v_init in ()
|
||||
and v_initialiser v = v_expr v
|
||||
and v_storage = function | Extern -> () | Static -> () | DefaultStorage -> ()
|
||||
|
||||
and v_struct_def { s_name = v_s_name; s_kind = v_s_kind; s_flds = v_s_flds } =
|
||||
let arg = v_name v_s_name in
|
||||
let arg = v_struct_kind v_s_kind in
|
||||
let arg = v_list v_field_def v_s_flds in ()
|
||||
|
||||
and v_field_def { fld_name = v_fld_name; fld_type = v_fld_type } =
|
||||
let arg = v_option v_name v_fld_name in let arg = v_type_ v_fld_type in ()
|
||||
|
||||
and v_func_def {
|
||||
f_name = v_f_name;
|
||||
f_type = v_f_type;
|
||||
f_body = v_f_body;
|
||||
f_static = v_f_static
|
||||
} =
|
||||
let arg = v_name v_f_name in
|
||||
let arg = v_function_type v_f_type in
|
||||
let arg = v_list v_stmt v_f_body in let arg = v_bool v_f_static in ()
|
||||
|
||||
and v_define_body =
|
||||
function
|
||||
| CppExpr v1 -> let v1 = v_expr v1 in ()
|
||||
| CppStmt v1 -> let v1 = v_stmt v1 in ()
|
||||
|
||||
and v_toplevel =
|
||||
function
|
||||
| Include v1 -> let v1 = v_wrap v_string v1 in ()
|
||||
| Define ((v1, v2)) -> let v1 = v_name v1 and v2 = v_define_body v2 in ()
|
||||
| Macro ((v1, v2, v3)) ->
|
||||
let v1 = v_name v1
|
||||
and v2 = v_list v_name v2
|
||||
and v3 = v_define_body v3
|
||||
in ()
|
||||
| StructDef v1 -> let v1 = v_struct_def v1 in ()
|
||||
| TypeDef v1 -> let v1 = v_type_def v1 in ()
|
||||
| EnumDef v1 -> let v1 = v_enum_def v1 in ()
|
||||
| FuncDef v1 -> let v1 = v_func_def v1 in ()
|
||||
| Global v1 -> let v1 = v_var_decl v1 in ()
|
||||
| Prototype v1 -> let v1 = v_func_def v1 in ()
|
||||
|
||||
and v_type_def (v1, v2) = let v1 = v_name v1 and v2 = v_type_ v2 in ()
|
||||
|
||||
and v_enum_def (v1, v2) =
|
||||
let v1 = v_name v1
|
||||
and v2 =
|
||||
v_list
|
||||
(fun (v1, v2) -> let v1 = v_name v1 and v2 = v_option v_expr v2 in ())
|
||||
v2
|
||||
in ()
|
||||
|
||||
and v_any =
|
||||
function
|
||||
| Expr v1 -> let v1 = v_expr v1 in ()
|
||||
| Stmt v1 -> let v1 = v_stmt v1 in ()
|
||||
| Type v1 -> let v1 = v_type_ v1 in ()
|
||||
| Toplevel v1 -> let v1 = v_toplevel v1 in ()
|
||||
| Program v1 -> let v1 = v_program v1 in ()
|
||||
|
||||
and v_program v = v_list v_toplevel v
|
||||
|
||||
and all_functions x = v_any x
|
||||
in
|
||||
v_any
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue