(*
- * Copyright 2010, INRIA, University of Copenhagen
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
* Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
it is used in deciding how much to remove, when two adjacent code tokens are
removed. *)
type 'a mcode =
- 'a * arity * info * mcodekind * meta_pos list ref (* pos, - only *) *
+ 'a * arity * info * mcodekind * anything list ref (* pos, - only *) *
int (* adjacency_index *)
(* int ref is an index *)
and 'a wrap =
expression dots * string mcode (* ) *)
| Assignment of expression * Ast.assignOp mcode * expression *
bool (* true if it can match an initialization *)
+ | Sequence of expression * string mcode (* , *) * expression
| CondExpr of expression * string mcode (* ? *) * expression option *
string mcode (* : *) * expression
| Postfix of expression * Ast.fixOp mcode
TC.typeC list option * Ast.form * pure
| MetaExprList of Ast.meta_name mcode (* only in arg lists *) *
listlen * pure
+ | AsExpr of expression * expression (* as expr, always metavar *)
| EComma of string mcode (* only in arg lists *)
| DisjExpr of string mcode * expression list *
string mcode list (* the |s *) * string mcode
string mcode (* { *) * declaration dots * string mcode (* } *)
| TypeName of string mcode
| MetaType of Ast.meta_name mcode * pure
+ | AsType of typeC * typeC (* as type, always metavar *)
| DisjType of string mcode * typeC list * (* only after iso *)
string mcode list (* the |s *) * string mcode
| OptType of typeC
should be a separate type for fields, as in the C AST *)
| MetaField of Ast.meta_name mcode * pure (* structure fields *)
| MetaFieldList of Ast.meta_name mcode * listlen * pure (* structure fields *)
+ | AsDecl of declaration * declaration
| Init of Ast.storage mcode option * typeC * ident * string mcode (*=*) *
initialiser * string mcode (*;*)
| UnInit of Ast.storage mcode option * typeC * ident * string mcode (* ; *)
| TyDecl of typeC * string mcode (* ; *)
| MacroDecl of ident (* name *) * string mcode (* ( *) *
expression dots * string mcode (* ) *) * string mcode (* ; *)
+ | MacroDeclInit of ident (* name *) * string mcode (* ( *) *
+ expression dots * string mcode (* ) *) * string mcode (*=*) *
+ initialiser * string mcode (* ; *)
| Typedef of string mcode (* typedef *) * typeC * typeC * string mcode (*;*)
| DisjDecl of string mcode * declaration list *
string mcode list (* the |s *) * string mcode
and base_initialiser =
MetaInit of Ast.meta_name mcode * pure
| MetaInitList of Ast.meta_name mcode * listlen * pure
+ | AsInit of initialiser * initialiser (* as init, always metavar *)
| InitExpr of expression
| InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) *
(* true if ordered, as for array, false if unordered, as for struct *)
string mcode (* ; *)
| MetaStmt of Ast.meta_name mcode * pure
| MetaStmtList of Ast.meta_name mcode(*only in statement lists*) * pure
+ | AsStmt of statement * statement (* as statement, always metavar *)
| Exp of expression (* only in dotted statement lists *)
| TopExp of expression (* for macros body *)
| Ty of typeC (* only at top level *)
| IsoWhenTTag of expression
| IsoWhenFTag of expression
| MetaPosTag of meta_pos
+ | HiddenVarTag of anything list (* in iso_compile/pattern only *)
let dotsExpr x = DotsExprTag x
let dotsParam x = DotsParamTag x
(* --------------------------------------------------------------------- *)
+let rec meta_pos_name = function
+ HiddenVarTag(vars) ->
+ (* totally fake, just drop the rest, only for isos *)
+ meta_pos_name (List.hd vars)
+ | MetaPosTag(MetaPos(name,constraints,_)) -> name
+ | ExprTag(e) ->
+ (match unwrap e with
+ MetaExpr(name,constraints,ty,form,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | TypeCTag(t) ->
+ (match unwrap t with
+ MetaType(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | DeclTag(d) ->
+ (match unwrap d with
+ MetaDecl(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | InitTag(i) ->
+ (match unwrap i with
+ MetaInit(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | StmtTag(s) ->
+ (match unwrap s with
+ MetaStmt(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | _ -> failwith "bad metavariable"
+
+(* --------------------------------------------------------------------- *)
+
(* unique indices, for mcode and tree nodes *)
let index_counter = ref 0
let fresh_index _ = let cur = !index_counter in index_counter := cur + 1; cur
"For type checking assuming the name of the metavariable is the name of the type\n";
TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false)))
| _ -> failwith "unexpected enum type name")
- | EnumName(su,None) -> failwith "nameless enum - what to do???"
+ | EnumName(su,None) -> TC.EnumName TC.NoName
| EnumDef(ty,_,_,_) -> ast0_type_to_type ty
| StructUnionName(su,Some tag) ->
(match unwrap tag with
perhaps polymorphism would help? *)
failwith "constraints not supported on struct type name"
| _ -> failwith "unexpected struct/union type name")
- | StructUnionName(su,None) -> failwith "nameless structure - what to do???"
+ | StructUnionName(su,None) -> TC.StructUnionName(structUnion su,TC.NoName)
| StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty
| TypeName(name) -> TC.TypeName(unwrap_mcode name)
| MetaType(name,_) ->
TC.MetaType(unwrap_mcode name,TC.Unitary,false)
+ | AsType(ty,asty) -> failwith "not created yet"
| DisjType(_,types,_,_) ->
Common.pr2_once
"disjtype not supported in smpl type inference, assuming unknown";
HCoop / bpt / coccinelle.git / blobdiff