diff --git a/src/classes/dune b/src/classes/dune index 9f446742a..3a8fb3ebc 100644 --- a/src/classes/dune +++ b/src/classes/dune @@ -11,6 +11,7 @@ ; Smtlib2 & versions dolmen_smtlib2 dolmen_smtlib2_poly + dolmen_smtlib2_mcil dolmen_smtlib2_v6 dolmen_smtlib2_v6_script dolmen_smtlib2_v6_response ; TPTP & versions dolmen_tptp dolmen_tptp_v6_3_0 diff --git a/src/classes/logic.ml b/src/classes/logic.ml index 2c833e3c2..602c7d4c6 100644 --- a/src/classes/logic.ml +++ b/src/classes/logic.ml @@ -79,6 +79,7 @@ module Make "smt2", Smtlib2 `Latest; "smt2.6", Smtlib2 `V2_6; "psmt2", Smtlib2 `Poly; + "mcil", Smtlib2 `MCIL; "tptp", Tptp `Latest; "tptp-6.3.0", Tptp `V6_3_0; "zf", Zf; @@ -108,6 +109,8 @@ module Make (module Dolmen_smtlib2.Script.V2_6.Make(L)(I)(T)(S) : S); Smtlib2 `Poly, ".psmt2", (module Dolmen_smtlib2.Script.Poly.Make(L)(I)(T)(S) : S); + Smtlib2 `MCIL, ".mcil", + (module Dolmen_smtlib2.Script.MCIL.Make(L)(I)(T)(S) : S); (* TPTP *) Tptp `Latest, ".p", diff --git a/src/interface/stmt.ml b/src/interface/stmt.ml index a00fae9aa..cb06a829a 100644 --- a/src/interface/stmt.ml +++ b/src/interface/stmt.ml @@ -207,6 +207,20 @@ module type Logic = sig i.e f is a function symbol with arguments [args], and which returns the value [body] which is of type [ret]. *) + val sys_def : + ?loc:location -> id -> + input:term list -> output:term list -> local:term list -> + subs:(id * term * location) list -> + init:term -> trans:term -> inv:term -> t + (** Defines a new transition system. *) + + val sys_check : ?loc:location -> term -> + input:term list -> output:term list -> local:term list -> + assumption:(id * term * location) list -> + reachable:(id * term * location) list -> + queries:(id * term list * location) list -> t + (** Check the existence of a trace in a transition system **) + val funs_def_rec : ?loc:location -> (id * term list * term list * term * term) list -> t (** Define a list of mutually recursive functions. Each function has the same definition as in [fun_def] *) diff --git a/src/languages/smtlib2/dolmen_smtlib2.ml b/src/languages/smtlib2/dolmen_smtlib2.ml index 1229a17da..13f06c068 100644 --- a/src/languages/smtlib2/dolmen_smtlib2.ml +++ b/src/languages/smtlib2/dolmen_smtlib2.ml @@ -22,11 +22,13 @@ module Script = struct | `Latest | `V2_6 | `Poly + | `MCIL ] (* Alias the sub-libraries *) module V2_6 = Dolmen_smtlib2_v6.Script module Poly = Dolmen_smtlib2_poly + module MCIL = Dolmen_smtlib2_mcil (* Alias for the latest module *) module Latest = V2_6 diff --git a/src/languages/smtlib2/dune b/src/languages/smtlib2/dune index edd906c61..813cb475d 100644 --- a/src/languages/smtlib2/dune +++ b/src/languages/smtlib2/dune @@ -3,5 +3,5 @@ (name dolmen_smtlib2) (public_name dolmen.smtlib2) (modules Dolmen_smtlib2) - (libraries dolmen_smtlib2_v6 dolmen_smtlib2_poly) + (libraries dolmen_smtlib2_v6 dolmen_smtlib2_poly dolmen_smtlib2_mcil) ) diff --git a/src/languages/smtlib2/mcil/ast.ml b/src/languages/smtlib2/mcil/ast.ml new file mode 100644 index 000000000..25b1f30a1 --- /dev/null +++ b/src/languages/smtlib2/mcil/ast.ml @@ -0,0 +1,263 @@ + +(* This file is free software, part of dolmen. See file "LICENSE" for more information. *) + +(** AST requirement for the Smtlib format. + The smtlib format is widely used among SMT solvers, and is the language + of the smtlib benchmark library. Terms are expressed as s-expressions, + and top-level directives include everything needed to use a prover + in an interactive loop (so it includes directive for getting and setting options, + getting information about the solver's internal model, etc...) *) + +module type Id = sig + + type t + (** The type of identifiers *) + + type namespace + (** Namespace for identifiers *) + + val sort : namespace + val term : namespace + val attr : namespace + (** The namespace for sorts (also called typee), terms + and attributes, respectively. *) + + val mk : namespace -> string -> t + (** Make an identifier from a name and namespace. *) + + val indexed : namespace -> string -> string list -> t + (** Create an indexed identifier. *) + +end + +module type Term = sig + + type t + (** The type of terms. *) + + type id + (** The type of identifiers for constants. *) + + type location + (** The type of locations. *) + + val const : ?loc:location -> id -> t + (** Constants, i.e non predefined symbols. This includes both constants + defined by theories, defined locally in a problem, and also quantified variables. *) + + val str : ?loc:location -> string -> t + (** Quoted strings. According to the smtlib manual, these can be interpreted as + either string literals (when the String theory is used), or simply constants *) + + val int : ?loc:location -> string -> t + val real : ?loc:location -> string -> t + val hexa : ?loc:location -> string -> t + val binary : ?loc:location -> string -> t + (** Constants lexically recognised as numbers in different formats. According to the smtlib + manual, these should not always be interpreted as numbers since their interpretation + is actually dependent on the theory set by the problem. *) + + val colon : ?loc:location -> t -> t -> t + (** Juxtaposition of terms, used to annotate terms with their type. *) + + val apply : ?loc:location -> t -> t list -> t + (** Application. *) + + val letand : ?loc:location -> t list -> t -> t + (** Local parrallel bindings. The bindings are a list of terms built using + the [colon] function. *) + + val forall : ?loc:location -> t list -> t -> t + (** Universal quantification. *) + + val exists : ?loc:location -> t list -> t -> t + (** Existencial quantification. *) + + val match_ : ?loc:location -> t -> (t * t) list -> t + (** Pattern matching. The first term is the term to match, + and each tuple in the list is a match case, which is a pair + of a pattern and a match branch. *) + + val sexpr : ?loc:location -> t list -> t + (** S-expressions. Used in smtlib's annotations, *) + + val annot : ?loc:location -> t -> t list -> t + (** Attach a list of attributes (also called annotations) to a term. As written + in the smtlib manual, "Term attributes have no logical meaning -- + semantically, [attr t l] is equivalent to [t]" *) + +end +(** Implementation requirements for Smtlib terms. *) + +module type Statement = sig + + type t + (** The type of statements. *) + + type id + (** The type of identifiers. *) + + type term + (** The type of terms. *) + + type location + (** The type of locations. *) + + (** (Re)starting and terminating *) + + val reset : ?loc:location -> unit -> t + (** Full reset of the prover state. *) + + val set_logic : ?loc:location -> string -> t + (** Set the problem logic. *) + + val set_option : ?loc:location -> term -> t + (** Set the value of a prover option. *) + + val exit : ?loc:location -> unit -> t + (** Exit the interactive loop. *) + + + (** Modifying the assertion stack *) + + val push : ?loc:location -> int -> t + (** Push the given number of new level on the stack of assertions. *) + + val pop : ?loc:location -> int -> t + (** Pop the given number of level on the stack of assertions. *) + + val reset_assertions : ?loc:location -> unit -> t + (** Reset assumed assertions. *) + + + (** Introducing new symbols *) + + val type_decl : ?loc:location -> id -> int -> t + (** Declares a new type constructor with given arity. *) + + val type_def : ?loc:location -> id -> id list -> term -> t + (** Defines an alias for types. [type_def f args body] is such that + later occurences of [f] applied to a list of arguments [l] should + be replaced by [body] where the [args] have been substituted by + their value in [l]. *) + + val datatypes : ?loc:location -> (id * term list * (id * term list) list) list -> t + (** Inductive type definitions. *) + + val fun_decl : ?loc:location -> id -> term list -> term list -> term -> t + (** Declares a new term symbol, and its type. [fun_decl f args ret] + declares [f] as a new function symbol which takes arguments of types + described in [args], and with return type [ret]. *) + + val fun_def : ?loc:location -> id -> term list -> term list -> term -> term -> t + (** Defines a new function. [fun_def f args ret body] is such that + applications of [f] are equal to [body] (module substitution of the arguments), + which should be of type [ret]. *) + + val funs_def_rec : ?loc:location -> (id * term list * term list * term * term) list -> t + (** Declare a list of mutually recursive functions. *) + + val sys_def : + ?loc:location -> id -> + input:term list -> output:term list -> local:term list -> + subs:(id * term * location) list -> + init:term -> trans:term -> inv:term -> t + (** Defines a new transition system. *) + + + (** Asserting and inspecting formulas *) + + val assert_ : ?loc:location -> term -> t + (** Add a proposition to the current set of assertions. *) + + val get_assertions : ?loc:location -> unit -> t + (** Return the current set of assertions. *) + + (** Checking for satisfiablity *) + + val check_sat : ?loc:location -> term list -> t + (** Solve the current set of assertions for satisfiability, + under the local assumptions specified. *) + + val sys_check : ?loc:location -> term -> + input:term list -> output:term list -> local:term list -> + assumption:(id * term * location) list -> + reachable:(id * term * location) list -> + queries:(id * term list * location) list -> t + (** Check the existence of a trace in a transition system **) + + + (** Models *) + + val get_model : ?loc:location -> unit -> t + (** Return the model found. *) + + val get_value : ?loc:location -> term list -> t + (** Return the value of the given terms in the current model of the solver. *) + + val get_assignment : ?loc:location -> unit -> t + (** Return the values of asserted propositions which have been labelled using + the ":named" attribute. *) + + (** Proofs *) + + val get_proof : ?loc:location -> unit -> t + (** Return the proof of the lastest [check_sat] if it returned unsat, else + is undefined. *) + + val get_unsat_core : ?loc:location -> unit -> t + (** Return the unsat core of the latest [check_sat] if it returned unsat, + else is undefined. *) + + val get_unsat_assumptions : ?loc:location -> unit -> t + (** Return a list of local assumptions (as givne in {!check_sat}, + that is enough to deduce unsat. *) + + (** Inspecting settings *) + + val get_info : ?loc:location -> string -> t + (** Get information (see smtlib manual). *) + + val get_option : ?loc:location -> string -> t + (** Get the value of a prover option. *) + + (** Scripts commands *) + + val echo : ?loc:location -> string -> t + (** Print back as-is, including the double quotes. *) + + val set_info : ?loc:location -> term -> t + (** Set information (see smtlib manual). *) + +end +(** implementation requirement for smtlib statements. *) + + +module View = struct + + module type Ty = sig + + type t + + type view + + val view : t -> view + + end + + module type Term = sig + + type t + + type ty + + type view + + val ty : t -> ty + + val view : t -> view + + end + +end + diff --git a/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.ml b/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.ml new file mode 100644 index 000000000..2af60cf18 --- /dev/null +++ b/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.ml @@ -0,0 +1,19 @@ + +(* This file is free software, part of dolmen. See file "LICENSE" for more information *) + +module type Id = Ast.Id +module type Term = Ast.Term +module type Statement = Ast.Statement + +module Make + (L : Dolmen_intf.Location.S) + (I : Id) + (T : Term with type location := L.t and type id := I.t) + (S : Statement with type location := L.t and type id := I.t and type term := T.t) = + Dolmen_std.Transformer.Make(L)(struct + type token = Tokens.token + type statement = S.t + let env = [] + let incremental = true + let error s = Syntax_messages.message s + end)(Lexer)(Parser.Make(L)(I)(T)(S)) diff --git a/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.mli b/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.mli new file mode 100644 index 000000000..4ed8d336d --- /dev/null +++ b/src/languages/smtlib2/mcil/dolmen_smtlib2_mcil.mli @@ -0,0 +1,17 @@ + +(* This file is free software, part of dolmen. See file "LICENSE" for more information *) + +(** Smtlib language input *) + +module type Id = Ast.Id +module type Term = Ast.Term +module type Statement = Ast.Statement +(** Implementation requirement for the Smtlib format. *) + +module Make + (L : Dolmen_intf.Location.S) + (I : Id) + (T : Term with type location := L.t and type id := I.t) + (S : Statement with type location := L.t and type id := I.t and type term := T.t) : + Dolmen_intf.Language.S with type statement = S.t and type file := L.file +(** Functor to generate a parser for the Smtlib format. *) diff --git a/src/languages/smtlib2/mcil/dune b/src/languages/smtlib2/mcil/dune new file mode 100644 index 000000000..5a874ae4f --- /dev/null +++ b/src/languages/smtlib2/mcil/dune @@ -0,0 +1,12 @@ + +; Language library definition +(library + (name dolmen_smtlib2_mcil) + (public_name dolmen.smtlib2.mcil) + (instrumentation (backend bisect_ppx)) + (libraries dolmen_std dolmen_intf menhirLib) + (modules Dolmen_smtlib2_mcil Tokens Lexer Parser Ast Syntax_messages) +) + +; Common include +(include ../../dune.common) diff --git a/src/languages/smtlib2/mcil/lexer.mll b/src/languages/smtlib2/mcil/lexer.mll new file mode 100644 index 000000000..d8def4284 --- /dev/null +++ b/src/languages/smtlib2/mcil/lexer.mll @@ -0,0 +1,225 @@ + +(* This file is free software, part of dolmen. See file "LICENSE" for more information. *) + +(** {1 Smtlib Lexer} *) + +{ + exception Error + + module T = Dolmen_std.Tok + module M = Map.Make(String) + + open Tokens + + (* Token printing *) + + let keyword_descr s = + T.descr s ~kind:"keyword" + + let reserved_descr s = + T.descr s ~kind:"reserved word" + + let descr token : T.descr = + match (token : token) with + | EOF -> T.descr ~kind:"end of file token" "" + | OPEN -> T.descr ~article:"an" ~kind:"opening parenthesis" "" + | CLOSE -> T.descr ~article:"a" ~kind:"closing parenthesis" "" + | NUM s -> T.descr ~kind:"integer" s + | DEC s -> T.descr ~kind:"decimal" s + | HEX s -> T.descr ~kind:"hexadecimal" s + | BIN s -> T.descr ~kind:"binary" s + | STR s -> T.descr ~kind:"string" s + | SYMBOL s -> T.descr ~kind:"symbol" s + | KEYWORD s -> keyword_descr s + | UNDERSCORE -> reserved_descr "_" + | ATTRIBUTE -> reserved_descr "!" + | AS -> reserved_descr "as" + | LET -> reserved_descr "let" + | EXISTS -> reserved_descr "exists" + | FORALL -> reserved_descr "forall" + | MATCH -> reserved_descr "match" + | PAR -> reserved_descr "par" + | ASSERT -> reserved_descr "assert" + | CHECK_SAT -> reserved_descr "check-sat" + | CHECK_SAT_ASSUMING -> reserved_descr "check-sat-assuming" + | DECLARE_CONST -> reserved_descr "declare-const" + | DECLARE_DATATYPE -> reserved_descr "declare-datatype" + | DECLARE_DATATYPES -> reserved_descr "declare-datatypes" + | DECLARE_FUN -> reserved_descr "declare-fun" + | DECLARE_SORT -> reserved_descr "declare-sort" + | DEFINE_FUN -> reserved_descr "define-fun" + | DEFINE_FUN_REC -> reserved_descr "define-fun-rec" + | DEFINE_FUNS_REC -> reserved_descr "define-funs-rec" + | DEFINE_SYS -> reserved_descr "define-system" + | DECLARE_ENUM_SORT -> reserved_descr "declare-enum-sort" + | CHECK_SYS -> reserved_descr "check-system" + | DEFINE_SORT -> reserved_descr "define-sort" + | ECHO -> reserved_descr "echo" + | EXIT -> reserved_descr "exit" + | GET_ASSERTIONS -> reserved_descr "get-assertions" + | GET_ASSIGNMENT -> reserved_descr "gert-assignment" + | GET_INFO -> reserved_descr "get-info" + | GET_MODEL -> reserved_descr "get-model" + | GET_OPTION -> reserved_descr "get-option" + | GET_PROOF -> reserved_descr "get-proof" + | GET_UNSAT_ASSUMPTIONS -> reserved_descr "get-unsat-assumptions" + | GET_UNSAT_CORE -> reserved_descr "get-unsat-core" + | GET_VALUE -> reserved_descr "get-value" + | POP -> reserved_descr "pop" + | PUSH -> reserved_descr "push" + | RESET -> reserved_descr "reset" + | RESET_ASSERTIONS -> reserved_descr "reset-assertions" + | SET_INFO -> reserved_descr "set-info" + | SET_LOGIC -> reserved_descr "set-logic" + | SET_OPTION -> reserved_descr "set-option" + | SYS_INPUT -> reserved_descr ":input" + | SYS_OUTPUT -> reserved_descr ":output" + | SYS_LOCAL -> reserved_descr ":local" + | SYS_SUBSYS -> reserved_descr ":subsys" + | SYS_INIT -> reserved_descr ":init" + | SYS_TRANS -> reserved_descr ":trans" + | SYS_INV -> reserved_descr ":inv" + | CHECK_REACH -> reserved_descr ":reachable" + | CHECK_ASSUMPTION -> reserved_descr ":assumption" + | CHECK_QUERY -> reserved_descr ":query" + | CHECK_QUERIES -> reserved_descr ":queries" + + (* Token parsing *) + + let bind map (x, v) = M.add x v map + + let reserved_words = + List.fold_left bind M.empty [ + (* reserved words *) + (* These are currently unused in smtlib scripts commands + * (they are only used in logic definitions), hence they are currently + * ignored, given that only scripts are currently parsed. + "BINARY", BINARY; + "DECIMAL", DECIMAL; + "HEXADECIMAL", HEXADECIMAL; + "NUMERAL", NUMERAL; + "STRING", STRING; + *) + "_", UNDERSCORE; + "!", ATTRIBUTE; + "as", AS; + "let", LET; + "exists", EXISTS; + "forall", FORALL; + "match", MATCH; + "par", PAR; + (* command names *) + "assert", ASSERT; + "check-sat", CHECK_SAT; + "check-sat-assuming", CHECK_SAT_ASSUMING; + "declare-const", DECLARE_CONST; + "declare-datatype", DECLARE_DATATYPE; + "declare-datatypes", DECLARE_DATATYPES; + "declare-fun", DECLARE_FUN; + "declare-sort", DECLARE_SORT; + "define-fun", DEFINE_FUN; + "define-fun-rec", DEFINE_FUN_REC; + "define-funs-rec", DEFINE_FUNS_REC; + "define-system", DEFINE_SYS; + "declare-enum-sort", DECLARE_ENUM_SORT; + "check-system", CHECK_SYS; + "define-sort", DEFINE_SORT; + "echo", ECHO; + "exit", EXIT; + "get-assertions", GET_ASSERTIONS; + "get-assignment", GET_ASSIGNMENT; + "get-info", GET_INFO; + "get-model", GET_MODEL; + "get-option", GET_OPTION; + "get-proof", GET_PROOF; + "get-unsat-assumptions", GET_UNSAT_ASSUMPTIONS; + "get-unsat-core", GET_UNSAT_CORE; + "get-value", GET_VALUE; + "pop", POP; + "push", PUSH; + "reset", RESET; + "reset-assertions", RESET_ASSERTIONS; + "set-info", SET_INFO; + "set-logic", SET_LOGIC; + "set-option", SET_OPTION; + ] + + let symbol newline lexbuf s = + (* register the newlines in quoted symbols to maintain correct locations.*) + for i = 0 to (String.length s - 1) do + match s.[i] with + | '\n' -> newline lexbuf + | _ -> () + done; + (* Check whether the symbol is a reserved word. *) + try M.find s reserved_words + with Not_found -> SYMBOL s + +} + +let white_space_char = ['\t' '\n' '\r' ' '] +let printable_char = [' ' - '~' '\128' - '\255'] +let white_space_or_printable = ['\t' '\n' '\r' ' ' - '~' '\128' - '\255'] +let digit = ['0' - '9'] +let letter = ['A' - 'Z' 'a' - 'z'] + +let numeral = '0' | (['1' - '9'] digit*) +let decimal = numeral '.' '0'* numeral + +let hex = ['0' - '9'] | ['A' - 'F'] | ['a' - 'f'] +let hexadecimal = "#x" hex+ + +let bin = ['0' '1'] +let binary = "#b" bin+ + +let ss_first_char = + letter | ['+' '-' '/' '*' '=' '%' '?' '!' '.' '$' '_' '~' '&' '^' '<' '>' '@'] +let ss_char = ss_first_char | digit +let ss_last_char = ss_first_char | digit | ['''] +let simple_symbol = ss_first_char ss_char* ss_last_char? + +let quoted_symbol_char = (white_space_or_printable # ['|' '\\']) + +let keyword = ':' simple_symbol + +let comment = ';' (white_space_or_printable # ['\r' '\n'])* + +rule token newline = parse + (* Whitespace, newlines and comments *) + | eof { EOF } + | [' ' '\t' '\r']+ { token newline lexbuf } + | '\n' { newline lexbuf; token newline lexbuf } + | comment { token newline lexbuf } + + (* SMTLIB tokens *) + | '(' { OPEN } + | ')' { CLOSE } + | numeral as s { NUM s } + | decimal as s { DEC s } + | hexadecimal as s { HEX s } + | binary as s { BIN s } + | '"' { string newline (Buffer.create 42) lexbuf } + | ":input" { SYS_INPUT } + | ":output" { SYS_OUTPUT } + | ":local" { SYS_LOCAL } + | ":subsys" { SYS_SUBSYS } + | ":init" { SYS_INIT } + | ":trans" { SYS_TRANS } + | ":inv" { SYS_INV } + | ":reachable" { CHECK_REACH } + | ":assumption" { CHECK_ASSUMPTION } + | ":query" { CHECK_QUERY } + | ":queries" { CHECK_QUERIES } + + | keyword as s { KEYWORD s } + | simple_symbol as s + | '|' (quoted_symbol_char* as s) '|' + { symbol newline lexbuf s } + +and string newline b = parse + | '"' '"' { Buffer.add_char b '"'; string newline b lexbuf } + | '"' { STR (Buffer.contents b) } + | (printable_char | white_space_char) as c + { if c = '\n' then newline lexbuf; + Buffer.add_char b c; string newline b lexbuf } + diff --git a/src/languages/smtlib2/mcil/parser.mly b/src/languages/smtlib2/mcil/parser.mly new file mode 100644 index 000000000..ade5bba27 --- /dev/null +++ b/src/languages/smtlib2/mcil/parser.mly @@ -0,0 +1,694 @@ + +(* This file is free software, part of dolmem. See file "LICENSE" for more information *) + +%parameter +%parameter +%parameter +%parameter + +%start term +%start file +%start input + +%{ + + let pp_num_list fmt (l, singular, plural) = + let n = List.length l in + Format.fprintf fmt "%d %s" n (if n = 1 then singular else plural) + + let mismatched_lists ~loc l1 l2 = + let msg = Format.dprintf + "@[@[Expected@ two@ lists@ of@ the@ same@ size,@ but@ got:@]@ \ + - @[%a@]@ - @[%a@]@]" + pp_num_list l1 pp_num_list l2 + in + raise (L.Syntax_error (loc, `Regular msg)) + +%} + +%% + +spec_constant: + | s=NUM + { let loc = L.mk_pos $startpos $endpos in T.int ~loc s } + | s=DEC + { let loc = L.mk_pos $startpos $endpos in T.real ~loc s } + | s=HEX + { let loc = L.mk_pos $startpos $endpos in T.hexa ~loc s } + | s=BIN + { let loc = L.mk_pos $startpos $endpos in T.binary ~loc s } + | s=STR + { let loc = L.mk_pos $startpos $endpos in T.str ~loc s } +; + +reserved: + /* these are currently unused, see lexer. + * | BINARY { "BINARY" } + * | DECIMAL { "DECIMAL" } + * | HEXADECIMAL { "HEXADECIMAL" } + * | NUMERAL { "NUMERAL" } + * | STRING { "STRING" } + */ + | UNDERSCORE { "_" } + | ATTRIBUTE { "!" } + | AS { "as" } + | LET { "let" } + | EXISTS { "exists" } + | FORALL { "forall" } + | MATCH { "match" } + | PAR { "par" } + | ASSERT { "assert" } + | CHECK_SAT { "check-sat" } + | CHECK_SAT_ASSUMING { "check-sat-assuming" } + | DECLARE_CONST { "declare-const" } + | DECLARE_DATATYPE { "declare-datatype" } + | DECLARE_DATATYPES { "declare-datatypes" } + | DECLARE_FUN { "declare-fun" } + | DECLARE_SORT { "declare-sort" } + | DEFINE_FUN { "define-fun" } + | DEFINE_FUN_REC { "define-fun-rec" } + | DEFINE_FUNS_REC { "define-funs-rec" } + | DEFINE_SYS { "define-system" } + | CHECK_SYS { "check-system" } + | DEFINE_SORT { "define-sort" } + | ECHO { "echo" } + | EXIT { "exit" } + | GET_ASSERTIONS { "get-assertions" } + | GET_ASSIGNMENT { "get-assignment" } + | GET_INFO { "get-info" } + | GET_MODEL { "get-model" } + | GET_OPTION { "get-option" } + | GET_PROOF { "get-proof" } + | GET_UNSAT_ASSUMPTIONS { "get-unsat-assumptions" } + | GET_UNSAT_CORE { "get-unsat-core" } + | GET_VALUE { "get-value" } + | POP { "pop" } + | PUSH { "push" } + | RESET { "reset" } + | RESET_ASSERTIONS { "reset-assertions" } + | SET_INFO { "set-info" } + | SET_LOGIC { "set-logic" } + | SET_OPTION { "set-option" } + | SYS_INPUT { ":input" } + | SYS_OUTPUT { ":output" } + | SYS_LOCAL { ":local" } + | SYS_SUBSYS { ":subsys" } + | SYS_INIT { ":init" } + | SYS_TRANS { ":trans" } + | SYS_INV { ":inv" } + | CHECK_REACH { ":reachable" } + | CHECK_ASSUMPTION { ":assumption" } + | CHECK_QUERY { ":query" } + | CHECK_QUERIES { ":queries" } +; + +s_expr: + | c=spec_constant + { c } + | s=SYMBOL + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk term s) } + | s=reserved + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk term s) } + | s=KEYWORD + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk term s) } + | OPEN l=s_expr* CLOSE + { let loc = L.mk_pos $startpos $endpos in T.sexpr ~loc l } +; + +index: + | s=NUM + | s=SYMBOL + { s } + /* Small language extension to support string char literals */ + | s=HEX + { s } +; + +identifier: + | s=SYMBOL + { fun ns -> I.mk ns s } + | OPEN UNDERSCORE s=SYMBOL l=index+ CLOSE + { fun ns -> I.indexed ns s l } +; + +sort: + | s=identifier + { let loc = L.mk_pos $startpos $endpos in T.const ~loc (s I.sort) } + | OPEN f=identifier args=sort+ CLOSE + { let c = + let loc = L.mk_pos $startpos(f) $endpos(f) in + T.const ~loc (f I.sort) + in + let loc = L.mk_pos $startpos $endpos in T.apply ~loc c args } +; + +attribute_value: + | v=spec_constant + { v } + | v=SYMBOL + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk attr v) } + | OPEN l=s_expr* CLOSE + { let loc = L.mk_pos $startpos $endpos in T.sexpr ~loc l } +; + +attribute: + | s=KEYWORD a=attribute_value? + { + let t = + let loc = L.mk_pos $startpos(s) $endpos(s) in + T.const ~loc I.(mk attr s) + in + match a with + | None -> t + | Some t' -> + let loc = L.mk_pos $startpos $endpos in + T.apply ~loc t [t'] + } +; + +/* +The [(as id ty)] doesn't specify the type of the function [id] +but only its result type +*/ +qual_identifier: + | s=identifier + { let loc = L.mk_pos $startpos $endpos in `NoAs (T.const ~loc (s I.term)) } + | OPEN AS s=identifier ty=sort CLOSE + { let loc = L.mk_pos $startpos(s) $endpos(s) in + let as_loc = L.mk_pos $startpos $endpos in + `As (T.const ~loc (s I.term), ty, as_loc) } +; + +var_binding: + | OPEN s=SYMBOL t=term CLOSE + { let c = + let loc = L.mk_pos $startpos(s) $endpos(s) in + T.const ~loc I.(mk term s) + in + let loc = L.mk_pos $startpos $endpos in T.colon ~loc c t } +; + +sorted_var: + | OPEN s=SYMBOL ty=sort CLOSE + { let c = + let loc = L.mk_pos $startpos(s) $endpos(s) in + T.const ~loc I.(mk term s) + in + let loc = L.mk_pos $startpos $endpos in T.colon ~loc c ty } +; + +/* Additional rule for pattern symbols, useful for: + 1- locations in symbol lists in patterns, + 2- menhir '+' syntax doesn't support raw tokens afaik */ +pattern_symbol: + | s=SYMBOL + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk term s) } +; + +pattern: + | c=pattern_symbol + { c } + | OPEN f=pattern_symbol args=pattern_symbol+ CLOSE + { let loc = L.mk_pos $startpos $endpos in T.apply ~loc f args } +; + +match_case: + | OPEN p=pattern t=term CLOSE + { p, t } +; + +term: + | c=spec_constant + { c } + | s=qual_identifier + { match s with + | `NoAs f -> f + | `As (f, ty, loc) -> T.colon ~loc f ty } + | OPEN s=qual_identifier args=term+ CLOSE + { let loc = L.mk_pos $startpos $endpos in + match s with + | `NoAs f -> T.apply ~loc f args + | `As (f, ty, as_loc) -> T.colon ~loc:as_loc (T.apply ~loc f args) ty } + | OPEN LET OPEN l=var_binding+ CLOSE t=term CLOSE + { let loc = L.mk_pos $startpos $endpos in T.letand ~loc l t } + | OPEN FORALL OPEN l=sorted_var+ CLOSE t=term CLOSE + { let loc = L.mk_pos $startpos $endpos in T.forall ~loc l t } + | OPEN EXISTS OPEN l=sorted_var+ CLOSE t=term CLOSE + { let loc = L.mk_pos $startpos $endpos in T.exists ~loc l t } + | OPEN MATCH t=term OPEN l=match_case+ CLOSE CLOSE + { let loc = L.mk_pos $startpos $endpos in T.match_ ~loc t l } + | OPEN ATTRIBUTE f=term args=attribute+ CLOSE + { let loc = L.mk_pos $startpos $endpos in T.annot ~loc f args } +; + +info_flag: + /* The following cases are subsumed by the last case, and thus ignored, + most notably because they would force to introduce tokens for specific + keywords even though these rules are syntaxically useless. + | :all-statistics + | :assertion-stack-levels + | :authors + | :error-behavior + | :name + | :reason-unknown + | :version + */ + | s=KEYWORD + { s } +; + +/* This definition is useless (not used in the syntax), + and it would force to match on non-reserved symbols, + which is very, very, very ugly... +b_value: + | true + | false +; +*/ + +/* renamed from option to avoid a name_clash */ +command_option: + /* These cases are subsumed by the last case, and thus ignored, + most notably because they would force to introduce tokens for specific + keywords even though these rules are syntaxically useless. + Also, this allows to ignore the definition of , which is problematic. + | :diagnostic-output-channel + | :global-declarations + | :interactive-mode + | :print-success + | :produce-assertions + | :produce-assignments + | :produce-models + | :produce-proofs + | :produce-unsat-assumptions + | :produce-unsat-cores + | :random-seed + | :regular-output-channel + | :reproducible-resource-limit + | :verbosity + */ + | a=attribute + { a } +; + +sort_dec: + | OPEN s=SYMBOL n=NUM CLOSE + { I.(mk sort s), int_of_string n + (* shouldn't raise because of the definition of numeral in lexer *) } +; + +selector_dec: + | OPEN s=SYMBOL ty=sort CLOSE + { let f = + let loc = L.mk_pos $startpos $endpos in + T.const ~loc (I.mk I.term s) + in + let loc = L.mk_pos $startpos $endpos in + T.colon ~loc f ty } +; + +enum_constructor_dec: + | s=SYMBOL + { (I.mk I.term s), [] } + +constructor_dec: + | OPEN s=SYMBOL l=selector_dec* CLOSE + { (I.mk I.term s), l } +; + +/* Additional rule for datatype symbols, useful because + menhir '+' syntax does'nt support raw tokens afaik */ +datatype_symbol: + | s=SYMBOL + { let loc = L.mk_pos $startpos $endpos in T.const ~loc I.(mk sort s) } + +datatype_dec: + | OPEN l=constructor_dec+ CLOSE + { [], l } + | OPEN PAR OPEN vars=datatype_symbol+ CLOSE OPEN l=constructor_dec+ CLOSE CLOSE + { vars, l } +; + +function_dec: + | OPEN s=SYMBOL OPEN args=sorted_var* CLOSE ret=sort CLOSE + { I.(mk term s), [], args, ret } + +function_def: + | s=SYMBOL OPEN args=sorted_var* CLOSE ret=sort body=term + { I.(mk term s), [], args, ret, body } + +input_var_decl: + | SYS_INPUT OPEN vars=sorted_var* CLOSE + { L.mk_pos $startpos $endpos, vars } + +output_var_decl: + | SYS_OUTPUT OPEN vars=sorted_var* CLOSE + { L.mk_pos $startpos $endpos, vars } + +local_var_decl: + | SYS_LOCAL OPEN vars=sorted_var* CLOSE + { L.mk_pos $startpos $endpos, vars } + +system_var_decls_lst: + | i=input_var_decl others=system_var_decls_lst + { let input, output, local = others in + i :: input, output, local + } + | o=output_var_decl others=system_var_decls_lst + { let input, output, local = others in + input, o :: output, local + } + | l=local_var_decl others=system_var_decls_lst + { let input, output, local = others in + input, output, l :: local + } + | i=input_var_decl + { [i], [], [] } + | o=output_var_decl + { [], [o], [] } + | l=local_var_decl + { [], [], [l] } + +system_var_decls: + | decls=system_var_decls_lst + { + let get_system_var_decl var_decl attr_name = + match var_decl with + | [] -> [] + | [(_, d)] -> d + | _ :: (loc, _) :: _ -> + let msg = Format.dprintf "%a attribute is not repeatable" + Format.pp_print_text attr_name + in + raise (L.Syntax_error (loc, `Regular msg)) + in + let input, output, local = decls in + get_system_var_decl input ":input", + get_system_var_decl output ":output", + get_system_var_decl local ":local" + } + +opt_system_var_decls: + | { [], [], [] } + | decls=system_var_decls { decls } + +sys_symbol: + | s=pattern_symbol { s } + +sys_var_symbol: + | s=pattern_symbol { s } + +system_instantiation: + | OPEN s=sys_symbol args=sys_var_symbol* CLOSE + { let loc = L.mk_pos $startpos $endpos in T.apply ~loc s args } + +system_subsys_dec: + | SYS_SUBSYS OPEN local_name=SYMBOL sys_inst=system_instantiation CLOSE + { let loc = L.mk_pos $startpos $endpos in I.(mk term local_name), sys_inst, loc } + +init_cond: + | SYS_INIT cond=term + { L.mk_pos $startpos $endpos, cond } + +trans_cond: + | SYS_TRANS cond=term + { L.mk_pos $startpos $endpos, cond } + +inv_cond: + | SYS_INV cond=term + { L.mk_pos $startpos $endpos, cond } + +subs_and_conds_lst: + | sub=system_subsys_dec others=subs_and_conds_lst + { let subs, init, trans, inv = others in + sub::subs, init, trans, inv + } + | i=init_cond others=subs_and_conds_lst + { let subs, init, trans, inv = others in + subs, i :: init, trans, inv + } + | t=trans_cond others=subs_and_conds_lst + { let subs, init, trans, inv = others in + subs, init, t :: trans, inv + } + | i=inv_cond others=subs_and_conds_lst + { let subs, init, trans, inv = others in + subs, init, trans, i :: inv + } + | sub=system_subsys_dec + { [sub], [], [], [] } + | init=init_cond + { [], [init], [], [] } + | trans=trans_cond + { [], [], [trans], [] } + | inv=inv_cond + { [], [], [], [inv] } + +subs_and_conds: + | sc=subs_and_conds_lst + { + let get_cond cond_lst attr_name = + match cond_lst with + | [] -> T.const I.(mk term "true") + | [(_, c)] -> c + | _ :: (loc, _) :: _ -> + let msg = Format.dprintf "%a attribute is not repeatable" + Format.pp_print_text attr_name + in + raise (L.Syntax_error (loc, `Regular msg)) + in + let subs, init, trans, inv = sc in + subs, + get_cond init ":init", + get_cond trans ":trans", + get_cond inv ":inv" + } + +opt_subs_and_conds : + | + { let true_ = T.const I.(mk term "true") in + [], true_, true_, true_ + } + | sc=subs_and_conds { sc } + +system_def: + | s=SYMBOL vars=opt_system_var_decls sc=opt_subs_and_conds + { let subs, init, trans, inv = sc in + I.(mk term s), vars, subs, init, trans, inv + } + +reach_cond: + | CHECK_REACH OPEN s=SYMBOL cond=term CLOSE + { let loc = L.mk_pos $startpos $endpos in I.(mk term s), cond, loc } + +assump_cond: + | CHECK_ASSUMPTION OPEN s=SYMBOL cond=term CLOSE + { let loc = L.mk_pos $startpos $endpos in I.(mk term s), cond, loc } + +cond_symbol: + | s=pattern_symbol { s } + +sys_check_query_base: + | OPEN s=SYMBOL OPEN args=cond_symbol* CLOSE CLOSE + { let loc = L.mk_pos $startpos $endpos in I.(mk term s), args, loc } + +sys_check_query: + | CHECK_QUERY query=sys_check_query_base + { [query] } + | CHECK_QUERIES OPEN queries=sys_check_query_base* CLOSE + { queries } + +sys_check_attrs_and_queries: + | a=assump_cond others=sys_check_attrs_and_queries + { let assumption, reachable, queries = others in + a :: assumption, reachable, queries + } + | r=reach_cond others=sys_check_attrs_and_queries + { let assumption, reachable, queries = others in + assumption, r :: reachable, queries + } + | q=sys_check_query others=sys_check_attrs_and_queries + { let assumption, reachable, queries = others in + assumption, reachable, q :: queries + } + | a=assump_cond + { [a], [], [] } + | r=reach_cond + { [], [r], [] } + | q=sys_check_query + { [], [], [q] } + +opt_sys_check_attrs_and_queries: + | { [], [], [] } + | aq = sys_check_attrs_and_queries { aq } + +system_check: + | sid=sys_symbol vars=opt_system_var_decls attrs_queries=opt_sys_check_attrs_and_queries + { let assumption, reachable, queries = attrs_queries in + sid, vars, assumption, reachable, List.flatten queries + } + +/* Additional rule for prop_literals symbols, to have lighter + semantic actions in prop_literal reductions. */ +prop_symbol: + | s=pattern_symbol { s } +; + +/* This is a ugly hack, but necessary because the syntax defines + this reduction using a `not` token which doesn't really exists, + since it is not a reserved word, thus forcing us to pattern + match on the string... */ +not_symbol: + | s=SYMBOL + { let loc = L.mk_pos $startpos $endpos in + match s with + | "not" -> + T.const ~loc I.(mk term s) + | _ -> + let msg = Format.dprintf "@[@[%a@]@ Hint: @[%a@]@]" + Format.pp_print_text "expected the 'not' symbol at that point." + Format.pp_print_text + "check-sat-assuming only accepts a list of terms \ + of the form 'p' or '(not p)', where p is a boolean literal." + in + raise (L.Syntax_error (loc, `Regular msg)) } +; + +prop_literal: + | s=prop_symbol + { s } + | OPEN f=not_symbol s=prop_symbol CLOSE + { let loc = L.mk_pos $startpos $endpos in T.apply ~loc f [s] } +; + +command: + | OPEN ASSERT t=term CLOSE + { let loc = L.mk_pos $startpos $endpos in S.assert_ ~loc t } + | OPEN CHECK_SAT CLOSE + { let loc = L.mk_pos $startpos $endpos in S.check_sat ~loc [] } + | OPEN CHECK_SAT_ASSUMING OPEN l=prop_literal* CLOSE CLOSE + { let loc = L.mk_pos $startpos $endpos in S.check_sat ~loc l } + | OPEN DECLARE_CONST s=SYMBOL ty=sort CLOSE + { let loc = L.mk_pos $startpos $endpos in S.fun_decl ~loc I.(mk term s) [] [] ty } + | OPEN DECLARE_DATATYPE s=SYMBOL d=datatype_dec CLOSE + { let vars, constructors = d in + let loc = L.mk_pos $startpos $endpos in + S.datatypes ~loc [I.(mk sort s), vars, constructors] } + | OPEN DECLARE_DATATYPES OPEN l1=sort_dec+ CLOSE OPEN l2=datatype_dec+ CLOSE CLOSE + { let res = + try + List.map2 (fun (s, _) (vars, constructors) -> s, vars, constructors) l1 l2 + with Invalid_argument _ -> + let loc = L.mk_pos $startpos($3) $endpos($8) in + mismatched_lists ~loc + (l1, "sort declaration", "sort declarations") + (l2, "datatype definition", "datatype definitions") + in + let loc = L.mk_pos $startpos $endpos in + S.datatypes ~loc res } + | OPEN DECLARE_FUN s=SYMBOL OPEN args=sort* CLOSE ty=sort CLOSE + { let id = I.(mk term s) in + let loc = L.mk_pos $startpos $endpos in + S.fun_decl ~loc id [] args ty } + | OPEN DECLARE_SORT s=SYMBOL n=NUM CLOSE + { let id = I.(mk sort s) in + let loc = L.mk_pos $startpos $endpos in + S.type_decl ~loc id (int_of_string n) } + | OPEN DEFINE_FUN f=function_def CLOSE + { let id, vars, args, ret, body = f in + let loc = L.mk_pos $startpos $endpos in + S.fun_def ~loc id vars args ret body } + | OPEN DEFINE_FUN_REC f=function_def CLOSE + { let id, vars, args, ret, body = f in + let loc = L.mk_pos $startpos $endpos in + S.funs_def_rec ~loc [id, vars, args, ret, body] } + /* The syntax technically defines this reduction as having l and l' be the same length, + but that isn't easily expressible in menhir, so the check is delayed */ + | OPEN DEFINE_FUNS_REC OPEN l1=function_dec+ CLOSE OPEN l2=term+ CLOSE CLOSE + { let res = + try List.map2 (fun (id, vars, args, ret) body -> id, vars, args, ret, body) l1 l2 + with Invalid_argument _ -> + let loc = L.mk_pos $startpos($3) $endpos($8) in + mismatched_lists ~loc + (l1, "function declaration", "function declarations") + (l2, "function body", "function bodies") + in + let loc = L.mk_pos $startpos $endpos in + S.funs_def_rec ~loc res } + | OPEN DEFINE_SYS f=system_def CLOSE + { let id, vars, subs, init, trans, inv = f in + let input, output, local = vars in + let loc = L.mk_pos $startpos $endpos in + S.sys_def ~loc id ~input ~output ~local ~subs ~init ~trans ~inv } + | OPEN DECLARE_ENUM_SORT s=SYMBOL OPEN d=enum_constructor_dec+ CLOSE CLOSE + { + let constructors = d in + let loc = L.mk_pos $startpos $endpos in + S.datatypes ~loc [I.(mk sort s), [], constructors] + } + | OPEN CHECK_SYS sc=system_check CLOSE + { let sid, vars, assumption, reachable, queries = sc in + let input, output, local = vars in + let loc = L.mk_pos $startpos $endpos in + S.sys_check ~loc sid ~input ~output ~local ~assumption ~reachable ~queries + } + | OPEN DEFINE_SORT s=SYMBOL OPEN args=SYMBOL* CLOSE ty=sort CLOSE + { let id = I.(mk sort s) in + let l = List.map I.(mk sort) args in + let loc = L.mk_pos $startpos $endpos in + S.type_def ~loc id l ty } + | OPEN ECHO s=STR CLOSE + { let loc = L.mk_pos $startpos $endpos in + S.echo ~loc s } + + | OPEN EXIT CLOSE + { let loc = L.mk_pos $startpos $endpos in S.exit ~loc () } + + | OPEN GET_ASSERTIONS CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_assertions ~loc () } + | OPEN GET_ASSIGNMENT CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_assignment ~loc () } + | OPEN GET_INFO i=info_flag CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_info ~loc i } + | OPEN GET_MODEL CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_model ~loc () } + | OPEN GET_OPTION k=KEYWORD CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_option ~loc k } + | OPEN GET_PROOF CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_proof ~loc () } + | OPEN GET_UNSAT_ASSUMPTIONS CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_unsat_assumptions ~loc () } + | OPEN GET_UNSAT_CORE CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_unsat_core ~loc () } + | OPEN GET_VALUE OPEN l=term+ CLOSE CLOSE + { let loc = L.mk_pos $startpos $endpos in S.get_value ~loc l } + + | OPEN POP n=NUM CLOSE + { let loc = L.mk_pos $startpos $endpos in S.pop ~loc (int_of_string n) } + | OPEN PUSH n=NUM CLOSE + { let loc = L.mk_pos $startpos $endpos in S.push ~loc (int_of_string n) } + | OPEN RESET CLOSE + { let loc = L.mk_pos $startpos $endpos in S.reset ~loc () } + | OPEN RESET_ASSERTIONS CLOSE + { let loc = L.mk_pos $startpos $endpos in S.reset_assertions ~loc () } + + | OPEN SET_INFO c=command_option CLOSE + { let loc = L.mk_pos $startpos $endpos in S.set_info ~loc c } + | OPEN SET_LOGIC s=SYMBOL CLOSE + { let loc = L.mk_pos $startpos $endpos in S.set_logic ~loc s } + | OPEN SET_OPTION c=command_option CLOSE + { let loc = L.mk_pos $startpos $endpos in S.set_option ~loc c } +; + +file: + | l=command* EOF + { l } +; + +input: + | EOF + { None } + | c=command + { Some c } + +%% diff --git a/src/languages/smtlib2/mcil/syntax.messages b/src/languages/smtlib2/mcil/syntax.messages new file mode 100644 index 000000000..e07f1b04c --- /dev/null +++ b/src/languages/smtlib2/mcil/syntax.messages @@ -0,0 +1,4639 @@ +# +# Syntax Error Messages for smtlib v2.6 +# +# Each error message *must* follow the following format: +# +# """ +# XXX +# production parsed (on a single line) +# what is expected at that point, +# possibly on multiple lines +# """ +# +# The error numbers can be pretty much arbitrary, but for each +# error number XXX, a corresponding test case file must exists as +# tests/parsing/smtlib/v2.6/errors/XXX_some_descr_of_the_error_Y.smt2 +# (Y is there to allow multiple example of the error test case to exist, +# for instance with various different error tokens) +# +# Notes: +# - some error messages are shared among more than one error case, +# in such cases, the error number is the same, so when modifying +# an error message, be sure to modify all occurrences of the same +# error number + +term: OPEN AS OPEN SYMBOL +## +## Ends in an error in state: 110. +## +## identifier -> OPEN . UNDERSCORE SYMBOL nonempty_list(index) CLOSE [ SYMBOL OPEN ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +001 +an identifier +an underscore: identifiers starting with an opening parenthesis must be +indexed identifiers, of the form "(_ symbol index+)" + +term: OPEN AS SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 603. +## +## qual_identifier -> OPEN AS identifier sort . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN AS identifier sort +## + +002 +a qualified identifier +a closing parenthesis + +term: OPEN AS SYMBOL UNDERSCORE +## +## Ends in an error in state: 602. +## +## qual_identifier -> OPEN AS identifier . sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN AS identifier +## + +003 +a qualified identifier +a sort, i.e. either an identifier, or a sort constructor application; +note that keywords and reserved words (such as '_', 'as', ...) are not +identifiers, and thus are not allowed here + +term: OPEN AS UNDERSCORE +## +## Ends in an error in state: 601. +## +## qual_identifier -> OPEN AS . identifier sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN AS +## + +004 +a qualified identifier +an identifier; +note that keywords and reserved words (such as '_', 'as', ...) are not +identifiers, and thus are not allowed here + +term: OPEN ATTRIBUTE SYMBOL KEYWORD BIN UNDERSCORE +## +## Ends in an error in state: 178. +## +## nonempty_list(attribute) -> attribute . [ CLOSE ] +## nonempty_list(attribute) -> attribute . nonempty_list(attribute) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## attribute +## + +005 +an attribute list +either a closing parenthesis, or another attribute of the form +"keyword value" + +term: OPEN ATTRIBUTE SYMBOL UNDERSCORE +## +## Ends in an error in state: 598. +## +## term -> OPEN ATTRIBUTE term . nonempty_list(attribute) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ATTRIBUTE term +## + +006 +a term +an attribute of the form "keyword value" + +term: OPEN ATTRIBUTE UNDERSCORE +## +## Ends in an error in state: 597. +## +## term -> OPEN ATTRIBUTE . term nonempty_list(attribute) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ATTRIBUTE +## + +007 +a term with attribute +a term + +term: OPEN EXISTS OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 595. +## +## term -> OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE term . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE term +## + +008 +a term +a closing parenthesis to end the existencially quantified formula + +term: OPEN EXISTS OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 594. +## +## term -> OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE . term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE +## + +009 +a term +a term (body for the existencial quantification) + +term: OPEN EXISTS OPEN UNDERSCORE +## +## Ends in an error in state: 592. +## +## term -> OPEN EXISTS OPEN . nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN +## + +010 +a term +a sorted variable of the form "(var sort)" + +term: OPEN EXISTS UNDERSCORE +## +## Ends in an error in state: 591. +## +## term -> OPEN EXISTS . OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS +## + +011 +a term +a list of sorted variables, starting with an opening parenthesis + +term: OPEN FORALL OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 589. +## +## term -> OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE term . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE term +## + +012 +a term +a closing parenthesis to end the universally quantified formula + +term: OPEN FORALL OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 588. +## +## term -> OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE . term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE +## + +013 +a term +a term (body for the universal quantification) + +term: OPEN FORALL OPEN OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 162. +## +## nonempty_list(sorted_var) -> sorted_var . [ CLOSE ] +## nonempty_list(sorted_var) -> sorted_var . nonempty_list(sorted_var) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sorted_var +## + +014 +a list of sorted variables +either a closing parentheis, or a sorted var of the form "(var sort)" + +term: OPEN FORALL OPEN OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 160. +## +## sorted_var -> OPEN SYMBOL sort . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL sort +## + +015 +a sorted variable +a closing parenthesis + +term: OPEN FORALL OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 159. +## +## sorted_var -> OPEN SYMBOL . sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +016 +a sorted variable +a sort, i.e. either an identifier, or a sort constructor application; +note that keywords and reserved words (such as '_', 'as', ...) are not +identifiers, and thus are not allowed here + +term: OPEN FORALL OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 158. +## +## sorted_var -> OPEN . SYMBOL sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +017 +a sorted variable +a symbol, i.e. a variable name + +term: OPEN FORALL OPEN UNDERSCORE +## +## Ends in an error in state: 586. +## +## term -> OPEN FORALL OPEN . nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN +## + +018 +a term +a sorted variable of the form "(var sort)" + +term: OPEN FORALL UNDERSCORE +## +## Ends in an error in state: 585. +## +## term -> OPEN FORALL . OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL +## + +019 +a term +a list of sorted variables, starting with an opening parenthesis + +term: OPEN LET OPEN OPEN SYMBOL BIN CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 583. +## +## term -> OPEN LET OPEN nonempty_list(var_binding) CLOSE term . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN nonempty_list(var_binding) CLOSE term +## + +020 +a term +a closing parenthesis to end the let binding + +term: OPEN LET OPEN OPEN SYMBOL BIN CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 582. +## +## term -> OPEN LET OPEN nonempty_list(var_binding) CLOSE . term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN nonempty_list(var_binding) CLOSE +## + +021 +a term +a term (body for the let binding) + +term: OPEN LET OPEN OPEN SYMBOL BIN CLOSE UNDERSCORE +## +## Ends in an error in state: 150. +## +## nonempty_list(var_binding) -> var_binding . [ CLOSE ] +## nonempty_list(var_binding) -> var_binding . nonempty_list(var_binding) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## var_binding +## + +022 +a list of variable binding +a closing parenthesis or a variable binding of the form "(var term)" + +term: OPEN LET OPEN OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 148. +## +## var_binding -> OPEN SYMBOL term . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL term +## + +023 +a variable binding +a closing parenthesis + +term: OPEN LET OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 147. +## +## var_binding -> OPEN SYMBOL . term CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +024 +a variable binding +a term + +term: OPEN LET OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 146. +## +## var_binding -> OPEN . SYMBOL term CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +025 +a variable binding +a symbol (i.e. variable name) + +term: OPEN LET OPEN UNDERSCORE +## +## Ends in an error in state: 580. +## +## term -> OPEN LET OPEN . nonempty_list(var_binding) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN +## + +026 +a term +a variable binding of the form "(var term)" + +term: OPEN LET UNDERSCORE +## +## Ends in an error in state: 579. +## +## term -> OPEN LET . OPEN nonempty_list(var_binding) CLOSE term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN LET +## + +027 +a term +a variable binding list, starting with an opening parenthesis + +term: OPEN MATCH SYMBOL OPEN OPEN OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 128. +## +## nonempty_list(pattern_symbol) -> pattern_symbol . [ CLOSE ] +## nonempty_list(pattern_symbol) -> pattern_symbol . nonempty_list(pattern_symbol) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## pattern_symbol +## + +028 +arguments of a constructor in a pattern +a closing parenthesis, or a symbol to bind the argument; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN MATCH SYMBOL OPEN OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 127. +## +## pattern -> OPEN pattern_symbol . nonempty_list(pattern_symbol) CLOSE [ SYMBOL STR OPEN NUM HEX DEC BIN ] +## +## The known suffix of the stack is as follows: +## OPEN pattern_symbol +## + +029 +arguments of a constructor in a pattern +a symbol to bind the first constructor argument; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN MATCH SYMBOL OPEN OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 126. +## +## pattern -> OPEN . pattern_symbol nonempty_list(pattern_symbol) CLOSE [ SYMBOL STR OPEN NUM HEX DEC BIN ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +030 +a pattern +a symbol (either a variable or a datatype constructor); +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN MATCH SYMBOL OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 577. +## +## term -> OPEN MATCH term OPEN nonempty_list(match_case) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term OPEN nonempty_list(match_case) CLOSE +## + +031 +a match +a closing parenthesis to close the match + +term: OPEN MATCH SYMBOL OPEN OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 142. +## +## nonempty_list(match_case) -> match_case . [ CLOSE ] +## nonempty_list(match_case) -> match_case . nonempty_list(match_case) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## match_case +## + +032 +a list of match cases +a closing parenthesis or a match case of the form "(pattern body)" + +term: OPEN MATCH SYMBOL OPEN OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 134. +## +## match_case -> OPEN pattern term . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN pattern term +## + +033 +a match case +a closing parenthesis to close the match case + +term: OPEN MATCH SYMBOL OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 133. +## +## match_case -> OPEN pattern . term CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN pattern +## + +034 +a match case +a term for the case body + +term: OPEN MATCH SYMBOL OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 124. +## +## match_case -> OPEN . pattern term CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +035 +a match case +a pattern, i.e. either a symbol or a datatype pattern of +the form "(symbol symbol+)"; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN MATCH SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 575. +## +## term -> OPEN MATCH term OPEN . nonempty_list(match_case) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term OPEN +## + +036 +a list of match cases +a match case of the form "(pattern term)" + +term: OPEN MATCH SYMBOL UNDERSCORE +## +## Ends in an error in state: 574. +## +## term -> OPEN MATCH term . OPEN nonempty_list(match_case) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term +## + +037 +a match +a match case list, starting with an opening parenthesis + +term: OPEN MATCH UNDERSCORE +## +## Ends in an error in state: 573. +## +## term -> OPEN MATCH . term OPEN nonempty_list(match_case) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH +## + +038 +a match +a term to match (i.e. the scrutinee of the match) + +term: OPEN OPEN AS SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 119. +## +## qual_identifier -> OPEN AS identifier sort . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN AS identifier sort +## + +002 +a qualified identifier +a closing parenthesis + +term: OPEN OPEN AS SYMBOL UNDERSCORE +## +## Ends in an error in state: 111. +## +## qual_identifier -> OPEN AS identifier . sort CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN AS identifier +## + +003 +a qualified identifier +a sort, i.e. either an identifier, or a sort constructor application; +note that keywords (such as '_', 'as', ...) are none of these, and thus +are not allowed here. + +term: OPEN OPEN AS UNDERSCORE +## +## Ends in an error in state: 109. +## +## qual_identifier -> OPEN AS . identifier sort CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN AS +## + +004 +a qualified identifier +an identifier. +Note that keywords (such as '_', 'as', ...) are not identifiers, +and thus are not allowed here. + +term: OPEN OPEN SYMBOL +## +## Ends in an error in state: 108. +## +## identifier -> OPEN . UNDERSCORE SYMBOL nonempty_list(index) CLOSE [ SYMBOL STR OPEN NUM HEX DEC BIN ] +## qual_identifier -> OPEN . AS identifier sort CLOSE [ SYMBOL STR OPEN NUM HEX DEC BIN ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +039 +an identifier in parentheses +either an indexed identifier (starting with an underscore) +or an 'as' type ascription; +note that this is because of the preceding opening parenthesis + +term: OPEN OPEN UNDERSCORE SYMBOL UNDERSCORE +## +## Ends in an error in state: 100. +## +## identifier -> OPEN UNDERSCORE SYMBOL . nonempty_list(index) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN UNDERSCORE SYMBOL +## + +040 +an indexed identifier +an index, i.e. either a numeral, a symbol, or a hexadecimal number; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN OPEN UNDERSCORE UNDERSCORE +## +## Ends in an error in state: 99. +## +## identifier -> OPEN UNDERSCORE . SYMBOL nonempty_list(index) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN UNDERSCORE +## + +041 +an indexed identifier +a symbol; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN STR +## +## Ends in an error in state: 568. +## +## identifier -> OPEN . UNDERSCORE SYMBOL nonempty_list(index) CLOSE [ # ] +## qual_identifier -> OPEN . AS identifier sort CLOSE [ # ] +## term -> OPEN . qual_identifier nonempty_list(term) CLOSE [ # ] +## term -> OPEN . LET OPEN nonempty_list(var_binding) CLOSE term CLOSE [ # ] +## term -> OPEN . FORALL OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## term -> OPEN . EXISTS OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ # ] +## term -> OPEN . MATCH term OPEN nonempty_list(match_case) CLOSE CLOSE [ # ] +## term -> OPEN . ATTRIBUTE term nonempty_list(attribute) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +042 +a term +a term construction (identifier, let binding, quantification, ...); +note that this expectation if caused by the preceding opening parenthesis + + +term: OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 181. +## +## nonempty_list(term) -> term . [ CLOSE ] +## nonempty_list(term) -> term . nonempty_list(term) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## term +## + +043 +a list of terms +either a closing parenthesis, or another term; +note that keywords and reserved words (such as '_', 'as', ...) are +not terms, and thus are not allowed here + +term: OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 605. +## +## term -> OPEN qual_identifier . nonempty_list(term) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN qual_identifier +## + +044 +a function application +a term as argument; +note that keywords and reserved words (such as '_', 'as', ...) are +not terms, and thus are not allowed here + +term: OPEN UNDERSCORE SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 106. +## +## nonempty_list(index) -> index . [ CLOSE ] +## nonempty_list(index) -> index . nonempty_list(index) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## index +## + +045 +an index list +either a closing parenthesis, or an index (i.e. a numeral, a symbol, +or a hexadecimal); +note that keywords and reserved words (such as '_', 'as', ...) are +not symbols, and thus are not allowed here + +term: OPEN UNDERSCORE SYMBOL UNDERSCORE +## +## Ends in an error in state: 570. +## +## identifier -> OPEN UNDERSCORE SYMBOL . nonempty_list(index) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN UNDERSCORE SYMBOL +## + +040 +an indexed identifier +an index, i.e. either a numeral, a symbol, or a hexadecimal number; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: OPEN UNDERSCORE UNDERSCORE +## +## Ends in an error in state: 569. +## +## identifier -> OPEN UNDERSCORE . SYMBOL nonempty_list(index) CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN UNDERSCORE +## + +041 +an indexed identifier +a symbol; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +term: UNDERSCORE +## +## Ends in an error in state: 565. +## +## term' -> . term [ # ] +## +## The known suffix of the stack is as follows: +## +## + +046 +a term +a term construction (symbol, function application, match, let binding, ...); +note that keywords and reserved words (such as '_', 'as', ...) are +not symbols, and thus are not allowed here + +input: OPEN ASSERT SYMBOL UNDERSCORE +## +## Ends in an error in state: 560. +## +## command -> OPEN ASSERT term . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ASSERT term +## + +049 +an assertion +a closing parenthesis + +input: OPEN ASSERT UNDERSCORE +## +## Ends in an error in state: 559. +## +## command -> OPEN ASSERT . term CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ASSERT +## + +048 +a term +a term construction (symbol, function application, match, let binding, ...); +note that keywords and reserved words (such as '_', 'as', ...) are +not symbols, and thus are not allowed here + +input: OPEN CHECK_SAT UNDERSCORE +## +## Ends in an error in state: 557. +## +## command -> OPEN CHECK_SAT . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT +## + +050 +a check-sat command +a closing parenthesis + +input: OPEN CHECK_SAT_ASSUMING OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 555. +## +## command -> OPEN CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE +## + +051 +a check-sat-assuming command +a closing parenthesis + +input: OPEN CHECK_SAT_ASSUMING OPEN UNDERSCORE +## +## Ends in an error in state: 553. +## +## command -> OPEN CHECK_SAT_ASSUMING OPEN . list(prop_literal) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING OPEN +## + +052 +a list of propositional literals +a propositional literal, i.e. either a symbol or the negation of a symbol + +input: OPEN CHECK_SAT_ASSUMING UNDERSCORE +## +## Ends in an error in state: 552. +## +## command -> OPEN CHECK_SAT_ASSUMING . OPEN list(prop_literal) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING +## + +053 +a check-sat-assuming command +a list of propositional literals, starting with an opening parenthesis + +input: OPEN DECLARE_CONST SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 547. +## +## command -> OPEN DECLARE_CONST SYMBOL sort . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST SYMBOL sort +## + +054 +a constant declaration +a closing parenthesis + +input: OPEN DECLARE_CONST SYMBOL UNDERSCORE +## +## Ends in an error in state: 546. +## +## command -> OPEN DECLARE_CONST SYMBOL . sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST SYMBOL +## + +055 +a constant declaration +a sort + +input: OPEN DECLARE_CONST UNDERSCORE +## +## Ends in an error in state: 545. +## +## command -> OPEN DECLARE_CONST . SYMBOL sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST +## + +056 +a constant declaration +a symbol; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +input: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 543. +## +## command -> OPEN DECLARE_DATATYPE SYMBOL datatype_dec . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE SYMBOL datatype_dec +## + +057 +a datatype declaration +a closing parenthesis + +input: OPEN DECLARE_DATATYPE SYMBOL UNDERSCORE +## +## Ends in an error in state: 542. +## +## command -> OPEN DECLARE_DATATYPE SYMBOL . datatype_dec CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE SYMBOL +## + +058 +a datatype declaration +an opening parenthesis to start the datatype declaration + +input: OPEN DECLARE_DATATYPE UNDERSCORE +## +## Ends in an error in state: 541. +## +## command -> OPEN DECLARE_DATATYPE . SYMBOL datatype_dec CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE +## + +059 +a datatype declaration +a symbol + +input: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE OPEN OPEN OPEN SYMBOL CLOSE CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 539. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE +## + +060 +a datatypes declaration +a closing parenthesis + +input: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE OPEN UNDERSCORE +## +## Ends in an error in state: 537. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN . nonempty_list(datatype_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN +## + +061 +a datatypes definition +an opening parenthesis to start a list of constructors for the first defined datatype + +input: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 536. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE . OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE +## + +062 +a datatypes declaration +an opening parenthesis to start a list of datatype definitions, +one for each of the sorts being declared + +input: OPEN DECLARE_DATATYPES OPEN UNDERSCORE +## +## Ends in an error in state: 534. +## +## command -> OPEN DECLARE_DATATYPES OPEN . nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN +## + +063 +a datatypes declaration +a parametric sort declaration of the form "(symbol num)" + +input: OPEN DECLARE_DATATYPES UNDERSCORE +## +## Ends in an error in state: 533. +## +## command -> OPEN DECLARE_DATATYPES . OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES +## + +064 +a datatypes declaration +a list of sort declaration, starting with an opening parenthesis + +input: OPEN DECLARE_FUN SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 525. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort +## + +065 +a function declaration +a closing parenthesis + +input: OPEN DECLARE_FUN SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 524. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE . sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE +## + +066 +a function declaration +a sort for the return type of the function + +input: OPEN DECLARE_FUN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 522. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN . list(sort) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN +## + +067 +a function declaration +a closing parenthesis, or a list of sorts for the arguments of the function + +input: OPEN DECLARE_FUN SYMBOL UNDERSCORE +## +## Ends in an error in state: 521. +## +## command -> OPEN DECLARE_FUN SYMBOL . OPEN list(sort) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL +## + +068 +a function declaration +an opening parenthesis to start the list of sorts for the function's arguments + +input: OPEN DECLARE_FUN UNDERSCORE +## +## Ends in an error in state: 520. +## +## command -> OPEN DECLARE_FUN . SYMBOL OPEN list(sort) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN +## + +069 +a function declaration +a symbol for the function's name + +input: OPEN DECLARE_SORT SYMBOL NUM UNDERSCORE +## +## Ends in an error in state: 518. +## +## command -> OPEN DECLARE_SORT SYMBOL NUM . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT SYMBOL NUM +## + +070 +a sort declaration +a closing parenthesis + +input: OPEN DECLARE_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 517. +## +## command -> OPEN DECLARE_SORT SYMBOL . NUM CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT SYMBOL +## + +071 +a sort declaration +a numeral for the arity of the sort being declared + +input: OPEN DECLARE_SORT UNDERSCORE +## +## Ends in an error in state: 516. +## +## command -> OPEN DECLARE_SORT . SYMBOL NUM CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT +## + +072 +a sort declaration +a symbol for the sort name + +input: OPEN DEFINE_FUN SYMBOL OPEN CLOSE SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 514. +## +## command -> OPEN DEFINE_FUN function_def . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN function_def +## + +073 +a function definition +a closing parenthesis + +input: OPEN DEFINE_FUN UNDERSCORE +## +## Ends in an error in state: 513. +## +## command -> OPEN DEFINE_FUN . function_def CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN +## + +074 +a function definition +a symbol for the function's name + +input: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 511. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE +## + +075 +a recursive functions definition +a closing parenthesis + +input: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE OPEN UNDERSCORE +## +## Ends in an error in state: 509. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN . nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN +## + +076 +a recursive functions definition +a term for the first function's body + +input: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 508. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE . OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE +## + +077 +a recursive functions definition +an opening parenthesis to start a list the function's bodies + +input: OPEN DEFINE_FUNS_REC OPEN UNDERSCORE +## +## Ends in an error in state: 506. +## +## command -> OPEN DEFINE_FUNS_REC OPEN . nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN +## + +078 +a recursive functions definition +a function declaration of the form "(name (sort*) sort)" + +input: OPEN DEFINE_FUNS_REC UNDERSCORE +## +## Ends in an error in state: 505. +## +## command -> OPEN DEFINE_FUNS_REC . OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC +## + +079 +a recursive functions declaration +an opening parenthesis to start a list of function declaration + +input: OPEN DEFINE_FUN_REC SYMBOL OPEN CLOSE SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 503. +## +## command -> OPEN DEFINE_FUN_REC function_def . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN_REC function_def +## + +080 +a recursive function definition +a closing parenthesis + +input: OPEN DEFINE_FUN_REC UNDERSCORE +## +## Ends in an error in state: 502. +## +## command -> OPEN DEFINE_FUN_REC . function_def CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN_REC +## + +081 +a recursive function definition +a symbol for the function's name + +input: OPEN DEFINE_SORT SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 500. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort +## + +082 +a sort definition +a closing parenthesis + +input: OPEN DEFINE_SORT SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 499. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE . sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE +## + +083 +a sort definition +a sort for the definition body + +input: OPEN DEFINE_SORT SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 497. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN . list(SYMBOL) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN +## + +084 +a sort definition +a closing parenthesis, or a list of symbols for the definition arguments + +input: OPEN DEFINE_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 496. +## +## command -> OPEN DEFINE_SORT SYMBOL . OPEN list(SYMBOL) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL +## + +085 +a sort definition +an opening parenthesis to start a list of arguments + +input: OPEN DEFINE_SORT UNDERSCORE +## +## Ends in an error in state: 495. +## +## command -> OPEN DEFINE_SORT . SYMBOL OPEN list(SYMBOL) CLOSE sort CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT +## + +086 +a sort definition +a symbol for the defined sort's name + +input: OPEN ECHO STR UNDERSCORE +## +## Ends in an error in state: 490. +## +## command -> OPEN ECHO STR . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ECHO STR +## + +087 +an echo command +a closing parenthesis + +input: OPEN ECHO UNDERSCORE +## +## Ends in an error in state: 489. +## +## command -> OPEN ECHO . STR CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN ECHO +## + +088 +an echo command +a string literal + +input: OPEN EXIT UNDERSCORE +## +## Ends in an error in state: 487. +## +## command -> OPEN EXIT . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN EXIT +## + +089 +an exit command +a closing parenthesis + +input: OPEN GET_ASSERTIONS UNDERSCORE +## +## Ends in an error in state: 485. +## +## command -> OPEN GET_ASSERTIONS . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_ASSERTIONS +## + +090 +a get-assertions command +a closing parenthesis + +input: OPEN GET_ASSIGNMENT UNDERSCORE +## +## Ends in an error in state: 483. +## +## command -> OPEN GET_ASSIGNMENT . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_ASSIGNMENT +## + +091 +a get-assignment command +a closing parenthesis + +input: OPEN GET_INFO KEYWORD UNDERSCORE +## +## Ends in an error in state: 481. +## +## command -> OPEN GET_INFO info_flag . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_INFO info_flag +## + +092 +a get-info command +a closing parenthesis + +input: OPEN GET_INFO UNDERSCORE +## +## Ends in an error in state: 480. +## +## command -> OPEN GET_INFO . info_flag CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_INFO +## + +093 +a get-info command +a keyword of the form ":symbol" + +input: OPEN GET_MODEL UNDERSCORE +## +## Ends in an error in state: 478. +## +## command -> OPEN GET_MODEL . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_MODEL +## + +094 +a get-model command +a closing parenthesis + +input: OPEN GET_OPTION KEYWORD UNDERSCORE +## +## Ends in an error in state: 476. +## +## command -> OPEN GET_OPTION KEYWORD . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_OPTION KEYWORD +## + +095 +a get-option command +a closing parenthesis + +input: OPEN GET_OPTION UNDERSCORE +## +## Ends in an error in state: 475. +## +## command -> OPEN GET_OPTION . KEYWORD CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_OPTION +## + +096 +a get-option command +a keyword of the form ":symbol" + +input: OPEN GET_PROOF UNDERSCORE +## +## Ends in an error in state: 473. +## +## command -> OPEN GET_PROOF . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_PROOF +## + +097 +a get-proof command +a closing parenthesis + +input: OPEN GET_UNSAT_ASSUMPTIONS UNDERSCORE +## +## Ends in an error in state: 471. +## +## command -> OPEN GET_UNSAT_ASSUMPTIONS . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_UNSAT_ASSUMPTIONS +## + +098 +a get-unsat-assumptions command +a closing parenthesis + +input: OPEN GET_UNSAT_CORE UNDERSCORE +## +## Ends in an error in state: 469. +## +## command -> OPEN GET_UNSAT_CORE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_UNSAT_CORE +## + +099 +a get-unsat-core command +a closing parenthesis + +input: OPEN GET_VALUE OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 467. +## +## command -> OPEN GET_VALUE OPEN nonempty_list(term) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE OPEN nonempty_list(term) CLOSE +## + +100 +a get-value command +a closing parenthesis + +input: OPEN GET_VALUE OPEN UNDERSCORE +## +## Ends in an error in state: 465. +## +## command -> OPEN GET_VALUE OPEN . nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE OPEN +## + +101 +a get-value command +a term + +input: OPEN GET_VALUE UNDERSCORE +## +## Ends in an error in state: 464. +## +## command -> OPEN GET_VALUE . OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE +## + +102 +a get-value command +an opening parenthesis to start a list of terms + +input: OPEN POP NUM UNDERSCORE +## +## Ends in an error in state: 462. +## +## command -> OPEN POP NUM . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN POP NUM +## + +103 +a pop command +a closing parenthesis + +input: OPEN POP UNDERSCORE +## +## Ends in an error in state: 461. +## +## command -> OPEN POP . NUM CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN POP +## + +104 +a pop command +a numeral + +input: OPEN PUSH NUM UNDERSCORE +## +## Ends in an error in state: 459. +## +## command -> OPEN PUSH NUM . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN PUSH NUM +## + +105 +a push command +a closing parenthesis + +input: OPEN PUSH UNDERSCORE +## +## Ends in an error in state: 458. +## +## command -> OPEN PUSH . NUM CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN PUSH +## + +106 +a push command +a numeral + +input: OPEN RESET UNDERSCORE +## +## Ends in an error in state: 456. +## +## command -> OPEN RESET . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN RESET +## + +107 +a reset command +a closing parenthesis + +input: OPEN RESET_ASSERTIONS UNDERSCORE +## +## Ends in an error in state: 454. +## +## command -> OPEN RESET_ASSERTIONS . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN RESET_ASSERTIONS +## + +108 +a reset-assertions command +a closing parenthesis + +input: OPEN SET_INFO KEYWORD KEYWORD +## +## Ends in an error in state: 452. +## +## command -> OPEN SET_INFO command_option . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_INFO command_option +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 3, spurious reduction of production option(attribute_value) -> +## In state 74, spurious reduction of production attribute -> KEYWORD option(attribute_value) +## In state 78, spurious reduction of production command_option -> attribute +## + +109 +a set-info command +a closing parenthesis, or an attribute value; +note that keywords and reserved words (such as '_', 'as', ...) are not +valid attribute values, and thus are not allowed here + +input: OPEN SET_INFO UNDERSCORE +## +## Ends in an error in state: 451. +## +## command -> OPEN SET_INFO . command_option CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_INFO +## + +110 +a set-info command +an attribute of the form "keyword value?" + +input: OPEN SET_LOGIC SYMBOL UNDERSCORE +## +## Ends in an error in state: 449. +## +## command -> OPEN SET_LOGIC SYMBOL . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_LOGIC SYMBOL +## + +111 +a set-logic command +a closing parenthesis + +input: OPEN SET_LOGIC UNDERSCORE +## +## Ends in an error in state: 448. +## +## command -> OPEN SET_LOGIC . SYMBOL CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_LOGIC +## + +112 +a set-logic command +a symbol for the logic name + +input: OPEN SET_OPTION KEYWORD KEYWORD +## +## Ends in an error in state: 446. +## +## command -> OPEN SET_OPTION command_option . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_OPTION command_option +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 3, spurious reduction of production option(attribute_value) -> +## In state 74, spurious reduction of production attribute -> KEYWORD option(attribute_value) +## In state 78, spurious reduction of production command_option -> attribute +## + +113 +a set-option command +a closing parenthesis, or an attribute value; +note that keywords and reserved words (such as '_', 'as', ...) are not +valid attribute values, and thus are not allowed here + +input: OPEN SET_OPTION UNDERSCORE +## +## Ends in an error in state: 445. +## +## command -> OPEN SET_OPTION . command_option CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN SET_OPTION +## + +114 +a set-option command +an attribute of the form "keyword value?" + +input: OPEN UNDERSCORE +## +## Ends in an error in state: 444. +## +## command -> OPEN . ASSERT term CLOSE [ # ] +## command -> OPEN . CHECK_SAT CLOSE [ # ] +## command -> OPEN . CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE CLOSE [ # ] +## command -> OPEN . DECLARE_CONST SYMBOL sort CLOSE [ # ] +## command -> OPEN . DECLARE_DATATYPE SYMBOL datatype_dec CLOSE [ # ] +## command -> OPEN . DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ # ] +## command -> OPEN . DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort CLOSE [ # ] +## command -> OPEN . DECLARE_SORT SYMBOL NUM CLOSE [ # ] +## command -> OPEN . DEFINE_FUN function_def CLOSE [ # ] +## command -> OPEN . DEFINE_FUN_REC function_def CLOSE [ # ] +## command -> OPEN . DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## command -> OPEN . DEFINE_SYS system_def CLOSE [ # ] +## command -> OPEN . DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ # ] +## command -> OPEN . CHECK_SYS system_check CLOSE [ # ] +## command -> OPEN . DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort CLOSE [ # ] +## command -> OPEN . ECHO STR CLOSE [ # ] +## command -> OPEN . EXIT CLOSE [ # ] +## command -> OPEN . GET_ASSERTIONS CLOSE [ # ] +## command -> OPEN . GET_ASSIGNMENT CLOSE [ # ] +## command -> OPEN . GET_INFO info_flag CLOSE [ # ] +## command -> OPEN . GET_MODEL CLOSE [ # ] +## command -> OPEN . GET_OPTION KEYWORD CLOSE [ # ] +## command -> OPEN . GET_PROOF CLOSE [ # ] +## command -> OPEN . GET_UNSAT_ASSUMPTIONS CLOSE [ # ] +## command -> OPEN . GET_UNSAT_CORE CLOSE [ # ] +## command -> OPEN . GET_VALUE OPEN nonempty_list(term) CLOSE CLOSE [ # ] +## command -> OPEN . POP NUM CLOSE [ # ] +## command -> OPEN . PUSH NUM CLOSE [ # ] +## command -> OPEN . RESET CLOSE [ # ] +## command -> OPEN . RESET_ASSERTIONS CLOSE [ # ] +## command -> OPEN . SET_INFO command_option CLOSE [ # ] +## command -> OPEN . SET_LOGIC SYMBOL CLOSE [ # ] +## command -> OPEN . SET_OPTION command_option CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +115 +a command +a command name + +input: UNDERSCORE +## +## Ends in an error in state: 443. +## +## input' -> . input [ # ] +## +## The known suffix of the stack is as follows: +## +## + +116 +an input statement +an opening parenthesis to start a command + +file: OPEN ASSERT OPEN ATTRIBUTE SYMBOL UNDERSCORE +## +## Ends in an error in state: 175. +## +## term -> OPEN ATTRIBUTE term . nonempty_list(attribute) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN ATTRIBUTE term +## + +006 +attributes for a term +an attribute of the form "keyword value" + +file: OPEN ASSERT OPEN ATTRIBUTE UNDERSCORE +## +## Ends in an error in state: 174. +## +## term -> OPEN ATTRIBUTE . term nonempty_list(attribute) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN ATTRIBUTE +## + +007 +a term with attribute +a term. + +file: OPEN ASSERT OPEN EXISTS OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 172. +## +## term -> OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE term . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE term +## + +008 +a term +a closing parenthesis to end the existencially quantified formula + +file: OPEN ASSERT OPEN EXISTS OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 171. +## +## term -> OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE . term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN nonempty_list(sorted_var) CLOSE +## + +009 +a term +a term (body for the existencial quantification) + +file: OPEN ASSERT OPEN EXISTS OPEN UNDERSCORE +## +## Ends in an error in state: 169. +## +## term -> OPEN EXISTS OPEN . nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS OPEN +## + +010 +a term +a sorted variable of the form "(var sort)" + +file: OPEN ASSERT OPEN EXISTS UNDERSCORE +## +## Ends in an error in state: 168. +## +## term -> OPEN EXISTS . OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN EXISTS +## + +011 +a term +a list of sorted variables, starting with an opening parenthesis + +file: OPEN ASSERT OPEN FORALL OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 166. +## +## term -> OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE term . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE term +## + +012 +a term +a closing parenthesis to end the universally quantified formula + +file: OPEN ASSERT OPEN FORALL OPEN OPEN SYMBOL SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 165. +## +## term -> OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE . term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN nonempty_list(sorted_var) CLOSE +## + +013 +a term +a term (body for the universal quantification) + +file: OPEN ASSERT OPEN FORALL OPEN UNDERSCORE +## +## Ends in an error in state: 157. +## +## term -> OPEN FORALL OPEN . nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL OPEN +## + +018 +a term +a sorted variable of the form "(var sort)" + +file: OPEN ASSERT OPEN FORALL UNDERSCORE +## +## Ends in an error in state: 156. +## +## term -> OPEN FORALL . OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN FORALL +## + +019 +a term +a list of sorted variables, starting with an opening parenthesis + +file: OPEN ASSERT OPEN LET OPEN OPEN SYMBOL BIN CLOSE CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 154. +## +## term -> OPEN LET OPEN nonempty_list(var_binding) CLOSE term . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN nonempty_list(var_binding) CLOSE term +## + +020 +a term +a closing parenthesis to end the let binding + +file: OPEN ASSERT OPEN LET OPEN OPEN SYMBOL BIN CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 153. +## +## term -> OPEN LET OPEN nonempty_list(var_binding) CLOSE . term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN nonempty_list(var_binding) CLOSE +## + +021 +a term +a term (body for the let binding) + +file: OPEN ASSERT OPEN LET OPEN UNDERSCORE +## +## Ends in an error in state: 145. +## +## term -> OPEN LET OPEN . nonempty_list(var_binding) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN LET OPEN +## + +026 +a term +a variable binding of the form "(var term)" + +file: OPEN ASSERT OPEN LET UNDERSCORE +## +## Ends in an error in state: 144. +## +## term -> OPEN LET . OPEN nonempty_list(var_binding) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN LET +## + +027 +a term +a variable binding list, starting with an opening parenthesis + +file: OPEN ASSERT OPEN MATCH SYMBOL OPEN OPEN SYMBOL BIN CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 140. +## +## term -> OPEN MATCH term OPEN nonempty_list(match_case) CLOSE . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term OPEN nonempty_list(match_case) CLOSE +## + +031 +a match +a closing parenthesis to close the match + +file: OPEN ASSERT OPEN MATCH SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 123. +## +## term -> OPEN MATCH term OPEN . nonempty_list(match_case) CLOSE CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term OPEN +## + +036 +a list of match cases +a match case of the form "(pattern term)" + +file: OPEN ASSERT OPEN MATCH SYMBOL UNDERSCORE +## +## Ends in an error in state: 122. +## +## term -> OPEN MATCH term . OPEN nonempty_list(match_case) CLOSE CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH term +## + +037 +a match +a match case list, starting with an opening parenthesis + +file: OPEN ASSERT OPEN MATCH UNDERSCORE +## +## Ends in an error in state: 121. +## +## term -> OPEN MATCH . term OPEN nonempty_list(match_case) CLOSE CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN MATCH +## + +038 +a match +a term to match (i.e. the scrutinee of the match) + +file: OPEN ASSERT OPEN STR +## +## Ends in an error in state: 98. +## +## identifier -> OPEN . UNDERSCORE SYMBOL nonempty_list(index) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## qual_identifier -> OPEN . AS identifier sort CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . qual_identifier nonempty_list(term) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . LET OPEN nonempty_list(var_binding) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . FORALL OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . EXISTS OPEN nonempty_list(sorted_var) CLOSE term CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . MATCH term OPEN nonempty_list(match_case) CLOSE CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## term -> OPEN . ATTRIBUTE term nonempty_list(attribute) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +042 +a term +a term construction (identifier, let binding, quantification, ...); +note that this expectation if caused by the preceding opening parenthesis + +file: OPEN ASSERT OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 180. +## +## term -> OPEN qual_identifier . nonempty_list(term) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT SYMBOL STR OPEN NUM KEYWORD HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN qual_identifier +## + +044 +a function application +a term as argument; +note that keywords and reserved words (such as '_', 'as', ...) are +not terms, and thus are not allowed here + +file: OPEN ASSERT SYMBOL UNDERSCORE +## +## Ends in an error in state: 436. +## +## command -> OPEN ASSERT term . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN ASSERT term +## + +049 +an assertion +a closing parenthesis + +file: OPEN ASSERT UNDERSCORE +## +## Ends in an error in state: 435. +## +## command -> OPEN ASSERT . term CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN ASSERT +## + +048 +a term +a term construction (symbol, function application, match, let binding, ...); +note that keywords and reserved words (such as '_', 'as', ...) are +not symbols, and thus are not allowed here + +file: OPEN CHECK_SAT UNDERSCORE +## +## Ends in an error in state: 433. +## +## command -> OPEN CHECK_SAT . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT +## + +050 +a check-sat command +a closing parenthesis + +file: OPEN CHECK_SAT_ASSUMING OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 431. +## +## command -> OPEN CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE +## + +051 +a check-sat-assuming command +a closing parenthesis + +file: OPEN CHECK_SAT_ASSUMING OPEN OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 424. +## +## prop_literal -> OPEN not_symbol prop_symbol . CLOSE [ SYMBOL OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN not_symbol prop_symbol +## + +046 +a propositional literal +a closing parenthesis + +file: OPEN CHECK_SAT_ASSUMING OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 423. +## +## prop_literal -> OPEN not_symbol . prop_symbol CLOSE [ SYMBOL OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN not_symbol +## + +047 +a propositional literal +a symbol + +file: OPEN CHECK_SAT_ASSUMING OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 421. +## +## prop_literal -> OPEN . not_symbol prop_symbol CLOSE [ SYMBOL OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +117 +a propositional literal +the "not" symbol + +file: OPEN CHECK_SAT_ASSUMING OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 428. +## +## list(prop_literal) -> prop_literal . list(prop_literal) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## prop_literal +## + +119 +a list of propositional literals +a propositional literal of the form "symbol" or "(not symbol)" + +file: OPEN CHECK_SAT_ASSUMING OPEN UNDERSCORE +## +## Ends in an error in state: 420. +## +## command -> OPEN CHECK_SAT_ASSUMING OPEN . list(prop_literal) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING OPEN +## + +052 +a list of propositional literals +a propositional literal, i.e. either a symbol or the negation of a symbol + +file: OPEN CHECK_SAT_ASSUMING UNDERSCORE +## +## Ends in an error in state: 419. +## +## command -> OPEN CHECK_SAT_ASSUMING . OPEN list(prop_literal) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SAT_ASSUMING +## + +053 +a check-sat-assuming command +a list of propositional literals, starting with an opening parenthesis + +file: OPEN DECLARE_CONST SYMBOL OPEN STR +## +## Ends in an error in state: 112. +## +## identifier -> OPEN . UNDERSCORE SYMBOL nonempty_list(index) CLOSE [ SYMBOL STR OPEN NUM HEX DEC CLOSE BIN ] +## sort -> OPEN . identifier nonempty_list(sort) CLOSE [ SYMBOL STR OPEN NUM HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +120 +a sort +an identifier to make a sort function application (such as "f x y"), +or an underscore to start an indexed identifier + +file: OPEN DECLARE_CONST SYMBOL OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 114. +## +## nonempty_list(sort) -> sort . [ CLOSE ] +## nonempty_list(sort) -> sort . nonempty_list(sort) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sort +## + +121 +a list of sorts +a sort, or a closing parenthesis + +file: OPEN DECLARE_CONST SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 113. +## +## sort -> OPEN identifier . nonempty_list(sort) CLOSE [ SYMBOL STR OPEN NUM HEX DEC CLOSE BIN ] +## +## The known suffix of the stack is as follows: +## OPEN identifier +## + +122 +a sort +a sort to start a non-empty list of arguments + +file: OPEN DECLARE_CONST SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 377. +## +## command -> OPEN DECLARE_CONST SYMBOL sort . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST SYMBOL sort +## + +054 +a constant declaration +a closing parenthesis + +file: OPEN DECLARE_CONST SYMBOL UNDERSCORE +## +## Ends in an error in state: 376. +## +## command -> OPEN DECLARE_CONST SYMBOL . sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST SYMBOL +## + +055 +a constant declaration +a sort + +file: OPEN DECLARE_CONST UNDERSCORE +## +## Ends in an error in state: 375. +## +## command -> OPEN DECLARE_CONST . SYMBOL sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_CONST +## + +056 +a constant declaration +a symbol; +note that keywords and reserved words (such as '_', 'as', ...) are not +symbols, and thus are not allowed here + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 373. +## +## command -> OPEN DECLARE_DATATYPE SYMBOL datatype_dec . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE SYMBOL datatype_dec +## + +057 +a datatype declaration +a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 360. +## +## nonempty_list(constructor_dec) -> constructor_dec . [ CLOSE ] +## nonempty_list(constructor_dec) -> constructor_dec . nonempty_list(constructor_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## constructor_dec +## + +123 +a list of constructor declarations +another constructor declaration of the form "(constructor selectors*)", +or a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 353. +## +## list(selector_dec) -> selector_dec . list(selector_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## selector_dec +## + +124 +a list of selectors +another selector of the form "(selector sort)", or a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 351. +## +## selector_dec -> OPEN SYMBOL sort . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL sort +## + +125 +a selector declaration +a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 350. +## +## selector_dec -> OPEN SYMBOL . sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +126 +a selector declaration +a sort for the return type of the selector + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 349. +## +## selector_dec -> OPEN . SYMBOL sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +127 +a selector declaration +a symbol for the selector name + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 348. +## +## constructor_dec -> OPEN SYMBOL . list(selector_dec) CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +128 +a constructor declaration +a selector declaration, of the form "(selector sort)", or a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 347. +## +## constructor_dec -> OPEN . SYMBOL list(selector_dec) CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +129 +a constructor declaration +a symbol for the constructor name + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR OPEN SYMBOL CLOSE OPEN OPEN SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 358. +## +## datatype_dec -> OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE OPEN nonempty_list(constructor_dec) CLOSE . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE OPEN nonempty_list(constructor_dec) CLOSE +## + +130 +a datatype declaration +a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR OPEN SYMBOL CLOSE OPEN UNDERSCORE +## +## Ends in an error in state: 346. +## +## datatype_dec -> OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE OPEN . nonempty_list(constructor_dec) CLOSE CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE OPEN +## + +131 +a datatype declaration +a constructor declaration of the form "(symbol selector*)" + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 345. +## +## datatype_dec -> OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE . OPEN nonempty_list(constructor_dec) CLOSE CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN PAR OPEN nonempty_list(datatype_symbol) CLOSE +## + +132 +a datatype declaration +an opening parenthesis to start the list of constructors + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 362. +## +## nonempty_list(datatype_symbol) -> datatype_symbol . [ CLOSE ] +## nonempty_list(datatype_symbol) -> datatype_symbol . nonempty_list(datatype_symbol) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## datatype_symbol +## + +133 +a list of sort variables to parameterize a datatype +another symbol, or a closing parenthesis + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR OPEN UNDERSCORE +## +## Ends in an error in state: 342. +## +## datatype_dec -> OPEN PAR OPEN . nonempty_list(datatype_symbol) CLOSE OPEN nonempty_list(constructor_dec) CLOSE CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN PAR OPEN +## + +134 +a list of sort variables to parameterize a datatype +a symbol + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN PAR UNDERSCORE +## +## Ends in an error in state: 341. +## +## datatype_dec -> OPEN PAR . OPEN nonempty_list(datatype_symbol) CLOSE OPEN nonempty_list(constructor_dec) CLOSE CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN PAR +## + +135 +a datatype declaration +an opening parenthesis to start a list of sort parameters for the datatype + +file: OPEN DECLARE_DATATYPE SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 340. +## +## datatype_dec -> OPEN . nonempty_list(constructor_dec) CLOSE [ OPEN CLOSE ] +## datatype_dec -> OPEN . PAR OPEN nonempty_list(datatype_symbol) CLOSE OPEN nonempty_list(constructor_dec) CLOSE CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +136 +a datatype declaration +a list of constructor declarations of the form "(symbol selector*)", +or a parameterization of the datatype of the form "par (sort+)" + +file: OPEN DECLARE_DATATYPE SYMBOL UNDERSCORE +## +## Ends in an error in state: 372. +## +## command -> OPEN DECLARE_DATATYPE SYMBOL . datatype_dec CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE SYMBOL +## + +058 +a datatype declaration +an opening parenthesis to start the datatype declaration + +file: OPEN DECLARE_DATATYPE UNDERSCORE +## +## Ends in an error in state: 371. +## +## command -> OPEN DECLARE_DATATYPE . SYMBOL datatype_dec CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPE +## + +059 +a datatype declaration +a symbol + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE OPEN OPEN OPEN SYMBOL CLOSE CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 367. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE +## + +060 +a datatypes declaration +a closing parenthesis + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE OPEN OPEN OPEN SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 369. +## +## nonempty_list(datatype_dec) -> datatype_dec . [ CLOSE ] +## nonempty_list(datatype_dec) -> datatype_dec . nonempty_list(datatype_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## datatype_dec +## + +137 +a list of datatype declarations +another datatype declaration, or a closing parenthesis + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE OPEN UNDERSCORE +## +## Ends in an error in state: 339. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN . nonempty_list(datatype_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN +## + +061 +a datatypes definition +an opening parenthesis to start a list of constructors for the first defined datatype + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 338. +## +## command -> OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE . OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE +## + +062 +a datatypes declaration +an opening parenthesis to start a list of datatype definitions, +one for each of the sorts being declared + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM CLOSE UNDERSCORE +## +## Ends in an error in state: 335. +## +## nonempty_list(sort_dec) -> sort_dec . [ CLOSE ] +## nonempty_list(sort_dec) -> sort_dec . nonempty_list(sort_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sort_dec +## + +138 +a list of datatype arity declarations +another datatype arity declaration, or a closing parenthesis + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL NUM UNDERSCORE +## +## Ends in an error in state: 333. +## +## sort_dec -> OPEN SYMBOL NUM . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL NUM +## + +139 +a datatype arity declaration +a closing parenthesis + +file: OPEN DECLARE_DATATYPES OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 332. +## +## sort_dec -> OPEN SYMBOL . NUM CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +140 +a datatype arity declaration +a numeral for the datatype arity + +file: OPEN DECLARE_DATATYPES OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 331. +## +## sort_dec -> OPEN . SYMBOL NUM CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +141 +a datatype arity declaration +a symbol for the datatype name + +file: OPEN DECLARE_DATATYPES OPEN UNDERSCORE +## +## Ends in an error in state: 330. +## +## command -> OPEN DECLARE_DATATYPES OPEN . nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES OPEN +## + +063 +a datatypes declaration +a parametric sort declaration of the form "(symbol num)" + +file: OPEN DECLARE_DATATYPES UNDERSCORE +## +## Ends in an error in state: 329. +## +## command -> OPEN DECLARE_DATATYPES . OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_DATATYPES +## + +064 +a datatypes declaration +a list of sort declaration, starting with an opening parenthesis + +file: OPEN DECLARE_FUN SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 318. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort +## + +065 +a function declaration +a closing parenthesis + +file: OPEN DECLARE_FUN SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 317. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE . sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN list(sort) CLOSE +## + +066 +a function declaration +a sort for the return type of the function + +file: OPEN DECLARE_FUN SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 314. +## +## list(sort) -> sort . list(sort) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sort +## + +142 +a list of sorts +another sort or a closing parenthesis + +file: OPEN DECLARE_FUN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 313. +## +## command -> OPEN DECLARE_FUN SYMBOL OPEN . list(sort) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL OPEN +## + +067 +a function declaration +a closing parenthesis, or a list of sorts for the arguments of the function + +file: OPEN DECLARE_FUN SYMBOL UNDERSCORE +## +## Ends in an error in state: 312. +## +## command -> OPEN DECLARE_FUN SYMBOL . OPEN list(sort) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN SYMBOL +## + +068 +a function declaration +an opening parenthesis to start the list of sorts for the function's arguments + +file: OPEN DECLARE_FUN UNDERSCORE +## +## Ends in an error in state: 311. +## +## command -> OPEN DECLARE_FUN . SYMBOL OPEN list(sort) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_FUN +## + +069 +a function declaration +a symbol for the function's name + +file: OPEN DECLARE_SORT SYMBOL NUM UNDERSCORE +## +## Ends in an error in state: 309. +## +## command -> OPEN DECLARE_SORT SYMBOL NUM . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT SYMBOL NUM +## + +070 +a sort declaration +a closing parenthesis + +file: OPEN DECLARE_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 308. +## +## command -> OPEN DECLARE_SORT SYMBOL . NUM CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT SYMBOL +## + +071 +a sort declaration +a numeral for the arity of the sort being declared + +file: OPEN DECLARE_SORT UNDERSCORE +## +## Ends in an error in state: 307. +## +## command -> OPEN DECLARE_SORT . SYMBOL NUM CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_SORT +## + +072 +a sort declaration +a symbol for the sort name + +file: OPEN DEFINE_FUN SYMBOL OPEN CLOSE SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 305. +## +## command -> OPEN DEFINE_FUN function_def . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN function_def +## + +073 +a function definition +a closing parenthesis + +file: OPEN DEFINE_FUN UNDERSCORE +## +## Ends in an error in state: 304. +## +## command -> OPEN DEFINE_FUN . function_def CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN +## + +074 +a function definition +a symbol for the function's name + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 300. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE +## + +075 +a recursive functions definition +a closing parenthesis + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE OPEN UNDERSCORE +## +## Ends in an error in state: 298. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN . nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN +## + +076 +a recursive functions definition +a term for the first function's body + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 297. +## +## command -> OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE . OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE +## + +077 +a recursive functions definition +an opening parenthesis to start a list the function's bodies + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 302. +## +## nonempty_list(function_dec) -> function_dec . [ CLOSE ] +## nonempty_list(function_dec) -> function_dec . nonempty_list(function_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## function_dec +## + +143 +a list of function declarations +another function declaration, or a closing parenthesis + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 294. +## +## function_dec -> OPEN SYMBOL OPEN list(sorted_var) CLOSE sort . CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL OPEN list(sorted_var) CLOSE sort +## + +144 +a function declaration +a closing parenthesis + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 293. +## +## function_dec -> OPEN SYMBOL OPEN list(sorted_var) CLOSE . sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL OPEN list(sorted_var) CLOSE +## + +145 +a function declaration +a sort for the return type of the function + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 291. +## +## function_dec -> OPEN SYMBOL OPEN . list(sorted_var) CLOSE sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL OPEN +## + +146 +a function declaration +either a sort for the first argument type, or a closing parenthesis + +file: OPEN DEFINE_FUNS_REC OPEN OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 290. +## +## function_dec -> OPEN SYMBOL . OPEN list(sorted_var) CLOSE sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +147 +a function declaration +an opening parenthesis to start the list of arguments sorts + +file: OPEN DEFINE_FUNS_REC OPEN OPEN UNDERSCORE +## +## Ends in an error in state: 289. +## +## function_dec -> OPEN . SYMBOL OPEN list(sorted_var) CLOSE sort CLOSE [ OPEN CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +148 +a function declaration +a symbol for the function name + +file: OPEN DEFINE_FUNS_REC OPEN UNDERSCORE +## +## Ends in an error in state: 288. +## +## command -> OPEN DEFINE_FUNS_REC OPEN . nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC OPEN +## + +078 +a recursive functions definition +a function declaration of the form "(name (sort*) sort)" + +file: OPEN DEFINE_FUNS_REC UNDERSCORE +## +## Ends in an error in state: 287. +## +## command -> OPEN DEFINE_FUNS_REC . OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUNS_REC +## + +079 +a recursive functions declaration +an opening parenthesis to start a list of function declaration + +file: OPEN DEFINE_FUN_REC SYMBOL OPEN CLOSE SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 285. +## +## command -> OPEN DEFINE_FUN_REC function_def . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN_REC function_def +## + +080 +a recursive function definition +a closing parenthesis + +file: OPEN DEFINE_FUN_REC SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 283. +## +## function_def -> SYMBOL OPEN list(sorted_var) CLOSE sort . term [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL OPEN list(sorted_var) CLOSE sort +## + +149 +a function definition +a term for the body of the function + +file: OPEN DEFINE_FUN_REC SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 282. +## +## function_def -> SYMBOL OPEN list(sorted_var) CLOSE . sort term [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL OPEN list(sorted_var) CLOSE +## + +150 +a function definition +a sort for the return type of the function + +file: OPEN DEFINE_FUN_REC SYMBOL OPEN OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 216. +## +## list(sorted_var) -> sorted_var . list(sorted_var) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sorted_var +## + +151 +a list of sorted variables +another sorted variable of the form "(var sort)", or a closing parenthesis + +file: OPEN DEFINE_FUN_REC SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 280. +## +## function_def -> SYMBOL OPEN . list(sorted_var) CLOSE sort term [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL OPEN +## + +152 +a function definition +a sorted variable of the form "(var sort)", or a closing parenthesis + +file: OPEN DEFINE_FUN_REC SYMBOL UNDERSCORE +## +## Ends in an error in state: 279. +## +## function_def -> SYMBOL . OPEN list(sorted_var) CLOSE sort term [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL +## + +153 +a function definition +an opening parenthesis to start the list of arguments + +file: OPEN DEFINE_FUN_REC UNDERSCORE +## +## Ends in an error in state: 278. +## +## command -> OPEN DEFINE_FUN_REC . function_def CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_FUN_REC +## + +081 +a recursive function definition +a symbol for the function's name + +file: OPEN DEFINE_SORT SYMBOL OPEN CLOSE SYMBOL UNDERSCORE +## +## Ends in an error in state: 276. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort +## + +082 +a sort definition +a closing parenthesis + +file: OPEN DEFINE_SORT SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 275. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE . sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE +## + +083 +a sort definition +a sort for the definition body + +file: OPEN DEFINE_SORT SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 272. +## +## list(SYMBOL) -> SYMBOL . list(SYMBOL) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL +## + +154 +a list of symbols +another symbol or a closing parenthesis + +file: OPEN DEFINE_SORT SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 271. +## +## command -> OPEN DEFINE_SORT SYMBOL OPEN . list(SYMBOL) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL OPEN +## + +084 +a sort definition +a closing parenthesis, or a list of symbols for the definition arguments + +file: OPEN DEFINE_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 270. +## +## command -> OPEN DEFINE_SORT SYMBOL . OPEN list(SYMBOL) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT SYMBOL +## + +085 +a sort definition +an opening parenthesis to start a list of arguments + +file: OPEN DEFINE_SORT UNDERSCORE +## +## Ends in an error in state: 269. +## +## command -> OPEN DEFINE_SORT . SYMBOL OPEN list(SYMBOL) CLOSE sort CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SORT +## + +086 +a sort definition +a symbol for the defined sort's name + +file: OPEN ECHO STR UNDERSCORE +## +## Ends in an error in state: 210. +## +## command -> OPEN ECHO STR . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN ECHO STR +## + +087 +an echo command +a closing parenthesis + +file: OPEN ECHO UNDERSCORE +## +## Ends in an error in state: 209. +## +## command -> OPEN ECHO . STR CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN ECHO +## + +088 +an echo command +a string literal + +file: OPEN EXIT UNDERSCORE +## +## Ends in an error in state: 207. +## +## command -> OPEN EXIT . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN EXIT +## + +089 +an exit command +a closing parenthesis + +file: OPEN GET_ASSERTIONS UNDERSCORE +## +## Ends in an error in state: 205. +## +## command -> OPEN GET_ASSERTIONS . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_ASSERTIONS +## + +090 +a get-assertions command +a closing parenthesis + +file: OPEN GET_ASSIGNMENT UNDERSCORE +## +## Ends in an error in state: 203. +## +## command -> OPEN GET_ASSIGNMENT . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_ASSIGNMENT +## + +091 +a get-assignment command +a closing parenthesis + +file: OPEN GET_INFO KEYWORD UNDERSCORE +## +## Ends in an error in state: 201. +## +## command -> OPEN GET_INFO info_flag . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_INFO info_flag +## + +092 +a get-info command +a closing parenthesis + +file: OPEN GET_INFO UNDERSCORE +## +## Ends in an error in state: 199. +## +## command -> OPEN GET_INFO . info_flag CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_INFO +## + +093 +a get-info command +a keyword of the form ":symbol" + +file: OPEN GET_MODEL UNDERSCORE +## +## Ends in an error in state: 197. +## +## command -> OPEN GET_MODEL . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_MODEL +## + +094 +a get-model command +a closing parenthesis + +file: OPEN GET_OPTION KEYWORD UNDERSCORE +## +## Ends in an error in state: 195. +## +## command -> OPEN GET_OPTION KEYWORD . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_OPTION KEYWORD +## + +095 +a get-option command +a closing parenthesis + +file: OPEN GET_OPTION UNDERSCORE +## +## Ends in an error in state: 194. +## +## command -> OPEN GET_OPTION . KEYWORD CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_OPTION +## + +096 +a get-option command +a keyword of the form ":symbol" + +file: OPEN GET_PROOF UNDERSCORE +## +## Ends in an error in state: 192. +## +## command -> OPEN GET_PROOF . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_PROOF +## + +097 +a get-proof command +a closing parenthesis + +file: OPEN GET_UNSAT_ASSUMPTIONS UNDERSCORE +## +## Ends in an error in state: 190. +## +## command -> OPEN GET_UNSAT_ASSUMPTIONS . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_UNSAT_ASSUMPTIONS +## + +098 +a get-unsat-assumptions command +a closing parenthesis + +file: OPEN GET_UNSAT_CORE UNDERSCORE +## +## Ends in an error in state: 188. +## +## command -> OPEN GET_UNSAT_CORE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_UNSAT_CORE +## + +099 +a get-unsat-core command +a closing parenthesis + +file: OPEN GET_VALUE OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 186. +## +## command -> OPEN GET_VALUE OPEN nonempty_list(term) CLOSE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE OPEN nonempty_list(term) CLOSE +## + +100 +a get-value command +a closing parenthesis + +file: OPEN GET_VALUE OPEN UNDERSCORE +## +## Ends in an error in state: 96. +## +## command -> OPEN GET_VALUE OPEN . nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE OPEN +## + +101 +a get-value command +a term + +file: OPEN GET_VALUE UNDERSCORE +## +## Ends in an error in state: 95. +## +## command -> OPEN GET_VALUE . OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN GET_VALUE +## + +102 +a get-value command +an opening parenthesis to start a list of terms + +file: OPEN POP NUM UNDERSCORE +## +## Ends in an error in state: 93. +## +## command -> OPEN POP NUM . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN POP NUM +## + +103 +a pop command +a closing parenthesis + +file: OPEN POP UNDERSCORE +## +## Ends in an error in state: 92. +## +## command -> OPEN POP . NUM CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN POP +## + +104 +a pop command +a numeral + +file: OPEN PUSH NUM UNDERSCORE +## +## Ends in an error in state: 90. +## +## command -> OPEN PUSH NUM . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN PUSH NUM +## + +105 +a push command +a closing parenthesis + +file: OPEN PUSH UNDERSCORE +## +## Ends in an error in state: 89. +## +## command -> OPEN PUSH . NUM CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN PUSH +## + +106 +a push command +a numeral + +file: OPEN RESET UNDERSCORE +## +## Ends in an error in state: 87. +## +## command -> OPEN RESET . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN RESET +## + +107 +a reset command +a closing parenthesis + +file: OPEN RESET_ASSERTIONS CLOSE UNDERSCORE +## +## Ends in an error in state: 441. +## +## list(command) -> command . list(command) [ EOF ] +## +## The known suffix of the stack is as follows: +## command +## + +116 +an input statement +an opening parenthesis to start a command + +file: OPEN RESET_ASSERTIONS UNDERSCORE +## +## Ends in an error in state: 85. +## +## command -> OPEN RESET_ASSERTIONS . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN RESET_ASSERTIONS +## + +108 +a reset-assertions command +a closing parenthesis + +file: OPEN SET_INFO KEYWORD KEYWORD +## +## Ends in an error in state: 83. +## +## command -> OPEN SET_INFO command_option . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_INFO command_option +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 3, spurious reduction of production option(attribute_value) -> +## In state 74, spurious reduction of production attribute -> KEYWORD option(attribute_value) +## In state 78, spurious reduction of production command_option -> attribute +## + +109 +a set-info command +a closing parenthesis, or an attribute value; +note that keywords and reserved words (such as '_', 'as', ...) are not +valid attribute values, and thus are not allowed here + +file: OPEN SET_INFO UNDERSCORE +## +## Ends in an error in state: 82. +## +## command -> OPEN SET_INFO . command_option CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_INFO +## + +110 +a set-info command +an attribute of the form "keyword value?" + +file: OPEN SET_LOGIC SYMBOL UNDERSCORE +## +## Ends in an error in state: 80. +## +## command -> OPEN SET_LOGIC SYMBOL . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_LOGIC SYMBOL +## + +111 +a set-logic command +a closing parenthesis + +file: OPEN SET_LOGIC UNDERSCORE +## +## Ends in an error in state: 79. +## +## command -> OPEN SET_LOGIC . SYMBOL CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_LOGIC +## + +112 +a set-logic command +a symbol for the logic name + +file: OPEN SET_OPTION KEYWORD KEYWORD +## +## Ends in an error in state: 76. +## +## command -> OPEN SET_OPTION command_option . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_OPTION command_option +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 3, spurious reduction of production option(attribute_value) -> +## In state 74, spurious reduction of production attribute -> KEYWORD option(attribute_value) +## In state 78, spurious reduction of production command_option -> attribute +## + +113 +a set-option command +a closing parenthesis, or an attribute value; +note that keywords and reserved words (such as '_', 'as', ...) are not +valid attribute values, and thus are not allowed here + +file: OPEN SET_OPTION KEYWORD OPEN OPEN EOF +## +## Ends in an error in state: 24. +## +## s_expr -> OPEN . list(s_expr) CLOSE [ UNDERSCORE SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT SYMBOL STR SET_OPTION SET_LOGIC SET_INFO RESET_ASSERTIONS RESET PUSH POP PAR OPEN NUM MATCH LET KEYWORD HEX GET_VALUE GET_UNSAT_CORE GET_UNSAT_ASSUMPTIONS GET_PROOF GET_OPTION GET_MODEL GET_INFO GET_ASSIGNMENT GET_ASSERTIONS FORALL EXIT EXISTS ECHO DEFINE_SYS DEFINE_SORT DEFINE_FUN_REC DEFINE_FUNS_REC DEFINE_FUN DECLARE_SORT DECLARE_FUN DECLARE_DATATYPES DECLARE_DATATYPE DECLARE_CONST DEC CLOSE CHECK_SYS CHECK_SAT_ASSUMING CHECK_SAT CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION BIN ATTRIBUTE ASSERT AS ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +155 +an s-expression +a closing parenthesis, or another s-expression, i.e. +a literal, symbol, reserved word, keyword, or an s-expression in parentheses + + +file: OPEN SET_OPTION KEYWORD OPEN SYMBOL EOF +## +## Ends in an error in state: 66. +## +## list(s_expr) -> s_expr . list(s_expr) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## s_expr +## + +156 +a list of s-expressions +a closing parenthesis, or another s-expression, i.e. +a literal, symbol, reserved word, keyword, or an s-expression in parentheses + +file: OPEN SET_OPTION KEYWORD OPEN EOF +## +## Ends in an error in state: 6. +## +## attribute_value -> OPEN . list(s_expr) CLOSE [ KEYWORD CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +157 +an attribute value +a closing parenthesis, or an s-expression, i.e. +a literal, symbol, reserved word, keyword, or an s-expression in parentheses + +file: OPEN SET_OPTION KEYWORD UNDERSCORE +## +## Ends in an error in state: 3. +## +## attribute -> KEYWORD . option(attribute_value) [ KEYWORD CLOSE ] +## +## The known suffix of the stack is as follows: +## KEYWORD +## + +158 +an attribute +either an attribute value as s-expression, +another attribute, or a closing parenthesis + +file: OPEN SET_OPTION UNDERSCORE +## +## Ends in an error in state: 2. +## +## command -> OPEN SET_OPTION . command_option CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN SET_OPTION +## + +114 +a set-option command +an attribute of the form "keyword value?" + +file: OPEN UNDERSCORE +## +## Ends in an error in state: 1. +## +## command -> OPEN . ASSERT term CLOSE [ OPEN EOF ] +## command -> OPEN . CHECK_SAT CLOSE [ OPEN EOF ] +## command -> OPEN . CHECK_SAT_ASSUMING OPEN list(prop_literal) CLOSE CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_CONST SYMBOL sort CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_DATATYPE SYMBOL datatype_dec CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_DATATYPES OPEN nonempty_list(sort_dec) CLOSE OPEN nonempty_list(datatype_dec) CLOSE CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_FUN SYMBOL OPEN list(sort) CLOSE sort CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_SORT SYMBOL NUM CLOSE [ OPEN EOF ] +## command -> OPEN . DEFINE_FUN function_def CLOSE [ OPEN EOF ] +## command -> OPEN . DEFINE_FUN_REC function_def CLOSE [ OPEN EOF ] +## command -> OPEN . DEFINE_FUNS_REC OPEN nonempty_list(function_dec) CLOSE OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## command -> OPEN . DEFINE_SYS system_def CLOSE [ OPEN EOF ] +## command -> OPEN . DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ OPEN EOF ] +## command -> OPEN . CHECK_SYS system_check CLOSE [ OPEN EOF ] +## command -> OPEN . DEFINE_SORT SYMBOL OPEN list(SYMBOL) CLOSE sort CLOSE [ OPEN EOF ] +## command -> OPEN . ECHO STR CLOSE [ OPEN EOF ] +## command -> OPEN . EXIT CLOSE [ OPEN EOF ] +## command -> OPEN . GET_ASSERTIONS CLOSE [ OPEN EOF ] +## command -> OPEN . GET_ASSIGNMENT CLOSE [ OPEN EOF ] +## command -> OPEN . GET_INFO info_flag CLOSE [ OPEN EOF ] +## command -> OPEN . GET_MODEL CLOSE [ OPEN EOF ] +## command -> OPEN . GET_OPTION KEYWORD CLOSE [ OPEN EOF ] +## command -> OPEN . GET_PROOF CLOSE [ OPEN EOF ] +## command -> OPEN . GET_UNSAT_ASSUMPTIONS CLOSE [ OPEN EOF ] +## command -> OPEN . GET_UNSAT_CORE CLOSE [ OPEN EOF ] +## command -> OPEN . GET_VALUE OPEN nonempty_list(term) CLOSE CLOSE [ OPEN EOF ] +## command -> OPEN . POP NUM CLOSE [ OPEN EOF ] +## command -> OPEN . PUSH NUM CLOSE [ OPEN EOF ] +## command -> OPEN . RESET CLOSE [ OPEN EOF ] +## command -> OPEN . RESET_ASSERTIONS CLOSE [ OPEN EOF ] +## command -> OPEN . SET_INFO command_option CLOSE [ OPEN EOF ] +## command -> OPEN . SET_LOGIC SYMBOL CLOSE [ OPEN EOF ] +## command -> OPEN . SET_OPTION command_option CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +115 +a command +a command name + +file: UNDERSCORE +## +## Ends in an error in state: 0. +## +## file' -> . file [ # ] +## +## The known suffix of the stack is as follows: +## +## + +116 +an input statement +an opening parenthesis to start a command + +file: OPEN DEFINE_SYS SYMBOL UNDERSCORE +## +## Ends in an error in state: 213. +## +## system_def -> SYMBOL . opt_system_var_decls opt_subs_and_conds [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL +## + +218 +a system definition +an attribute from the set (:input, :output, :local, :subsys, :init, :trans, :inv) + +file: OPEN CHECK_SYS SYMBOL SYS_OUTPUT UNDERSCORE +## +## Ends in an error in state: 214. +## +## output_var_decl -> SYS_OUTPUT . OPEN list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_OUTPUT +## + +219 +a system output definition +a list of sorted variables + +file: OPEN CHECK_SYS SYMBOL SYS_OUTPUT OPEN UNDERSCORE +## +## Ends in an error in state: 215. +## +## output_var_decl -> SYS_OUTPUT OPEN . list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_OUTPUT OPEN +## + +220 +a system output variable declaration +a sorted variable of the form "(var sort)", or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL SYS_LOCAL UNDERSCORE +## +## Ends in an error in state: 220. +## +## local_var_decl -> SYS_LOCAL . OPEN list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_LOCAL +## + +221 +a system local definition +a list of sorted variables + +file: OPEN CHECK_SYS SYMBOL SYS_LOCAL OPEN UNDERSCORE +## +## Ends in an error in state: 221. +## +## local_var_decl -> SYS_LOCAL OPEN . list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_LOCAL OPEN +## + +222 +a system local variable declaration +a sorted variable of the form "(var sort)", or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL SYS_INPUT UNDERSCORE +## +## Ends in an error in state: 224. +## +## input_var_decl -> SYS_INPUT . OPEN list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_INPUT +## + +223 +a system input definition +a list of sorted variables + +file: OPEN CHECK_SYS SYMBOL SYS_INPUT OPEN UNDERSCORE +## +## Ends in an error in state: 225. +## +## input_var_decl -> SYS_INPUT OPEN . list(sorted_var) CLOSE [ SYS_TRANS SYS_SUBSYS SYS_OUTPUT SYS_LOCAL SYS_INV SYS_INPUT SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## SYS_INPUT OPEN +## + +224 +a system input variable declaration +a sorted variable of the form "(var sort)", or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL SYS_INPUT OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 234. +## +## system_var_decls_lst -> input_var_decl . system_var_decls_lst [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## system_var_decls_lst -> input_var_decl . [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## input_var_decl +## + +225 +a system definition +an attribute from the set (:input, :output, :local, :subsys, :init, :trans, :inv) + +file: OPEN DEFINE_SYS SYMBOL SYS_TRANS UNDERSCORE +## +## Ends in an error in state: 237. +## +## trans_cond -> SYS_TRANS . term [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_TRANS +## + +227 +a transition condition definition +a formula + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS UNDERSCORE +## +## Ends in an error in state: 239. +## +## system_subsys_dec -> SYS_SUBSYS . OPEN SYMBOL system_instantiation CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_SUBSYS +## + +228 +a subsystem declaration +an s-expression of the form (local_name (subsystem_name var_1 ...)) + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN UNDERSCORE +## +## Ends in an error in state: 240. +## +## system_subsys_dec -> SYS_SUBSYS OPEN . SYMBOL system_instantiation CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_SUBSYS OPEN +## + +229 +a subsystem declaration +a local subsystem name + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 241. +## +## system_subsys_dec -> SYS_SUBSYS OPEN SYMBOL . system_instantiation CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_SUBSYS OPEN SYMBOL +## + +230 +a system declaration +an instantiation of a defined transition system S of the form: +(S input_arg_1 ... input_arg_N output_arg_1 ... output_arg_M) + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 250. +## +## system_subsys_dec -> SYS_SUBSYS OPEN SYMBOL system_instantiation . CLOSE [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_SUBSYS OPEN SYMBOL system_instantiation +## + +231 +a subsystem declaration +a closing parenthesis + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 242. +## +## system_instantiation -> OPEN . sys_symbol list(sys_var_symbol) CLOSE [ CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +232 +a subsystem declaration +a symbol corresponding to a defined system + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL OPEN SYMBOL CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 257. +## +## subs_and_conds_lst -> system_subsys_dec . subs_and_conds_lst [ CLOSE ] +## subs_and_conds_lst -> system_subsys_dec . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## system_subsys_dec +## + +233 +a system definition +an attribute from the set (:input, :output, :local, :subsys, :init, :inv) or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY OPEN SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 397. +## +## list(cond_symbol) -> cond_symbol . list(cond_symbol) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## cond_symbol +## + +234 +a query definition +a reachability variable name or closing parenthesis + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 243. +## +## system_instantiation -> OPEN sys_symbol . list(sys_var_symbol) CLOSE [ CLOSE ] +## +## The known suffix of the stack is as follows: +## OPEN sys_symbol +## + +235 +a system instantiation +a system variable as an argument + +file: OPEN DEFINE_SYS SYMBOL SYS_INV UNDERSCORE +## +## Ends in an error in state: 252. +## +## inv_cond -> SYS_INV . term [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_INV +## + +236 +an invariant formula definition +a formula + +file: OPEN DEFINE_SYS SYMBOL SYS_INIT UNDERSCORE +## +## Ends in an error in state: 254. +## +## init_cond -> SYS_INIT . term [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE ] +## +## The known suffix of the stack is as follows: +## SYS_INIT +## + +237 +an initial state condition definition +a formula + +file: OPEN DEFINE_SYS SYMBOL SYS_SUBSYS OPEN SYMBOL OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 244. +## +## list(sys_var_symbol) -> sys_var_symbol . list(sys_var_symbol) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sys_var_symbol +## + +238 +a subsystem instantiation +a symbol or a closing parenthesis + +file: OPEN DEFINE_SYS SYMBOL SYS_INIT SYMBOL UNDERSCORE +## +## Ends in an error in state: 261. +## +## subs_and_conds_lst -> init_cond . subs_and_conds_lst [ CLOSE ] +## subs_and_conds_lst -> init_cond . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## init_cond +## + +239 +a system definition +an attribute from the set (:subsys, :init, :trans, :inv) + +file: OPEN CHECK_SYS SYMBOL UNDERSCORE +## +## Ends in an error in state: 382. +## +## system_check -> sys_symbol . opt_system_var_decls opt_sys_check_attrs_and_queries [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sys_symbol +## + +246 +a check-system command +an attribute from the set (:input, :output, :local, +:assumption, :reachable, :query, :queries) + +file: OPEN CHECK_SYS SYMBOL SYS_INPUT OPEN CLOSE SYS_TRANS +## +## Ends in an error in state: 383. +## +## system_check -> sys_symbol opt_system_var_decls . opt_sys_check_attrs_and_queries [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sys_symbol opt_system_var_decls +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 234, spurious reduction of production system_var_decls_lst -> input_var_decl +## In state 228, spurious reduction of production system_var_decls -> system_var_decls_lst +## In state 229, spurious reduction of production opt_system_var_decls -> system_var_decls +## + +247 +a check-system command +an attribute from the set (:input, :output, :local, +:assumption, :reachable, :query, :queries) + +file: OPEN CHECK_SYS SYMBOL CHECK_REACH UNDERSCORE +## +## Ends in an error in state: 384. +## +## reach_cond -> CHECK_REACH . OPEN SYMBOL term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_REACH +## + +248 +a reachability condition definition +an s-expression of the form (name formula) + +file: OPEN CHECK_SYS SYMBOL CHECK_REACH OPEN UNDERSCORE +## +## Ends in an error in state: 385. +## +## reach_cond -> CHECK_REACH OPEN . SYMBOL term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_REACH OPEN +## + +249 +a reachability condition definition +a name and a formula + +file: OPEN CHECK_SYS SYMBOL CHECK_REACH OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 386. +## +## reach_cond -> CHECK_REACH OPEN SYMBOL . term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_REACH OPEN SYMBOL +## + +250 +a reachability condition definition +a formula + +file: OPEN CHECK_SYS SYMBOL CHECK_REACH OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 387. +## +## reach_cond -> CHECK_REACH OPEN SYMBOL term . CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_REACH OPEN SYMBOL term +## + +251 +a reachability condition definition +a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY UNDERSCORE +## +## Ends in an error in state: 389. +## +## sys_check_query -> CHECK_QUERY . sys_check_query_base [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_QUERY +## + +252 +a check-system query +a query of the form +(query_name (reachable_var1 ... reachable_varN)) + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY OPEN UNDERSCORE +## +## Ends in an error in state: 390. +## +## sys_check_query_base -> OPEN . SYMBOL OPEN list(cond_symbol) CLOSE CLOSE [ OPEN CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## OPEN +## + +253 +a check-system query +a query name + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 391. +## +## sys_check_query_base -> OPEN SYMBOL . OPEN list(cond_symbol) CLOSE CLOSE [ OPEN CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL +## + +254 +a check-system query +a list of reachability variables + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY OPEN SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 392. +## +## sys_check_query_base -> OPEN SYMBOL OPEN . list(cond_symbol) CLOSE CLOSE [ OPEN CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL OPEN +## + +255 +a check-system query +a reachability variable name + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERY OPEN SYMBOL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 395. +## +## sys_check_query_base -> OPEN SYMBOL OPEN list(cond_symbol) CLOSE . CLOSE [ OPEN CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## OPEN SYMBOL OPEN list(cond_symbol) CLOSE +## + +256 +a check-system query +a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERIES UNDERSCORE +## +## Ends in an error in state: 400. +## +## sys_check_query -> CHECK_QUERIES . OPEN list(sys_check_query_base) CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_QUERIES +## + +257 +a check-system query list +a list of queries of the form +((query_name (reachable_var1 ... reachable_varN)) ... ) + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERIES OPEN UNDERSCORE +## +## Ends in an error in state: 401. +## +## sys_check_query -> CHECK_QUERIES OPEN . list(sys_check_query_base) CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_QUERIES OPEN +## + +258 +a check-system query +a query of the form (query_name (reachable_var1 ... reachable_varN)) + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERIES OPEN OPEN SYMBOL OPEN CLOSE CLOSE UNDERSCORE +## +## Ends in an error in state: 402. +## +## list(sys_check_query_base) -> sys_check_query_base . list(sys_check_query_base) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sys_check_query_base +## + +259 +a check-system query list +a check-system query definition or closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_QUERIES OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 411. +## +## sys_check_attrs_and_queries -> sys_check_query . sys_check_attrs_and_queries [ CLOSE ] +## sys_check_attrs_and_queries -> sys_check_query . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## sys_check_query +## + +260 +a check-system command +an attribute from the set (:assumption, :reachable, :query, :queries) or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_REACH OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 413. +## +## sys_check_attrs_and_queries -> reach_cond . sys_check_attrs_and_queries [ CLOSE ] +## sys_check_attrs_and_queries -> reach_cond . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## reach_cond +## + +261 +a check-system command +an attribute from the set (:assumption, :reachable, :query, :queries) or a closing parenthesis + +input: OPEN DEFINE_SYS UNDERSCORE +## +## Ends in an error in state: 492. +## +## command -> OPEN DEFINE_SYS . system_def CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SYS +## + +262 +a system definition +a system name symbol + +input: OPEN DECLARE_ENUM_SORT UNDERSCORE +## +## Ends in an error in state: 527. +## +## command -> OPEN DECLARE_ENUM_SORT . SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT +## + +263 +an enumeration declaration +a symbol for the enumeration sort name + +input: OPEN DECLARE_ENUM_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 528. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL . OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL +## + +264 +an enumeration declaration +a list of enumeration values (enum1 enum2 ...) + +input: OPEN DECLARE_ENUM_SORT SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 529. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL OPEN . nonempty_list(enum_constructor_dec) CLOSE CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL OPEN +## + +265 +an enumeration declaration +a nonempty list of enumeration values (enum1 enum2 ...) + +input: OPEN DECLARE_ENUM_SORT SYMBOL OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 531. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE . CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE +## + +266 +an enumeration declaration +a closing parenthesis + +input: OPEN CHECK_SYS UNDERSCORE +## +## Ends in an error in state: 549. +## +## command -> OPEN CHECK_SYS . system_check CLOSE [ # ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SYS +## + +267 +a check-system command +a symbol corresponding to a defined system + +file: OPEN DEFINE_SYS UNDERSCORE +## +## Ends in an error in state: 212. +## +## command -> OPEN DEFINE_SYS . system_def CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DEFINE_SYS +## + +268 +a system definition +a system name symbol + +file: OPEN DECLARE_ENUM_SORT UNDERSCORE +## +## Ends in an error in state: 320. +## +## command -> OPEN DECLARE_ENUM_SORT . SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT +## + +269 +an enumeration declaration +a symbol for the enumeration sort name + +file: OPEN DECLARE_ENUM_SORT SYMBOL UNDERSCORE +## +## Ends in an error in state: 321. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL . OPEN nonempty_list(enum_constructor_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL +## + +270 +an enumeration declaration +a list of enumeration values (enum1 enum2 ...) + +file: OPEN DECLARE_ENUM_SORT SYMBOL OPEN UNDERSCORE +## +## Ends in an error in state: 322. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL OPEN . nonempty_list(enum_constructor_dec) CLOSE CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL OPEN +## + +271 +an enumeration declaration +a nonempty list of enumeration values (enum1 enum2 ...) + +file: OPEN DECLARE_ENUM_SORT SYMBOL OPEN SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 325. +## +## command -> OPEN DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE . CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN DECLARE_ENUM_SORT SYMBOL OPEN nonempty_list(enum_constructor_dec) CLOSE +## + +272 +an enumeration declaration +a closing parenthesis + +file: OPEN CHECK_SYS UNDERSCORE +## +## Ends in an error in state: 379. +## +## command -> OPEN CHECK_SYS . system_check CLOSE [ OPEN EOF ] +## +## The known suffix of the stack is as follows: +## OPEN CHECK_SYS +## + +274 +a check-system command +a symbol corresponding to a defined system + +file: OPEN DECLARE_ENUM_SORT SYMBOL OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 327. +## +## nonempty_list(enum_constructor_dec) -> enum_constructor_dec . [ CLOSE ] +## nonempty_list(enum_constructor_dec) -> enum_constructor_dec . nonempty_list(enum_constructor_dec) [ CLOSE ] +## +## The known suffix of the stack is as follows: +## enum_constructor_dec +## + +275 +an enumeration declaration +an enumeration value; +note that keywords and reserved words (such as '_', 'as', ...) are not +valid enumeration values + +file: OPEN CHECK_SYS SYMBOL CHECK_ASSUMPTION UNDERSCORE +## +## Ends in an error in state: 406. +## +## assump_cond -> CHECK_ASSUMPTION . OPEN SYMBOL term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_ASSUMPTION +## + +276 +an assumption of a check-system command +an opening parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_ASSUMPTION OPEN UNDERSCORE +## +## Ends in an error in state: 407. +## +## assump_cond -> CHECK_ASSUMPTION OPEN . SYMBOL term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_ASSUMPTION OPEN +## + +277 +an assumption of a check-system command +an identifier + +file: OPEN CHECK_SYS SYMBOL CHECK_ASSUMPTION OPEN SYMBOL UNDERSCORE +## +## Ends in an error in state: 408. +## +## assump_cond -> CHECK_ASSUMPTION OPEN SYMBOL . term CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_ASSUMPTION OPEN SYMBOL +## + +278 +an assumption of a check-system command +a formula + +file: OPEN CHECK_SYS SYMBOL CHECK_ASSUMPTION OPEN SYMBOL SYMBOL UNDERSCORE +## +## Ends in an error in state: 409. +## +## assump_cond -> CHECK_ASSUMPTION OPEN SYMBOL term . CLOSE [ CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## CHECK_ASSUMPTION OPEN SYMBOL term +## + +279 +an assumption of a check-system command +a closing parenthesis + +file: OPEN DEFINE_SYS SYMBOL SYS_INPUT OPEN CLOSE CHECK_REACH +## +## Ends in an error in state: 236. +## +## system_def -> SYMBOL opt_system_var_decls . opt_subs_and_conds [ CLOSE ] +## +## The known suffix of the stack is as follows: +## SYMBOL opt_system_var_decls +## +## WARNING: This example involves spurious reductions. +## This implies that, although the LR(1) items shown above provide an +## accurate view of the past (what has been recognized so far), they +## may provide an INCOMPLETE view of the future (what was expected next). +## In state 234, spurious reduction of production system_var_decls_lst -> input_var_decl +## In state 228, spurious reduction of production system_var_decls -> system_var_decls_lst +## In state 229, spurious reduction of production opt_system_var_decls -> system_var_decls +## + +280 +a system definition +an attribute from the set (:output, :local, :subsys, :init, :trans, :inv) + +file: OPEN CHECK_SYS SYMBOL SYS_OUTPUT OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 230. +## +## system_var_decls_lst -> output_var_decl . system_var_decls_lst [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## system_var_decls_lst -> output_var_decl . [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## output_var_decl +## + +281 +a check-system command +an attribute from the set (:input, :local, +:assumption, :reachable, :query, :queries) + +file: OPEN CHECK_SYS SYMBOL SYS_LOCAL OPEN CLOSE UNDERSCORE +## +## Ends in an error in state: 232. +## +## system_var_decls_lst -> local_var_decl . system_var_decls_lst [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## system_var_decls_lst -> local_var_decl . [ SYS_TRANS SYS_SUBSYS SYS_INV SYS_INIT CLOSE CHECK_REACH CHECK_QUERY CHECK_QUERIES CHECK_ASSUMPTION ] +## +## The known suffix of the stack is as follows: +## local_var_decl +## + +282 +a check-system command +an attribute from the set (:input, :output, +:assumption, :reachable, :query, :queries) + +file: OPEN DEFINE_SYS SYMBOL SYS_TRANS SYMBOL UNDERSCORE +## +## Ends in an error in state: 256. +## +## subs_and_conds_lst -> trans_cond . subs_and_conds_lst [ CLOSE ] +## subs_and_conds_lst -> trans_cond . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## trans_cond +## + +283 +a system definition +an attribute from the set (:input, :output, :local, :subsys, :init, :inv) or a closing parenthesis + +file: OPEN DEFINE_SYS SYMBOL SYS_INV SYMBOL UNDERSCORE +## +## Ends in an error in state: 259. +## +## subs_and_conds_lst -> inv_cond . subs_and_conds_lst [ CLOSE ] +## subs_and_conds_lst -> inv_cond . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## inv_cond +## + +284 +a system definition +an attribute from the set (:input, :output, :local, :subsys, :init, :trans) or a closing parenthesis + +file: OPEN CHECK_SYS SYMBOL CHECK_ASSUMPTION OPEN SYMBOL SYMBOL CLOSE UNDERSCORE +## +## Ends in an error in state: 415. +## +## sys_check_attrs_and_queries -> assump_cond . sys_check_attrs_and_queries [ CLOSE ] +## sys_check_attrs_and_queries -> assump_cond . [ CLOSE ] +## +## The known suffix of the stack is as follows: +## assump_cond +## + +285 +a check-system command +an attribute from the set (:input, :output, :local, +:assumption, :reachable, :query, :queries) diff --git a/src/languages/smtlib2/mcil/tokens.mly b/src/languages/smtlib2/mcil/tokens.mly new file mode 100644 index 000000000..59d7d0e04 --- /dev/null +++ b/src/languages/smtlib2/mcil/tokens.mly @@ -0,0 +1,60 @@ + +(* This file is free software, part of dolmen. See file "LICENSE" for more information *) + +/* Token declarations for Smtlib parser */ + +%token EOF + +%token OPEN CLOSE +%token NUM DEC HEX BIN STR SYMBOL KEYWORD + +/* Currently unused, see lexer. +%token BINARY DECIMAL HEXADECIMAL NUMERAL STRING +*/ +%token UNDERSCORE ATTRIBUTE AS LET EXISTS FORALL MATCH PAR + +%token ASSERT + CHECK_SAT + CHECK_SAT_ASSUMING + DECLARE_CONST + DECLARE_DATATYPE + DECLARE_DATATYPES + DECLARE_FUN + DECLARE_SORT + DEFINE_FUN + DEFINE_FUN_REC + DEFINE_FUNS_REC + DEFINE_SYS + DECLARE_ENUM_SORT + DEFINE_SORT + ECHO EXIT + GET_ASSERTIONS + GET_ASSIGNMENT + GET_INFO + GET_MODEL + GET_OPTION + GET_PROOF + GET_UNSAT_ASSUMPTIONS + GET_UNSAT_CORE + GET_VALUE + POP + PUSH + RESET + RESET_ASSERTIONS + SET_INFO + SET_LOGIC + SET_OPTION + SYS_INPUT + SYS_OUTPUT + SYS_LOCAL + SYS_SUBSYS + SYS_INIT + SYS_TRANS + SYS_INV + CHECK_SYS + CHECK_REACH + CHECK_ASSUMPTION + CHECK_QUERY + CHECK_QUERIES +%% + diff --git a/src/loop/flow.ml b/src/loop/flow.ml index bdbda1ef3..5cb0a1301 100644 --- a/src/loop/flow.ml +++ b/src/loop/flow.ml @@ -339,7 +339,7 @@ module Smtlib2(State : State.S) end (* smtlib ref case: 'ad' *) - | Defs _ | Decls _ + | Defs _ | Decls _ | Def_sys _ | Chk_sys _ | Clause _ | Antecedent _ | Consequent _ -> begin match mode with | Start_mode -> no_set_logic st mode stmt diff --git a/src/loop/typer.ml b/src/loop/typer.ml index 8a2a73eb5..5eb905438 100644 --- a/src/loop/typer.ml +++ b/src/loop/typer.ml @@ -62,6 +62,8 @@ module Smtlib2_String = Dolmen_type.Strings.Smtlib2.Tff(T) (Dolmen.Std.Expr.Ty)(Dolmen.Std.Expr.Term) +module MCIL_Trans_Sys = Dolmen_type.Trans_sys.MCIL(T) + (* Zf *) module Zf_Core = Dolmen_type.Core.Zf.Tff(T)(Dolmen.Std.Expr.Tags) @@ -125,6 +127,7 @@ let print_var_kind fmt k = | `Quantified -> Format.fprintf fmt "quantified variable" | `Function_param -> Format.fprintf fmt "function parameter" | `Type_alias_param -> Format.fprintf fmt "type alias parameter" + | `Trans_sys_param -> Format.fprintf fmt "transition system parameter" let print_reason ?(already=false) fmt r = let pp_already fmt () = @@ -600,6 +603,30 @@ let unbound_identifier = (fun (_, msg, _) -> text_hint msg);] ~name:"Unbound identifier" () +let undefined_transition_system = + Report.Error.mk ~code ~mnemonic:"undefined-transition-system" + ~message:(fun fmt id -> + Format.fprintf fmt "Undefined transition system:@ %a" + (pp_wrap Dolmen.Std.Id.print) id) + ~name:"Undefined transition system" () + +let bad_system_instantiation_arity = + Report.Error.mk ~code ~mnemonic:"bad-system-instantiation-arity" + ~message:(fun fmt (id, expected, actual) -> + Format.fprintf fmt + "Bad arity: expected %d arguments but got %d arguments for system %a" + expected actual (pp_wrap Dolmen.Std.Id.print) id) + ~name:"Incorrect arity for transition system instantiation" () + +let duplicate_definition = + Report.Error.mk ~code ~mnemonic:"duplicate-definition" + ~message:(fun fmt (id, file, old) -> + Format.fprintf fmt + "Duplicate declaration of %a, which was already defined at %a" + (pp_wrap Dolmen.Std.Id.print) id + Dolmen.Std.Loc.fmt_pos (Dolmen.Std.Loc.loc file old)) + ~name:"Duplicate definition of the same symbol" () + let multiple_declarations = Report.Error.mk ~code ~mnemonic:"redeclaration" ~message:(fun fmt (id, old) -> @@ -1274,6 +1301,13 @@ module Typer(State : State.S) = struct error ~input ~loc st invalid_string_char c | Smtlib2_String.Invalid_escape_sequence (s, i) -> error ~input ~loc st invalid_string_escape_sequence (s, i) + (* MCIL errors *) + | MCIL_Trans_Sys.Cannot_find_system id -> + error ~input ~loc st undefined_transition_system id + | MCIL_Trans_Sys.Bad_inst_arity (id, exp, act) -> + error ~input ~loc st bad_system_instantiation_arity (id, exp, act) + | MCIL_Trans_Sys.Duplicate_definition (id, old) -> + error ~input ~loc st duplicate_definition (id, T.file env, old) (* Bad sexpr *) | Smtlib2_Core.Incorrect_sexpression msg -> error ~input ~loc st incorrect_sexpression msg @@ -1767,6 +1801,20 @@ module Typer(State : State.S) = struct ) l ) + (* MCIL Only System Definitions and Checks *) + (* ************************************************************************ *) + + let sys_def st ~input loc ?attrs d = + typing_wrap ?attrs ?loc:(Some loc) ~input st ~f:(fun env -> + MCIL_Trans_Sys.parse_def env d + ) + + let check_sys st ~input loc ?attrs d = + typing_wrap ?attrs ?loc:(Some loc) ~input st ~f:(fun env -> + MCIL_Trans_Sys.parse_check env d + ) + + (* Wrappers around the Type-checking module *) (* ************************************************************************ *) @@ -1854,6 +1902,11 @@ module Make | `Defs of def list ] + type sys = [ + | `Sys_def of Dolmen.Std.Id.t * Expr.term_var list * Expr.term_var list * Expr.term_var list (* id, inputs, outputs, locals *) + | `Sys_check + ] + type decl = [ | `Type_decl of Expr.ty_cst * Expr.ty_def option | `Term_decl of Expr.term_cst @@ -1905,7 +1958,7 @@ module Make ] (* Agregate types *) - type typechecked = [ defs | decls | assume | solve | get_info | set_info | stack_control | exit ] + type typechecked = [ sys | defs | decls | assume | solve | get_info | set_info | stack_control | exit ] (* Simple constructor *) (* let tr implicit contents = { implicit; contents; } *) @@ -1955,6 +2008,8 @@ module Make | `Decls l -> Format.fprintf fmt "@[decls:@ %a@]" (Format.pp_print_list print_decl) l + | `Sys_def _ -> Format.fprintf fmt "@[sys-def:@ TODO Print typechecked value @]" + | `Sys_check -> Format.fprintf fmt "@[sys-check:@ TODO Print typechecked value @]" | `Hyp f -> Format.fprintf fmt "@[hyp:@ %a@]" Print.formula f | `Goal f -> @@ -2147,6 +2202,16 @@ module Make let st, l = Typer.decls st ~input ~loc ~attrs l in let res : typechecked stmt = simple (decl_id c) loc attrs (`Decls l) in st, (res) + + (* MCIL Custom commands*) + | { S.descr = S.Def_sys s ; loc ; attrs; _ } -> + let st, l = Typer.sys_def st ~input loc ~attrs s in + let res : typechecked stmt = simple (decl_id c) loc attrs l in + st, res + | { S.descr = S.Chk_sys s ; loc ; attrs ; _ } -> + let st, l = Typer.check_sys st ~input loc ~attrs s in + let res : typechecked stmt = simple (decl_id c) loc attrs l in + st, res (* Smtlib's proof/model instructions *) | { S.descr = S.Get_proof; loc; attrs; _ } -> diff --git a/src/loop/typer_intf.ml b/src/loop/typer_intf.ml index a88886436..f6b8473a2 100644 --- a/src/loop/typer_intf.ml +++ b/src/loop/typer_intf.ml @@ -62,6 +62,22 @@ module type Typer = sig | `Instanceof of Dolmen.Std.Id.t * term_cst * ty list * ty_var list * term_var list * term ] list + val sys_def : + state -> + input:input -> + Dolmen_std.Loc.t -> + ?attrs:Dolmen_std.Term.t list -> + Dolmen_std.Statement.sys_def -> + state * [> `Sys_def of Dolmen.Std.Id.t * term_var list * term_var list * term_var list] + + val check_sys : + state -> + input:input -> + Dolmen_std.Loc.t -> + ?attrs:Dolmen_std.Term.t list -> + Dolmen_std.Statement.sys_check -> + state * [> `Sys_check] + val decls : state -> input:input -> ?loc:Dolmen.Std.Loc.t -> ?attrs:Dolmen.Std.Term.t list -> Dolmen.Std.Statement.decls -> @@ -213,6 +229,11 @@ module type S = sig ] (** A list of definitions *) + type sys = [ + | `Sys_def of Dolmen.Std.Id.t * term_var list * term_var list * term_var list + | `Sys_check + ] + type assume = [ | `Hyp of formula | `Goal of formula @@ -262,7 +283,7 @@ module type S = sig ] (** Exit statement *) - type typechecked = [ defs | decls | assume | solve | get_info | set_info | stack_control | exit ] + type typechecked = [ sys | defs | decls | assume | solve | get_info | set_info | stack_control | exit ] (** The type of statements after typechecking *) val print : Format.formatter -> typechecked stmt -> unit diff --git a/src/model/loop.ml b/src/model/loop.ml index 31ad3e932..117251c99 100644 --- a/src/model/loop.ml +++ b/src/model/loop.ml @@ -712,6 +712,10 @@ module Make State.error ~file ~loc st assertion_stack_not_supported () | `Defs defs -> check_defs ~file ~loc st defs + | `Sys_def _ -> + st + | `Sys_check -> + st | `Hyp contents -> check_hyps ~file ~loc st contents | `Goal contents -> diff --git a/src/standard/scope.ml b/src/standard/scope.ml index 6629e1f82..4b8c3b4e5 100644 --- a/src/standard/scope.ml +++ b/src/standard/scope.ml @@ -15,6 +15,7 @@ module Make type term_var = Term_Var_Map.key type term_cst = Term_Cst_Map.key + type id = [ | `Type_var of type_var | `Type_cst of type_cst @@ -54,7 +55,7 @@ module Make let type_csts = Type_Cst_Map.empty in let term_vars = Term_Var_Map.empty in let term_csts = Term_Cst_Map.empty in - { conf; in_scope; type_vars; type_csts; term_vars; term_csts; } + { conf; in_scope; type_vars; type_csts; term_vars; term_csts } let find_opt t id = match id with diff --git a/src/standard/statement.ml b/src/standard/statement.ml index 943ad0974..b13dc8c90 100644 --- a/src/standard/statement.ml +++ b/src/standard/statement.ml @@ -43,6 +43,29 @@ type def = { attrs : term list; } +type sys_def = { + id : Id.t; + loc : location; + input : term list; + output : term list; + local : term list; + init : term; + trans : term; + inv : term; + subs : (Id.t * term * location) list; +} + +type sys_check = { + sid : term; + loc : location; + input : term list; + output : term list; + local : term list; + reachable : (Id.t * term * location) list; + assumption : (Id.t * term * location) list; + queries : (Id.t * term list * location) list; +} + type 'a group = { contents : 'a list; recursive : bool; @@ -83,6 +106,9 @@ type descr = | Defs of def group | Decls of decl group + | Def_sys of sys_def + | Chk_sys of sys_check + | Get_proof | Get_unsat_core | Get_unsat_assumptions @@ -256,6 +282,47 @@ let print_group print fmt ({ contents; recursive; } : _ group) = else aux fmt contents + +let print_attr fmt attr = Term.print fmt attr + +let print_def_sys fmt ({ id; loc = _; input; output; local; init; trans; inv; subs;} : sys_def) = + let print_sub fmt (local_name, subsys_inst, _) = + Format.fprintf fmt "@[subsys: ( %a = %a ) @]" + Id.print local_name + Term.print subsys_inst + in + + let print_subs fmt subs = + List.iter (Format.fprintf fmt "%a" print_sub) subs in + + Format.fprintf fmt "@[def-sys:@ %a =@ {@,input = %a;@,output = %a;@,local = %a;@,init = %a;@,trans = %a;@,inv = %a;%a;@ }@]" + Id.print id + print_attrs input + print_attrs output + print_attrs local + print_attr init + print_attr trans + print_attr inv + print_subs subs + +let print_check_sys fmt ({sid; loc = _; input; output; local; reachable; assumption; queries}: sys_check) = + let print_formula base_name fmt (name, term, _) = + Format.fprintf fmt "%s %a = %a;" base_name Id.print name Term.print term in + + let print_query fmt (name, formula_names, _) = + Format.fprintf fmt "query %a (%a);" + Id.print name + (Misc.print_list ~print_sep:Format.fprintf ~sep:" " ~print:Term.print) formula_names in + + Format.fprintf fmt "@[check-sys:@ %a =@ {@,input = %a;@,output = %a;@,local = %a;%a@;%a@;%a@,}@]" + Term.print sid + print_attrs input + print_attrs output + print_attrs local + (Misc.print_list ~print_sep:Format.fprintf ~sep:"@," ~print:(print_formula "assumption")) assumption + (Misc.print_list ~print_sep:Format.fprintf ~sep:"@," ~print:(print_formula "reachable")) reachable + (Misc.print_list ~print_sep:Format.fprintf ~sep:"@," ~print:print_query) queries + let rec print_descr fmt = function | Pack l -> Format.fprintf fmt "@[pack(%d):@ %a@]" (List.length l) @@ -305,6 +372,9 @@ let rec print_descr fmt = function | Defs d -> print_group print_def fmt d | Decls d -> print_group print_decl fmt d + | Def_sys d -> print_def_sys fmt d + | Chk_sys d -> print_check_sys fmt d + | Get_proof -> Format.fprintf fmt "get-proof" | Get_unsat_core -> Format.fprintf fmt "get-unsat-core" | Get_unsat_assumptions -> Format.fprintf fmt "get-unsat-assumptions" @@ -408,6 +478,12 @@ let group_decls ?loc ?attrs ~recursive l = let mk_defs ?loc ?attrs ~recursive defs = mk ?loc ?attrs (Defs { recursive; contents = defs; }) +let sys_def ?(loc=no_loc) id ~input ~output ~local ~subs ~init ~trans ~inv = + mk ~loc (Def_sys {id; loc; input; output; local; init; trans; inv; subs} ) + +let sys_check ?(loc=no_loc) sid ~input ~output ~local ~assumption ~reachable ~queries = + mk ~loc (Chk_sys {sid; loc; input; output; local; reachable; assumption; queries} ) + let group_defs ?loc ?attrs ~recursive l = let defs, others = List.fold_left (fun (defs, others) s -> match s with diff --git a/src/standard/statement.mli b/src/standard/statement.mli index fc567ecb2..a1c3b92d9 100644 --- a/src/standard/statement.mli +++ b/src/standard/statement.mli @@ -68,6 +68,31 @@ type def = { } (** Term definition. *) +type sys_def = { + id : Id.t; + loc : location; + input : term list; + output : term list; + local : term list; + init : term; + trans : term; + inv : term; + subs : (Id.t * term * location) list; +} +(** System definition. *) + +type sys_check = { + sid : term; + loc : location; + input : term list; + output : term list; + local : term list; + reachable : (Id.t * term * location) list; + assumption : (Id.t * term * location) list; + queries : (Id.t * term list * location) list; +} +(** System check. *) + type 'a group = { contents : 'a list; recursive : bool; @@ -128,6 +153,11 @@ type descr = | Decls of decl group (** A list of potentially recursive type definitions. *) + | Def_sys of sys_def + (** System definition. *) + | Chk_sys of sys_check + (** Checks the existence of a trace in a transition system. *) + | Get_proof (** Get the proof of the last sequent (if it was proved). *) | Get_unsat_core @@ -213,3 +243,6 @@ val print_group : Format.formatter -> 'a group -> unit (* Printer for groups. *) +val print_def_sys : Format.formatter -> sys_def -> unit +(* Printer for system definition. *) + diff --git a/src/typecheck/dune b/src/typecheck/dune index 8546d937b..8ca687a62 100644 --- a/src/typecheck/dune +++ b/src/typecheck/dune @@ -15,6 +15,8 @@ Intf Tff_intf Tff Thf_intf Thf ; Builtins Core Def Arith Arrays Bitv Float Strings + ; Transition Systems + Trans_sys ; Helpers Base Logic Misc ) diff --git a/src/typecheck/intf.ml b/src/typecheck/intf.ml index d4c7a3335..5701ac498 100644 --- a/src/typecheck/intf.ml +++ b/src/typecheck/intf.ml @@ -214,6 +214,7 @@ module type Formulas = sig | `Quantified | `Function_param | `Type_alias_param + | `Trans_sys_param ] (** The type of kinds of variables *) @@ -451,6 +452,14 @@ module type Formulas = sig val state : env -> state (** Get the mutable state for an env. *) + val file : env -> Dolmen.Std.Loc.file + (** Get the file for an env. *) + + val add_term_var : env -> Dolmen.Std.Id.t -> term_var -> Dolmen.Std.Term.t -> env + + val check_used_term_var : kind:var_kind -> env -> term_var -> builtin_meta_tags + + val check_no_free_wildcards : env -> Dolmen.Std.Term.t -> unit (** {2 Inference for vars and syms} *) @@ -630,6 +639,9 @@ module type Formulas = sig (** Unwrap a result, raising the adequate typing error if the result if not as expected. *) + val parse_typed_var_in_binding_pos : + env -> Dolmen.Std.Term.t -> Dolmen.Std.Id.t * term_var * Dolmen.Std.Term.t + (** {2 High-level functions} *) diff --git a/src/typecheck/thf.ml b/src/typecheck/thf.ml index c77f8e16e..bab0a9484 100644 --- a/src/typecheck/thf.ml +++ b/src/typecheck/thf.ml @@ -260,6 +260,7 @@ module Make | `Quantified | `Function_param | `Type_alias_param + | `Trans_sys_param ] (** The type of kinds of variables *) @@ -487,6 +488,8 @@ module Make let state env = env.st + let file env = env.file + let var_infer env = env.var_infer let sym_infer env = env.sym_infer diff --git a/src/typecheck/trans_sys.ml b/src/typecheck/trans_sys.ml new file mode 100644 index 000000000..d3101346d --- /dev/null +++ b/src/typecheck/trans_sys.ml @@ -0,0 +1,246 @@ +(* This file is free software, part of dolmen. See file "LICENSE" for more information *) + +module Id = Dolmen.Std.Id +module Ast = Dolmen.Std.Term +module Loc = Dolmen.Std.Loc +module Stmt = Dolmen.Std.Statement + +module M = Map.Make(Dolmen.Std.Id) +module S = Set.Make(Dolmen.Std.Id) + +(* MCIL transition systems *) +(* ************************************************************************ *) + +module MCIL (Type : Tff_intf.S) = struct + + type _ Type.err += + | Bad_inst_arity : Dolmen.Std.Id.t * int * int -> Dolmen.Std.Loc.t Type.err + | Cannot_find_system : Dolmen.Std.Id.t -> Dolmen.Std.Loc.t Type.err + | Duplicate_definition : Dolmen.Std.Id.t * Dolmen.Std.Loc.t -> Dolmen.Std.Loc.t Type.err + + + let key = Dolmen.Std.Tag.create () + + let get_defs env = + match Type.get_global_custom env key with + | None -> M.empty + | Some m -> m + + let define_sys id ((env, _), input, output, local) = + let map = get_defs env in + let m = M.add id (`Trans_Sys (input, output, local)) map in + Type.set_global_custom env key m + + let create_primed_id id = + match (Id.name id) with + | Simple name -> + Id.create (Id.ns id) (Dolmen_std.Name.simple (name ^ "'") ) + | _ -> assert false + + let get_symbol_id = function + | { Ast.term = Ast.Symbol s; _ } -> s + | _ -> assert false + + let get_symbol_id_and_loc = function + | { Ast.term = Ast.Symbol s; loc; _ } -> s, loc + | _ -> assert false + + let get_app_info = function + | { Ast.term = Ast.App ({ Ast.term = Ast.Symbol s; loc=s_loc; _}, args); loc=app_loc; _ } -> + s, s_loc, args, app_loc + | _ -> assert false + + let parse_def_params (env, env') params = + let rec aux env env' acc = function + | [] -> (env, env'), List.rev acc + | p :: r -> + let id, v, ast = Type.parse_typed_var_in_binding_pos env p in + let id' = create_primed_id id in + let env = Type.add_term_var env id v ast in + let env' = Type.add_term_var env' id v ast in + let env' = Type.add_term_var env' id' v ast in + aux env env' ((id, v, ast) :: acc) r + in + aux env env' [] params + + let parse_sig env input output local = + let envs = env, env in + let envs, parsed_input = parse_def_params envs input in + let envs, parsed_output = parse_def_params envs output in + let envs, parsed_local = parse_def_params envs local in + envs, parsed_input, parsed_output, parsed_local + + let parse_condition env cond = + Type.parse_prop env cond |> ignore + + let _cannot_find_system env loc id = + Type._error env (Located loc) (Cannot_find_system id) + + let _bad_inst_arity env loc id e a = + Type._error env (Located loc) (Bad_inst_arity (id, e, a)) + + let _duplicate_definition env loc1 id loc2 = + let loc1, loc2 = + if Loc.compare loc1 loc2 < 0 then loc2, loc1 else loc1, loc2 + in + Type._error env (Located loc1) (Duplicate_definition (id, loc2)) + + let ensure env ast t ty = + Type._wrap2 env ast Type.T.ensure t ty + + let parse_ensure env ast ty = + let t = Type.parse_term env ast in + ensure env ast t ty + + let vars l = List.map (fun (_, v, _) -> v) l + + let _bad_arity env s n m t = + Type._error env (Ast t) (Type.Bad_op_arity (s, [n], m)) + + let parse_subsystems env (parent : Stmt.sys_def) = + let defs = get_defs env in + List.fold_left + (fun other_subs (local_name, sub_inst, loc) -> + (* Make sure local name isn't used twice *) + match M.find_opt local_name other_subs with + | Some other_loc -> + _duplicate_definition env loc local_name other_loc + | None -> ( + let sub_id, sid_loc, args, inst_loc = get_app_info sub_inst in + let sub_inputs, sub_outputs = + match M.find_opt sub_id defs with + | None -> + _cannot_find_system env sid_loc sub_id + | Some (`Trans_Sys (input, output, _)) -> + (vars input, vars output) + in + let num_args = List.length args in + let params = sub_inputs @ sub_outputs in + let num_params = List.length params in + if (num_args != num_params) then ( + _bad_inst_arity env inst_loc sub_id num_params num_args + ) ; + List.iter2 + (fun arg param -> + let expected_type = Type.T.Var.ty param in + parse_ensure env arg expected_type |> ignore + ) + args + params ; + M.add local_name loc other_subs + ) + ) + M.empty + parent.subs + |> ignore + + let parse_def_body ((env, env'), _input, _output, _local) (d: Stmt.sys_def) = + parse_condition env d.init ; + parse_condition env' d.trans ; + parse_condition env d.inv ; + parse_subsystems env d + + let finalize_sys (d : Stmt.sys_def) ((env, _), input, output, local) = + Type.check_no_free_wildcards env d.init; + Type.check_no_free_wildcards env d.trans; + Type.check_no_free_wildcards env d.inv; + let input, output, local = vars input, vars output, vars local in + (* TODO: review cases of unused variable *) + List.iter (Type.check_used_term_var ~kind:`Trans_sys_param env) input ; + List.iter (Type.check_used_term_var ~kind:`Trans_sys_param env) output ; + List.iter (Type.check_used_term_var ~kind:`Trans_sys_param env) local ; + `Sys_def (d.id, input, output, local) + + let parse_def env (d : Stmt.sys_def) = + let ssig = parse_sig env d.input d.output d.local in + parse_def_body ssig d ; + define_sys d.id ssig ; + finalize_sys d ssig + + let get_sys_sig env sid = + let defs = get_defs env in + let id, loc = get_symbol_id_and_loc sid in + match M.find_opt id defs with + | None -> _cannot_find_system env loc id + | Some (`Trans_Sys ssig) -> ssig + + let check_sig (env, env') id sys chk = + match chk with + | [] -> ( + List.fold_left + (fun (env, env') (id, v, ast) -> + let id' = create_primed_id id in + let env = Type.add_term_var env id v ast in + let env' = Type.add_term_var env' id v ast in + let env' = Type.add_term_var env' id' v ast in + env, env' + ) + (env, env') + sys + ) + | (_, _, a) :: _ -> ( + let n1 = List.length sys in + let n2 = List.length chk in + if (n1 != n2) then _bad_arity env (Id id) n1 n2 a ; + List.iter2 + (fun (_, v1, _) (_, v2, a2) -> + ensure env a2 (Type.T.of_var v2) (Type.T.Var.ty v1) + |> ignore + ) + sys + chk ; + env, env' + ) + + let parse_check_sig env (c : Stmt.sys_check) = + let sys_input, sys_output, sys_local = get_sys_sig env c.sid in + let (envs, input, output, local) = + parse_sig env c.input c.output c.local + in + let id = get_symbol_id c.sid in + let envs = check_sig envs id sys_input input in + let envs = check_sig envs id sys_output output in + let envs = check_sig envs id sys_local local in + envs + + let parse_conditions env ids conds = + List.fold_left + (fun acc (id, f, loc) -> + match M.find_opt id acc with + | Some other_loc -> + _duplicate_definition env loc id other_loc + | None -> + parse_condition env f ; M.add id loc acc + ) + ids + conds + + let parse_assumptions_and_conditions (_, env') (c : Stmt.sys_check) = + let cids = parse_conditions env' M.empty c.assumption in + let cids = parse_conditions env' cids c.reachable in + cids + + let parse_queries (env,_) cond_ids (c : Stmt.sys_check) = + let parse_query query_ids (id, conds, loc) = + match M.find_opt id query_ids with + | Some old_loc -> + _duplicate_definition env loc id old_loc + | None -> + conds |> List.iter (function + | { Ast.term = Ast.Symbol s; _ } as ast -> ( + if not (M.mem s cond_ids) then + Type._error env (Ast ast) (Type.Cannot_find (s, "")); + ) + | _ -> assert false + ) ; + M.add id loc query_ids + in + List.fold_left parse_query M.empty c.queries |> ignore + + let parse_check env (c : Stmt.sys_check) = + let envs = parse_check_sig env c in + let cids = parse_assumptions_and_conditions envs c in + parse_queries envs cids c ; + `Sys_check + +end \ No newline at end of file diff --git a/src/typecheck/trans_sys.mli b/src/typecheck/trans_sys.mli new file mode 100644 index 000000000..71daae144 --- /dev/null +++ b/src/typecheck/trans_sys.mli @@ -0,0 +1,26 @@ + +(* MCIL transition systems *) + +module MCIL (Type : Tff_intf.S) : sig + + type _ Type.err += + | Bad_inst_arity : Dolmen.Std.Id.t * int * int -> Dolmen.Std.Loc.t Type.err + (** [Bad_inst_arity (name, expected, actual)] denotes an error where + an instantiation of a system [name] was expecting [expected] arguments, + but which was instantiated with [actual] arguments. *) + | Cannot_find_system : Dolmen.Std.Id.t -> Dolmen.Std.Loc.t Type.err + (** Error raised when an transition system cannot be found *) + | Duplicate_definition : Dolmen.Std.Id.t * Dolmen.Std.Loc.t -> Dolmen.Std.Loc.t Type.err + (** Error raised when a duplicate definition is found *) + (** Additional errors specific to MCIL typing. *) + + val parse_def : + Type.env -> + Dolmen.Std.Statement.sys_def -> + [> `Sys_def of Dolmen.Std.Id.t * Type.T.Var.t list * Type.T.Var.t list * Type.T.Var.t list] + (** Parse a transition system definition *) + + val parse_check : Type.env -> Dolmen.Std.Statement.sys_check -> [> `Sys_check ] + (** Parse a transition system check *) + +end \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.expected b/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.expected new file mode 100644 index 000000000..aa020bef1 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.mcil", line 1, character 19-20: +1 | (define-system sys _) + ^ +Error while parsing a system definition, read the reserved word '_', + but expected an attribute from the set (:input, :output, :local, + :subsys, :init, :trans, :inv). diff --git a/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.mcil b/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.mcil new file mode 100644 index 000000000..c0701e17f --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/218_define-system_bad_attribute_1.mcil @@ -0,0 +1 @@ +(define-system sys _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.expected b/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.expected new file mode 100644 index 000000000..ca2967262 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.mcil", line 1, character 27-28: +1 | (define-system sys :output ) + ^ +Error while parsing a system output definition, read a closing parenthesis, + but expected a list of sorted variables. diff --git a/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.mcil b/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.mcil new file mode 100644 index 000000000..61a242790 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/219_define-system_missing_output_list.mcil @@ -0,0 +1 @@ +(define-system sys :output ) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.expected b/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.expected new file mode 100644 index 000000000..97d4b6884 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.expected @@ -0,0 +1,7 @@ +File "tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.mcil", line 1, character 28-31: +1 | (define-system sys :output (Int)) + ^^^ +Error while parsing a system output variable declaration, + read the symbol 'Int', + but expected a sorted variable of the form "(var sort)", or a closing + parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.mcil b/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.mcil new file mode 100644 index 000000000..78fb6fa88 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/220_define-system_bad_output_list.mcil @@ -0,0 +1 @@ +(define-system sys :output (Int)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.expected b/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.expected new file mode 100644 index 000000000..786a0d6b3 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.mcil", line 1, character 25-26: +1 | (define-system sys :local) + ^ +Error while parsing a system local definition, read a closing parenthesis, + but expected a list of sorted variables. diff --git a/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.mcil b/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.mcil new file mode 100644 index 000000000..36f24cd84 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/221_define-system_missing_local_list.mcil @@ -0,0 +1 @@ +(define-system sys :local) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.expected b/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.expected new file mode 100644 index 000000000..6d5416287 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.expected @@ -0,0 +1,7 @@ +File "tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.mcil", line 1, character 27-30: +1 | (define-system sys :local (Int)) + ^^^ +Error while parsing a system local variable declaration, + read the symbol 'Int', + but expected a sorted variable of the form "(var sort)", or a closing + parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.mcil b/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.mcil new file mode 100644 index 000000000..c6e6d5cf5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/222_define-system_bad_local_list.mcil @@ -0,0 +1 @@ +(define-system sys :local (Int)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.expected b/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.expected new file mode 100644 index 000000000..94f5cacb9 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.mcil", line 1, character 25-26: +1 | (define-system sys :input) + ^ +Error while parsing a system input definition, read a closing parenthesis, + but expected a list of sorted variables. diff --git a/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.mcil b/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.mcil new file mode 100644 index 000000000..d28755cf2 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/223_define-system_missing_input_list.mcil @@ -0,0 +1 @@ +(define-system sys :input) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.expected b/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.expected new file mode 100644 index 000000000..5fb85d02b --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.expected @@ -0,0 +1,7 @@ +File "tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.mcil", line 1, character 27-30: +1 | (define-system sys :input (Int)) + ^^^ +Error while parsing a system input variable declaration, + read the symbol 'Int', + but expected a sorted variable of the form "(var sort)", or a closing + parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.mcil b/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.mcil new file mode 100644 index 000000000..d265a93ad --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/224_define-system_bad_input_list.mcil @@ -0,0 +1 @@ +(define-system sys :input (Int)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.expected b/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.expected new file mode 100644 index 000000000..b9c834289 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.mcil", line 1, character 29-34: +1 | (define-system sys :input () error) + ^^^^^ +Error while parsing a system definition, read the symbol 'error', + but expected an attribute from the set (:input, :output, :local, + :subsys, :init, :trans, :inv). diff --git a/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.mcil b/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.mcil new file mode 100644 index 000000000..64c6ade6b --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/225_define-system_bad_attribute_2.mcil @@ -0,0 +1 @@ +(define-system sys :input () error) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.expected b/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.expected new file mode 100644 index 000000000..f89853bf5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.mcil", line 1, character 26-27: +1 | (define-system sys :trans ) + ^ +Error while parsing a transition condition definition, + read a closing parenthesis, + but expected a formula. diff --git a/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.mcil b/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.mcil new file mode 100644 index 000000000..6c0406e0b --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/227_define-system_missing_trans_formula.mcil @@ -0,0 +1 @@ +(define-system sys :trans ) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.expected b/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.expected new file mode 100644 index 000000000..55ef0ee55 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.mcil", line 1, character 27-28: +1 | (define-system sys :subsys ) + ^ +Error while parsing a subsystem declaration, read a closing parenthesis, + but expected an s-expression of the form (local_name (subsystem_name + var_1 ...)). diff --git a/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.mcil b/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.mcil new file mode 100644 index 000000000..e4f5bfe17 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/228_define-system_missing_subsys_decl.mcil @@ -0,0 +1 @@ +(define-system sys :subsys ) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.expected b/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.expected new file mode 100644 index 000000000..2d5fc32f5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.mcil", line 1, character 28-29: +1 | (define-system sys :subsys ()) + ^ +Error while parsing a subsystem declaration, read a closing parenthesis, + but expected a local subsystem name. diff --git a/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.mcil b/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.mcil new file mode 100644 index 000000000..925697251 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/229_define-system_bad_subsys_decl_1.mcil @@ -0,0 +1 @@ +(define-system sys :subsys ()) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.expected b/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.expected new file mode 100644 index 000000000..c9bd9edd1 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.mcil", line 1, character 29-30: +1 | (define-system sys :subsys (a)) + ^ +Error while parsing a system declaration, read a closing parenthesis, + but expected an instantiation of a defined transition system S of the + form: (S input_arg_1 ... input_arg_N output_arg_1 ... output_arg_M). diff --git a/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.mcil b/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.mcil new file mode 100644 index 000000000..e759971cc --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/230_define-system_bad_subsys_decl_2.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (a)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.expected b/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.expected new file mode 100644 index 000000000..6cd752a43 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.mcil", line 1, character 34-35: +1 | (define-system sys :subsys (a (b) _)) + ^ +Error while parsing a subsystem declaration, read the reserved word '_', + but expected a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.mcil b/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.mcil new file mode 100644 index 000000000..96e46293f --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/231_define-system_bad_subsys_decl_3.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (a (b) _)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.expected b/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.expected new file mode 100644 index 000000000..844b0a915 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.mcil", line 1, character 31-32: +1 | (define-system sys :subsys (a ())) + ^ +Error while parsing a subsystem declaration, read a closing parenthesis, + but expected a symbol corresponding to a defined system. diff --git a/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.mcil b/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.mcil new file mode 100644 index 000000000..1192a0c7f --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/232_define-system_bad_subsys_decl_4.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (a ())) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.expected b/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.expected new file mode 100644 index 000000000..41a129eff --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.mcil", line 1, character 35-36: +1 | (define-system sys :subsys (a (b)) _) + ^ +Error while parsing a system definition, read the reserved word '_', + but expected an attribute from the set (:input, :output, :local, + :subsys, :init, :inv) or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.mcil b/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.mcil new file mode 100644 index 000000000..84eee53b5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/233_define-system_bad_attribute_7.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (a (b)) _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.expected b/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.expected new file mode 100644 index 000000000..f8799be6d --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.mcil", line 1, character 34-40: +1 | (check-system system :query (q (r :query))) + ^^^^^^ +Error while parsing a query definition, read the reserved word ':query', + but expected a reachability variable name or closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.mcil b/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.mcil new file mode 100644 index 000000000..18f231770 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/234_check-system_bad_query_1.mcil @@ -0,0 +1 @@ +(check-system system :query (q (r :query))) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.expected b/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.expected new file mode 100644 index 000000000..72d43bc04 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.mcil", line 1, character 33-34: +1 | (define-system sys :subsys (n (s _))) + ^ +Error while parsing a system instantiation, read the reserved word '_', + but expected a system variable as an argument. diff --git a/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.mcil b/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.mcil new file mode 100644 index 000000000..b1f4e20bb --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/235_define-system_bad_subsys_decl_5.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (n (s _))) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.expected b/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.expected new file mode 100644 index 000000000..7d84dd518 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.mcil", line 1, character 24-25: +1 | (define-system sys :inv ) + ^ +Error while parsing an invariant formula definition, + read a closing parenthesis, + but expected a formula. diff --git a/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.mcil b/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.mcil new file mode 100644 index 000000000..84fc3ab72 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/236_define-system_missing_inv_formula.mcil @@ -0,0 +1 @@ +(define-system sys :inv ) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.expected b/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.expected new file mode 100644 index 000000000..4262c176c --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.mcil", line 1, character 24-25: +1 | (define-system sys :init) + ^ +Error while parsing an initial state condition definition, + read a closing parenthesis, + but expected a formula. diff --git a/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.mcil b/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.mcil new file mode 100644 index 000000000..0859ff1ee --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/237_define-system_missing_init_formula.mcil @@ -0,0 +1 @@ +(define-system sys :init) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.expected b/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.expected new file mode 100644 index 000000000..11f2b1dbb --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.mcil", line 1, character 35-36: +1 | (define-system sys :subsys (a (b c _))) + ^ +Error while parsing a subsystem instantiation, read the reserved word '_', + but expected a symbol or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.mcil b/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.mcil new file mode 100644 index 000000000..0a2725d67 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/238_define-system_bad_subsys_decl_5.mcil @@ -0,0 +1 @@ +(define-system sys :subsys (a (b c _))) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.expected b/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.expected new file mode 100644 index 000000000..d0b21b693 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.mcil", line 1, character 36-42: +1 | (define-system system :init (= 1 1) :query) + ^^^^^^ +Error while parsing a system definition, read the reserved word ':query', + but expected an attribute from the set (:subsys, :init, :trans, :inv). diff --git a/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.mcil b/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.mcil new file mode 100644 index 000000000..89942a6b9 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/239_define-system_bad_attribute_4.mcil @@ -0,0 +1 @@ +(define-system system :init (= 1 1) :query) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.expected b/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.expected new file mode 100644 index 000000000..21f587e5d --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.mcil", line 1, character 18-27: +1 | (check-system sys :reachabe ((q (r))) f) + ^^^^^^^^^ +Error while parsing a check-system command, read the keyword ':reachabe', + but expected an attribute from the set (:input, :output, :local, + :assumption, :reachable, :query, :queries). diff --git a/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.mcil b/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.mcil new file mode 100644 index 000000000..f6a200914 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/246_check-system_bad_attribute_1.mcil @@ -0,0 +1 @@ +(check-system sys :reachabe ((q (r))) f) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.expected b/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.expected new file mode 100644 index 000000000..2c0642dd6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.mcil", line 1, character 28-34: +1 | (check-system sys :input () :trans) + ^^^^^^ +Error while parsing a check-system command, read the reserved word ':trans', + but expected an attribute from the set (:input, :output, :local, + :assumption, :reachable, :query, :queries). diff --git a/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.mcil b/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.mcil new file mode 100644 index 000000000..97b0f3660 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/247_check-system_bad_attribute_2.mcil @@ -0,0 +1 @@ +(check-system sys :input () :trans) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.expected b/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.expected new file mode 100644 index 000000000..429629b72 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.mcil", line 1, character 28-29: +1 | (check-system sys :reachable) + ^ +Error while parsing a reachability condition definition, + read a closing parenthesis, + but expected an s-expression of the form (name formula). diff --git a/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.mcil b/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.mcil new file mode 100644 index 000000000..6d2002a1a --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/248_check-system_missing_reachable_formula_1.mcil @@ -0,0 +1 @@ +(check-system sys :reachable) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.expected b/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.expected new file mode 100644 index 000000000..df091a1f6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.mcil", line 1, character 30-31: +1 | (check-system sys :reachable ()) + ^ +Error while parsing a reachability condition definition, + read a closing parenthesis, + but expected a name and a formula. diff --git a/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.mcil b/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.mcil new file mode 100644 index 000000000..8c1179f84 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/249_check-system_missing_reachable_formula_2.mcil @@ -0,0 +1 @@ +(check-system sys :reachable ()) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.expected b/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.expected new file mode 100644 index 000000000..725bde7ed --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.mcil", line 1, character 31-32: +1 | (check-system sys :reachable (a)) + ^ +Error while parsing a reachability condition definition, + read a closing parenthesis, + but expected a formula. diff --git a/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.mcil b/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.mcil new file mode 100644 index 000000000..8a33d6d27 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/250_check-system_missing_reachable_formula_3.mcil @@ -0,0 +1 @@ +(check-system sys :reachable (a)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.expected b/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.expected new file mode 100644 index 000000000..72d603891 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.mcil", line 1, character 40-41: +1 | (check-system sys :reachable (a (= 1 2) b)) + ^ +Error while parsing a reachability condition definition, read the symbol 'b', + but expected a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.mcil b/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.mcil new file mode 100644 index 000000000..cf8511b73 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/251_check-system_reachable_unclosed.mcil @@ -0,0 +1 @@ +(check-system sys :reachable (a (= 1 2) b)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.expected b/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.expected new file mode 100644 index 000000000..6899267f1 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.mcil", line 1, character 24-25: +1 | (check-system sys :query) + ^ +Error while parsing a check-system query, read a closing parenthesis, + but expected a query of the form (query_name (reachable_var1 ... + reachable_varN)). diff --git a/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.mcil b/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.mcil new file mode 100644 index 000000000..29c14f1db --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/252_check-system_missing_query.mcil @@ -0,0 +1 @@ +(check-system sys :query) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.expected b/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.expected new file mode 100644 index 000000000..d70b47a8e --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.mcil", line 1, character 26-27: +1 | (check-system sys :query ()) + ^ +Error while parsing a check-system query, read a closing parenthesis, + but expected a query name. diff --git a/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.mcil b/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.mcil new file mode 100644 index 000000000..94e5779c6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/253_check-system_missing_query_name.mcil @@ -0,0 +1 @@ +(check-system sys :query ()) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.expected b/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.expected new file mode 100644 index 000000000..f2dd37da5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.mcil", line 1, character 27-28: +1 | (check-system sys :query (q)) + ^ +Error while parsing a check-system query, read a closing parenthesis, + but expected a list of reachability variables. diff --git a/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.mcil b/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.mcil new file mode 100644 index 000000000..aca277511 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/254_check-system_query_missing_condition_var_list.mcil @@ -0,0 +1 @@ +(check-system sys :query (q)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.expected b/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.expected new file mode 100644 index 000000000..29a0bfa75 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.mcil", line 1, character 32-33: +1 | (check-system sys :query (q (r) s)) + ^ +Error while parsing a check-system query, read the symbol 's', + but expected a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.mcil b/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.mcil new file mode 100644 index 000000000..66807f13d --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/256_check-system_query_unclosed.mcil @@ -0,0 +1 @@ +(check-system sys :query (q (r) s)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.expected b/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.expected new file mode 100644 index 000000000..3c915c2a8 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.mcil", line 1, character 27-28: +1 | (check-system sys :queries ) + ^ +Error while parsing a check-system query list, read a closing parenthesis, + but expected a list of queries of the form ((query_name (reachable_var1 + ... reachable_varN)) ... ). diff --git a/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.mcil b/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.mcil new file mode 100644 index 000000000..b9698d327 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/257_check-system_missing_queries_list.mcil @@ -0,0 +1 @@ +(check-system sys :queries ) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.expected b/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.expected new file mode 100644 index 000000000..e16f46450 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.mcil", line 1, character 28-29: +1 | (check-system sys :queries (a)) + ^ +Error while parsing a check-system query, read the symbol 'a', + but expected a query of the form (query_name (reachable_var1 ... + reachable_varN)). diff --git a/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.mcil b/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.mcil new file mode 100644 index 000000000..deace2b6a --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/258_check-system_bad_query.mcil @@ -0,0 +1 @@ +(check-system sys :queries (a)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.expected b/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.expected new file mode 100644 index 000000000..ab3d893ae --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.mcil", line 1, character 36-37: +1 | (check-system sys :queries ((q (r)) x)) + ^ +Error while parsing a check-system query list, read the symbol 'x', + but expected a check-system query definition or closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.mcil b/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.mcil new file mode 100644 index 000000000..5c4dbf546 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/259_check-system_bad_query_or_unclosed.mcil @@ -0,0 +1 @@ +(check-system sys :queries ((q (r)) x)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.expected b/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.expected new file mode 100644 index 000000000..570c98dc0 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.mcil", line 1, character 37-38: +1 | (check-system sys :queries ((q (r))) f) + ^ +Error while parsing a check-system command, read the symbol 'f', + but expected an attribute from the set (:assumption, :reachable, + :query, :queries) or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.mcil b/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.mcil new file mode 100644 index 000000000..46deac76c --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/260_check-system_bad_attribute_3.mcil @@ -0,0 +1 @@ +(check-system sys :queries ((q (r))) f) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.expected b/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.expected new file mode 100644 index 000000000..f212d8052 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.mcil", line 1, character 41-47: +1 | (check-system sys :reachable (r (= 1 1)) :trans) + ^^^^^^ +Error while parsing a check-system command, read the reserved word ':trans', + but expected an attribute from the set (:assumption, :reachable, + :query, :queries) or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.mcil b/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.mcil new file mode 100644 index 000000000..04cfdd22b --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/261_check-system_bad_attribute_4.mcil @@ -0,0 +1 @@ +(check-system sys :reachable (r (= 1 1)) :trans) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.expected b/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.expected new file mode 100644 index 000000000..d05f72be2 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.mcil", line 1, character 14-15: +1 | (define-system) + ^ +Error while parsing a system definition, read a closing parenthesis, + but expected a system name symbol. diff --git a/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.mcil b/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.mcil new file mode 100644 index 000000000..ab3858156 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/262_check-system_missing_system_name.mcil @@ -0,0 +1 @@ +(define-system) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.expected b/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.expected new file mode 100644 index 000000000..eb5212478 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.mcil", line 1, character 18-19: +1 | (declare-enum-sort) + ^ +Error while parsing an enumeration declaration, read a closing parenthesis, + but expected a symbol for the enumeration sort name. diff --git a/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.mcil b/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.mcil new file mode 100644 index 000000000..17d49fa83 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/263_declare-enum-sort_missing_name.mcil @@ -0,0 +1 @@ +(declare-enum-sort) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.expected b/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.expected new file mode 100644 index 000000000..127e6d374 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.mcil", line 1, character 23-24: +1 | (declare-enum-sort enum) + ^ +Error while parsing an enumeration declaration, read a closing parenthesis, + but expected a list of enumeration values (enum1 enum2 ...). diff --git a/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.mcil b/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.mcil new file mode 100644 index 000000000..f3d844771 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/264_declare-enum-sort_missing_value_list.mcil @@ -0,0 +1 @@ +(declare-enum-sort enum) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.expected b/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.expected new file mode 100644 index 000000000..31e5670b5 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.mcil", line 1, character 25-26: +1 | (declare-enum-sort enum ()) + ^ +Error while parsing an enumeration declaration, read a closing parenthesis, + but expected a nonempty list of enumeration values (enum1 enum2 ...). diff --git a/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.mcil b/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.mcil new file mode 100644 index 000000000..553f36178 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/265_declare-enum-sort_empty_list.mcil @@ -0,0 +1 @@ +(declare-enum-sort enum ()) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.expected b/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.expected new file mode 100644 index 000000000..481c42655 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.mcil", line 1, character 32-37: +1 | (declare-enum-sort enum (A B C) error) + ^^^^^ +Error while parsing an enumeration declaration, read the symbol 'error', + but expected a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.mcil b/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.mcil new file mode 100644 index 000000000..1a361d4cb --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/266_declare-enum-sort_unclosed.mcil @@ -0,0 +1 @@ +(declare-enum-sort enum (A B C) error) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.expected b/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.expected new file mode 100644 index 000000000..fad425204 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.mcil", line 1, character 13-14: +1 | (check-system) + ^ +Error while parsing a check-system command, read a closing parenthesis, + but expected a symbol corresponding to a defined system. diff --git a/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.mcil b/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.mcil new file mode 100644 index 000000000..5118fa9cc --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/267_check-system_missing_system_name.mcil @@ -0,0 +1 @@ +(check-system) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.expected b/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.expected new file mode 100644 index 000000000..1258d11f1 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.mcil", line 1, character 15-16: +1 | (define-system _) + ^ +Error while parsing a system definition, read the reserved word '_', + but expected a system name symbol. diff --git a/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.mcil b/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.mcil new file mode 100644 index 000000000..1718a789c --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/268_define-system_bad_system_name.mcil @@ -0,0 +1 @@ +(define-system _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.expected b/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.expected new file mode 100644 index 000000000..c040d5804 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.mcil", line 1, character 19-20: +1 | (declare-enum-sort _) + ^ +Error while parsing an enumeration declaration, read the reserved word '_', + but expected a symbol for the enumeration sort name. diff --git a/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.mcil b/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.mcil new file mode 100644 index 000000000..622af12f0 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/269_declare-enum-sort_bad_enum_name.mcil @@ -0,0 +1 @@ +(declare-enum-sort _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.expected b/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.expected new file mode 100644 index 000000000..2a9b8804e --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.expected @@ -0,0 +1,5 @@ +File "tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.mcil", line 1, character 14-15: +1 | (check-system _) + ^ +Error while parsing a check-system command, read the reserved word '_', + but expected a symbol corresponding to a defined system. diff --git a/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.mcil b/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.mcil new file mode 100644 index 000000000..9850a9cc9 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/274_check-system_bad_system_name.mcil @@ -0,0 +1 @@ +(check-system _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.expected b/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.expected new file mode 100644 index 000000000..a5c7624e7 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.mcil", line 1, character 25-26: +1 | (declare-enum-sort e (c1 _)) + ^ +Error while parsing an enumeration declaration, read the reserved word '_', + but expected an enumeration value; note that keywords and reserved + words (such as '_', 'as', ...) are not valid enumeration values. diff --git a/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.mcil b/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.mcil new file mode 100644 index 000000000..e6b009ed6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/275_declare-enum-sort_bad_value.mcil @@ -0,0 +1 @@ +(declare-enum-sort e (c1 _)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.expected b/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.expected new file mode 100644 index 000000000..9177f1025 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.mcil", line 1, character 29-30: +1 | (check-system s1 :assumption _) + ^ +Error while parsing an assumption of a check-system command, + read the reserved word '_', + but expected an opening parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.mcil b/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.mcil new file mode 100644 index 000000000..407f3f1d0 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/276_check-system_assumption_unopened.mcil @@ -0,0 +1 @@ +(check-system s1 :assumption _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.expected b/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.expected new file mode 100644 index 000000000..08d372912 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.mcil", line 1, character 30-31: +1 | (check-system s1 :assumption (_)) + ^ +Error while parsing an assumption of a check-system command, + read the reserved word '_', + but expected an identifier. diff --git a/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.mcil b/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.mcil new file mode 100644 index 000000000..3e1318759 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/277_check-system_assumption_bad_id.mcil @@ -0,0 +1 @@ +(check-system s1 :assumption (_)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.expected b/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.expected new file mode 100644 index 000000000..b736fca19 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.mcil", line 1, character 32-33: +1 | (check-system s1 :assumption (a _)) + ^ +Error while parsing an assumption of a check-system command, + read the reserved word '_', + but expected a formula. diff --git a/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.mcil b/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.mcil new file mode 100644 index 000000000..2c8b5b400 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/278_check-system_assumption_bad_formula.mcil @@ -0,0 +1 @@ +(check-system s1 :assumption (a _)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.expected b/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.expected new file mode 100644 index 000000000..4a7758718 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.mcil", line 1, character 34-35: +1 | (check-system s1 :assumption (a t _)) + ^ +Error while parsing an assumption of a check-system command, + read the reserved word '_', + but expected a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.mcil b/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.mcil new file mode 100644 index 000000000..ab2a77221 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/279_check-system_assumption_unclosed.mcil @@ -0,0 +1 @@ +(check-system s1 :assumption (a t _)) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.expected b/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.expected new file mode 100644 index 000000000..5352ebdd8 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.mcil", line 1, character 29-39: +1 | (define-system sys :input () :reachable) + ^^^^^^^^^^ +Error while parsing a system definition, read the reserved word ':reachable', + but expected an attribute from the set (:output, :local, :subsys, + :init, :trans, :inv). diff --git a/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.mcil b/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.mcil new file mode 100644 index 000000000..5387f3bcb --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/280_define-system_bad_attribute.mcil @@ -0,0 +1 @@ +(define-system sys :input () :reachable) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.expected b/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.expected new file mode 100644 index 000000000..6ad32cb82 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.mcil", line 1, character 29-30: +1 | (check-system sys :output () _) + ^ +Error while parsing a check-system command, read the reserved word '_', + but expected an attribute from the set (:input, :local, :assumption, + :reachable, :query, :queries). diff --git a/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.mcil b/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.mcil new file mode 100644 index 000000000..6b385592f --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/281_check-system_bad_attribute_5.mcil @@ -0,0 +1 @@ +(check-system sys :output () _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.expected b/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.expected new file mode 100644 index 000000000..63696c5fa --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.mcil", line 1, character 28-29: +1 | (check-system sys :local () _) + ^ +Error while parsing a check-system command, read the reserved word '_', + but expected an attribute from the set (:input, :output, :assumption, + :reachable, :query, :queries). diff --git a/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.mcil b/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.mcil new file mode 100644 index 000000000..08b7e4dd6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/282_check-system_bad_attribute_6.mcil @@ -0,0 +1 @@ +(check-system sys :local () _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.expected b/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.expected new file mode 100644 index 000000000..5f624b41f --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.mcil", line 1, character 28-29: +1 | (define-system sys :trans t _) + ^ +Error while parsing a system definition, read the reserved word '_', + but expected an attribute from the set (:input, :output, :local, + :subsys, :init, :inv) or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.mcil b/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.mcil new file mode 100644 index 000000000..afc50f417 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/283_define-system_bad_attribute_6.mcil @@ -0,0 +1 @@ +(define-system sys :trans t _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.expected b/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.expected new file mode 100644 index 000000000..59e13761a --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.mcil", line 1, character 26-27: +1 | (define-system sys :inv t _) + ^ +Error while parsing a system definition, read the reserved word '_', + but expected an attribute from the set (:input, :output, :local, + :subsys, :init, :trans) or a closing parenthesis. diff --git a/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.mcil b/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.mcil new file mode 100644 index 000000000..bffaa4f0e --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/284_define-system_bad_attribute_7.mcil @@ -0,0 +1 @@ +(define-system sys :inv t _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.expected b/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.expected new file mode 100644 index 000000000..e473b112d --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.expected @@ -0,0 +1,6 @@ +File "tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.mcil", line 1, character 36-37: +1 | (check-system sys :assumption (a f) _) + ^ +Error while parsing a check-system command, read the reserved word '_', + but expected an attribute from the set (:input, :output, :local, + :assumption, :reachable, :query, :queries). diff --git a/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.mcil b/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.mcil new file mode 100644 index 000000000..15ea18281 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/285_check-system_bad_attribute_7.mcil @@ -0,0 +1 @@ +(check-system sys :assumption (a f) _) \ No newline at end of file diff --git a/tests/parsing/smtlib/mcil/errors/dune b/tests/parsing/smtlib/mcil/errors/dune new file mode 100644 index 000000000..d7dc521d6 --- /dev/null +++ b/tests/parsing/smtlib/mcil/errors/dune @@ -0,0 +1,1796 @@ +; File auto-generated by gentests.ml + +; Auto-generated part begin +; Test for 218_define-system_bad_attribute_1.mcil +; Incremental test + +(rule + (target 218_define-system_bad_attribute_1.incremental) + (deps (:input 218_define-system_bad_attribute_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 218_define-system_bad_attribute_1.expected 218_define-system_bad_attribute_1.incremental))) + +; Full mode test + +(rule + (target 218_define-system_bad_attribute_1.full) + (deps (:input 218_define-system_bad_attribute_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 218_define-system_bad_attribute_1.expected 218_define-system_bad_attribute_1.full))) + + +; Test for 219_define-system_missing_output_list.mcil +; Incremental test + +(rule + (target 219_define-system_missing_output_list.incremental) + (deps (:input 219_define-system_missing_output_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 219_define-system_missing_output_list.expected 219_define-system_missing_output_list.incremental))) + +; Full mode test + +(rule + (target 219_define-system_missing_output_list.full) + (deps (:input 219_define-system_missing_output_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 219_define-system_missing_output_list.expected 219_define-system_missing_output_list.full))) + + +; Test for 220_define-system_bad_output_list.mcil +; Incremental test + +(rule + (target 220_define-system_bad_output_list.incremental) + (deps (:input 220_define-system_bad_output_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 220_define-system_bad_output_list.expected 220_define-system_bad_output_list.incremental))) + +; Full mode test + +(rule + (target 220_define-system_bad_output_list.full) + (deps (:input 220_define-system_bad_output_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 220_define-system_bad_output_list.expected 220_define-system_bad_output_list.full))) + + +; Test for 221_define-system_missing_local_list.mcil +; Incremental test + +(rule + (target 221_define-system_missing_local_list.incremental) + (deps (:input 221_define-system_missing_local_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 221_define-system_missing_local_list.expected 221_define-system_missing_local_list.incremental))) + +; Full mode test + +(rule + (target 221_define-system_missing_local_list.full) + (deps (:input 221_define-system_missing_local_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 221_define-system_missing_local_list.expected 221_define-system_missing_local_list.full))) + + +; Test for 222_define-system_bad_local_list.mcil +; Incremental test + +(rule + (target 222_define-system_bad_local_list.incremental) + (deps (:input 222_define-system_bad_local_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 222_define-system_bad_local_list.expected 222_define-system_bad_local_list.incremental))) + +; Full mode test + +(rule + (target 222_define-system_bad_local_list.full) + (deps (:input 222_define-system_bad_local_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 222_define-system_bad_local_list.expected 222_define-system_bad_local_list.full))) + + +; Test for 223_define-system_missing_input_list.mcil +; Incremental test + +(rule + (target 223_define-system_missing_input_list.incremental) + (deps (:input 223_define-system_missing_input_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 223_define-system_missing_input_list.expected 223_define-system_missing_input_list.incremental))) + +; Full mode test + +(rule + (target 223_define-system_missing_input_list.full) + (deps (:input 223_define-system_missing_input_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 223_define-system_missing_input_list.expected 223_define-system_missing_input_list.full))) + + +; Test for 224_define-system_bad_input_list.mcil +; Incremental test + +(rule + (target 224_define-system_bad_input_list.incremental) + (deps (:input 224_define-system_bad_input_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 224_define-system_bad_input_list.expected 224_define-system_bad_input_list.incremental))) + +; Full mode test + +(rule + (target 224_define-system_bad_input_list.full) + (deps (:input 224_define-system_bad_input_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 224_define-system_bad_input_list.expected 224_define-system_bad_input_list.full))) + + +; Test for 225_define-system_bad_attribute_2.mcil +; Incremental test + +(rule + (target 225_define-system_bad_attribute_2.incremental) + (deps (:input 225_define-system_bad_attribute_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 225_define-system_bad_attribute_2.expected 225_define-system_bad_attribute_2.incremental))) + +; Full mode test + +(rule + (target 225_define-system_bad_attribute_2.full) + (deps (:input 225_define-system_bad_attribute_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 225_define-system_bad_attribute_2.expected 225_define-system_bad_attribute_2.full))) + + +; Test for 227_define-system_missing_trans_formula.mcil +; Incremental test + +(rule + (target 227_define-system_missing_trans_formula.incremental) + (deps (:input 227_define-system_missing_trans_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 227_define-system_missing_trans_formula.expected 227_define-system_missing_trans_formula.incremental))) + +; Full mode test + +(rule + (target 227_define-system_missing_trans_formula.full) + (deps (:input 227_define-system_missing_trans_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 227_define-system_missing_trans_formula.expected 227_define-system_missing_trans_formula.full))) + + +; Test for 228_define-system_missing_subsys_decl.mcil +; Incremental test + +(rule + (target 228_define-system_missing_subsys_decl.incremental) + (deps (:input 228_define-system_missing_subsys_decl.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 228_define-system_missing_subsys_decl.expected 228_define-system_missing_subsys_decl.incremental))) + +; Full mode test + +(rule + (target 228_define-system_missing_subsys_decl.full) + (deps (:input 228_define-system_missing_subsys_decl.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 228_define-system_missing_subsys_decl.expected 228_define-system_missing_subsys_decl.full))) + + +; Test for 229_define-system_bad_subsys_decl_1.mcil +; Incremental test + +(rule + (target 229_define-system_bad_subsys_decl_1.incremental) + (deps (:input 229_define-system_bad_subsys_decl_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 229_define-system_bad_subsys_decl_1.expected 229_define-system_bad_subsys_decl_1.incremental))) + +; Full mode test + +(rule + (target 229_define-system_bad_subsys_decl_1.full) + (deps (:input 229_define-system_bad_subsys_decl_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 229_define-system_bad_subsys_decl_1.expected 229_define-system_bad_subsys_decl_1.full))) + + +; Test for 230_define-system_bad_subsys_decl_2.mcil +; Incremental test + +(rule + (target 230_define-system_bad_subsys_decl_2.incremental) + (deps (:input 230_define-system_bad_subsys_decl_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 230_define-system_bad_subsys_decl_2.expected 230_define-system_bad_subsys_decl_2.incremental))) + +; Full mode test + +(rule + (target 230_define-system_bad_subsys_decl_2.full) + (deps (:input 230_define-system_bad_subsys_decl_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 230_define-system_bad_subsys_decl_2.expected 230_define-system_bad_subsys_decl_2.full))) + + +; Test for 231_define-system_bad_subsys_decl_3.mcil +; Incremental test + +(rule + (target 231_define-system_bad_subsys_decl_3.incremental) + (deps (:input 231_define-system_bad_subsys_decl_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 231_define-system_bad_subsys_decl_3.expected 231_define-system_bad_subsys_decl_3.incremental))) + +; Full mode test + +(rule + (target 231_define-system_bad_subsys_decl_3.full) + (deps (:input 231_define-system_bad_subsys_decl_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 231_define-system_bad_subsys_decl_3.expected 231_define-system_bad_subsys_decl_3.full))) + + +; Test for 232_define-system_bad_subsys_decl_4.mcil +; Incremental test + +(rule + (target 232_define-system_bad_subsys_decl_4.incremental) + (deps (:input 232_define-system_bad_subsys_decl_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 232_define-system_bad_subsys_decl_4.expected 232_define-system_bad_subsys_decl_4.incremental))) + +; Full mode test + +(rule + (target 232_define-system_bad_subsys_decl_4.full) + (deps (:input 232_define-system_bad_subsys_decl_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 232_define-system_bad_subsys_decl_4.expected 232_define-system_bad_subsys_decl_4.full))) + + +; Test for 233_define-system_bad_attribute_7.mcil +; Incremental test + +(rule + (target 233_define-system_bad_attribute_7.incremental) + (deps (:input 233_define-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 233_define-system_bad_attribute_7.expected 233_define-system_bad_attribute_7.incremental))) + +; Full mode test + +(rule + (target 233_define-system_bad_attribute_7.full) + (deps (:input 233_define-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 233_define-system_bad_attribute_7.expected 233_define-system_bad_attribute_7.full))) + + +; Test for 234_check-system_bad_query_1.mcil +; Incremental test + +(rule + (target 234_check-system_bad_query_1.incremental) + (deps (:input 234_check-system_bad_query_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 234_check-system_bad_query_1.expected 234_check-system_bad_query_1.incremental))) + +; Full mode test + +(rule + (target 234_check-system_bad_query_1.full) + (deps (:input 234_check-system_bad_query_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 234_check-system_bad_query_1.expected 234_check-system_bad_query_1.full))) + + +; Test for 235_define-system_bad_subsys_decl_5.mcil +; Incremental test + +(rule + (target 235_define-system_bad_subsys_decl_5.incremental) + (deps (:input 235_define-system_bad_subsys_decl_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 235_define-system_bad_subsys_decl_5.expected 235_define-system_bad_subsys_decl_5.incremental))) + +; Full mode test + +(rule + (target 235_define-system_bad_subsys_decl_5.full) + (deps (:input 235_define-system_bad_subsys_decl_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 235_define-system_bad_subsys_decl_5.expected 235_define-system_bad_subsys_decl_5.full))) + + +; Test for 236_define-system_missing_inv_formula.mcil +; Incremental test + +(rule + (target 236_define-system_missing_inv_formula.incremental) + (deps (:input 236_define-system_missing_inv_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 236_define-system_missing_inv_formula.expected 236_define-system_missing_inv_formula.incremental))) + +; Full mode test + +(rule + (target 236_define-system_missing_inv_formula.full) + (deps (:input 236_define-system_missing_inv_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 236_define-system_missing_inv_formula.expected 236_define-system_missing_inv_formula.full))) + + +; Test for 237_define-system_missing_init_formula.mcil +; Incremental test + +(rule + (target 237_define-system_missing_init_formula.incremental) + (deps (:input 237_define-system_missing_init_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 237_define-system_missing_init_formula.expected 237_define-system_missing_init_formula.incremental))) + +; Full mode test + +(rule + (target 237_define-system_missing_init_formula.full) + (deps (:input 237_define-system_missing_init_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 237_define-system_missing_init_formula.expected 237_define-system_missing_init_formula.full))) + + +; Test for 238_define-system_bad_subsys_decl_5.mcil +; Incremental test + +(rule + (target 238_define-system_bad_subsys_decl_5.incremental) + (deps (:input 238_define-system_bad_subsys_decl_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 238_define-system_bad_subsys_decl_5.expected 238_define-system_bad_subsys_decl_5.incremental))) + +; Full mode test + +(rule + (target 238_define-system_bad_subsys_decl_5.full) + (deps (:input 238_define-system_bad_subsys_decl_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 238_define-system_bad_subsys_decl_5.expected 238_define-system_bad_subsys_decl_5.full))) + + +; Test for 239_define-system_bad_attribute_4.mcil +; Incremental test + +(rule + (target 239_define-system_bad_attribute_4.incremental) + (deps (:input 239_define-system_bad_attribute_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 239_define-system_bad_attribute_4.expected 239_define-system_bad_attribute_4.incremental))) + +; Full mode test + +(rule + (target 239_define-system_bad_attribute_4.full) + (deps (:input 239_define-system_bad_attribute_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 239_define-system_bad_attribute_4.expected 239_define-system_bad_attribute_4.full))) + + +; Test for 246_check-system_bad_attribute_1.mcil +; Incremental test + +(rule + (target 246_check-system_bad_attribute_1.incremental) + (deps (:input 246_check-system_bad_attribute_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 246_check-system_bad_attribute_1.expected 246_check-system_bad_attribute_1.incremental))) + +; Full mode test + +(rule + (target 246_check-system_bad_attribute_1.full) + (deps (:input 246_check-system_bad_attribute_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 246_check-system_bad_attribute_1.expected 246_check-system_bad_attribute_1.full))) + + +; Test for 247_check-system_bad_attribute_2.mcil +; Incremental test + +(rule + (target 247_check-system_bad_attribute_2.incremental) + (deps (:input 247_check-system_bad_attribute_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 247_check-system_bad_attribute_2.expected 247_check-system_bad_attribute_2.incremental))) + +; Full mode test + +(rule + (target 247_check-system_bad_attribute_2.full) + (deps (:input 247_check-system_bad_attribute_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 247_check-system_bad_attribute_2.expected 247_check-system_bad_attribute_2.full))) + + +; Test for 248_check-system_missing_reachable_formula_1.mcil +; Incremental test + +(rule + (target 248_check-system_missing_reachable_formula_1.incremental) + (deps (:input 248_check-system_missing_reachable_formula_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 248_check-system_missing_reachable_formula_1.expected 248_check-system_missing_reachable_formula_1.incremental))) + +; Full mode test + +(rule + (target 248_check-system_missing_reachable_formula_1.full) + (deps (:input 248_check-system_missing_reachable_formula_1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 248_check-system_missing_reachable_formula_1.expected 248_check-system_missing_reachable_formula_1.full))) + + +; Test for 249_check-system_missing_reachable_formula_2.mcil +; Incremental test + +(rule + (target 249_check-system_missing_reachable_formula_2.incremental) + (deps (:input 249_check-system_missing_reachable_formula_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 249_check-system_missing_reachable_formula_2.expected 249_check-system_missing_reachable_formula_2.incremental))) + +; Full mode test + +(rule + (target 249_check-system_missing_reachable_formula_2.full) + (deps (:input 249_check-system_missing_reachable_formula_2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 249_check-system_missing_reachable_formula_2.expected 249_check-system_missing_reachable_formula_2.full))) + + +; Test for 250_check-system_missing_reachable_formula_3.mcil +; Incremental test + +(rule + (target 250_check-system_missing_reachable_formula_3.incremental) + (deps (:input 250_check-system_missing_reachable_formula_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 250_check-system_missing_reachable_formula_3.expected 250_check-system_missing_reachable_formula_3.incremental))) + +; Full mode test + +(rule + (target 250_check-system_missing_reachable_formula_3.full) + (deps (:input 250_check-system_missing_reachable_formula_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 250_check-system_missing_reachable_formula_3.expected 250_check-system_missing_reachable_formula_3.full))) + + +; Test for 251_check-system_reachable_unclosed.mcil +; Incremental test + +(rule + (target 251_check-system_reachable_unclosed.incremental) + (deps (:input 251_check-system_reachable_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 251_check-system_reachable_unclosed.expected 251_check-system_reachable_unclosed.incremental))) + +; Full mode test + +(rule + (target 251_check-system_reachable_unclosed.full) + (deps (:input 251_check-system_reachable_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 251_check-system_reachable_unclosed.expected 251_check-system_reachable_unclosed.full))) + + +; Test for 252_check-system_missing_query.mcil +; Incremental test + +(rule + (target 252_check-system_missing_query.incremental) + (deps (:input 252_check-system_missing_query.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 252_check-system_missing_query.expected 252_check-system_missing_query.incremental))) + +; Full mode test + +(rule + (target 252_check-system_missing_query.full) + (deps (:input 252_check-system_missing_query.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 252_check-system_missing_query.expected 252_check-system_missing_query.full))) + + +; Test for 253_check-system_missing_query_name.mcil +; Incremental test + +(rule + (target 253_check-system_missing_query_name.incremental) + (deps (:input 253_check-system_missing_query_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 253_check-system_missing_query_name.expected 253_check-system_missing_query_name.incremental))) + +; Full mode test + +(rule + (target 253_check-system_missing_query_name.full) + (deps (:input 253_check-system_missing_query_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 253_check-system_missing_query_name.expected 253_check-system_missing_query_name.full))) + + +; Test for 254_check-system_query_missing_condition_var_list.mcil +; Incremental test + +(rule + (target 254_check-system_query_missing_condition_var_list.incremental) + (deps (:input 254_check-system_query_missing_condition_var_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 254_check-system_query_missing_condition_var_list.expected 254_check-system_query_missing_condition_var_list.incremental))) + +; Full mode test + +(rule + (target 254_check-system_query_missing_condition_var_list.full) + (deps (:input 254_check-system_query_missing_condition_var_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 254_check-system_query_missing_condition_var_list.expected 254_check-system_query_missing_condition_var_list.full))) + + +; Test for 256_check-system_query_unclosed.mcil +; Incremental test + +(rule + (target 256_check-system_query_unclosed.incremental) + (deps (:input 256_check-system_query_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 256_check-system_query_unclosed.expected 256_check-system_query_unclosed.incremental))) + +; Full mode test + +(rule + (target 256_check-system_query_unclosed.full) + (deps (:input 256_check-system_query_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 256_check-system_query_unclosed.expected 256_check-system_query_unclosed.full))) + + +; Test for 257_check-system_missing_queries_list.mcil +; Incremental test + +(rule + (target 257_check-system_missing_queries_list.incremental) + (deps (:input 257_check-system_missing_queries_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 257_check-system_missing_queries_list.expected 257_check-system_missing_queries_list.incremental))) + +; Full mode test + +(rule + (target 257_check-system_missing_queries_list.full) + (deps (:input 257_check-system_missing_queries_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 257_check-system_missing_queries_list.expected 257_check-system_missing_queries_list.full))) + + +; Test for 258_check-system_bad_query.mcil +; Incremental test + +(rule + (target 258_check-system_bad_query.incremental) + (deps (:input 258_check-system_bad_query.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 258_check-system_bad_query.expected 258_check-system_bad_query.incremental))) + +; Full mode test + +(rule + (target 258_check-system_bad_query.full) + (deps (:input 258_check-system_bad_query.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 258_check-system_bad_query.expected 258_check-system_bad_query.full))) + + +; Test for 259_check-system_bad_query_or_unclosed.mcil +; Incremental test + +(rule + (target 259_check-system_bad_query_or_unclosed.incremental) + (deps (:input 259_check-system_bad_query_or_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 259_check-system_bad_query_or_unclosed.expected 259_check-system_bad_query_or_unclosed.incremental))) + +; Full mode test + +(rule + (target 259_check-system_bad_query_or_unclosed.full) + (deps (:input 259_check-system_bad_query_or_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 259_check-system_bad_query_or_unclosed.expected 259_check-system_bad_query_or_unclosed.full))) + + +; Test for 260_check-system_bad_attribute_3.mcil +; Incremental test + +(rule + (target 260_check-system_bad_attribute_3.incremental) + (deps (:input 260_check-system_bad_attribute_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 260_check-system_bad_attribute_3.expected 260_check-system_bad_attribute_3.incremental))) + +; Full mode test + +(rule + (target 260_check-system_bad_attribute_3.full) + (deps (:input 260_check-system_bad_attribute_3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 260_check-system_bad_attribute_3.expected 260_check-system_bad_attribute_3.full))) + + +; Test for 261_check-system_bad_attribute_4.mcil +; Incremental test + +(rule + (target 261_check-system_bad_attribute_4.incremental) + (deps (:input 261_check-system_bad_attribute_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 261_check-system_bad_attribute_4.expected 261_check-system_bad_attribute_4.incremental))) + +; Full mode test + +(rule + (target 261_check-system_bad_attribute_4.full) + (deps (:input 261_check-system_bad_attribute_4.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 261_check-system_bad_attribute_4.expected 261_check-system_bad_attribute_4.full))) + + +; Test for 262_check-system_missing_system_name.mcil +; Incremental test + +(rule + (target 262_check-system_missing_system_name.incremental) + (deps (:input 262_check-system_missing_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 262_check-system_missing_system_name.expected 262_check-system_missing_system_name.incremental))) + +; Full mode test + +(rule + (target 262_check-system_missing_system_name.full) + (deps (:input 262_check-system_missing_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 262_check-system_missing_system_name.expected 262_check-system_missing_system_name.full))) + + +; Test for 263_declare-enum-sort_missing_name.mcil +; Incremental test + +(rule + (target 263_declare-enum-sort_missing_name.incremental) + (deps (:input 263_declare-enum-sort_missing_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 263_declare-enum-sort_missing_name.expected 263_declare-enum-sort_missing_name.incremental))) + +; Full mode test + +(rule + (target 263_declare-enum-sort_missing_name.full) + (deps (:input 263_declare-enum-sort_missing_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 263_declare-enum-sort_missing_name.expected 263_declare-enum-sort_missing_name.full))) + + +; Test for 264_declare-enum-sort_missing_value_list.mcil +; Incremental test + +(rule + (target 264_declare-enum-sort_missing_value_list.incremental) + (deps (:input 264_declare-enum-sort_missing_value_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 264_declare-enum-sort_missing_value_list.expected 264_declare-enum-sort_missing_value_list.incremental))) + +; Full mode test + +(rule + (target 264_declare-enum-sort_missing_value_list.full) + (deps (:input 264_declare-enum-sort_missing_value_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 264_declare-enum-sort_missing_value_list.expected 264_declare-enum-sort_missing_value_list.full))) + + +; Test for 265_declare-enum-sort_empty_list.mcil +; Incremental test + +(rule + (target 265_declare-enum-sort_empty_list.incremental) + (deps (:input 265_declare-enum-sort_empty_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 265_declare-enum-sort_empty_list.expected 265_declare-enum-sort_empty_list.incremental))) + +; Full mode test + +(rule + (target 265_declare-enum-sort_empty_list.full) + (deps (:input 265_declare-enum-sort_empty_list.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 265_declare-enum-sort_empty_list.expected 265_declare-enum-sort_empty_list.full))) + + +; Test for 266_declare-enum-sort_unclosed.mcil +; Incremental test + +(rule + (target 266_declare-enum-sort_unclosed.incremental) + (deps (:input 266_declare-enum-sort_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 266_declare-enum-sort_unclosed.expected 266_declare-enum-sort_unclosed.incremental))) + +; Full mode test + +(rule + (target 266_declare-enum-sort_unclosed.full) + (deps (:input 266_declare-enum-sort_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 266_declare-enum-sort_unclosed.expected 266_declare-enum-sort_unclosed.full))) + + +; Test for 267_check-system_missing_system_name.mcil +; Incremental test + +(rule + (target 267_check-system_missing_system_name.incremental) + (deps (:input 267_check-system_missing_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 267_check-system_missing_system_name.expected 267_check-system_missing_system_name.incremental))) + +; Full mode test + +(rule + (target 267_check-system_missing_system_name.full) + (deps (:input 267_check-system_missing_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 267_check-system_missing_system_name.expected 267_check-system_missing_system_name.full))) + + +; Test for 268_define-system_bad_system_name.mcil +; Incremental test + +(rule + (target 268_define-system_bad_system_name.incremental) + (deps (:input 268_define-system_bad_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 268_define-system_bad_system_name.expected 268_define-system_bad_system_name.incremental))) + +; Full mode test + +(rule + (target 268_define-system_bad_system_name.full) + (deps (:input 268_define-system_bad_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 268_define-system_bad_system_name.expected 268_define-system_bad_system_name.full))) + + +; Test for 269_declare-enum-sort_bad_enum_name.mcil +; Incremental test + +(rule + (target 269_declare-enum-sort_bad_enum_name.incremental) + (deps (:input 269_declare-enum-sort_bad_enum_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 269_declare-enum-sort_bad_enum_name.expected 269_declare-enum-sort_bad_enum_name.incremental))) + +; Full mode test + +(rule + (target 269_declare-enum-sort_bad_enum_name.full) + (deps (:input 269_declare-enum-sort_bad_enum_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 269_declare-enum-sort_bad_enum_name.expected 269_declare-enum-sort_bad_enum_name.full))) + + +; Test for 274_check-system_bad_system_name.mcil +; Incremental test + +(rule + (target 274_check-system_bad_system_name.incremental) + (deps (:input 274_check-system_bad_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 274_check-system_bad_system_name.expected 274_check-system_bad_system_name.incremental))) + +; Full mode test + +(rule + (target 274_check-system_bad_system_name.full) + (deps (:input 274_check-system_bad_system_name.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 274_check-system_bad_system_name.expected 274_check-system_bad_system_name.full))) + + +; Test for 275_declare-enum-sort_bad_value.mcil +; Incremental test + +(rule + (target 275_declare-enum-sort_bad_value.incremental) + (deps (:input 275_declare-enum-sort_bad_value.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 275_declare-enum-sort_bad_value.expected 275_declare-enum-sort_bad_value.incremental))) + +; Full mode test + +(rule + (target 275_declare-enum-sort_bad_value.full) + (deps (:input 275_declare-enum-sort_bad_value.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 275_declare-enum-sort_bad_value.expected 275_declare-enum-sort_bad_value.full))) + + +; Test for 276_check-system_assumption_unopened.mcil +; Incremental test + +(rule + (target 276_check-system_assumption_unopened.incremental) + (deps (:input 276_check-system_assumption_unopened.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 276_check-system_assumption_unopened.expected 276_check-system_assumption_unopened.incremental))) + +; Full mode test + +(rule + (target 276_check-system_assumption_unopened.full) + (deps (:input 276_check-system_assumption_unopened.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 276_check-system_assumption_unopened.expected 276_check-system_assumption_unopened.full))) + + +; Test for 277_check-system_assumption_bad_id.mcil +; Incremental test + +(rule + (target 277_check-system_assumption_bad_id.incremental) + (deps (:input 277_check-system_assumption_bad_id.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 277_check-system_assumption_bad_id.expected 277_check-system_assumption_bad_id.incremental))) + +; Full mode test + +(rule + (target 277_check-system_assumption_bad_id.full) + (deps (:input 277_check-system_assumption_bad_id.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 277_check-system_assumption_bad_id.expected 277_check-system_assumption_bad_id.full))) + + +; Test for 278_check-system_assumption_bad_formula.mcil +; Incremental test + +(rule + (target 278_check-system_assumption_bad_formula.incremental) + (deps (:input 278_check-system_assumption_bad_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 278_check-system_assumption_bad_formula.expected 278_check-system_assumption_bad_formula.incremental))) + +; Full mode test + +(rule + (target 278_check-system_assumption_bad_formula.full) + (deps (:input 278_check-system_assumption_bad_formula.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 278_check-system_assumption_bad_formula.expected 278_check-system_assumption_bad_formula.full))) + + +; Test for 279_check-system_assumption_unclosed.mcil +; Incremental test + +(rule + (target 279_check-system_assumption_unclosed.incremental) + (deps (:input 279_check-system_assumption_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 279_check-system_assumption_unclosed.expected 279_check-system_assumption_unclosed.incremental))) + +; Full mode test + +(rule + (target 279_check-system_assumption_unclosed.full) + (deps (:input 279_check-system_assumption_unclosed.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 279_check-system_assumption_unclosed.expected 279_check-system_assumption_unclosed.full))) + + +; Test for 280_define-system_bad_attribute.mcil +; Incremental test + +(rule + (target 280_define-system_bad_attribute.incremental) + (deps (:input 280_define-system_bad_attribute.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 280_define-system_bad_attribute.expected 280_define-system_bad_attribute.incremental))) + +; Full mode test + +(rule + (target 280_define-system_bad_attribute.full) + (deps (:input 280_define-system_bad_attribute.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 280_define-system_bad_attribute.expected 280_define-system_bad_attribute.full))) + + +; Test for 281_check-system_bad_attribute_5.mcil +; Incremental test + +(rule + (target 281_check-system_bad_attribute_5.incremental) + (deps (:input 281_check-system_bad_attribute_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 281_check-system_bad_attribute_5.expected 281_check-system_bad_attribute_5.incremental))) + +; Full mode test + +(rule + (target 281_check-system_bad_attribute_5.full) + (deps (:input 281_check-system_bad_attribute_5.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 281_check-system_bad_attribute_5.expected 281_check-system_bad_attribute_5.full))) + + +; Test for 282_check-system_bad_attribute_6.mcil +; Incremental test + +(rule + (target 282_check-system_bad_attribute_6.incremental) + (deps (:input 282_check-system_bad_attribute_6.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 282_check-system_bad_attribute_6.expected 282_check-system_bad_attribute_6.incremental))) + +; Full mode test + +(rule + (target 282_check-system_bad_attribute_6.full) + (deps (:input 282_check-system_bad_attribute_6.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 282_check-system_bad_attribute_6.expected 282_check-system_bad_attribute_6.full))) + + +; Test for 283_define-system_bad_attribute_6.mcil +; Incremental test + +(rule + (target 283_define-system_bad_attribute_6.incremental) + (deps (:input 283_define-system_bad_attribute_6.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 283_define-system_bad_attribute_6.expected 283_define-system_bad_attribute_6.incremental))) + +; Full mode test + +(rule + (target 283_define-system_bad_attribute_6.full) + (deps (:input 283_define-system_bad_attribute_6.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 283_define-system_bad_attribute_6.expected 283_define-system_bad_attribute_6.full))) + + +; Test for 284_define-system_bad_attribute_7.mcil +; Incremental test + +(rule + (target 284_define-system_bad_attribute_7.incremental) + (deps (:input 284_define-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 284_define-system_bad_attribute_7.expected 284_define-system_bad_attribute_7.incremental))) + +; Full mode test + +(rule + (target 284_define-system_bad_attribute_7.full) + (deps (:input 284_define-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 284_define-system_bad_attribute_7.expected 284_define-system_bad_attribute_7.full))) + + +; Test for 285_check-system_bad_attribute_7.mcil +; Incremental test + +(rule + (target 285_check-system_bad_attribute_7.incremental) + (deps (:input 285_check-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 285_check-system_bad_attribute_7.expected 285_check-system_bad_attribute_7.incremental))) + +; Full mode test + +(rule + (target 285_check-system_bad_attribute_7.full) + (deps (:input 285_check-system_bad_attribute_7.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff 285_check-system_bad_attribute_7.expected 285_check-system_bad_attribute_7.full))) + + +; Auto-generated part end diff --git a/tests/parsing/smtlib/mcil/errors/flags.dune b/tests/parsing/smtlib/mcil/errors/flags.dune new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/errors/mcil/dune b/tests/typing/errors/mcil/dune new file mode 100644 index 000000000..cbfd80ab5 --- /dev/null +++ b/tests/typing/errors/mcil/dune @@ -0,0 +1,132 @@ +; File auto-generated by gentests.ml + +; Auto-generated part begin +; Test for repeated_init.mcil +; Incremental test + +(rule + (target repeated_init.incremental) + (deps (:input repeated_init.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff repeated_init.expected repeated_init.incremental))) + +; Full mode test + +(rule + (target repeated_init.full) + (deps (:input repeated_init.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff repeated_init.expected repeated_init.full))) + + +; Test for repeated_input.mcil +; Incremental test + +(rule + (target repeated_input.incremental) + (deps (:input repeated_input.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff repeated_input.expected repeated_input.incremental))) + +; Full mode test + +(rule + (target repeated_input.full) + (deps (:input repeated_input.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff repeated_input.expected repeated_input.full))) + + +; Test for undefined-subsystem.mcil +; Incremental test + +(rule + (target undefined-subsystem.incremental) + (deps (:input undefined-subsystem.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff undefined-subsystem.expected undefined-subsystem.incremental))) + +; Full mode test + +(rule + (target undefined-subsystem.full) + (deps (:input undefined-subsystem.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff undefined-subsystem.expected undefined-subsystem.full))) + + +; Test for undefined-system.mcil +; Incremental test + +(rule + (target undefined-system.incremental) + (deps (:input undefined-system.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff undefined-system.expected undefined-system.incremental))) + +; Full mode test + +(rule + (target undefined-system.full) + (deps (:input undefined-system.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff undefined-system.expected undefined-system.full))) + + +; Auto-generated part end diff --git a/tests/typing/errors/mcil/flags.dune b/tests/typing/errors/mcil/flags.dune new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/errors/mcil/repeated_init.expected b/tests/typing/errors/mcil/repeated_init.expected new file mode 100644 index 000000000..e848d2bb1 --- /dev/null +++ b/tests/typing/errors/mcil/repeated_init.expected @@ -0,0 +1,4 @@ +File "tests/typing/errors/mcil/repeated_init.mcil", line 5, character 2-13: +5 | :init false + ^^^^^^^^^^^ +Error :init attribute is not repeatable diff --git a/tests/typing/errors/mcil/repeated_init.mcil b/tests/typing/errors/mcil/repeated_init.mcil new file mode 100644 index 000000000..0c339c82f --- /dev/null +++ b/tests/typing/errors/mcil/repeated_init.mcil @@ -0,0 +1,6 @@ +(set-logic ALL) + +(define-system S1 + :init true + :init false +) \ No newline at end of file diff --git a/tests/typing/errors/mcil/repeated_input.expected b/tests/typing/errors/mcil/repeated_input.expected new file mode 100644 index 000000000..36fd739a3 --- /dev/null +++ b/tests/typing/errors/mcil/repeated_input.expected @@ -0,0 +1,4 @@ +File "tests/typing/errors/mcil/repeated_input.mcil", line 5, character 2-18: +5 | :input ((y Int)) + ^^^^^^^^^^^^^^^^ +Error :input attribute is not repeatable diff --git a/tests/typing/errors/mcil/repeated_input.mcil b/tests/typing/errors/mcil/repeated_input.mcil new file mode 100644 index 000000000..39814b6bf --- /dev/null +++ b/tests/typing/errors/mcil/repeated_input.mcil @@ -0,0 +1,6 @@ +(set-logic ALL) + +(define-system S1 + :input ((x Int)) + :input ((y Int)) +) \ No newline at end of file diff --git a/tests/typing/errors/mcil/undefined-subsystem.expected b/tests/typing/errors/mcil/undefined-subsystem.expected new file mode 100644 index 000000000..b7d8d479f --- /dev/null +++ b/tests/typing/errors/mcil/undefined-subsystem.expected @@ -0,0 +1,4 @@ +File "tests/typing/errors/mcil/undefined-subsystem.mcil", line 2, character 31-32: +2 | (define-system sys :subsys (a (b Int))) + ^ +Error Undefined transition system: `b` diff --git a/tests/typing/errors/mcil/undefined-subsystem.mcil b/tests/typing/errors/mcil/undefined-subsystem.mcil new file mode 100644 index 000000000..081fba3e0 --- /dev/null +++ b/tests/typing/errors/mcil/undefined-subsystem.mcil @@ -0,0 +1,2 @@ +(set-logic ALL) +(define-system sys :subsys (a (b Int))) \ No newline at end of file diff --git a/tests/typing/errors/mcil/undefined-system.expected b/tests/typing/errors/mcil/undefined-system.expected new file mode 100644 index 000000000..aaf7941c3 --- /dev/null +++ b/tests/typing/errors/mcil/undefined-system.expected @@ -0,0 +1,4 @@ +File "tests/typing/errors/mcil/undefined-system.mcil", line 2, character 14-17: +2 | (check-system sys :query (q ())) + ^^^ +Error Undefined transition system: `sys` diff --git a/tests/typing/errors/mcil/undefined-system.mcil b/tests/typing/errors/mcil/undefined-system.mcil new file mode 100644 index 000000000..0d72f3a12 --- /dev/null +++ b/tests/typing/errors/mcil/undefined-system.mcil @@ -0,0 +1,2 @@ +(set-logic ALL) +(check-system sys :query (q ())) \ No newline at end of file diff --git a/tests/typing/pass/mcil/DelayedArbiter.expected b/tests/typing/pass/mcil/DelayedArbiter.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/DelayedArbiter.mcil b/tests/typing/pass/mcil/DelayedArbiter.mcil new file mode 100644 index 000000000..cf05a3f5e --- /dev/null +++ b/tests/typing/pass/mcil/DelayedArbiter.mcil @@ -0,0 +1,24 @@ +(set-logic QF_UF) + +(define-system DelayedArbiter + :input ( (r1 Bool) (r2 Bool) ) + :output ( (g1 Bool) (g2 Bool) ) + :init (and (not g1) (not g2) ) ; nothing is granted initially + :trans (and + (=> (and (not r1) (not r2)) + (and (not g1') (not g2'))) + (=> (and r1 (not r2)) + (and g1' (not g2'))) + (=> (and (not r1) r2) + (and (not g1') g2')) + (=> (and r1 r2) + (not (= g1' g2'))) + ) +) + +(check-system DelayedArbiter + :input ( (r1 Bool) (r2 Bool) ) + :output ( (g1 Bool) (g2 Bool) ) + :reachable (r (and r1 r2 g2)) + :query (q (r)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/DoubleDelay1.expected b/tests/typing/pass/mcil/DoubleDelay1.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/DoubleDelay1.mcil b/tests/typing/pass/mcil/DoubleDelay1.mcil new file mode 100644 index 000000000..58998f335 --- /dev/null +++ b/tests/typing/pass/mcil/DoubleDelay1.mcil @@ -0,0 +1,25 @@ +(set-logic QF_LIA) + +; One-step delay +(define-system Delay :input ( (i Int) ) :output ( (o Int) ) + :local ( (s Int) ) + :inv (= s i) + :init (= o 0) + :trans (= o' s) +) + +; Two-step delay +(define-system DoubleDelay :input ( (in Int) ) :output ( (out Int) ) + :local ( (temp Int) ) + :subsys (D1 (Delay in temp)) + :subsys (D2 (Delay temp out)) +) + +(check-system DoubleDelay + :input ( (in Int) ) + :output ( (out Int) ) + :local ( (temp Int) ) + :reachable (r1 (= out 10)) + :reachable (r2 (= out (- 10))) + :queries ( (q1 (r1)) (q2 (r2)) ) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/DoubleDelay2.expected b/tests/typing/pass/mcil/DoubleDelay2.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/DoubleDelay2.mcil b/tests/typing/pass/mcil/DoubleDelay2.mcil new file mode 100644 index 000000000..ac2c79772 --- /dev/null +++ b/tests/typing/pass/mcil/DoubleDelay2.mcil @@ -0,0 +1,38 @@ +(set-logic QF_LIA) + +;; DoubleDelay expanded +(define-system DoubleDelay + :input ( (in Int) ) + :output ( (out Int) ) + :local ( + (temp Int) + (s1 Int) ; from `(Delay in temp)` + (s2 Int) ; from `(Delay temp out)` + ) + :inv (and + (= s1 in) ; from `(Delay in temp)` + (= s2 temp) ; from `(Delay temp out)` + ) + :init (and + (= temp 0) ; from `(Delay in temp)` + (= out 0) ; from `(Delay temp out)` + ) + :trans (and + (= temp' s1) ; from `(Delay in temp)` + (= out' s2) ; from `(Delay temp out)` + ) +) + + +(check-system DoubleDelay + :input ( (in Int) ) + :output ( (out Int) ) + :local ( + (temp Int) + (s1 Int) ; from `(Delay in temp)` + (s2 Int) ; from `(Delay temp out)` + ) + :reachable (r1 (= out 10)) + :reachable (r2 (= out (- 10))) + :queries ( (q1 (r1)) (q2 (r2)) ) +) diff --git a/tests/typing/pass/mcil/Monitor.expected b/tests/typing/pass/mcil/Monitor.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/Monitor.mcil b/tests/typing/pass/mcil/Monitor.mcil new file mode 100644 index 000000000..650efe208 --- /dev/null +++ b/tests/typing/pass/mcil/Monitor.mcil @@ -0,0 +1,77 @@ +(set-logic QF_LIA) + +(define-system Historically + :input ((b Bool)) + :output ((hb Bool)) + :init (= hb b) + :trans (= hb' (and b' hb)) +) + +(define-system Before + :input ((b Bool)) + :output ((bb Bool)) + :init (= bb false) + :trans (= bb' b) +) + +(define-system Count + :input ((b Bool)) + :output ((c Int)) + :init (= c (ite b 1 0)) + :trans (= c' (+ c (ite b 0 1))) +) + +(define-system NonDetArbiter + :input ( (r1 Bool) (r2 Bool) ) + :output ( (g1 Bool) (g2 Bool) ) + :local ( (s Bool) ) + :init (and (not g1) (not g2) ) ; nothing is granted initially + :trans (and + (=> (and (not r1') (not r2')) + (and (not g1') (not g2'))) + (=> (and r1' (not r2')) + (and g1' (not g2'))) + (=> (and (not r1') r2') + (and (not g1') g2')) + (=> (and r1' r2') + ; the unconstrained value of `s` is used as non-deterministic choice + (ite s' (and g1' (not g2')) + (and (not g1') g2'))) + ) +) + +(define-system Monitor + :input ((r1 Bool) (r2 Bool)) + :output ((g1 Bool) (g2 Bool)) + :local ((a1 Bool) (a2 Bool) (b Bool) (h1 Bool) (h2 Bool) (bf Bool) (c1 Int)) + :subsys (A (NonDetArbiter r1 r2 g1 g2)) + :subsys (H1 (Historically a1 h1)) + :subsys (H2 (Historically a2 h2)) + :subsys (C (Count g1 c1)) + :subsys (B (Before b bf)) + :inv (and + ; a1 <=> no requests + (= a1 (and (not r1) (not r2))) + ; a2 <=> no grants + (= a2 (and (not g1) (not g2))) + ; b <=> 1 is 4 + (= b (= c1 4)) + ) +) + +(check-system Monitor + :input ((r1 Bool) (r2 Bool)) + :output ((g1 Bool) (g2 Bool)) + :local ((a1 Bool) (a2 Bool) + (b Bool) (h1 Bool) + (h2 Bool) (bf Bool) + (c1 Int)) + ; no concurrent requests + :assumption (A (not (and r1 r2))) + ; neg of: if there have been no requests, there have been no grants + :reachable (P1 (not (=> h1 h2))) + ; neg of: a request is granted at most 4 times + :reachable (P2 (not (=> bf (not g1)))) + :query (Q1 (A P1)) + :query (Q2 (A P2)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/NonDetArbiter.expected b/tests/typing/pass/mcil/NonDetArbiter.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/NonDetArbiter.mcil b/tests/typing/pass/mcil/NonDetArbiter.mcil new file mode 100644 index 000000000..d4acbc3a5 --- /dev/null +++ b/tests/typing/pass/mcil/NonDetArbiter.mcil @@ -0,0 +1,34 @@ +(set-logic QF_UF) + +(define-system NonDetArbiter + :input ( (r1 Bool) (r2 Bool) ) + :output ( (g1 Bool) (g2 Bool) ) + :local ( (s Bool) ) + :init (and (not g1) (not g2) ) ; nothing is granted initially + :trans (and + (=> (and (not r1') (not r2')) + (and (not g1') (not g2'))) + (=> (and r1' (not r2')) + (and g1' (not g2'))) + (=> (and (not r1') r2') + (and (not g1') g2')) + (=> (and r1' r2') + ; the unconstrained value of `s` is used as non-deterministic choice + (ite s' (and g1' (not g2')) + (and (not g1') g2'))) + ) +) + +(check-system NonDetArbiter + :input ( (req1 Bool) (req2 Bool) ) + :output ( (gr1 Bool) (gr2 Bool) ) + :local ( (s Bool) ) + ; There are never concurrent requests + :assumption (a1 (not (and req1 req2))) + ; The same request is never issued twice in a row + :assumption (a2 (and (=> req1 (not req1')) (=> req2 (not req2')))) + ; Neg of: every request is immediately granted + :reachable (r (not (and (=> req1 gr1) (=> req2 gr2)))) + ; check the reachability of r under assumptions a1 and a2 + :query (q (a1 a2 r)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/SmallSystems.expected b/tests/typing/pass/mcil/SmallSystems.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/SmallSystems.mcil b/tests/typing/pass/mcil/SmallSystems.mcil new file mode 100644 index 000000000..fe7648593 --- /dev/null +++ b/tests/typing/pass/mcil/SmallSystems.mcil @@ -0,0 +1,23 @@ +; This file declares several small systems +; This is used to verify that the parser and +; typechecker work as expected but +; no check system commands are issued. + +(set-logic QF_LIA) + +(define-system Delay :input ( (i Int) ) :output ( (o Int) ) + :init (= o 0) + :trans (= o' i) ; the new output is the old input +) + +(define-system Delay :input ( (i Int) ) :output ( (o Int) ) + :init (<= 0 o 10) ; more than one possible initial output + :trans (= o' i) +) + +(define-system StutteringClockedCopy + :input ((clock Bool) (i Int)) + :output ((o Int)) + :init (=> clock (= o i)) ; o is arbitrary when clock is false + :trans (ite clock (= o' i') (= o' o)) ; ite is if-then-else +) diff --git a/tests/typing/pass/mcil/StutteringClockedCopy.expected b/tests/typing/pass/mcil/StutteringClockedCopy.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/StutteringClockedCopy.mcil b/tests/typing/pass/mcil/StutteringClockedCopy.mcil new file mode 100644 index 000000000..f45eb14b1 --- /dev/null +++ b/tests/typing/pass/mcil/StutteringClockedCopy.mcil @@ -0,0 +1,26 @@ +(set-logic QF_LIA) + +; The output of Delay is initially in [0,10] and +; then is the previous input +(define-system Delay + :input ((in Int)) + :output ((out Int)) + :init (<= 0 out 10) ; more than one possible initial output + :trans (= out' in) ; the new output is the old input +) + +; A clocked lossless channel, stuttering when clock is false +(define-system StutteringClockedCopy + :input ((clock Bool) (in Int)) + :output ((out Int)) + :init (=> clock (= out in)) ; out is arbitrary when clock is false + :trans (ite clock (= out' in') (= out' out)) +) + +; check system not part of the slides example +(check-system StutteringClockedCopy + :input ((clock Bool) (in Int)) + :output ((out Int)) + :reachable (r (= clock false)) + :query (query1 (r)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/ThreeBitCounter.expected b/tests/typing/pass/mcil/ThreeBitCounter.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/ThreeBitCounter.mcil b/tests/typing/pass/mcil/ThreeBitCounter.mcil new file mode 100644 index 000000000..34708b018 --- /dev/null +++ b/tests/typing/pass/mcil/ThreeBitCounter.mcil @@ -0,0 +1,46 @@ +(set-logic QF_LIA) + +(declare-const A Int) +(declare-const B Int) +(declare-const C Int) + +(define-system Latch + :input ( (set Bool) (reset_count Bool) ) + :output ( (out Bool)) + :local ( (s Bool) (b Bool) ) + :init (= out b) + :trans (and + (= out' s) + (= s' (or (and set (or (not reset_count) b)) + (and (not set) (not reset_count) out))) + ) +) + +(define-system OneBitCounter :input ( (inc Bool) (start Bool) ) + :output ( (out Bool) (carry Bool) ) + :local ( (set Bool) (reset_count Bool) ) + :subsys (L (Latch set reset_count out)) + :inv (and + (= set (and inc (not reset_count))) + (= reset_count (or carry start)) + (= carry (and inc out)) + ) +) + +(define-system ThreeBitCounter + :input ( (inc Bool) (start Bool) ) + :output ( (out0 Bool) (out1 Bool) (out2 Bool) ) + :local ( (car0 Bool) (car1 Bool) (car2 Bool) ) + :subsys (C1 (OneBitCounter inc start out0 car0)) + :subsys (C2 (OneBitCounter car0 start out1 car1)) + :subsys (C3 (OneBitCounter car1 start out2 car2)) +) + +; check system not part of the slides example +(check-system ThreeBitCounter + :input ((inc Bool) (start Bool)) + :output ((out0 Bool) (out1 Bool) (out2 Bool)) + :local ((car0 Bool) (car1 Bool) (car2 Bool)) + :reachable (r (and true (= out2 true))) + :query (query1 (r)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TimedSwitch1.expected b/tests/typing/pass/mcil/TimedSwitch1.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TimedSwitch1.mcil b/tests/typing/pass/mcil/TimedSwitch1.mcil new file mode 100644 index 000000000..de21d1fda --- /dev/null +++ b/tests/typing/pass/mcil/TimedSwitch1.mcil @@ -0,0 +1,31 @@ +(set-logic ALL) + +(declare-enum-sort LightStatus (on off)) + +(define-system TimedSwitch1 + :input ( (press Bool) ) + :output ( (sig Bool) ) + :local ( (s LightStatus) (n Int) ) + :inv (= sig (= s on)) + :init (and + (= n 0) + (ite press (= s on) (= s off)) + ) + :trans (let + (; transitions + (stay-off (and (= s off) (not press') (= s' off) (= n' n))) + (turn-on (and (= s off) press' (= s' on) (= n' n))) + (stay-on (and (= s on) (not press') (< n 10) (= s' on) (= n' (+ n 1)))) + (turn-off (and (= s on) (or press' (>= n 10)) (= s' off) (= n' 0))) + ) + (or stay-off turn-on turn-off stay-on) + ) +) + +(check-system TimedSwitch1 + :input ( (press Bool) ) + :output ( (sig Bool) ) + :local ( (s LightStatus) (n Int) ) + :reachable (r1 (and press (not sig) (= s off))) + :query (p1 (r1)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TimedSwitch2.expected b/tests/typing/pass/mcil/TimedSwitch2.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TimedSwitch2.mcil b/tests/typing/pass/mcil/TimedSwitch2.mcil new file mode 100644 index 000000000..6d0727879 --- /dev/null +++ b/tests/typing/pass/mcil/TimedSwitch2.mcil @@ -0,0 +1,32 @@ +(set-logic ALL) + +(declare-enum-sort LightStatus (on off)) + +(define-system TimedSwitch2 + :input ( (press Bool) ) + :output ( (sig Bool) ) + :local ( (s LightStatus) (n Int) ) + :inv (= sig (= s on)) + :init (and + (= n 0) + (ite press (= s on) (= s off)) + ) + :trans (and + (=> (and (= s off) (not press')) + (and (= s' off) (= n' n))) ; off --> off + (=> (and (= s off) press') + (and (= s' on) (= n' n))) ; off --> on + (=> (and (= s on) (not press') (< 10 n)) + (and (= s' on) (= n' (+ n 1)))) ; on --> on + (=> (and (= s on) (or press' (>= n 10))) + (and (= s' off) (= n' 0))) ; on --> off + ) +) + +(check-system TimedSwitch2 + :input ( (press Bool) ) + :output ( (sig Bool) ) + :local ( (s LightStatus) (n Int) ) + :reachable (r1 (and press (= n 5))) + :query (p1 (r1)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TimedSwitch3.expected b/tests/typing/pass/mcil/TimedSwitch3.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TimedSwitch3.mcil b/tests/typing/pass/mcil/TimedSwitch3.mcil new file mode 100644 index 000000000..68650f943 --- /dev/null +++ b/tests/typing/pass/mcil/TimedSwitch3.mcil @@ -0,0 +1,33 @@ +(set-logic ALL) + +(declare-enum-sort LightStatus (on off)) + +(define-fun flip ((s LightStatus)) LightStatus + (ite (= s off) on off) +) + +(define-system TimedSwitch3 + :input ( (press Bool) ) + :output ( (sig Bool) ) + :local ( (s LightStatus) (n Int) ) + :inv (= sig (= s on)) + :init (and + (= n 0) + (= s (ite press on off)) + ) + :trans (and + (= s' (ite press' (flip s) + (ite (or (= s off) (>= n 10)) off + on))) + (= n' (ite (or (= s off) (= s' off)) 0 + (+ n 1))) + ) +) + +(check-system TimedSwitch3 + :input ((press Bool)) + :output ((sig Bool)) + :local ((s LightStatus) (n Int)) + :reachable (r1 (and press (not sig) (= s off))) + :query (p1 (r1)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TrafficLight1.expected b/tests/typing/pass/mcil/TrafficLight1.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TrafficLight1.mcil b/tests/typing/pass/mcil/TrafficLight1.mcil new file mode 100644 index 000000000..caaf01c2e --- /dev/null +++ b/tests/typing/pass/mcil/TrafficLight1.mcil @@ -0,0 +1,115 @@ +(set-logic QF_LIA) + +;------------------- +;-- Auxiliary nodes +;------------------- + +(define-system Never + :input ((x Bool)) + :output ((y Bool)) + :init (= y (not x)) + :trans (= y' (and y (not x'))) +) + +; Counts how many consecutive steps X has been true +(define-system Count + :input ((x Bool)) + :output ((o Int)) + :local ((preO Int)) + :init (= preO 0) + :trans (= preO' o) + :inv (= o (ite x (+ preO 1) 0)) +) + +; ---------------------------------------------------------------------- +; -- This is an implementation of a simple traffic light system with one +; -- (bi-directional) car lane and one pedestrian crossing. +; -- +; -- ooo +; -- ------------------==------------------- +; -- == +; -- == +; -- ------------------==------------------- +; -- ooo +; -- +; ---------------------------------------------------------------------- +(define-system TrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + :local ((phase Int) (prePhase Int)) + + :init (= prePhase 0) + :trans (= prePhase' phase) + :inv (and + (= phase (ite button + 1 + (ite (and (> prePhase 0) (< prePhase 10)) + (+ prePhase 1) + 0 + ) + ) + ) + (= green (= phase 0)) + (= yellow (= phase 1)) + (= red (> phase 1)) + (= walk (and (> phase 2) (< phase 10))) + (= dontWalk (not walk)) + ) +) + +(define-system ReqTrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + + :local ((carsAllowed Bool) (buttonNeverPressed Bool) (countRed Int) + (r6 Bool) (r7 Bool) (r8 Bool) (r9 Bool) (r10 Bool) + (r13 Bool) (r15 Bool)) + + :subsys (observed (TrafficLight button red green yellow walk dontWalk)) + + :subsys (neverPressed (Never button buttonNeverPressed)) + :subsys (redLightCount (Count red countRed)) + :inv (= carsAllowed (or green yellow)) + + :init (and (= r6 true) (= r7 true) (= r8 true) (= r9 true) (= r10 true) (= r13 true) (= r15 true)) + :trans (and + (= r6' (not (and red' green))) + (= r7' (=> carsAllowed (not walk'))) + (= r8' (=> walk (not carsAllowed'))) + (= r9' (not (and yellow yellow'))) + (= r10' (=> (and red (not red')) green')) + (= r13' (=> yellow' green)) + (= r15' (=> (and red' (not red)) (and (not walk) (not walk')))) + + ) +) + +(check-system ReqTrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + + :local ((carsAllowed Bool) (buttonNeverPressed Bool) (countRed Int) + (r6 Bool) (r7 Bool) (r8 Bool) (r9 Bool) (r10 Bool) + (r13 Bool) (r15 Bool)) + + :reachable (r1 (not (=> carsAllowed (not walk)))) + :reachable (r2 (not (not (and red green)))) + :reachable (r3 (not (or red green yellow))) + :reachable (r4 (not (=> walk red))) + :reachable (r5 (not (xor walk dontWalk))) + :reachable (r6 (not r6)) + :reachable (r7 (not r7)) + :reachable (r8 (not r8)) + :reachable (r9 (not r9)) + :reachable (r10 (not r10)) + :reachable (r11 (not (=> buttonNeverPressed green))) + :reachable (r12 (not (=> walk red))) + :reachable (r13 (not r13)) + :reachable (r14 (not (<= countRed 9))) + :reachable (r15 (not r15)) + + :queries ( (q1 (r1)) (q2 (r2)) (q3 (r3)) (q4 (r4)) (q5 (r5)) + (q6 (r6)) (q7 (r7)) (q8 (r8)) (q9 (r9)) (q10 (r10)) + (q11 (r11)) (q12 (r12)) (q13 (r13)) (q14 (r14)) (q15 (r15)) + ) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TrafficLight3.expected b/tests/typing/pass/mcil/TrafficLight3.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TrafficLight3.mcil b/tests/typing/pass/mcil/TrafficLight3.mcil new file mode 100644 index 000000000..88e269840 --- /dev/null +++ b/tests/typing/pass/mcil/TrafficLight3.mcil @@ -0,0 +1,115 @@ +(set-logic QF_LIA) + +;------------------- +;-- Auxiliary nodes +;------------------- + +(define-system Never + :input ((x Bool)) + :output ((y Bool)) + :init (= y (not x)) + :trans (= y' (and y (not x'))) +) + +; Counts how many consecutive steps X has been true +(define-system Count + :input ((x Bool)) + :output ((o Int)) + :local ((preO Int)) + :init (= preO 0) + :trans (= preO' o) + :inv (= o (ite x (+ preO 1) 0)) +) + +; ---------------------------------------------------------------------- +; -- This is an implementation of a simple traffic light system with one +; -- (bi-directional) car lane and one pedestrian crossing. +; -- +; -- ooo +; -- ------------------==------------------- +; -- == +; -- == +; -- ------------------==------------------- +; -- ooo +; -- +; ---------------------------------------------------------------------- +(define-system TrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + :local ((phase Int) (prePhase Int)) + + :init (= prePhase 0) + :trans (= prePhase' phase) + :inv (and + (= phase (ite (and button (= prePhase 0)) + 1 + (ite (and (> prePhase 0) (< prePhase 10)) + (+ prePhase 1) + 0 + ) + ) + ) + (= green (= phase 0)) + (= yellow (= phase 1)) + (= red (> phase 1)) + (= walk (and (> phase 2) (< phase 10))) + (= dontWalk (not walk)) + ) +) + +(define-system ReqTrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + + :local ((carsAllowed Bool) (buttonNeverPressed Bool) (countRed Int) + (r6 Bool) (r7 Bool) (r8 Bool) (r9 Bool) (r10 Bool) + (r13 Bool) (r15 Bool)) + + :subsys (observed (TrafficLight button red green yellow walk dontWalk)) + + :subsys (neverPressed (Never button buttonNeverPressed)) + :subsys (redLightCount (Count red countRed)) + :inv (= carsAllowed (or green yellow)) + + :init (and (= r6 true) (= r7 true) (= r8 true) (= r9 true) (= r10 true) (= r13 true) (= r15 true)) + :trans (and + (= r6' (not (and red' green))) + (= r7' (=> carsAllowed (not walk'))) + (= r8' (=> walk (not carsAllowed'))) + (= r9' (not (and yellow yellow'))) + (= r10' (=> (and red (not red')) green')) + (= r13' (=> yellow' green)) + (= r15' (=> (and red' (not red)) (and (not walk) (not walk')))) + + ) +) + +(check-system ReqTrafficLight + :input ((button Bool)) + :output ((red Bool) (green Bool) (yellow Bool) (walk Bool) (dontWalk Bool)) + + :local ((carsAllowed Bool) (buttonNeverPressed Bool) (countRed Int) + (r6 Bool) (r7 Bool) (r8 Bool) (r9 Bool) (r10 Bool) + (r13 Bool) (r15 Bool)) + + :reachable (r1 (not (=> carsAllowed (not walk)))) + :reachable (r2 (not (not (and red green)))) + :reachable (r3 (not (or red green yellow))) + :reachable (r4 (not (=> walk red))) + :reachable (r5 (not (xor walk dontWalk))) + :reachable (r6 (not r6)) + :reachable (r7 (not r7)) + :reachable (r8 (not r8)) + :reachable (r9 (not r9)) + :reachable (r10 (not r10)) + :reachable (r11 (not (=> buttonNeverPressed green))) + :reachable (r12 (not (=> walk red))) + :reachable (r13 (not r13)) + :reachable (r14 (not (<= countRed 9))) + :reachable (r15 (not r15)) + + :queries ( (q1 (r1)) (q2 (r2)) (q3 (r3)) (q4 (r4)) (q5 (r5)) + (q6 (r6)) (q7 (r7)) (q8 (r8)) (q9 (r9)) (q10 (r10)) + (q11 (r11)) (q12 (r12)) (q13 (r13)) (q14 (r14)) (q15 (r15)) + ) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/TrafficLightEnum.expected b/tests/typing/pass/mcil/TrafficLightEnum.expected new file mode 100644 index 000000000..e69de29bb diff --git a/tests/typing/pass/mcil/TrafficLightEnum.mcil b/tests/typing/pass/mcil/TrafficLightEnum.mcil new file mode 100644 index 000000000..4558ba763 --- /dev/null +++ b/tests/typing/pass/mcil/TrafficLightEnum.mcil @@ -0,0 +1,51 @@ +(set-logic ALL) + +(declare-enum-sort LightStatus (red green yellow)) +(declare-enum-sort WalkStatus (yesWalk noWalk)) + +(define-system CountToTen + :input ((switch Bool)) + :output ((count Int)) + :local ((counting Bool) (precount Int)) + :init (and (= precount 0) (not counting)) + :inv (= count (ite counting (+ precount 1) 0)) + :trans (and + (= counting' (ite (and switch (= precount 0)) true (and counting (< count 10)))) + (= precount' count) + ) +) + +(define-system TrafficLight + :input ((button Bool)) + :output ((light LightStatus) (walk WalkStatus)) + :local ((phase Int)) + :subsys (timer (CountToTen button phase)) + + :inv (and + (= light (ite (= phase 0) + green + (ite (= phase 1) + yellow + red + ) + ) + ) + + (= walk (ite (and (> phase 2) (< phase 10)) + yesWalk + noWalk + ) + ) + ) +) + +(check-system TrafficLight + :input ((button Bool)) + :output ((light LightStatus) (walk WalkStatus)) + :local ((phase Int)) + + :reachable (r1 (and (= walk noWalk) (> phase 2))) + :reachable (r2 (and (= walk yesWalk) (= light green))) + :query (query1 (r1)) + :query (query2 (r2)) +) \ No newline at end of file diff --git a/tests/typing/pass/mcil/dune b/tests/typing/pass/mcil/dune new file mode 100644 index 000000000..2f349d03d --- /dev/null +++ b/tests/typing/pass/mcil/dune @@ -0,0 +1,452 @@ +; File auto-generated by gentests.ml + +; Auto-generated part begin +; Test for DelayedArbiter.mcil +; Incremental test + +(rule + (target DelayedArbiter.incremental) + (deps (:input DelayedArbiter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DelayedArbiter.expected DelayedArbiter.incremental))) + +; Full mode test + +(rule + (target DelayedArbiter.full) + (deps (:input DelayedArbiter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DelayedArbiter.expected DelayedArbiter.full))) + + +; Test for DoubleDelay1.mcil +; Incremental test + +(rule + (target DoubleDelay1.incremental) + (deps (:input DoubleDelay1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DoubleDelay1.expected DoubleDelay1.incremental))) + +; Full mode test + +(rule + (target DoubleDelay1.full) + (deps (:input DoubleDelay1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DoubleDelay1.expected DoubleDelay1.full))) + + +; Test for DoubleDelay2.mcil +; Incremental test + +(rule + (target DoubleDelay2.incremental) + (deps (:input DoubleDelay2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DoubleDelay2.expected DoubleDelay2.incremental))) + +; Full mode test + +(rule + (target DoubleDelay2.full) + (deps (:input DoubleDelay2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff DoubleDelay2.expected DoubleDelay2.full))) + + +; Test for Monitor.mcil +; Incremental test + +(rule + (target Monitor.incremental) + (deps (:input Monitor.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff Monitor.expected Monitor.incremental))) + +; Full mode test + +(rule + (target Monitor.full) + (deps (:input Monitor.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff Monitor.expected Monitor.full))) + + +; Test for NonDetArbiter.mcil +; Incremental test + +(rule + (target NonDetArbiter.incremental) + (deps (:input NonDetArbiter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff NonDetArbiter.expected NonDetArbiter.incremental))) + +; Full mode test + +(rule + (target NonDetArbiter.full) + (deps (:input NonDetArbiter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff NonDetArbiter.expected NonDetArbiter.full))) + + +; Test for SmallSystems.mcil +; Incremental test + +(rule + (target SmallSystems.incremental) + (deps (:input SmallSystems.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff SmallSystems.expected SmallSystems.incremental))) + +; Full mode test + +(rule + (target SmallSystems.full) + (deps (:input SmallSystems.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff SmallSystems.expected SmallSystems.full))) + + +; Test for StutteringClockedCopy.mcil +; Incremental test + +(rule + (target StutteringClockedCopy.incremental) + (deps (:input StutteringClockedCopy.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff StutteringClockedCopy.expected StutteringClockedCopy.incremental))) + +; Full mode test + +(rule + (target StutteringClockedCopy.full) + (deps (:input StutteringClockedCopy.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff StutteringClockedCopy.expected StutteringClockedCopy.full))) + + +; Test for ThreeBitCounter.mcil +; Incremental test + +(rule + (target ThreeBitCounter.incremental) + (deps (:input ThreeBitCounter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff ThreeBitCounter.expected ThreeBitCounter.incremental))) + +; Full mode test + +(rule + (target ThreeBitCounter.full) + (deps (:input ThreeBitCounter.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff ThreeBitCounter.expected ThreeBitCounter.full))) + + +; Test for TimedSwitch1.mcil +; Incremental test + +(rule + (target TimedSwitch1.incremental) + (deps (:input TimedSwitch1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch1.expected TimedSwitch1.incremental))) + +; Full mode test + +(rule + (target TimedSwitch1.full) + (deps (:input TimedSwitch1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch1.expected TimedSwitch1.full))) + + +; Test for TimedSwitch2.mcil +; Incremental test + +(rule + (target TimedSwitch2.incremental) + (deps (:input TimedSwitch2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch2.expected TimedSwitch2.incremental))) + +; Full mode test + +(rule + (target TimedSwitch2.full) + (deps (:input TimedSwitch2.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch2.expected TimedSwitch2.full))) + + +; Test for TimedSwitch3.mcil +; Incremental test + +(rule + (target TimedSwitch3.incremental) + (deps (:input TimedSwitch3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch3.expected TimedSwitch3.incremental))) + +; Full mode test + +(rule + (target TimedSwitch3.full) + (deps (:input TimedSwitch3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TimedSwitch3.expected TimedSwitch3.full))) + + +; Test for TrafficLight1.mcil +; Incremental test + +(rule + (target TrafficLight1.incremental) + (deps (:input TrafficLight1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLight1.expected TrafficLight1.incremental))) + +; Full mode test + +(rule + (target TrafficLight1.full) + (deps (:input TrafficLight1.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLight1.expected TrafficLight1.full))) + + +; Test for TrafficLight3.mcil +; Incremental test + +(rule + (target TrafficLight3.incremental) + (deps (:input TrafficLight3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLight3.expected TrafficLight3.incremental))) + +; Full mode test + +(rule + (target TrafficLight3.full) + (deps (:input TrafficLight3.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLight3.expected TrafficLight3.full))) + + +; Test for TrafficLightEnum.mcil +; Incremental test + +(rule + (target TrafficLightEnum.incremental) + (deps (:input TrafficLightEnum.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=incremental --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLightEnum.expected TrafficLightEnum.incremental))) + +; Full mode test + +(rule + (target TrafficLightEnum.full) + (deps (:input TrafficLightEnum.mcil)) + (package dolmen_bin) + (action (chdir %{workspace_root} + (with-outputs-to %{target} + (with-accepted-exit-codes (or 0 (not 0)) + (run dolmen --mode=full --color=never %{input} %{read-lines:flags.dune})))))) +(rule + (alias runtest) + (package dolmen_bin) + (action (diff TrafficLightEnum.expected TrafficLightEnum.full))) + + +; Auto-generated part end diff --git a/tests/typing/pass/mcil/flags.dune b/tests/typing/pass/mcil/flags.dune new file mode 100644 index 000000000..e69de29bb diff --git a/tools/gentests.ml b/tools/gentests.ml index 688d75aff..a5124091f 100644 --- a/tools/gentests.ml +++ b/tools/gentests.ml @@ -29,6 +29,7 @@ let is_a_pb file = | ".ae" | ".cnf" | ".icnf" + | ".mcil" | ".smt2" | ".psmt2" | ".p"