(* Modified code *)
type info = { line : int; column : int;
- strbef : string list; straft : string list }
+ strbef : (string * int (* line *) * int (* col *)) list;
+ straft : (string * int (* line *) * int (* col *)) list }
type line = int
type meta_name = string * string
(* need to be careful about rewrapping, to avoid duplicating pos info
node_line : line;
free_vars : meta_name list; (*free vars*)
minus_free_vars : meta_name list; (*minus free vars*)
- fresh_vars : meta_name list; (*fresh vars*)
+ fresh_vars : (meta_name * string (*seed*) option) list; (*fresh vars*)
inherited : meta_name list; (*inherited vars*)
saved_witness : meta_name list; (*witness vars*)
bef_aft : dots_bef_aft;
and 'a mcode = 'a * info * mcodekind * meta_pos (* pos variable *)
(* pos is an offset indicating where in the C code the mcodekind has an
effect *)
+(* int list is the match instances, which are only meaningful in annotated
+C code *)
+(* int is the adjacency index, which is incremented on context dots *)
and mcodekind =
- MINUS of pos * anything list list
+ MINUS of pos * int list * int * anything list list
| CONTEXT of pos * anything befaft
| PLUS
and fixpos =
and multi = bool (*true if a nest is one or more, false if it is zero or more*)
and end_info =
- meta_name list (*free vars*) * meta_name list (*inherited vars*) *
- meta_name list (*witness vars*) * mcodekind
+ meta_name list (*free vars*) * (meta_name * string option) list (*fresh*) *
+ meta_name list (*inherited vars*) * mcodekind
(* --------------------------------------------------------------------- *)
(* Metavariables *)
and metavar =
MetaIdDecl of arity * meta_name (* name *)
- | MetaFreshIdDecl of arity * meta_name (* name *)
+ | MetaFreshIdDecl of meta_name (* name *) * string option (* seed *)
| MetaTypeDecl of arity * meta_name (* name *)
| MetaInitDecl of arity * meta_name (* name *)
| MetaListlenDecl of meta_name (* name *)
| StructUnionName of structUnion mcode * ident option (* name *)
| StructUnionDef of fullType (* either StructUnionName or metavar *) *
string mcode (* { *) * declaration dots * string mcode (* } *)
- | TypeName of string mcode
+ | TypeName of string mcode (* pad: should be 'of ident' ? *)
| MetaType of meta_name mcode * keep_binding * inherited
and rule_elem = base_rule_elem wrap
and base_statement =
- Seq of rule_elem (* { *) * statement dots *
+ Seq of rule_elem (* { *) *
statement dots * rule_elem (* } *)
| IfThen of rule_elem (* header *) * statement * end_info (* endif *)
| IfThenElse of rule_elem (* header *) * statement *
(statement dots,statement) whencode list * multi *
dots_whencode list * dots_whencode list
| FunDecl of rule_elem (* header *) * rule_elem (* { *) *
- statement dots * statement dots * rule_elem (* } *)
+ statement dots * rule_elem (* } *)
| Define of rule_elem (* header *) * statement dots
| Dots of string mcode (* ... *) *
(statement dots,statement) whencode list *
| GeneratedRulename of string option * dependency *
string list * string list * exists * bool
| ScriptRulename of string * dependency
+ | InitialScriptRulename of string
+ | FinalScriptRulename of string
and ruletype = Normal | Generated
(dependency * string list (* dropped isos *) * exists) * top_level list
* bool list * ruletype
| ScriptRule of string * dependency * (string * meta_name) list * string
+ | InitialScriptRule of string (*language*) * string (*code*)
+ | FinalScriptRule of string (*language*) * string (*code*)
and dependency =
Dep of string (* rule applies for the current binding *)
| CaseLineTag of case_line
| ConstVolTag of const_vol
| Token of string * info option
+ | Pragma of string list
| Code of top_level
| ExprDotsTag of expression dots
| ParamDotsTag of parameterTypeDef dots
let get_mcodekind (_,_,x,_) = x
let get_line x = x.node_line
let get_mcode_line (_,l,_,_) = l.line
+let get_mcode_col (_,l,_,_) = l.column
let get_fvs x = x.free_vars
let set_fvs fvs x = {x with free_vars = fvs}
let get_mfvs x = x.minus_free_vars
let get_meta_name = function
MetaIdDecl(ar,nm) -> nm
- | MetaFreshIdDecl(ar,nm) -> nm
+ | MetaFreshIdDecl(nm,seed) -> nm
| MetaTypeDecl(ar,nm) -> nm
| MetaInitDecl(ar,nm) -> nm
| MetaListlenDecl(nm) -> nm
(* --------------------------------------------------------------------- *)
-let no_info = { line = 0; column = 0; strbef = []; straft = [] }
+and tag2c = function
+ FullTypeTag _ -> "FullTypeTag"
+ | BaseTypeTag _ -> "BaseTypeTag"
+ | StructUnionTag _ -> "StructUnionTag"
+ | SignTag _ -> "SignTag"
+ | IdentTag _ -> "IdentTag"
+ | ExpressionTag _ -> "ExpressionTag"
+ | ConstantTag _ -> "ConstantTag"
+ | UnaryOpTag _ -> "UnaryOpTag"
+ | AssignOpTag _ -> "AssignOpTag"
+ | FixOpTag _ -> "FixOpTag"
+ | BinaryOpTag _ -> "BinaryOpTag"
+ | ArithOpTag _ -> "ArithOpTag"
+ | LogicalOpTag _ -> "LogicalOpTag"
+ | DeclarationTag _ -> "DeclarationTag"
+ | InitTag _ -> "InitTag"
+ | StorageTag _ -> "StorageTag"
+ | IncFileTag _ -> "IncFileTag"
+ | Rule_elemTag _ -> "Rule_elemTag"
+ | StatementTag _ -> "StatementTag"
+ | CaseLineTag _ -> "CaseLineTag"
+ | ConstVolTag _ -> "ConstVolTag"
+ | Token _ -> "Token"
+ | Pragma _ -> "Pragma"
+ | Code _ -> "Code"
+ | ExprDotsTag _ -> "ExprDotsTag"
+ | ParamDotsTag _ -> "ParamDotsTag"
+ | StmtDotsTag _ -> "StmtDotsTag"
+ | DeclDotsTag _ -> "DeclDotsTag"
+ | TypeCTag _ -> "TypeCTag"
+ | ParamTag _ -> "ParamTag"
+ | SgrepStartTag _ -> "SgrepStartTag"
+ | SgrepEndTag _ -> "SgrepEndTag"
+
+(* --------------------------------------------------------------------- *)
+
+let no_info = { line = 0; column = -1; strbef = []; straft = [] }
let make_term x =
{node = x;