diff --git a/data/CHANGES b/data/CHANGES --- a/data/CHANGES +++ b/data/CHANGES @@ -1,3 +1,61 @@ +* 0.8.0.0 + - new homepage: http://www.infsec.ethz.ch/research/software/tamarin + - mailing list: https://groups.google.com/group/tamarin-prover + - issue tracker: https://github.com/tamarin-prover/tamarin-prover/issues + + - GUI: + - new: added shortcuts for bounded autoprover and searching for all + solutions, which can be used to characterize the set of solutions of + a constraint system. + + - improved: pretty-printing of formulas and constraint systems using + Unicode characters. + + - .spthy files: + - new: support for restricting the set of considered traces using + axioms. This allows for example to conveniently model equality + checks using actions and a corresponding axiom. See the 'Tutorial' + for more information. + + - new: proof checking support. This allows you to save interactive + proofs from the GUI for later verification. Just copy the proof or a + prefix of the proof into your input file. 'sorry' steps are + then automatically expanded when using 'tamarin-prover --prove'. + + - new: formulas can now use mathematical symbols represented using + their Unicode characters. + + - removed: support for (* ... *) style comments. + + - prover: + - We now use the following additional normal form condition. + + > There is no edge (i,1)>->(j,1) between two exponentiation rules + > i and j. + + This removes the need for exponentiation tags and thereby simplifies + the constraint-reduction rules, both in theory and in code. Note + that the arity of the 'KU' fact changed from arity two to arity one. + Theories using typing invariants must thus be adapted, which is the + reason for the minor version bump. + + - improved: error messages of wellformedness checks + - reduced: memory usage of the autoprover by a factor 2 to 10. + - improved parallelization: 10% speed increase on an i7 Quad-Core + + - editor support: Tomas Zgraggen contributed a syntax highligthing file + for .spthy files for Notepad++ (http://notepad-plus-plus.org/). This is + great text editor for Windows. The syntax-highlighting file is installed + in the same directory as the 'examples' directory under + 'etc/notepad_plus_plus_stphy.xml'. + + - fixed: bug in unique facts computation and application. + - fixed: induction now generates cases for the empty and the non-empty trace + - fixed: We no longer use local 'tamarin-prover-img' directories to cache + rendered constraint systems. All images are now cached in + a 'tamarin-prover-cache/img' subdirectory of the OS specific + temporary directory. + * 0.6.1.0 - fixed: parallel exploration of proof tree was using too much memory - fixed: reference to Tutorial.spthy broken in help message diff --git a/data/css/tamarin-prover-ui.css b/data/css/tamarin-prover-ui.css --- a/data/css/tamarin-prover-ui.css +++ b/data/css/tamarin-prover-ui.css @@ -2,7 +2,7 @@ **************/ html, body { - font-family: + font-family: 'DejaVu Sans', /* Linux */ 'Liberation Sans', /* Linux/RedHat */ 'Geneva', /* Mac OS X */ @@ -59,7 +59,7 @@ background-image: url(/static/img/ajax-loader.gif); background-repeat: no-repeat; background-position: 0.4em; - background-size: 1.2em; + background-size: 1.2em; } div.content { @@ -117,8 +117,7 @@ } .hl_superfluous { - color: #ff0000; - text-decoration: line-through; + color: #907070; } .keys { @@ -170,8 +169,9 @@ div#help { border: solid 1px #000000; background: #dfeff1; - padding: 1em; - margin: 2em; + padding: 0.5em; + margin: 0px; + margin-bottom: 0.5em; } /* Forms diff --git a/data/doc/MANUAL b/data/doc/MANUAL --- a/data/doc/MANUAL +++ b/data/doc/MANUAL @@ -9,10 +9,11 @@ Installation ============ -See http://www.infsec.ethz.ch/research/software#TAMARIN for detailed +See http://www.infsec.ethz.ch/research/software/tamarin for detailed installation instructions for Linux and Mac. The Tamarin prover also runs on Windows. Drop us a mail, if you would like access to a precompiled binary. - +Subscribe to https://groups.google.com/group/tamarin-prover for receiving news +on updates and new releases of the Tamarin prover. Syntax highlighting ------------------- @@ -28,7 +29,14 @@ and copy 'DATA_PATH/etc/spthy.vim' to the '~/.vim/syntax directory'. If one of these directories does not exist, then just create it. +We also provide a syntax highlighting file for Notepad++ +(http://notepad-plus-plus.org/). This is a great text editor for Windows. See + DATA_PATH/notepad_plus_plus_stphy.xml + +for the syntax highlighting file. + + Usage ===== @@ -69,19 +77,73 @@ Note that you can also use the GUI to sanity check your model. Just go through the message theory and check that it really models what you intent to model. Moreover, the precomputed case distinctions, described - below, give a good overview about the behaviour/specification of your + below, give a good overview about the behavior/specification of your protocol. If something is wrong with your model, then it is likely that you can see it already from the precomputed case distinctions. + 5. If you have constructed a proof by hand and want to store it for later + usage, then you can just copy it from the GUI to your input file. The + Tamarin prover will parse and re-check this proof when loading this + security protocol theory. +Heuristics and Non-Termination +------------------------------ + +The problems tackled by the Tamarin prover are undecidable in general. Thus +there will always be protocols satisfying properties that cannot be proven +using the constraint-reduction rules implemented in the Tamarin prover. +However, sometimes there would exist a proof, but the heuristic employed by +the Tamarin prover does not select the right goals to solve. In this case you +have two options: (1) construct your proof interactively in the GUI or (2) try +to twiddle with the '--heuristic' flag. + +Option (1) has already been described above. Option (2) is currently +experimental. The argument of the '--heuristic' flag is a word built from the +alphabet '{s,S,c,C}'. Each of these letters describes a different way to rank +the open goals of a constraint system. + + s: the 'smart' ranking is the ranking described in the extended version of + our CSF'12 paper. It is the default ranking and works very well in a wide + range of situations. + + S: is like the 'smart' ranking, but does not delay the solving of premises + marked as loop-breakers. What premises are loop breakers is determined + from the protocol using a simple under-approximation to the vertex + feedback set of the conclusion-may-unify-to-premise graph. We require + these loop-breakers for example to guarantee the termination of the case + distinction precomputation. You can inspect which premises are marked as + loop breakers in the 'Multiset rewriting rules' page in the GUI. + + c: is the 'consecutive' or 'conservative' ranking. It solves goals in the + order they occur in the constraint system. This guarantees that no goal + is delayed indefinitely, but often leads to large proofs because some + of the early goals are not worth solving. + + C: is like 'c' but without delaying loop breakers. + +If several rankings are given for the heuristic flag, then they are employed +in a round-robin fashion depending on the proof-depth. For example, a flag +'--heuristic=ssC' always uses two times the smart ranking and then once the +'Consecutive' goal ranking. The idea is that you can mix goal rankings easily +in this way. + +Note that it might be the case that your case studies require a different goal +ranking that the ones give above. If you have concrete suggestions on +how to compute your required ranking from a constraint system, then we would +love to hear about it: https://github.com/tamarin-prover/tamarin-prover/issues. +Note that your ranking may depend on *all* the information present in a +constraint system. Scroll down in the constraint system visualization page in +the GUI to see what information that is. + + Additional Theory ================= Most of the theory behind the Tamarin prover is described in our CSF 2012 paper, whose extended version is available from - http://www.infsec.ethz.ch/research/software#TAMARIN + http://www.infsec.ethz.ch/research/software/tamarin The implementation exploits a slightly more restricted definition of normal dependency graphs and adapted versions of the constraint solving rules that @@ -192,27 +254,63 @@ precomputed case distinctions are marked with "all chains solved". -Reasoning about Exclusivity ---------------------------- +Reasoning about Exclusivity: Facts Symbols with Injective Instances +----------------------------------------------------------- -We say that a fact symbol 'f' has `unique instances with respect to a security -protocol 'P', if all instances of 'f' occur with cardinality <= 1 in all -reachable states of 'P'. As computing the set of fact symbols with unique -instances with respect to a security protocol 'P' is undecidable, we use a -simple under-approximation to this set. We gather all linear fact symbols that -occur in all conclusions either as a copy of themselves or a copy of the term -of a Fr-fact. +We say that a fact symbol 'f' has *injective instances* with respect to a +multiset rewriting system 'R', if there is no reachable state of +the multiset rewriting system 'R' with more than one instance of an f-fact +with the same term as a first argument. Injective facts typically arise from +modeling databases using linear facts. An example of an fact with injective +instances, is the 'Store'-fact in the following multiset rewriting system. -For facts with unique instances, we can use a further constraint reduction -rule. This rule states that it is impossible that there is a node 'i' with a -premise with a unique fact instance and an edge with the same fact instance -from a node 'j' to a node 'k' such that 'j' < 'i' < 'k'. + rule CreateKey: [ Fr(handle), Fr(key) ] --> [ Store(handle, key) ] -Together with inductive strengthening, this simple construction suffices for -many protocols to reason about their exclusive use of a linear fact symbol to -model locked access to a resource. + rule NextKey: [ Store(handle, key) ] --> [ Store(handle, h(key)) ] + rule DelKey: [ Store(handle,key) ] --> [] +When reasoning about the above multiset rewriting system, we exploit that +'Store' has injective instances to prove that after the 'DelKey' rule no other +rule using the same handle can be applied. This proof uses trace induction and +the following constraint-reduction rule that exploits facts with unique +instances. + +Let 'f' be a fact symbol with injective instances. Let i, j, and k be temporal +variables ordered according to + + i < j < k + +and let there be an edge from (i,u) to (k,w) for some indices u and v. +Then, we have a contradiction, if the premise (k,w) requires a fact 'f(t,...)' +and there is a premise (j,v) requiring a fact 'f(t,...)'. These two premises +must be merged because the edge (i,u) >-> (k,w) crosses 'j' and the state at +'j' therefore contains 'f(t,...)'. This merging is not possible due to the +ordering constraints 'i < j < k'. + +Note that computing the set of fact symbols with injective instances is +undecidable in general. We therefore compute an under-approximation to this +set using the following simple heuristic. A fact tag is guaranteed to have +injective instance, if + + 1. the fact-symbol is linear, + 2. every introduction of such a fact is protected by a Fr-fact of the + first term, and + 3. every rule has at most one copy of this fact-tag in the conclusion and + the first term arguments agree. + +We exclude facts that are not copied in a rule, as they are already handled +properly by the naive backwards reasoning. + +Note that this support for reasoning about exclusivity was sufficient for our +case studies, but it is likely that more complicated case studies require +additional support. For example, that fact symbols with injective instances +can be specified by the user and the soundness proof that these symbols have +injective instances is constructed explicitly using the Tamarin prover. +Please tell us, if you encounter limitations in your case studies: +https://github.com/tamarin-prover/tamarin-prover/issues. + + Equation Store -------------- @@ -259,7 +357,7 @@ The paper explaining the theory behind Tamarin has been published at CSF 2012 and its extended version is available from - http://www.infsec.ethz.ch/research/software#TAMARIN + http://www.infsec.ethz.ch/research/software/tamarin Here, we explain the formal syntax of the security protocol theory format that is processed by Tamarin. We recommend first reading the 'Tutorial.spthy' @@ -274,7 +372,7 @@ We explain the non-terminals of the body in the following paragraphs. security_protocol_theory := 'theory' ident 'begin' body 'end' - body := (signature_spec | rule | lemma | formal_comment)+ + body := (signature_spec | rule | axiom | lemma | formal_comment)+ Here, we use the term signature more liberally to denote both the defined function symbols and the equalities describing their interaction. Note that @@ -318,6 +416,13 @@ This becomes a lot less confusing if you keep the set of variables on the left-hand side separate from the free variables on the right-hand side ;-) +Axioms specify restrictions on the set of traces considered, i.e., they filter +the set of traces of a protocol. The formula of an axiom is available as an +assumption in the proofs of *all* security properties specified in this +security protocol theory. + + axiom := 'axiom' ident ':' '"' formula '"' + Lemmas specify security properties. By default, the given formula is interpreted as a property that must hold for all traces of the protocol of the security protocol theory. You can change this using the 'exists-trace' trace @@ -326,8 +431,10 @@ lemma := 'lemma' ident [lemma_attrs] ':' [trace_quantifier] '"' formula '"' - lemma_attrs := '[' ('typing' | 'reuse' | 'use_induction') ']' + proof + lemma_attrs := '[' ('typing' | 'reuse' | 'use_induction') ']' trace_quantifier := 'all-traces' | 'exists-trace' + proof := ... a proof as output by the Tamarin prover .. Formal comments are used to make the input more readable. In contrast @@ -387,12 +494,12 @@ more liberal with respect to guardedness. We accept a conjunction of atoms as guards. - formula := atom | '(' iff ')' | ( 'All' | 'Ex' ) ident+ '.' iff - iff := imp '<=>' imp - imp := disjuncts '==>' disjuncts - disjuctions := conjuncts ('|' disjuncts)+ // left-associative - conjuncts := negation ('|' disjuncts)+ // left-associative - negation := 'not' formula + formula := atom | '(' iff ')' | ( 'All' | 'Ex' ) ident+ '.' iff + iff := imp '<=>' imp + imp := disjuncts '==>' disjuncts + disjuncts := conjuncts ('|' disjuncts)+ // left-associative + conjuncts := negation ('|' conjuncts)+ // left-associative + negation := 'not' formula atom := tvar '<' tvar // ordering of temporal variables | '#' ident '=' '#' ident // equality between temporal variables diff --git a/data/etc/spthy.vim b/data/etc/spthy.vim --- a/data/etc/spthy.vim +++ b/data/etc/spthy.vim @@ -1,6 +1,6 @@ " Vim syntax file " Language: DH-proto-proof Security Protocol Theory Files -" Maintainer: +" Maintainer: " Last Change: 2010 12 17 " based on Claudio Fleiner's spthy syntax highlighting " file. @@ -51,7 +51,7 @@ syn match spthyConstr "\" " syn match spthyNumber "\<\d\+\([eE][-+]\=\d\+\)\=[fFdD]\>" -" +" " " unicode characters " syn match spthySpecial "\\u\+\d\{4\}" -" +" " syn cluster spthyTop add=spthyString,spthyCharacter,spthyNumber,spthySpecial,spthyStringError " catch errors caused by wrong parenthesis @@ -122,7 +122,7 @@ " syn region spthyParenT1 transparent matchgroup=spthyParen1 start="\[" end="\]" contains=@spthyTop,spthyParenT2 contained " syn region spthyParenT2 transparent matchgroup=spthyParen2 start="\[" end="\]" contains=@spthyTop,spthyParenT contained " syn match spthyParenError "\]" -" +" " SpthyHiLink spthyParenError spthyError if !exists("spthy_minlines") diff --git a/data/examples/Tutorial.spthy b/data/examples/Tutorial.spthy --- a/data/examples/Tutorial.spthy +++ b/data/examples/Tutorial.spthy @@ -12,7 +12,7 @@ This user guide assumes that you have a copy of our CSF'12 paper on "Automated Analysis of Diffie-Hellman Protocols and Advanced Security Properties", whose extended version is available from -http://www.infsec.ethz.ch/research/software#TAMARIN. +http://www.infsec.ethz.ch/research/software/tamarin. The input files for the Tamarin prover have the extension .spthy, which is short for 'security protocol theory'. A security protocol theory specifies @@ -289,16 +289,23 @@ operator inside the quantifier is a conjunction. Note also that currently the precedence of the logical connectives is not specified. We therefore recommend to use parentheses, when in doubt. +*/ +/* +Note that you can specify additional axioms that restrict the set of +considered traces. In this example, we restrict our attention to traces where +all equality checks succeed. */ +axiom Equality_Checks_Succeed: "All x y #i. Eq(x,y) @ i ==> x = y" + +/* The following two properties should be self-explanatory. +Note that the order between axioms and lemmas does not matter. All axioms are +always available/assumed in the proofs of all security properties. */ lemma Client_session_key_secrecy: - " /* For all traces, where all equality checks succeed, */ - (All x y #i. Eq(x,y) @ i ==> x = y) - ==> - /* it cannot be that a */ + " /* It cannot be that a */ not( Ex S k #i #j. /* client setup a session key 'k' with a server'S' */ @@ -311,12 +318,8 @@ " -/* FIXME: Uncomment lemma Client_auth: - " /* For all traces, where all equality checks succeed, */ - (All x y #i. Eq(x,y) @ i ==> x = y) - ==> - /* for all session keys 'k' setup by clients with a server 'S' */ + " /* For all session keys 'k' setup by clients with a server 'S' */ ( All S k #i. SessKeyC(S, k) @ #i ==> /* there is a server that answered the request */ @@ -327,7 +330,6 @@ ) ) " -*/ /* You can verify them by calling @@ -338,26 +340,20 @@ Tutorial security protocol theory with the lemmas and their attached (dis)proofs. - Finding attacks is very useful, to check that a security property is not - trivial due to too strong preconditions. The following property must not be - provable, as otherwise there would be no possibility to setup a session key - with a honest sever. + Note that when adding inconsistent axioms, you can prove any property. To + check that there still exist traces, you can state an 'exists-trace' lemma. + When modeling protocols such existence proofs are very useful sanity checks. - We can check for the existence of a trace using the 'exists-trace' - quantifier in front of the trace formula. When modeling protocols such - existence proof are very useful sanity checks. + The following property must be provable, as otherwise there would be no + possibility to setup a session key with a honest sever. */ -/* FIXME: Uncomment + lemma Client_session_key_honest_setup: exists-trace - " (All x y #i. Eq(x,y) @ i ==> x = y) - & ( - Ex S k #i. + " Ex S k #i. SessKeyC(S, k) @ #i & not(Ex #r. LtkReveal(S) @ r) - ) " -*/ /* diff --git a/data/examples/classic/NSLPK3.spthy b/data/examples/classic/NSLPK3.spthy --- a/data/examples/classic/NSLPK3.spthy +++ b/data/examples/classic/NSLPK3.spthy @@ -114,14 +114,14 @@ " (All ni m1 #i. IN_R_1_ni( ni, m1) @ i ==> - ( (Ex f #j. KU(f, ni) @ j & j < i) + ( (Ex #j. KU(ni) @ j & j < i) | (Ex #j. OUT_I_1( m1 ) @ j) ) ) & (All nr m2 #i. IN_I_2_nr( nr, m2) @ i ==> - ( (Ex f #j. KU(f, nr) @ j & j < i) + ( (Ex #j. KU(nr) @ j & j < i) | (Ex #j. OUT_R_1( m2 ) @ j) ) ) diff --git a/data/examples/csf12/JKL_TS2_2004_KI_wPFS.spthy b/data/examples/csf12/JKL_TS2_2004_KI_wPFS.spthy --- a/data/examples/csf12/JKL_TS2_2004_KI_wPFS.spthy +++ b/data/examples/csf12/JKL_TS2_2004_KI_wPFS.spthy @@ -90,11 +90,11 @@ (We model wpfs, for pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) )" @@ -124,11 +124,11 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) )" diff --git a/data/examples/csf12/JKL_TS2_2008_KI_wPFS.spthy b/data/examples/csf12/JKL_TS2_2008_KI_wPFS.spthy --- a/data/examples/csf12/JKL_TS2_2008_KI_wPFS.spthy +++ b/data/examples/csf12/JKL_TS2_2008_KI_wPFS.spthy @@ -34,7 +34,7 @@ [ Init_1( ~ekI, $I, $R, ~lkI , hkI), In( Y ), !Pk( $R,'g'^~lkR ) ] --[SidI_2( ~ekI, $I, $R, hkI, Y, h( < $I, $R, hkI, Y, Y^~ekI, ('g'^~lkR)^~lkI > ) ) ]-> - [ !Sessk( ~ekI, + [ !Sessk( ~ekI, h( < $I, $R, hkI, Y, Y^~ekI, ('g'^~lkR)^~lkI > ) ) ] rule Resp_1: @@ -43,10 +43,10 @@ h( < $I, $R, X, 'g'^~ekR, X^~ekR, ('g'^~lkI)^~lkR > ) ) ]-> [ Out( 'g'^~ekR ), !Ephk(~ekR), - !Sessk( ~ekR, + !Sessk( ~ekR, h( < $I, $R, X, 'g'^~ekR, X^~ekR, ('g'^~lkI)^~lkR > ) ) ] -rule Sessk_reveal: +rule Sessk_reveal: [ !Sessk(~tid, k) ] --[ SesskRev(~tid) ]-> [ Out(k) ] @@ -94,11 +94,11 @@ (We model wpfs, for pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) )" @@ -128,11 +128,11 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) )" diff --git a/data/examples/csf12/JKL_TS3_2004_KI_wPFS.spthy_nonterm b/data/examples/csf12/JKL_TS3_2004_KI_wPFS.spthy_nonterm --- a/data/examples/csf12/JKL_TS3_2004_KI_wPFS.spthy_nonterm +++ b/data/examples/csf12/JKL_TS3_2004_KI_wPFS.spthy_nonterm @@ -151,11 +151,11 @@ (We model wpfs, for pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) )" @@ -188,11 +188,11 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) )" */ diff --git a/data/examples/csf12/JKL_TS3_2008_KI_wPFS.spthy_nonterm b/data/examples/csf12/JKL_TS3_2008_KI_wPFS.spthy_nonterm --- a/data/examples/csf12/JKL_TS3_2008_KI_wPFS.spthy_nonterm +++ b/data/examples/csf12/JKL_TS3_2008_KI_wPFS.spthy_nonterm @@ -142,11 +142,11 @@ (We model wpfs, for pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)) )" @@ -176,11 +176,11 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)) )" */ diff --git a/data/examples/csf12/KEA_plus_eCK.spthy b/data/examples/csf12/KEA_plus_eCK.spthy --- a/data/examples/csf12/KEA_plus_eCK.spthy +++ b/data/examples/csf12/KEA_plus_eCK.spthy @@ -105,7 +105,7 @@ * matching session. */ /* (We model eCK-wpfs, for eCK-pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( R ) @ i3 ==> - (* (i1 < i3) | *) + /* (i1 < i3) | */ (Ex #i4 ekR kpartner. SidR_1( ekR,I,R,hkI,hkR,kpartner ) @i4)) @@ -147,7 +147,7 @@ (We model eCK-wpfs, for eCK-pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( I ) @ i3 ==> - (* (i1 < i3) | *) + /* (i1 < i3) | */ (Ex #i4 ekI. SidI_1( ekI,I,R,hkI ) @i4) ) ) )" diff --git a/data/examples/csf12/SignedDH_eCK.spthy b/data/examples/csf12/SignedDH_eCK.spthy --- a/data/examples/csf12/SignedDH_eCK.spthy +++ b/data/examples/csf12/SignedDH_eCK.spthy @@ -99,7 +99,7 @@ /* (We model eCK-wpfs, for eCK-pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)))" /* An attack is valid in eCK if the session key of the test session is deduced and @@ -134,7 +134,7 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)))" end diff --git a/data/examples/csf12/UM_eCK.spthy b/data/examples/csf12/UM_eCK.spthy --- a/data/examples/csf12/UM_eCK.spthy +++ b/data/examples/csf12/UM_eCK.spthy @@ -99,7 +99,7 @@ (We model eCK-wpfs, for eCK-pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)))" /* An attack is valid in eCK if the session key of the test session is deduced and @@ -134,7 +134,7 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)))" end diff --git a/data/examples/csf12/UM_eCK_noKCI.spthy b/data/examples/csf12/UM_eCK_noKCI.spthy --- a/data/examples/csf12/UM_eCK_noKCI.spthy +++ b/data/examples/csf12/UM_eCK_noKCI.spthy @@ -99,7 +99,7 @@ (We model eCK-wpfs, for eCK-pfs, add i1 < i3 to conclusion) */ & (All #i3. LtkRev( R ) @ i3 ==> (Ex #i4 tpartner kpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidR_1( tpartner,I,R,hkI,hkR,kpartner ) @i4)))" /* An attack is valid in eCK if the session key of the test session is deduced and @@ -134,7 +134,7 @@ */ & (All #i3. LtkRev( I ) @ i3 ==> (Ex #i4 tpartner. - (* (i1 < i3) | *) + /* (i1 < i3) | */ SidI_1( tpartner,I,R,hkI ) @i4)))" end diff --git a/data/examples/loops/JCS12_Typing_Example.spthy b/data/examples/loops/JCS12_Typing_Example.spthy new file mode 100644 --- /dev/null +++ b/data/examples/loops/JCS12_Typing_Example.spthy @@ -0,0 +1,149 @@ +theory JCS12_Typing_Example +begin + +/* + Protocol: Typing Assertion Example from our JCS'12 paper [1] + Modeler: Simon Meier + Date: July 2012 + + Status: working + + Notable differences: We do not require a fixed type system. Instead we + introduce actions marking sent cryptographic components and actions marking + that a participant instantiated a variable, which it received as part of a + cryptographic component. The typing assertion is then the trace formula + stating that this variable was either known to the adversary before it was + instantiated or the cryptographic component stems from the expected origin. + + [1] Efficient Construction of Machine-Checked Symbolic Protocol Security + Proofs. S. Meier, C. Cremers, D. Basin. Journal of Computer Security. To + appear. +*/ + + +builtins: asymmetric-encryption, hashing + +// Public-Key Infrastructure +rule Register_pk: + [ Fr(~ltk) ] + --> + [ !Ltk($A, ~ltk), !Pk($A, pk(~ltk)) ] + +rule Get_pk: + [ !Pk(A, pk) ] + --> + [ Out(pk) ] + +rule Reveal_ltk: + [ !Ltk(A, ltk) ] + --[ LtkReveal(A) ]-> + [ Out(ltk) ] + + +// Protocol +rule Client_1: + let request = aenc{'1', <$C, ~k>}pkS + in + [ Fr(~k), !Pk($S, pkS) + ] + --[ Out_Client_1(request) + ]-> + [ Client_1( $C, $S, ~k ), Out( request ) ] + +rule Client_2: + [ Client_1(C, S, k), In( aenc{'2',k}pk(ltkC) ), !Ltk(C, ltkC) ] + --[ SessKeyC( C, S, k ) ]-> + [] + +// A server thread answering in one-step to a session-key setup request from +// some client. +rule Serv_1: + let msg = adec(request, ~ltkS) + tag = fst(msg) + C = fst(snd(msg)) + k = snd(snd(msg)) + in + [ !Ltk($S, ~ltkS) + , In( request ) + , !Pk(C, pkC) + ] + --[ Eq(tag, '1') // This check is crucial to avoid receiving the + // message output in this step as a client + // message. Try proving the Client_auth lemma + // without it to see the problem. (If you bound + // the proof depth and use the GUI, then you can see that + // there is the option that, without this check, servers + // just forward messages to further servers.) + , ReceivedKey(C, $S, k) + , In_Serv_1(request, k) + ]-> + [ Out( aenc{'2',k}pkC ) ] + +/* This is our typing assertion. It follows the construction outline above and + * uses the same trick as [1] to account for the interaction of the adversary, + * who doesn't have to follow a typing discipline. + */ +lemma typing_assertion [typing]: + "(All m v #i. In_Serv_1(m, v) @ i ==> + ( (Ex #j. KU(v) @ j & j < i) + | (Ex #j. Out_Client_1(m) @ j) + ) + ) + " + +/* We formulate the following lemma over the actions on adversary message + * deductions. This is the core secrecy lemma, which verify for the traces of + * the normal form dependency graphs of the protocol. We afterwards reuse it + * in the proof of the two security properties formulated over the standard + * traces of the protocol. + */ +lemma Client_session_key_secrecy_raw [reuse]: + " /* For all traces, we have that */ + All S C k #i #j. + /* if client setup a session key 'k' with a server'S' */ + SessKeyC(C, S, k) @ #i + /* and the adversary deduced 'k' */ + & KU(k) @ #j + /* the he must have performed a long-term key reveal on 'S' or 'C' + * before learning the key 'k'. */ + ==> + ( (Ex #r. LtkReveal(S) @ r & r < j) + | (Ex #r. LtkReveal(C) @ r & r < j) + ) + " + +// Check the proof of this lemma. It consists only of showing that the above +// lemma implies this one. +lemma Client_session_key_secrecy: + " /* For all traces, we have that */ + All S C k #i #j. + /* if client setup a session key 'k' with a server'S' */ + SessKeyC(C, S, k) @ #i + /* and the adversary knows 'k' */ + & K(k) @ #j + /* the he must have performed a long-term key reveal on 'S' or 'C' + * before learning the key 'k'. */ + ==> + ( (Ex #r. LtkReveal(S) @ r & r < j) + | (Ex #r. LtkReveal(C) @ r & r < j) + ) + " + +lemma Client_auth: + /* For all traces satisfying all equality checks */ + " (All x y #i. Eq(x,y) @ i ==> x = y) + ==> + ( All C S k #i. SessKeyC(C, S, k) @ #i + /* for all session keys 'k' setup by clients with a server 'S' */ + ==> + /* there is a server that answered the request */ + ( (Ex #a. ReceivedKey(C, S, k) @ a) + /* or the intruder performed a long-term key reveal on 'S' or 'C' + before the key was setup. */ + | (Ex #r. LtkReveal(S) @ r & r < i) + | (Ex #r. LtkReveal(C) @ r & r < i) + ) + ) + " + +end diff --git a/data/examples/loops/Minimal_Create_Use_Destroy.spthy b/data/examples/loops/Minimal_Create_Use_Destroy.spthy --- a/data/examples/loops/Minimal_Create_Use_Destroy.spthy +++ b/data/examples/loops/Minimal_Create_Use_Destroy.spthy @@ -7,7 +7,7 @@ Date: 2011 12 01 Status: Working - One model of the key mechnaism for certificate revocation. + One model of the key mechanism for certificate revocation. For every certificate, we create a single fact denoting that it has not yet been revoked. In every use of the certificate, we check that this fact still exists. diff --git a/data/examples/loops/Minimal_Crypto_API.spthy b/data/examples/loops/Minimal_Crypto_API.spthy --- a/data/examples/loops/Minimal_Crypto_API.spthy +++ b/data/examples/loops/Minimal_Crypto_API.spthy @@ -56,7 +56,7 @@ * Tamarin can prove this property automatically. */ lemma NewKey_invariant [reuse, use_induction]: - "not(Ex #i #j h k f. NewKey(h, k) @ i & KU(f,k) @ j) " + "not(Ex #i #j h k. NewKey(h, k) @ i & KU(k) @ j) " /* This property talks only about standard traces that do not refer to the * actions of construction rules. It can be proven thanks to the diff --git a/data/examples/loops/Minimal_KeyRenegotiation.spthy b/data/examples/loops/Minimal_KeyRenegotiation.spthy --- a/data/examples/loops/Minimal_KeyRenegotiation.spthy +++ b/data/examples/loops/Minimal_KeyRenegotiation.spthy @@ -37,6 +37,6 @@ // TODO: Investigate the form of the property and its proof when key // compromise is allowed. lemma secrecy [use_induction]: - "All k f #i #j. Secret(k) @ i & KU(f,k) @ j ==> F" + "All k #i #j. Secret(k) @ i & KU(k) @ j ==> F" end diff --git a/data/examples/loops/Minimal_Loop_Example.spthy b/data/examples/loops/Minimal_Loop_Example.spthy new file mode 100644 --- /dev/null +++ b/data/examples/loops/Minimal_Loop_Example.spthy @@ -0,0 +1,37 @@ +theory Minimal_Loop_Example begin + + + +/* + Author: Simon Meier + Date: 2012 06 10 + Status: Working + + A minimal example that is looping and satisfies a property cannot be proven + without inductive strengthening. + +*/ + +rule Start: [ Fr(x) ] --[ Start(x) ]-> [ A(x) ] + +rule Loop: [ A(x) ] --[ Loop(x) ]-> [ A(x) ] + +rule Stop: [ A(x) ] --[ Stop(x) ]-> [ ] + +lemma Start_before_Loop [reuse, use_induction]: + "All x #j. Loop(x) @ j ==> (Ex #i. Start(x) @ i & i < j)" + +lemma Start_before_Stop: + "All x #j. Stop(x) @ j ==> (Ex #i. Start(x) @ i & i < j)" + +lemma Loop_before_Stop [reuse, use_induction]: + "All x #i #j. Stop(x) @ j & Loop(x) @ i ==> #i < #j" + +lemma Stop_unique [reuse]: + "All x #i #j. Stop(x) @ j & Stop(x) @ i ==> #i = #j" + +lemma Satisfied_by_empty_trace_only [use_induction]: + exists-trace + "All x #j. Loop(x) @ j ==> F" + +end diff --git a/data/examples/loops/Minimal_Typing_Example.spthy b/data/examples/loops/Minimal_Typing_Example.spthy new file mode 100644 --- /dev/null +++ b/data/examples/loops/Minimal_Typing_Example.spthy @@ -0,0 +1,110 @@ +theory Minimal_Typing_Example +begin + +/* + Protocol: A minimal example to demonstrate the use of typing assertions + Modeler: Simon Meier + Date: July 2012 + + Status: working + + Note that this is an artificial example to demonstrate the use of typing + assertions. It is explained in detail in my Ph.D. thesis. +*/ + + +builtins: symmetric-encryption, hashing + +// Shared keys that can be compromised. +rule Setup_Key: + [ Fr(~k) ] --> [ !Key(~k) ] + +rule Reveal_Key: + [ !Key(k) ] --[ Rev(k) ]-> [ Out(k) ] + + +/* The protocol: there are shared keys that all honest processes have access + * to. The intruder can access them too by revealing them using the + * 'Reveal_Key' rule above. We use these keys to exchange a message consisting + * of a public part and a secret part. The initiator sends the message and the + * responder claims that the secret part is secret provided that the used key + * has not been revealed by the adversary. + */ +rule Initiator: + let msg = senc{~sec,~pub}k + in + [ !Key(k), Fr(~sec), Fr(~pub) ] + --[ Out_Initiator(msg) + , Public(~pub) + ]-> + [ Out( msg ) ] + +rule Responder: + let msg = senc{sec,pub}key + in + [ !Key(key), In( msg ) + ] + --[ In_Responder(msg, pub) + , Secret(sec, key) + ]-> + [ Out( pub ) ] + +/* This is our typing assertion: it ensures that we have enough constraints on + * the 'pub' variable in the 'Responder' rule to determine all possible + * messages that can be extracted from it using the deconstruction rules. + * You can see the effect of having too few constraint in the GUI under the + * 'untyped precomupted case distinctions' link. Several cases have + * superfluous decryption chains. Getting rid of them is the goal of the + * typing assertion. + * + * Note that typing assertions are invariants over the traces of the normal + * form dependency graphs of a protocol. We mark lemmas with the 'typing' + * attribute to ensure that they are proving using induction and that they are + * reused when precomputing case distinctions and proving non-typing lemmas. + */ +lemma typing_assertion [typing]: + /* For all messages received by the responder */ + "(All m k #i. In_Responder(m, k) @ i ==> + /* they either came from the adversary and he therefore knows the + * contained 'k' variable before it was instantiated */ + ( (Ex #j. KU(k) @ j & j < i) + /* or there is an initiator that sent 'm'. */ + | (Ex #j. Out_Initiator(m) @ j) + ) + ) + " +/* Note that in general typing assertions do not directly relate received + * messsages to sent messages, but received cryptographic components to sent + * cryptographic components. For this simple protocol, the two notions + * however coincide. + */ + + +/* The secret part of the message received by Responder is secret provided the + * key has not been compromised. + */ +lemma Responder_secrecy: + " /* For all traces, we have that */ + All sec key #i #j. + /* if a responder claims the secrecy of a message 'sec' provided 'key' + * is not compromised */ + Secret(sec, key) @ #i + /* and the adversary nevertheless deduced 'k' */ + & K(sec) @ #j + /* then the adversary must have revealed 'key' */ + ==> + (Ex #r. Rev(key) @ r) + " + +/* Sanity check: the public part is accessible to the adversary without + * performing a key reveal. + */ +lemma Public_part_public: + exists-trace + " /* No key reveal has been performed */ + not (Ex k #i. Rev(k) @ i) + /* and the public part of a message is known to the adversary. */ + & (Ex pub #i #j. Public(pub) @ i & K(pub) @ j ) + " + +end diff --git a/data/examples/loops/TESLA_Scheme1.spthy b/data/examples/loops/TESLA_Scheme1.spthy --- a/data/examples/loops/TESLA_Scheme1.spthy +++ b/data/examples/loops/TESLA_Scheme1.spthy @@ -5,9 +5,12 @@ Modeler: Simon Meier Date: May 2012 - Status: WIP + Status: working + Original descrption in [1]. This model is based on the following description + from [2]. + Msg 0a. R -> S: nR Msg 0b. S -> R: {f (k1 ), nR }SK (S ) Msg 1. S -> R: D1 , MAC (k1 , D1 ) where D1 = m1 , f (k2 ) @@ -16,10 +19,88 @@ For n > 1, the n-th message is:2 Msg n. S -> R : Dn , MAC (kn , Dn ) where Dn = mn , f (kn+1 ), kn-1 . + + We verify that the use of cryptography is correct under the assumption that + the security condition holds. We do not verify that the timing schedule + works, as we do not have a notion of time. For a manual, but machine-checked + verification of the Scheme 2 of the TESLA protocol with time see [3]. + + + [1] Perrig, Adrian, Ran Canetti, Dawn Song, and Doug Tygar. "The TESLA + Broadcast Authentication Protocol." In RSA Cryptobytes, Summer 2002. + + [2] Philippa J. Hopcroft, Gavin Lowe: Analysing a stream authentication + protocol using model checking. Int. J. Inf. Sec. 3(1): 2-13 (2004) + + [3] David A. Basin, Srdjan Capkun, Patrick Schaller, Benedikt Schmidt: + Formal Reasoning about Physical Properties of Security Protocols. ACM Trans. + Inf. Syst. Secur. 14(2): 16 (2011) + */ +builtins: signing + functions: MAC/2, f/1 +// PKI +////// + +rule Generate_Keypair: + [ Fr(~ltk) ] + --> + [ !Ltk($A, ~ltk), !Pk($A, pk(~ltk)), Out(pk(~ltk)) ] + +// We assume an active adversary. +rule Reveal_Ltk: + [ !Ltk(A, ltk) ] + --[ RevealLtk(A) ]-> + [ Out(ltk) ] + + +// Setup phase +////////////// + +// We choose a fresh start key and provide facts for sending and answering +// receiver connection requests. +rule Sender_Setup: + [ Fr(~k1) ] + --> + [ Sender1(~k1), !Sender0a(~k1) ] + +// Everybody can listen in by sending a request for the commitment to the +// first key. +rule Sender0a: + [ !Sender0a(k1) + , In( < R, S, nR> ) + , !Ltk(S, ltkS) + ] + --> + [ Out( ) ] + +// Receivers start by requesting the commitment to the first key and verifying +// the signature on this commitment. +rule Receiver0a: + [ Fr( ~nR ) ] + --> + [ Out( < $R, $S, ~nR > ) + , Receiver0b( $R, $S, ~nR ) ] + +rule Receiver0b: + [ Receiver0b ( R, S, nR ) + , !Pk( S, pkS) + , In( ) + ] + --> + [ Receiver0b_check(S, k2, verify(signature, , pkS)) ] + +rule Receiver0b_check: + [ Receiver0b_check(S, k2, true) ] + --> + [ Receiver1( S, k2 ) ] + + +/* The following setup-phase allows for a simpler proof. + rule Setup: [ Fr(~k1) ] --> @@ -27,6 +108,9 @@ , Receiver1(f(~k1)) ] +*/ + +// Authenticated broadcasting rule Send1: let data1 = <'1', ~m1, f(~k2)> in @@ -43,12 +127,12 @@ rule Recv1: let data1 = <'1', m1, commit_k2> in - [ Receiver1(commit_k1) + [ Receiver1(S, commit_k1) , In( ) ] --[ AssumeCommitNotExpired(commit_k1) ]-> - [ Receiver(data1, mac1, commit_k1, commit_k2) ] + [ Receiver(S, data1, mac1, commit_k1, commit_k2) ] rule SendN: let data = <'N', ~m, f(~kNew), ~kOld> @@ -64,44 +148,50 @@ , Out( ) ] -rule Recv: +rule RecvN: let data = <'N', m, commit_kNew, kOld> in [ In(< data, mac >) - , Receiver(dataOld, MAC{dataOld}kOld, f(kOld), commit_k) + , Receiver(S, dataOld, MAC{dataOld}kOld, f(kOld), commit_k) ] - --[ ClaimSent(dataOld) + --[ FromSender(S, dataOld) , AssumeCommitNotExpired(commit_k) ]-> - [ Receiver(data, mac, commit_k, commit_kNew) ] + [ Receiver(S, data, mac, commit_k, commit_kNew) ] -lemma claim_reachable [use_induction]: - exists-trace + +// The desired security property: if all commits expired after all asumptions +// that they are not expired, then we have message authentication provided the +// long-term key of the server was not revealed. +// +// Note that we could strengthen this property such that only expiredness of +// commits in this broadcasting session before the 'FromSender'-claim is +// required. +lemma authentic [use_induction]: "(All commit #i #j . AssumeCommitNotExpired(commit) @ i & CommitExpired(commit) @ j ==> i < j ) ==> - (Ex m #i. ClaimSent(m) @ i) + (All S m #i. FromSender(S, m) @ i ==> + ( (Ex #j. Sent(m) @ j & j < i) + | (Ex #j. RevealLtk(S) @ j & j < i) + ) + ) " -lemma authentic2 [use_induction]: +// Ensure that the above lemma is not vacuous due to the filtering condition. +lemma authentic_reachable [use_induction]: + exists-trace "(All commit #i #j . AssumeCommitNotExpired(commit) @ i & CommitExpired(commit) @ j ==> i < j ) - ==> - (All m #i. ClaimSent(m) @ i ==> (Ex #j. Sent(m) @ j & j < i) ) + & + (Ex S m #i. FromSender(S, m) @ i) " - - - - - - - end diff --git a/data/examples/related_work/AIF_Moedersheim_CCS10/Keyserver.spthy b/data/examples/related_work/AIF_Moedersheim_CCS10/Keyserver.spthy --- a/data/examples/related_work/AIF_Moedersheim_CCS10/Keyserver.spthy +++ b/data/examples/related_work/AIF_Moedersheim_CCS10/Keyserver.spthy @@ -92,7 +92,7 @@ // ensure that it always makes at least some progress. lemma types [typing]: "All sk #i. Revoked(sk) @ i ==> - ( (Ex f #j. KU(f,sk) @ j & j < i) + ( (Ex #j. KU(sk) @ j & j < i) | (Ex #j. HonestKey(sk) @ j & j < i) ) " diff --git a/data/examples/related_work/StatVerif_ARR_CSF11/StatVerif_Example1.spthy b/data/examples/related_work/StatVerif_ARR_CSF11/StatVerif_Example1.spthy --- a/data/examples/related_work/StatVerif_ARR_CSF11/StatVerif_Example1.spthy +++ b/data/examples/related_work/StatVerif_ARR_CSF11/StatVerif_Example1.spthy @@ -22,7 +22,7 @@ components, but never both. Note that in contrast to [1], we allow the creation of an unbounded number - of devices. We also verify both the accessability of left and right + of devices. We also verify both the accessibility of left and right components, as well as their exclusivity. The source code of the model from [1] is attached at the end of this file. @@ -83,8 +83,8 @@ // incorporated in the case distinction precomputation. lemma types [typing]: "All m #i. Access(m) @ i ==> - (Ex f #j. KU(f,m) @ j & j < i) // Make use of the KU-facts logged - // by the construction rules. + (Ex #j. KU(m) @ j & j < i) // Make use of the KU-facts logged + // by the construction rules. | (Ex x #j. Exclusive(x,m) @ j) | (Ex y #j. Exclusive(m,y) @ j) " diff --git a/data/examples/related_work/TPM_DKRS_CSF11/Envelope.spthy b/data/examples/related_work/TPM_DKRS_CSF11/Envelope.spthy --- a/data/examples/related_work/TPM_DKRS_CSF11/Envelope.spthy +++ b/data/examples/related_work/TPM_DKRS_CSF11/Envelope.spthy @@ -150,7 +150,7 @@ lemma types [typing]: // Values created by the PCR_Unbind rule " (All m d1 d2 #i. PCR_Unbind(d1, d2, m) @ i ==> - (Ex f #j. KU(f,m) @ j & j < i) + (Ex #j. KU(m) @ j & j < i) | (Ex #j. Secret(m) @ j) ) " diff --git a/data/examples/related_work/TPM_DKRS_CSF11/RunningExample.spthy b/data/examples/related_work/TPM_DKRS_CSF11/RunningExample.spthy --- a/data/examples/related_work/TPM_DKRS_CSF11/RunningExample.spthy +++ b/data/examples/related_work/TPM_DKRS_CSF11/RunningExample.spthy @@ -88,7 +88,7 @@ lemma types [typing]: " (All m d1 d2 #i. PCR_Unbind(d1, d2, m) @ i ==> - (Ex f #j. KU(f,m) @ j & j < i) + (Ex #j. KU(m) @ j & j < i) | (Ex s #j. Secrets(m, s) @ j) | (Ex s #j. Secrets(s, m) @ j) ) diff --git a/data/intruder_variants_dh.spthy b/data/intruder_variants_dh.spthy --- a/data/intruder_variants_dh.spthy +++ b/data/intruder_variants_dh.spthy @@ -1,258 +1,213 @@ rule (modulo AC) cexp: - [ !KU( 'exp', x ), !KU( f_.2, x.1 ) ] - --[ !KU( 'noexp', x^x.1 ) ]-> - [ !KU( 'noexp', x^x.1 ) ] + [ !KU( x ), !KU( x.1 ) ] --[ !KU( x^x.1 ) ]-> [ !KU( x^x.1 ) ] rule (modulo AC) cinv: - [ !KU( f_.1, x ) ] --[ !KU( 'exp', inv(x) ) ]-> [ !KU( 'exp', inv(x) ) ] + [ !KU( x ) ] --[ !KU( inv(x) ) ]-> [ !KU( inv(x) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^x.4 ), !KU( f_.2, x.1 ) ] - --> - [ !KD( 'noexp', x.3^(x.1*x.4) ) ] + [ !KD( x.2^x.3 ), !KU( x.1 ) ] --> [ !KD( x.2^(x.1*x.3) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^x.3 ), !KU( f_.2, inv(x.3) ) ] - --> - [ !KD( 'noexp', x.4 ) ] + [ !KD( x.3^x.2 ), !KU( inv(x.2) ) ] --> [ !KD( x.3 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^inv(x.3) ), !KU( f_.2, x.3 ) ] - --> - [ !KD( 'noexp', x.4 ) ] + [ !KD( x.3^inv(x.2) ), !KU( x.2 ) ] --> [ !KD( x.3 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^inv(x.5) ), !KU( f_.2, inv(x.3) ) ] + [ !KD( x.3^inv(x.4) ), !KU( inv(x.2) ) ] --> - [ !KD( 'noexp', x.4^inv((x.3*x.5)) ) ] + [ !KD( x.3^inv((x.2*x.4)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^inv((x.3*x.5)) ), !KU( f_.2, x.3 ) ] - --> - [ !KD( 'noexp', x.4^inv(x.5) ) ] + [ !KD( x.3^inv((x.2*x.4)) ), !KU( x.2 ) ] --> [ !KD( x.3^inv(x.4) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^(x.3*x.5) ), !KU( f_.2, inv(x.3) ) ] - --> - [ !KD( 'noexp', x.4^x.5 ) ] + [ !KD( x.3^(x.2*x.4) ), !KU( inv(x.2) ) ] --> [ !KD( x.3^x.4 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^(x.5*inv(x.3)) ), !KU( f_.2, x.3 ) ] - --> - [ !KD( 'noexp', x.4^x.5 ) ] + [ !KD( x.3^(x.4*inv(x.2)) ), !KU( x.2 ) ] --> [ !KD( x.3^x.4 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^x.4 ), !KU( f_.2, inv((x.4*x.5)) ) ] - --> - [ !KD( 'noexp', x.3^inv(x.5) ) ] + [ !KD( x.2^x.3 ), !KU( inv((x.3*x.4)) ) ] --> [ !KD( x.2^inv(x.4) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^x.4 ), !KU( f_.2, (x.5*inv(x.4)) ) ] - --> - [ !KD( 'noexp', x.3^x.5 ) ] + [ !KD( x.2^x.3 ), !KU( (x.4*inv(x.3)) ) ] --> [ !KD( x.2^x.4 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^inv(x.4) ), !KU( f_.2, (x.3*x.4) ) ] - --> - [ !KD( 'noexp', x.5^x.3 ) ] + [ !KD( x.4^inv(x.3) ), !KU( (x.2*x.3) ) ] --> [ !KD( x.4^x.2 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^(x.5*inv(x.6)) ), !KU( f_.2, inv(x.3) ) ] + [ !KD( x.3^(x.4*inv(x.5)) ), !KU( inv(x.2) ) ] --> - [ !KD( 'noexp', x.4^(x.5*inv((x.3*x.6))) ) ] + [ !KD( x.3^(x.4*inv((x.2*x.5))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^inv(x.4) ), !KU( f_.2, (x.5*inv(x.6)) ) ] + [ !KD( x.2^inv(x.3) ), !KU( (x.4*inv(x.5)) ) ] --> - [ !KD( 'noexp', x.3^(x.5*inv((x.4*x.6))) ) ] + [ !KD( x.2^(x.4*inv((x.3*x.5))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.4^(x.5*inv((x.3*x.6))) ), !KU( f_.2, x.3 ) ] + [ !KD( x.3^(x.4*inv((x.2*x.5))) ), !KU( x.2 ) ] --> - [ !KD( 'noexp', x.4^(x.5*inv(x.6)) ) ] + [ !KD( x.3^(x.4*inv(x.5)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^inv((x.4*x.6)) ), !KU( f_.2, (x.3*x.4) ) ] + [ !KD( x.4^inv((x.3*x.5)) ), !KU( (x.2*x.3) ) ] --> - [ !KD( 'noexp', x.5^(x.3*inv(x.6)) ) ] + [ !KD( x.4^(x.2*inv(x.5)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*x.6) ), !KU( f_.2, inv((x.3*x.4)) ) ] + [ !KD( x.4^(x.3*x.5) ), !KU( inv((x.2*x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.6*inv(x.3)) ) ] + [ !KD( x.4^(x.5*inv(x.2)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*x.6) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^(x.3*x.5) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.3*x.6) ) ] + [ !KD( x.4^(x.2*x.5) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.6*inv(x.4)) ), !KU( f_.2, (x.3*x.4) ) ] + [ !KD( x.4^(x.5*inv(x.3)) ), !KU( (x.2*x.3) ) ] --> - [ !KD( 'noexp', x.5^(x.3*x.6) ) ] + [ !KD( x.4^(x.2*x.5) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^x.4 ), !KU( f_.2, (x.5*inv((x.4*x.6))) ) ] + [ !KD( x.2^x.3 ), !KU( (x.4*inv((x.3*x.5))) ) ] --> - [ !KD( 'noexp', x.3^(x.5*inv(x.6)) ) ] + [ !KD( x.2^(x.4*inv(x.5)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.6*inv(x.7)) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^(x.5*inv(x.6)) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.3*x.6*inv((x.4*x.7))) ) ] + [ !KD( x.4^(x.2*x.5*inv((x.3*x.6))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*inv(x.3)) ), !KU( f_.2, (x.3*inv(x.4)) ) ] - --> - [ !KD( 'noexp', x.5 ) ] + [ !KD( x.4^(x.3*inv(x.2)) ), !KU( (x.2*inv(x.3)) ) ] --> [ !KD( x.4 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*inv(x.6)) ), !KU( f_.2, inv((x.3*x.4)) ) ] + [ !KD( x.4^(x.3*inv(x.5)) ), !KU( inv((x.2*x.3)) ) ] --> - [ !KD( 'noexp', x.5^inv((x.3*x.6)) ) ] + [ !KD( x.4^inv((x.2*x.5)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^inv((x.3*x.6)) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^inv((x.2*x.5)) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^inv((x.4*x.6)) ) ] + [ !KD( x.4^inv((x.3*x.5)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.6*inv((x.4*x.7))) ), !KU( f_.2, (x.3*x.4) ) ] + [ !KD( x.4^(x.5*inv((x.3*x.6))) ), !KU( (x.2*x.3) ) ] --> - [ !KD( 'noexp', x.5^(x.3*x.6*inv(x.7)) ) ] + [ !KD( x.4^(x.2*x.5*inv(x.6)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^(x.4*x.5) ), !KU( f_.2, (x.6*inv((x.5*x.7))) ) ] + [ !KD( x.2^(x.3*x.4) ), !KU( (x.5*inv((x.4*x.6))) ) ] --> - [ !KD( 'noexp', x.3^(x.4*x.6*inv(x.7)) ) ] + [ !KD( x.2^(x.3*x.5*inv(x.6)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*x.6*inv(x.3)) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^(x.3*x.5*inv(x.2)) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^x.6 ) ] + [ !KD( x.4^x.5 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.5*inv(x.4)) ), !KU( f_.2, (x.3*x.4*inv(x.5)) ) ] + [ !KD( x.5^(x.4*inv(x.3)) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^x.3 ) ] + [ !KD( x.5^x.2 ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*x.6*inv(x.7)) ), !KU( f_.2, inv((x.3*x.4)) ) ] + [ !KD( x.4^(x.3*x.5*inv(x.6)) ), !KU( inv((x.2*x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.6*inv((x.3*x.7))) ) ] + [ !KD( x.4^(x.5*inv((x.2*x.6))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^inv((x.4*x.7)) ), !KU( f_.2, (x.3*x.4*inv(x.5)) ) ] + [ !KD( x.5^inv((x.3*x.6)) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^(x.3*inv((x.5*x.7))) ) ] + [ !KD( x.5^(x.2*inv((x.4*x.6))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*inv((x.3*x.6))) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^(x.3*inv((x.2*x.5))) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^inv(x.6) ) ] + [ !KD( x.4^inv(x.5) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^(x.4*inv(x.5)) ), !KU( f_.2, (x.5*inv((x.4*x.6))) ) ] + [ !KD( x.2^(x.3*inv(x.4)) ), !KU( (x.4*inv((x.3*x.5))) ) ] --> - [ !KD( 'noexp', x.3^inv(x.6) ) ] + [ !KD( x.2^inv(x.5) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^(x.4*inv(x.5)) ), !KU( f_.2, (x.6*inv((x.4*x.7))) ) ] + [ !KD( x.2^(x.3*inv(x.4)) ), !KU( (x.5*inv((x.3*x.6))) ) ] --> - [ !KD( 'noexp', x.3^(x.6*inv((x.5*x.7))) ) ] + [ !KD( x.2^(x.5*inv((x.4*x.6))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.5*x.7*inv(x.4)) ), !KU( f_.2, (x.3*x.4*inv(x.5)) ) ] + [ !KD( x.5^(x.4*x.6*inv(x.3)) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^(x.3*x.7) ) ] + [ !KD( x.5^(x.2*x.6) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.6*inv((x.3*x.7))) ), !KU( f_.2, (x.3*inv(x.4)) ) ] + [ !KD( x.4^(x.5*inv((x.2*x.6))) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.6*inv((x.4*x.7))) ) ] + [ !KD( x.4^(x.5*inv((x.3*x.6))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.3^(x.4*inv(x.5)) ), !KU( f_.2, (x.5*x.6*inv((x.4*x.7))) ) - ] + [ !KD( x.2^(x.3*inv(x.4)) ), !KU( (x.4*x.5*inv((x.3*x.6))) ) ] --> - [ !KD( 'noexp', x.3^(x.6*inv(x.7)) ) ] + [ !KD( x.2^(x.5*inv(x.6)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.5^(x.4*x.6*inv((x.3*x.7))) ), !KU( f_.2, (x.3*inv(x.4)) ) - ] + [ !KD( x.4^(x.3*x.5*inv((x.2*x.6))) ), !KU( (x.2*inv(x.3)) ) ] --> - [ !KD( 'noexp', x.5^(x.6*inv(x.7)) ) ] + [ !KD( x.4^(x.5*inv(x.6)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.5*inv((x.4*x.7))) ), !KU( f_.2, (x.3*x.4*inv(x.5)) ) - ] + [ !KD( x.5^(x.4*inv((x.3*x.6))) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^(x.3*inv(x.7)) ) ] + [ !KD( x.5^(x.2*inv(x.6)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.5*x.7*inv(x.3)) ), !KU( f_.2, (x.3*inv((x.4*x.5))) ) - ] + [ !KD( x.5^(x.4*x.6*inv(x.2)) ), !KU( (x.2*inv((x.3*x.4))) ) ] --> - [ !KD( 'noexp', x.6^(x.7*inv(x.4)) ) ] + [ !KD( x.5^(x.6*inv(x.3)) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.5*x.7*inv(x.8)) ), !KU( f_.2, (x.3*inv((x.4*x.5))) ) - ] + [ !KD( x.5^(x.4*x.6*inv(x.7)) ), !KU( (x.2*inv((x.3*x.4))) ) ] --> - [ !KD( 'noexp', x.6^(x.3*x.7*inv((x.4*x.8))) ) ] + [ !KD( x.5^(x.2*x.6*inv((x.3*x.7))) ) ] rule (modulo AC) dexp: - [ !KD( 'exp', x.6^(x.7*inv((x.4*x.8))) ), !KU( f_.2, (x.3*x.4*inv(x.5)) ) - ] + [ !KD( x.5^(x.6*inv((x.3*x.7))) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^(x.3*x.7*inv((x.5*x.8))) ) ] + [ !KD( x.5^(x.2*x.6*inv((x.4*x.7))) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.6^(x.5*inv((x.3*x.7))) ), !KU( f_.2, (x.3*inv((x.4*x.5))) ) - ] + [ !KD( x.5^(x.4*inv((x.2*x.6))) ), !KU( (x.2*inv((x.3*x.4))) ) ] --> - [ !KD( 'noexp', x.6^inv((x.4*x.7)) ) ] + [ !KD( x.5^inv((x.3*x.6)) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.3^(x.4*x.5*inv(x.6)) ), - !KU( f_.2, (x.6*x.7*inv((x.5*x.8))) ) - ] + [ !KD( x.2^(x.3*x.4*inv(x.5)) ), !KU( (x.5*x.6*inv((x.4*x.7))) ) ] --> - [ !KD( 'noexp', x.3^(x.4*x.7*inv(x.8)) ) ] + [ !KD( x.2^(x.3*x.6*inv(x.7)) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.6^(x.5*x.7*inv((x.4*x.8))) ), - !KU( f_.2, (x.3*x.4*inv(x.5)) ) - ] + [ !KD( x.5^(x.4*x.6*inv((x.3*x.7))) ), !KU( (x.2*x.3*inv(x.4)) ) ] --> - [ !KD( 'noexp', x.6^(x.3*x.7*inv(x.8)) ) ] + [ !KD( x.5^(x.2*x.6*inv(x.7)) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.7^(x.6*inv((x.4*x.8))) ), - !KU( f_.2, (x.3*x.4*inv((x.5*x.6))) ) - ] + [ !KD( x.6^(x.5*inv((x.3*x.7))) ), !KU( (x.2*x.3*inv((x.4*x.5))) ) ] --> - [ !KD( 'noexp', x.7^(x.3*inv((x.5*x.8))) ) ] + [ !KD( x.6^(x.2*inv((x.4*x.7))) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.6^(x.5*x.7*inv((x.3*x.8))) ), - !KU( f_.2, (x.3*inv((x.4*x.5))) ) - ] + [ !KD( x.5^(x.4*x.6*inv((x.2*x.7))) ), !KU( (x.2*inv((x.3*x.4))) ) ] --> - [ !KD( 'noexp', x.6^(x.7*inv((x.4*x.8))) ) ] + [ !KD( x.5^(x.6*inv((x.3*x.7))) ) ] rule (modulo AC) dexp: - [ - !KD( 'exp', x.7^(x.6*x.8*inv((x.4*x.9))) ), - !KU( f_.2, (x.3*x.4*inv((x.5*x.6))) ) - ] + [ !KD( x.6^(x.5*x.7*inv((x.3*x.8))) ), !KU( (x.2*x.3*inv((x.4*x.5))) ) ] --> - [ !KD( 'noexp', x.7^(x.3*x.8*inv((x.5*x.9))) ) ] + [ !KD( x.6^(x.2*x.7*inv((x.4*x.8))) ) ] rule (modulo AC) dinv: - [ !KD( f_.1, inv(x.2) ) ] --> [ !KD( 'exp', x.2 ) ] + [ !KD( inv(x.1) ) ] --> [ !KD( x.1 ) ] diff --git a/data/js/tamarin-prover-ui.js b/data/js/tamarin-prover-ui.js --- a/data/js/tamarin-prover-ui.js +++ b/data/js/tamarin-prover-ui.js @@ -113,7 +113,7 @@ // Display loading screen var display = $("p.loading"); display.hide().fadeIn(1000); - + // Install cancel click handler display.children("a#cancel").unbind('click').click(function() { loadingScreen.cancel(path); @@ -147,11 +147,15 @@ // Add keyboard shortcuts var shortcuts = { - 97 : function() { mainDisplay.applyAutoprover(); }, // a + 97 : function() { mainDisplay.applyProver('autoprove'); }, // a + 65 : function() { mainDisplay.applyProver('characterization'); }, // A + 98 : function() { mainDisplay.applyProver('bounded-autoprove'); }, // b + 66 : function() { mainDisplay.applyProver('bounded-characterization'); }, // B 74 : function() { proofScript.jump('next/smart', null); }, // j 75 : function() { proofScript.jump('prev/smart', null); }, // k 106 : function() { proofScript.jump('next/normal', null); }, // J - 107 : function() { proofScript.jump('prev/normal', null); } // K + 107 : function() { proofScript.jump('prev/normal', null); }, // K + 63 : proofScript.showHelp // ? } for(i = 1; i < 10; i++) { @@ -210,7 +214,7 @@ layout.toggle("east"); mainDisplay.toggleOption(debug_toggle); }); - + // Click handler for graph toggle var graph_toggle = $('a#graph-toggle'); graph_toggle.click(function(ev) { @@ -223,7 +227,7 @@ $("a.active-link").click(); mainDisplay.toggleOption(graph_toggle); }); - + // Click handler for sequent compression toggle var sequent_toggle = $('a#seqnt-toggle'); sequent_toggle.click(function(ev) { @@ -241,7 +245,7 @@ events.installScrollHandler( "west", "div.ui-layout-west div.scroll-wrapper"); - + // Install handlers on plain internal links events.installRelativeClickHandler( "div#proof a.internal-link", @@ -253,7 +257,7 @@ "div#proof a.internal-link.delete-link", "del/path", null); - + // Install handlers on proof-step links events.installRelativeClickHandler( "div#proof a.internal-link.proof-step", @@ -282,7 +286,7 @@ if($.cookie("east-size")) { layout.sizePane("east", $.cookie("east-size")); } - + if($.cookie("east-open")) { layout.open("east"); $("a#debug-toggle").addClass("active-option"); @@ -290,24 +294,24 @@ layout.close("east"); $("a#debug-toggle").addClass("inactive-option"); } - + if($.cookie("west-size")) { layout.sizePane("west", $.cookie("west-size")); } else { layout.sizePane("west", 475); } - + if($.cookie("west-position")) { var pos = $.cookie("west-position"); $("div.ui-layout-west div.scroll-wrapper").scrollTop(pos); } - + if($.cookie("uncompress-sequents")) { $("a#seqnt-toggle").addClass("inactive-option"); } else { $("a#seqnt-toggle").addClass("active-option"); } - + if($.cookie("uncompact-graphs")) { $("a#graph-toggle").addClass("inactive-option"); } else { @@ -413,7 +417,7 @@ // Remove (possible) old click handler(s) $(selector).unbind('click'); // Add new click handler - $(selector).click(function(ev) { + $(selector).click(function(ev) { ev.preventDefault(); var element = $(this); mainDisplay.loadTarget( @@ -468,6 +472,16 @@ var proofScript = { /** + * Show the help message + */ + showHelp: function() { + var auto = $("#proof").find("a.internal-link.help"); + + if(auto.length >= 1) + $(auto.get(0)).click(); + }, + + /** * Focus the active link by scrolling to it. */ focusActive: function() { @@ -483,7 +497,7 @@ var linkOffset = link.offset().top; var height = wrapper.height(); var newPos = pos + linkOffset - (height/2) - (contOffset/2); - + // Now scroll there wrapper.stop(true, true); wrapper.animate( @@ -501,9 +515,9 @@ jump: function(mode, err_callback) { var element = $("#proof"); var active = element.find("a.active-link").first(); - + if(active.length > 0) { - var current = active.attr("href"); + var current = active.attr("href"); server.performASR( theory.absolutePath(mode, theory.extractTheoryPath(current)), @@ -591,13 +605,16 @@ if(methods.length >= num) $(methods.get([ num - 1 ])).click(); }, - applyAutoprover: function() { - var auto = $("#ui-main-display").find("a.internal-link.autoprove"); + /** + * Apply a prover to the currently selected constraint system. + * @param prover The CSS style of the link to the prover + */ + applyProver: function(prover) { + var auto = $("#ui-main-display").find("a.internal-link." + prover); if(auto.length >= 1) $(auto.get(0)).click(); }, - /** * Update main view with new HTML data. * @param html_data The html data. @@ -618,7 +635,7 @@ // Received html, display it element.html(html_data); - + // Get image settings from cookie var params = [] if($.cookie("uncompact-graphs")) { @@ -631,7 +648,7 @@ { name: "uncompress", value: "" } ); } - + // Rewrite image paths (if necessary) if(params.length > 0) { var query_string = $.param(params); @@ -641,10 +658,10 @@ img.attr("src", path); }); } - + // Focus main view (so PgUp/PgDown works) wrapper.focus(); - + // Re-install click handlers on main events.installRelativeClickHandler( "div#ui-main-display a.internal-link", @@ -668,7 +685,7 @@ // Handle JSON reponse server.handleJson(data, function(title, html_data) { mainDisplay.setContent(title, html_data); - + if (window.history && window.history.pushState) { var url = theory.absolutePath("overview", theory.extractTheoryPath(target)); window.history.replaceState({}, "", url); @@ -676,7 +693,7 @@ ui.setActiveLink(target); }); - + // Call optional callback if(callback) callback(); }, @@ -737,7 +754,7 @@ $.cookie(name + "-size", elem.width(), { path: '/' }); }, }); - + // Initialize user interface ui.init(); }); diff --git a/interactive-only-src/Lexer.x b/interactive-only-src/Lexer.x deleted file mode 100644 --- a/interactive-only-src/Lexer.x +++ /dev/null @@ -1,418 +0,0 @@ -{ -{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-missing-signatures -fno-warn-lazy-unlifted-bindings #-} -module Theory.Lexer where - --- This file works only with Alex < 3.0. In the long-term, we plan to switch --- to a lexer-less approach, i.e., relying completely on parsec. -} - - -$digit = [0-9] -$letter = [a-zA-Z] -$others = [\192-\214\216-\246\248-\255] - -@integer = $digit+ -@identifierFirst = ($letter | $digit | $others) -@identifierAfter = ($letter | $digit | "_" | $others) -@identifier = @identifierFirst @identifierAfter* -@comment = $printable | $white -@text = $printable | $white -@lineComment = "//".* - -tokens :- - <0> $white+ ; - - <0> @lineComment ; - <0> "(*" { beginComment "(*" comment } - "(*" { beginComment "(*" comment } - "(*" { beginComment "(*" comment } - "*)" { endComment "(*" } - <0> "/*" { beginComment "/*" comment } - "/*" { beginComment "/*" comment } - "/*" { beginComment "/*" comment } - "*/" { endComment "/*" } - @comment { skip } - - <0> "text{*" { beginText "text" text } - <0> "section{*" { beginText "section" text } - <0> "subsection{*" { beginText "subsection" text } - "*}" { endText 0} - @text { scanString (TEXT . TextContent) } - - - <0> "∀" { keyword FORALL } - <0> "∃" { keyword EXISTS } - <0> "∧" { keyword LAND } - <0> "∨" { keyword LOR } - <0> "¬" { keyword LNOT } - <0> "≈" { keyword APPROX } - - <0> "," { keyword COMMA } - <0> "(" { keyword LPAREN } - <0> ")" { keyword RPAREN } - <0> "[" { keyword LBRACKET } - <0> "]" { keyword RBRACKET } - <0> "{" { keyword LBRACE } - <0> "}" { keyword RBRACE } - <0> "/" { keyword SLASH } - <0> "\\" { keyword BACKSLASH } - <0> "'" { keyword SQUOTE } - <0> \" { keyword DQUOTE } - <0> "~" { keyword TILDE } - <0> "^" { keyword HAT } - <0> "=" { keyword EQUAL } - <0> ":" { keyword COLON } - <0> "$" { keyword DOLLAR } - <0> "@" { keyword AT } - <0> "#" { keyword SHARP } - <0> "%" { keyword PERCENT } - <0> "*" { keyword STAR } - <0> "<" { keyword LESS } - <0> ">" { keyword GREATER } - <0> "?" { keyword QUESTIONMARK } - <0> "!" { keyword BANG } - <0> "&" { keyword AND } - <0> "|" { keyword MID } - <0> "." { keyword DOT } - <0> "_" { keyword UNDERSCORE } - <0> "-" { keyword MINUS } - <0> "+" { keyword PLUS } - <0> "->" { keyword RIGHTARROW } - <0> "<-" { keyword LEFTARROW } - <0> "-->" { keyword LONGRIGHTARROW } - <0> "<--" { keyword LONGLEFTARROW } - <0> @identifier { scanString IDENT} - - -{ - --- | Lex a keyword -keyword :: Keyword -> AlexAction Keyword -keyword kw input len = return kw - --- | Wrap a string into a keyword -scanString :: (String -> Keyword) -> AlexAction Keyword -scanString kw (_,_,input) len = return $ kw (take len input) - -{- --- | Scan a string until EOF is encountered. -alexScanTokens :: String -> Either String [Keyword] -alexScanTokens inp = runAlex inp gather - where - gather = do - t <- alexMonadScan - case trace (show t) t of - EOF -> return [EOF] - _ -> (t:) `liftM` gather - --- | Scan a file. -scanFile f = do - inp <- readFile f - return $ alexScanTokens inp --} - --- | Formal text types. -data TextType = - TextBegin String - | TextContent String - | TextEnd - deriving( Eq, Ord, Show ) - --- | Lexable Keywords -data Keyword = - IDENT String - | TEXT TextType - | SQUOTE - | DQUOTE - | RIGHTARROW - | LEFTARROW - | LONGRIGHTARROW - | LONGLEFTARROW - | COMMA - | DOT - | COLON - | QUESTIONMARK - | BANG - | AND - | MID - | DOLLAR - | AT - | SHARP - | PERCENT - | LPAREN - | RPAREN - | LBRACKET - | RBRACKET - | LBRACE - | RBRACE - | SLASH - | BACKSLASH - | TILDE - | HAT - | STAR - | UNDERSCORE - | MINUS - | PLUS - | EQUAL - | LESS - | GREATER - | EOF - | FORALL - | EXISTS - | LAND - | LOR - | LNOT - | APPROX - -- dummy keyword to get rid of overlapping pattern matches - | DUMMY_KEYWORD - deriving( Eq ) - -instance Show Keyword where - show kw = case kw of - IDENT i -> identifier i - TEXT t -> txt t - SQUOTE -> symbol "'" - DQUOTE -> symbol "\"" - RIGHTARROW -> symbol "->" - LEFTARROW -> symbol "<-" - LONGRIGHTARROW -> symbol "-->" - LONGLEFTARROW -> symbol "<--" - COMMA -> symbol "," - DOT -> symbol "." - COLON -> symbol ":" - QUESTIONMARK -> symbol "?" - BANG -> symbol "!" - AND -> symbol "&" - MID -> symbol "|" - DOLLAR -> symbol "$" - AT -> symbol "@" - SHARP -> symbol "#" - PERCENT -> symbol "%" - LPAREN -> symbol "(" - RPAREN -> symbol ")" - LBRACKET -> symbol "[" - RBRACKET -> symbol "]" - LBRACE -> symbol "{" - RBRACE -> symbol "}" - SLASH -> symbol "/" - BACKSLASH -> symbol "\\" - TILDE -> symbol "~" - HAT -> symbol "^" - STAR -> symbol "*" - UNDERSCORE -> symbol "_" - MINUS -> symbol "-" - PLUS -> symbol "+" - EQUAL -> symbol "=" - LESS -> symbol "<" - GREATER -> symbol ">" - EOF -> "end of file" - FORALL -> symbol "∀" - EXISTS -> symbol "∃" - LAND -> symbol "∧" - LOR -> symbol "∨" - LNOT -> symbol "¬" - APPROX -> symbol "≈" - DUMMY_KEYWORD -> "DUMMY_KEYWORD (this should not occur!)" - where - identifier i = "identifier `" ++ i ++ "'" - txt (TextBegin t) = "start of `" ++ t ++ "'" - txt (TextContent t) = "text `" ++ t ++ "'" - txt (TextEnd) = "start of text" - symbol s = "symbol `" ++ s ++ "'" - keyword s = "keyword `" ++ s ++ "'" - --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- The input type - - -type AlexInput = (AlexPosn, -- current position, - Char, -- previous char - String) -- current input string - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (p,c,s) = c - -alexGetChar :: AlexInput -> Maybe (Char,AlexInput) -alexGetChar (p,c,[]) = Nothing -alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq` - Just (c, (p', c, s)) - - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -data AlexPosn = AlexPn !Int !Int !Int - deriving (Eq) - -instance Show AlexPosn where - show (AlexPn _ l c) = "line "++show l++" column "++show c - -alexStartPos :: AlexPosn -alexStartPos = AlexPn 0 1 1 - -alexMove :: AlexPosn -> Char -> AlexPosn -alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1) -alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1 -alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) - - --- ----------------------------------------------------------------------------- --- Default monad - - -data AlexState = AlexState { - alex_pos :: !AlexPosn, -- position at current input location - alex_inp :: String, -- the current input - alex_chr :: !Char, -- the character before the input - alex_scd :: !Int, -- the current startcode - alex_ocd :: !Int, -- the old startcode before the comment started - alex_cmt :: [String] -- stack of begin comment identifiers - } - --- Compile with -funbox-strict-fields for best results! - -runAlex :: String -> Alex a -> Either String a -runAlex input (Alex f) - = case f (AlexState {alex_pos = alexStartPos, - alex_inp = input, - alex_chr = '\n', - alex_scd = 0, - alex_ocd = 0, - alex_cmt = [] - }) of - Left msg -> Left msg - Right ( _, a ) -> Right a - -newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } - -instance Monad Alex where - m >>= k = Alex $ \s -> case unAlex m s of - Left msg -> Left msg - Right (s',a) -> unAlex (k a) s' - return a = Alex $ \s -> Right (s,a) - -alexGetPos :: Alex AlexPosn -alexGetPos = Alex $ \s@AlexState{alex_pos=pos} -> Right (s, pos) - -alexGetInput :: Alex AlexInput -alexGetInput - = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_inp=inp} -> - Right (s, (pos,c,inp)) - -alexSetInput :: AlexInput -> Alex () -alexSetInput (pos,c,inp) - = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_inp=inp} of - s@(AlexState{}) -> Right (s, ()) - -alexError :: String -> Alex a -alexError message = Alex $ \s -> Left $ message ++ " in " ++ show (alex_pos s) - -alexGetStartCode :: Alex Int -alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc) - -alexSetStartCode :: Int -> Alex () -alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ()) - -alexGetOldStartCode :: Alex Int -alexGetOldStartCode = Alex $ \s@AlexState{alex_ocd=sc} -> Right (s, sc) - -alexSetOldStartCode :: Int -> Alex () -alexSetOldStartCode sc = Alex $ \s -> Right (s{alex_ocd=sc}, ()) - -alexGetComments :: Alex [String] -alexGetComments = Alex $ \s -> Right (s, alex_cmt s) - -alexSetComments :: [String] -> Alex () -alexSetComments cmt = Alex $ \s -> Right (s{alex_cmt=cmt}, ()) - -alexMonadScan = do - inp <- alexGetInput - sc <- alexGetStartCode - case alexScan inp sc of - AlexEOF -> alexEOF - AlexError inp' -> alexError "lexical error" - AlexSkip inp' len -> do - alexSetInput inp' - alexMonadScan - AlexToken inp' len action -> do - alexSetInput inp' - action inp len - --- ----------------------------------------------------------------------------- --- Useful token actions - -type AlexAction result = AlexInput -> Int -> Alex result - --- just ignore this token and scan another one -skip :: AlexAction Keyword -skip input len = alexMonadScan - --- ignore this token, but set the start code to a new value -begin :: Int -> AlexAction Keyword -begin code input len = do alexSetStartCode code; alexMonadScan - --- | Begin a text starting of the given type. -beginText :: String -> Int -> AlexAction Keyword -beginText ty code _ _ = do - alexSetStartCode code - return $ TEXT $ TextBegin ty - --- | End a text. -endText :: Int -> AlexAction Keyword -endText code _ _ = do - alexSetStartCode code - return $ TEXT TextEnd - --- | Begin a comment starting with the given sign. -beginComment :: String -> Int -> AlexAction Keyword -beginComment cmtBegin code input len = do - cmts <- alexGetComments - alexSetComments $ cmtBegin : cmts - if null cmts - then alexGetStartCode >>= alexSetOldStartCode - else return () - alexSetStartCode code - alexMonadScan - --- | End a comment that started with the given begin comment sign. -endComment :: String -> AlexAction Keyword -endComment cmtBegin input len = do - cmts <- alexGetComments - case cmts of - [] -> alexError $ "comment ended but no beginning '"++cmtBegin++"' marked." - (cmt:cmts') -> do - if cmt == cmtBegin - then do - alexSetComments cmts' - if null cmts' - then alexGetOldStartCode >>= alexSetStartCode - else return () - else return () - alexMonadScan - --- perform an action for this token, and set the start code to a new value --- andBegin :: AlexAction result -> Int -> AlexAction result -(action `andBegin` code) input len = do alexSetStartCode code; action input len - -alexEOF :: Alex Keyword -alexEOF = return EOF - - - -} - - - diff --git a/interactive-only-src/Paths_tamarin_prover.hs b/interactive-only-src/Paths_tamarin_prover.hs --- a/interactive-only-src/Paths_tamarin_prover.hs +++ b/interactive-only-src/Paths_tamarin_prover.hs @@ -12,7 +12,7 @@ version :: Version -version = Version {versionBranch = [0,6,1,0], versionTags = []} +version = Version {versionBranch = [0,8,0,0], versionTags = []} bindir, libdir, datadir, libexecdir :: FilePath bindir = "./" diff --git a/src/Main/Mode/Batch.hs b/src/Main/Mode/Batch.hs --- a/src/Main/Mode/Batch.hs +++ b/src/Main/Mode/Batch.hs @@ -21,6 +21,7 @@ import qualified Text.PrettyPrint.Class as Pretty import Theory +import Theory.Tools.Wellformedness (checkWellformedness) import Main.Console import Main.Environment @@ -114,9 +115,18 @@ | argExists "parseOnly" as = out (const Pretty.emptyDoc) prettyOpenTheory (loadOpenThy as inFile) | otherwise = - out prettyClosedSummary prettyClosedTheory (loadClosedThy as inFile) + out ppWfAndSummary prettyClosedTheory (loadClosedThy as inFile) where ppAnalyzed = Pretty.text $ "analyzed: " ++ inFile + + ppWfAndSummary thy = + case checkWellformedness (openTheory thy) of + [] -> Pretty.emptyDoc + errs -> Pretty.vcat $ map Pretty.text $ + [ "WARNING: " ++ show (length errs) + ++ " wellformedness check failed!" + , " The analysis results might be wrong!" ] + Pretty.$--$ prettyClosedSummary thy out :: (a -> Pretty.Doc) -> (a -> Pretty.Doc) -> IO a -> IO Pretty.Doc out summaryDoc fullDoc load diff --git a/src/Main/Mode/Interactive.hs b/src/Main/Mode/Interactive.hs --- a/src/Main/Mode/Interactive.hs +++ b/src/Main/Mode/Interactive.hs @@ -12,13 +12,13 @@ ) where import Control.Basics -import Control.Exception (handle, IOException) +import Control.Exception (IOException, handle) import Data.Char (toLower) import Data.List import Data.Maybe import Data.String (fromString) import System.Console.CmdArgs.Explicit as CmdArgs -import System.Directory (doesFileExist, doesDirectoryExist) +import System.Directory (doesDirectoryExist, doesFileExist, getTemporaryDirectory) import System.FilePath import Network.Wai.Handler.Warp (defaultSettings, settingsHost, settingsPort) @@ -74,6 +74,9 @@ wdIsDir <- doesDirectoryExist workDir if wdIsDir then do + -- determine caching directory + tempDir <- getTemporaryDirectory + let cacheDir = tempDir "tamarin-prover-cache" -- process theories _ <- ensureGraphVizDot as _ <- ensureMaude as @@ -89,6 +92,7 @@ ] withWebUI ("Finished loading theories ... server ready at \n\n " ++ webUrl ++ "\n") + cacheDir workDir (argExists "loadstate" as) (argExists "autosave" as) (loadClosedWfThy as) (loadClosedThyString as) (closeThy as) (argExists "debug" as) dataDir (dotPath as) readImageFormat diff --git a/src/Main/Mode/Intruder.hs b/src/Main/Mode/Intruder.hs --- a/src/Main/Mode/Intruder.hs +++ b/src/Main/Mode/Intruder.hs @@ -18,11 +18,11 @@ import System.FilePath import Theory +import Theory.Text.Parser (intruderVariantsFile) import Theory.Tools.IntruderRules import Main.Console import Main.Environment -import Main.TheoryLoader (intruderVariantsFile) import Main.Utils diff --git a/src/Main/Mode/Test.hs b/src/Main/Mode/Test.hs --- a/src/Main/Mode/Test.hs +++ b/src/Main/Mode/Test.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} -- | -- Copyright : (c) 2010, 2011 Benedikt Schmidt & Simon Meier -- License : GPL v3 (see LICENSE) @@ -13,12 +14,16 @@ import System.Console.CmdArgs.Explicit as CmdArgs import System.Exit -import Test.HUnit (Counts(..)) +import Test.HUnit (Counts(..), Test(..), runTestTT) +import Paths_tamarin_prover (getDataFileName) + import Main.Console import Main.Environment -import qualified Term.UnitTests as TestTerm (main) +import qualified Term.UnitTests as Term (tests) +import Theory +import qualified Theory.Text.Parser.UnitTests as Parser -- | Self-test mode. @@ -50,14 +55,41 @@ #else let successGraphVizDot = True #endif + -------------------------------------------------------------------------- + nextTopic "Testing the parser on our examples" + examplePath <- getDataFileName "examples" + let mkParseTest = Parser.testParseFile Nothing + parseTests <- Parser.testParseDirectory mkParseTest 2 examplePath + successParser <- runUnitTest $ TestList parseTests + + -------------------------------------------------------------------------- + nextTopic "Testing the prover on some of our examples" + + let heuristic = roundRobinHeuristic [SmartRanking False] + autoProver = AutoProver heuristic Nothing CutDFS + prover = Just ( maudePath as + , replaceSorryProver $ runAutoProver autoProver + ) + mkProverTest file = do + fullFile <- getDataFileName file + return $ Parser.testParseFile prover fullFile + + nslEx <- mkProverTest "examples/classic/NSLPK3.spthy" + loopEx <- mkProverTest "examples/loops/Minimal_Loop_Example.spthy" + diffieEx <- mkProverTest "examples/csf12/JKL_TS1_2008_KI.spthy" + + successProver <- runUnitTest $ TestList [ nslEx, loopEx, diffieEx ] + + -------------------------------------------------------------------------- nextTopic "Testing the unification infrastructure" - Counts _ _ termErrs termFails <- TestTerm.main (maudePath as) - let successTerm = termErrs == 0 && termFails == 0 - success = and [successMaude, successGraphVizDot, successTerm] + successTerm <- runUnitTest =<< Term.tests (maudePath as) + -------------------------------------------------------------------------- -- FIXME: Implement regression testing. -- nextTopic "TEST SUMMARY" + let success = and [ successMaude, successGraphVizDot + , successTerm, successParser, successProver ] if success then do putStrLn $ "All tests successful." putStrLn $ "The " ++ programName ++ " should work as intended." @@ -68,3 +100,8 @@ exitFailure where nextTopic msg = putStrLn $ "\n*** " ++ msg ++ " ***" + + runUnitTest test = do + Counts _ _ termErrs termFails <- runTestTT test + let success = termErrs == 0 && termFails == 0 + return success diff --git a/src/Main/TheoryLoader.hs b/src/Main/TheoryLoader.hs --- a/src/Main/TheoryLoader.hs +++ b/src/Main/TheoryLoader.hs @@ -9,8 +9,7 @@ -- Theory loading infrastructure. module Main.TheoryLoader ( -- * Static theory loading settings - intruderVariantsFile - , theoryLoadFlags + theoryLoadFlags -- ** Loading open theories , loadOpenThy @@ -30,7 +29,6 @@ import Prelude hiding (id, (.)) import Data.Char (toLower) -import Data.Label import Data.Monoid import Control.Basics @@ -38,32 +36,22 @@ import Control.DeepSeq (rnf) import System.Console.CmdArgs.Explicit -import System.Directory -import Extension.Prelude - import Theory import Theory.Text.Parser import Theory.Text.Pretty import Theory.Tools.AbstractInterpretation (EvaluationStyle(..)) -import Theory.Tools.IntruderRules import Theory.Tools.Wellformedness import Main.Console import Main.Environment -import Paths_tamarin_prover (getDataFileName) - ------------------------------------------------------------------------------ -- Theory loading: shared between interactive and batch mode ------------------------------------------------------------------------------ --- | The name of the intruder variants file. -intruderVariantsFile :: FilePath -intruderVariantsFile = "intruder_variants_dh.spthy" - -- | Flags for loading a theory. theoryLoadFlags :: [Flag Arguments] theoryLoadFlags = @@ -102,8 +90,16 @@ case checkWellformedness thy of [] -> close thy report -> do - putStrLn $ "WARNING: ignoring the following errors" + putStrLn "" + putStrLn $ replicate 78 '-' + putStrLn $ "Theory file '" ++ file ++ "'" + putStrLn $ replicate 78 '-' + putStrLn "" + putStrLn $ "WARNING: ignoring the following wellformedness errors" + putStrLn "" putStrLn $ renderDoc $ prettyWfErrorReport report + putStrLn $ replicate 78 '-' + putStrLn "" close thy -- report -> error $ renderDoc $ prettyWfErrorReport report where @@ -134,23 +130,7 @@ -> Arguments -> (a -> IO OpenTheory, OpenTheory -> IO ClosedTheory) loadGenericThy loader as = - (loader, (closeThy as) <=< tryAddIntrVariants) - where - -- intruder variants - -------------------- - tryAddIntrVariants :: OpenTheory -> IO OpenTheory - tryAddIntrVariants thy0 = do - let msig = get (sigpMaudeSig . thySignature) thy0 - thy = addIntrRuleACs (subtermIntruderRules msig ++ specialIntruderRules) thy0 - if (enableDH msig) then - do variantsFile <- getDataFileName intruderVariantsFile - ifM (doesFileExist variantsFile) - (do intrVariants <- parseIntruderRulesDH variantsFile - return $ addIntrRuleACs intrVariants thy - ) - (error $ "could not find intruder message deduction theory '" - ++ variantsFile ++ "'") - else return thy + (loader, (closeThy as) <=< addMessageDeductionRuleVariants) -- | Close a theory according to arguments. closeThy :: Arguments -> OpenTheory -> IO ClosedTheory @@ -176,8 +156,10 @@ noteWellformedness (checkWellformedness thy) thy + -- replace all annotated sorrys with the configured autoprover. prover :: Prover - prover | argExists "addProofs" as = runAutoProver $ constructAutoProver as + prover | argExists "addProofs" as = + replaceSorryProver $ runAutoProver $ constructAutoProver as | otherwise = mempty -- | Construct an 'AutoProver' from the given arguments (--bound, diff --git a/src/Theory.hs b/src/Theory.hs --- a/src/Theory.hs +++ b/src/Theory.hs @@ -1,5 +1,9 @@ -{-# LANGUAGE TemplateHaskell, TupleSections, DeriveFunctor #-} -{-# LANGUAGE StandaloneDeriving, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeSynonymInstances #-} -- | -- Copyright : (c) 2010-2012 Benedikt Schmidt & Simon Meier -- License : GPL v3 (see LICENSE) @@ -9,14 +13,18 @@ -- -- Theory datatype and transformations on it. module Theory ( + -- * Axioms + Axiom(..) + , axName + , axFormula + -- * Lemmas - LemmaAttribute(..) + , LemmaAttribute(..) , TraceQuantifier(..) , Lemma , lName , lTraceQuantifier - , lFormulaE - , lFormulaAC + , lFormula , lAttributes , lProof , unprovenLemma @@ -30,6 +38,8 @@ , thyCache , thyItems , theoryRules + , theoryAxioms + , addAxiom , addLemma , removeLemma , lookupLemma @@ -42,8 +52,9 @@ , OpenTheory , defaultOpenTheory , addProtoRule - , addIntrRuleACs , applyPartialEvaluation + , addIntrRuleACs + , normalizeTheory -- ** Closed theories , ClosedTheory @@ -58,6 +69,7 @@ , getProtoRuleEs , getProofContext , getClassifiedRules + , getInjectiveFactInsts , getCaseDistinction @@ -72,6 +84,7 @@ -- * Pretty printing , prettyFormalComment , prettyLemmaName + , prettyAxiom , prettyLemma , prettyClosedTheory , prettyOpenTheory @@ -87,7 +100,7 @@ ) where -import Prelude hiding ( (.), id ) +import Prelude hiding (id, (.)) import Data.Binary import Data.DeriveTH @@ -112,11 +125,10 @@ import Theory.Proof import Theory.Text.Pretty import Theory.Tools.AbstractInterpretation +import Theory.Tools.InjectiveFactInstances import Theory.Tools.LoopBreakers import Theory.Tools.RuleVariants -import Theory.Tools.UniqueFactInstances - ------------------------------------------------------------------------------ -- Specific proof types ------------------------------------------------------------------------------ @@ -157,7 +169,7 @@ { _crcRules :: ClassifiedRules , _crcUntypedCaseDists :: [CaseDistinction] , _crcTypedCaseDists :: [CaseDistinction] - , _crcUniqueFactInsts :: S.Set FactTag + , _crcInjectiveFactInsts :: S.Set FactTag } deriving( Eq, Ord, Show ) @@ -192,27 +204,27 @@ -- | Close a rule cache. Hower, note that the -- requires case distinctions are not computed here. -closeRuleCache :: [FormulaAC] -- ^ Typing lemmas. +closeRuleCache :: [LNFormula] -- ^ Axioms to use. + -> [LNFormula] -- ^ Typing lemmas to use. -> SignatureWithMaude -- ^ Signature of theory. -> [ClosedProtoRule] -- ^ Protocol rules with variants. -> OpenRuleCache -- ^ Intruder rules modulo AC. -> ClosedRuleCache -- ^ Cached rules and case distinctions. -closeRuleCache typingAsms sig protoRules intrRulesAC = +closeRuleCache axioms typAsms sig protoRules intrRulesAC = ClosedRuleCache - classifiedRules untypedCaseDists typedCaseDists uniqueFactInsts + classifiedRules untypedCaseDists typedCaseDists injFactInstances where ctxt0 = ProofContext - sig classifiedRules uniqueFactInsts UntypedCaseDist [] AvoidInduction + sig classifiedRules injFactInstances UntypedCaseDist [] AvoidInduction (error "closeRuleCache: trace quantifier should not matter here") - -- unique fact instances - uniqueFactInsts = - simpleUniqueFactInstances $ L.get cprRuleE <$> protoRules + -- inj fact instances + injFactInstances = + simpleInjectiveFactInstances $ L.get cprRuleE <$> protoRules -- precomputing the case distinctions - untypedCaseDists = precomputeCaseDistinctions ctxt0 [] - typedCaseDists = - refineWithTypingAsms typingAsms ctxt0 untypedCaseDists + untypedCaseDists = precomputeCaseDistinctions ctxt0 axioms + typedCaseDists = refineWithTypingAsms typAsms ctxt0 untypedCaseDists -- classifying the rules rulesAC = (fmap IntrInfo <$> intrRulesAC) <|> @@ -231,7 +243,21 @@ } +------------------------------------------------------------------------------ +-- Axioms (Trace filters) +------------------------------------------------------------------------------ +-- | An axiom describes a property that must hold for all traces. Axioms are +-- always used as lemmas in proofs. +data Axiom = Axiom + { _axName :: String + , _axFormula :: LNFormula + } + deriving( Eq, Ord, Show ) + +$(mkLabels [''Axiom]) + + ------------------------------------------------------------------------------ -- Lemmas ------------------------------------------------------------------------------ @@ -252,8 +278,7 @@ data Lemma p = Lemma { _lName :: String , _lTraceQuantifier :: TraceQuantifier - , _lFormulaE :: FormulaE - , _lFormulaAC :: Maybe FormulaAC + , _lFormula :: LNFormula , _lAttributes :: [LemmaAttribute] , _lProof :: p } @@ -266,13 +291,13 @@ ------------ instance Functor Lemma where - fmap f (Lemma n qua fE fAC atts prf) = Lemma n qua fE fAC atts (f prf) + fmap f (Lemma n qua fm atts prf) = Lemma n qua fm atts (f prf) instance Foldable Lemma where foldMap f = f . L.get lProof instance Traversable Lemma where - traverse f (Lemma n qua fE fAC atts prf) = Lemma n qua fE fAC atts <$> f prf + traverse f (Lemma n qua fm atts prf) = Lemma n qua fm atts <$> f prf -- Lemma queries @@ -294,13 +319,13 @@ ---------------------------------- -- | Create a new unproven lemma from a formula modulo E. -unprovenLemma :: String -> [LemmaAttribute] -> TraceQuantifier -> FormulaE +unprovenLemma :: String -> [LemmaAttribute] -> TraceQuantifier -> LNFormula -> Lemma ProofSkeleton -unprovenLemma name atts qua fmE = Lemma name qua fmE Nothing atts (unproven ()) +unprovenLemma name atts qua fm = Lemma name qua fm atts (unproven ()) -skeletonLemma :: String -> [LemmaAttribute] -> TraceQuantifier -> FormulaE +skeletonLemma :: String -> [LemmaAttribute] -> TraceQuantifier -> LNFormula -> ProofSkeleton -> Lemma ProofSkeleton -skeletonLemma name atts qua fmE = Lemma name qua fmE Nothing atts +skeletonLemma name atts qua fm = Lemma name qua fm atts -- | The case-distinction kind allowed for a lemma lemmaCaseDistKind :: Lemma p -> CaseDistKind @@ -320,6 +345,7 @@ data TheoryItem r p = RuleItem r | LemmaItem (Lemma p) + | AxiomItem Axiom | TextItem FormalComment deriving( Show, Eq, Ord, Functor ) @@ -332,6 +358,7 @@ , _thyCache :: c , _thyItems :: [TheoryItem r p] } + deriving( Eq, Ord, Show ) $(mkLabels [''Theory]) @@ -340,7 +367,6 @@ type OpenTheory = Theory SignaturePure [IntrRuleAC] OpenProtoRule ProofSkeleton -deriving instance Show OpenTheory -- | Closed theories can be proven. Invariants: -- 1. Lemma names are unique @@ -350,32 +376,47 @@ type ClosedTheory = Theory SignatureWithMaude ClosedRuleCache ClosedProtoRule IncrementalProof -deriving instance Show ClosedTheory -- Shared theory modification functions --------------------------------------- -- | Fold a theory item. -foldTheoryItem :: (r -> a) -> (Lemma p -> a) -> (FormalComment -> a) - -> TheoryItem r p -> a -foldTheoryItem fRule fLemma fText i = case i of - RuleItem r -> fRule r - LemmaItem l -> fLemma l - TextItem t -> fText t +foldTheoryItem + :: (r -> a) -> (Axiom -> a) -> (Lemma p -> a) -> (FormalComment -> a) + -> TheoryItem r p -> a +foldTheoryItem fRule fAxiom fLemma fText i = case i of + RuleItem ru -> fRule ru + LemmaItem lem -> fLemma lem + TextItem txt -> fText txt + AxiomItem ax -> fAxiom ax -- | Map a theory item. mapTheoryItem :: (r -> r') -> (p -> p') -> TheoryItem r p -> TheoryItem r' p' -mapTheoryItem f g = foldTheoryItem (RuleItem . f) (LemmaItem . fmap g) TextItem +mapTheoryItem f g = + foldTheoryItem (RuleItem . f) AxiomItem (LemmaItem . fmap g) TextItem -- | All rules of a theory. theoryRules :: Theory sig c r p -> [r] -theoryRules = foldTheoryItem return (const []) (const []) <=< L.get thyItems +theoryRules = + foldTheoryItem return (const []) (const []) (const []) <=< L.get thyItems +-- | All axioms of a theory. +theoryAxioms :: Theory sig c r p -> [Axiom] +theoryAxioms = + foldTheoryItem (const []) return (const []) (const []) <=< L.get thyItems + -- | All lemmas of a theory. theoryLemmas :: Theory sig c r p -> [Lemma p] -theoryLemmas = foldTheoryItem (const []) return (const []) <=< L.get thyItems +theoryLemmas = + foldTheoryItem (const []) (const []) return (const []) <=< L.get thyItems +-- | Add a new axiom. Fails, if axiom with the same name exists. +addAxiom :: Axiom -> Theory sig c r p -> Maybe (Theory sig c r p) +addAxiom l thy = do + guard (isNothing $ lookupAxiom (L.get axName l) thy) + return $ modify thyItems (++ [AxiomItem l]) thy + -- | Add a new lemma. Fails, if a lemma with the same name exists. addLemma :: Lemma p -> Theory sig c r p -> Maybe (Theory sig c r p) addLemma l thy = do @@ -388,9 +429,16 @@ _ <- lookupLemma lemmaName thy return $ modify thyItems (concatMap fItem) thy where - fItem = foldTheoryItem (return . RuleItem) check (return . TextItem) + fItem = foldTheoryItem (return . RuleItem) + (return . AxiomItem) + check + (return . TextItem) check l = do guard (L.get lName l /= lemmaName); return (LemmaItem l) +-- | Find the axiom with the given name. +lookupAxiom :: String -> Theory sig c r p -> Maybe Axiom +lookupAxiom name = find ((name ==) . L.get axName) . theoryAxioms + -- | Find the lemma with the given name. lookupLemma :: String -> Theory sig c r p -> Maybe (Lemma p) lookupLemma name = find ((name ==) . L.get lName) . theoryLemmas @@ -439,7 +487,31 @@ addIntrRuleACs :: [IntrRuleAC] -> OpenTheory -> OpenTheory addIntrRuleACs rs' = modify (thyCache) (\rs -> nub $ rs ++ rs') +-- | Normalize the theory representation such that they remain semantically +-- equivalent. Use this function when you want to compare two theories (quite +-- strictly) for semantic equality; e.g., when testing the parser. +normalizeTheory :: OpenTheory -> OpenTheory +normalizeTheory = + L.modify thyCache sort + . L.modify thyItems (\items -> do + item <- items + return $ case item of + LemmaItem lem -> + LemmaItem $ L.modify lProof stripProofAnnotations $ lem + RuleItem _ -> item + TextItem _ -> item + AxiomItem _ -> item) + where + stripProofAnnotations :: ProofSkeleton -> ProofSkeleton + stripProofAnnotations = fmap stripProofStepAnnotations + stripProofStepAnnotations (ProofStep method ()) = + ProofStep (case method of + Sorry _ -> Sorry Nothing + Contradiction _ -> Contradiction Nothing + _ -> method) + () + ------------------------------------------------------------------------------ -- Closed theory querying / construction / modification ------------------------------------------------------------------------------ @@ -464,7 +536,7 @@ getProofContext l thy = ProofContext ( L.get thySignature thy) ( L.get (crcRules . thyCache) thy) - ( L.get (crcUniqueFactInsts . thyCache) thy) + ( L.get (crcInjectiveFactInsts . thyCache) thy) kind ( L.get (cases . thyCache) thy) inductionHint @@ -477,6 +549,10 @@ | any (`elem` [TypingLemma, InvariantLemma]) (L.get lAttributes l) = UseInduction | otherwise = AvoidInduction +-- | The facts with injective instances in this theory +getInjectiveFactInsts :: ClosedTheory -> S.Set FactTag +getInjectiveFactInsts = L.get (crcInjectiveFactInsts . thyCache) + -- | The classified set of rules modulo AC in this theory. getClassifiedRules :: ClosedTheory -> ClassifiedRules getClassifiedRules = L.get (crcRules . thyCache) @@ -494,9 +570,8 @@ -- lemmaToGuarded :: Lemma p -> Maybe LNGuarded -- lemmaToGuarded lem = --- | Close a theory by closing its associated rule set and converting the proof --- skeletons to unannotated incremental proofs and caching AC variants as well --- as precomputed case distinctions. +-- | Close a theory by closing its associated rule set and checking the proof +-- skeletons and caching AC variants as well as precomputed case distinctions. -- -- This function initializes the relation to the Maude process with the -- correct signature. This is the right place to do that because in a closed @@ -512,27 +587,31 @@ -- the given theory. closeTheoryWithMaude :: SignatureWithMaude -> OpenTheory -> ClosedTheory closeTheoryWithMaude sig thy0 = do - proveTheory addSorrys $ Theory (L.get thyName thy0) sig cache items + proveTheory checkProof $ Theory (L.get thyName thy0) sig cache items where - cache = closeRuleCache typAsms sig rules $ L.get thyCache thy0 - addSorrys = checkAndExtendProver (sorryProver "not yet proven") + cache = closeRuleCache axioms typAsms sig rules (L.get thyCache thy0) + checkProof = checkAndExtendProver (sorryProver Nothing) -- Maude / Signature handle hnd = L.get sigmMaudeHandle sig - -- close all theory items: in parallel + -- Close all theory items: in parallel (especially useful for variants) + -- + -- NOTE that 'rdeepseq' is OK here, as the proof has not yet been checked + -- and therefore no constraint systems will be unnecessarily cached. (items, _solveRel, _breakers) = (`runReader` hnd) $ addSolvingLoopBreakers ((closeTheoryItem <$> L.get thyItems thy0) `using` parList rdeepseq) closeTheoryItem = foldTheoryItem (RuleItem . closeProtoRule hnd) - (LemmaItem . ensureFormulaAC . fmap skeletonToIncrementalProof) + AxiomItem + (LemmaItem . fmap skeletonToIncrementalProof) TextItem - -- extract typing lemmas - typAsms = do - LemmaItem lem <- items - guard (isTypingLemma lem) - maybe [] return $ L.get lFormulaAC lem + -- extract typing axioms and lemmas + axioms = [ L.get axFormula ax | AxiomItem ax <- items ] + typAsms = do LemmaItem lem <- items + guard (isTypingLemma lem) + return $ L.get lFormula lem -- extract protocol rules rules = theoryRules (Theory errClose errClose errClose items) @@ -602,44 +681,31 @@ return l _ -> do return item - proveLemma l0 preItems = - modify lProof add l + proveLemma lem preItems = + modify lProof add lem where - l = ensureFormulaAC l0 - ctxt = getProofContext l thy - sys = mkSystem ctxt preItems $ fromJust $ L.get lFormulaAC l + ctxt = getProofContext lem thy + sys = mkSystem ctxt (theoryAxioms thy) preItems $ L.get lFormula lem add prf = fromMaybe prf $ runProver prover ctxt 0 sys prf -- | Construct a constraint system for verifying the given formula. -mkSystem :: ProofContext -> [TheoryItem r p] -> FormulaAC -> System -mkSystem ctxt lems = - addLemmasToSystem lems +mkSystem :: ProofContext -> [Axiom] -> [TheoryItem r p] -> LNFormula -> System +mkSystem ctxt axioms preItems = + addAxiomsAndLemmasToSystem . formulaToSystem (L.get pcCaseDistKind ctxt) (L.get pcTraceQuantifier ctxt) - --- | Add the lemmas that have an associated AC variant to this sequent. -addLemmasToSystem :: [TheoryItem r p] -> System -> System -addLemmasToSystem items sys = - foldl' (flip insertLemma) sys $ - gatherReusableLemmas (L.get sCaseDistKind sys) items - --- | Gather reusable lemmas to be added to a sequent. -gatherReusableLemmas :: CaseDistKind -> [TheoryItem r p] -> [LNFormula] -gatherReusableLemmas kind items = do - LemmaItem lem <- items - guard $ lemmaCaseDistKind lem <= kind && - ReuseLemma `elem` L.get lAttributes lem - maybe [] return $ L.get lFormulaAC lem - --- | Ensure that the AC variant of a formula is present. -ensureFormulaAC :: Lemma p -> Lemma p -ensureFormulaAC l = - set lFormulaAC (Just fmAC) l where - -- FIXME: AC-variant of formula is formula itself. - -- This must be ensured by well-formed check (not implemented yet). - fmAC = fromMaybe (L.get lFormulaE l) $ L.get lFormulaAC l + addAxiomsAndLemmasToSystem sys = + (`insertLemmas` sys) $ + map (L.get axFormula) axioms ++ + gatherReusableLemmas (L.get sCaseDistKind sys) + gatherReusableLemmas kind = do + LemmaItem lem <- preItems + guard $ lemmaCaseDistKind lem <= kind && + ReuseLemma `elem` L.get lAttributes lem + return $ L.get lFormula lem + ------------------------------------------------------------------------------ -- References to lemmas ------------------------------------------------------------------------------ @@ -660,12 +726,11 @@ findLemma (LemmaItem lem) = name == L.get lName lem findLemma _ = False - change preItems (LemmaItem l0) = do - let l1 = ensureFormulaAC l0 - ctxt = getProofContext l1 thy - sys <- mkSystem ctxt preItems <$> L.get lFormulaAC l1 - l2 <- modA lProof (runProver prover ctxt 0 sys) l1 - return $ LemmaItem l2 + change preItems (LemmaItem lem) = do + let ctxt = getProofContext lem thy + sys = mkSystem ctxt (theoryAxioms thy) preItems $ L.get lFormula lem + lem' <- modA lProof (runProver prover ctxt 0 sys) lem + return $ LemmaItem lem' change _ _ = error "LemmaProof: change: impossible" changeItems items = case break findLemma items of @@ -689,7 +754,7 @@ => (sig -> d) -> (c -> d) -> (r -> d) -> (p -> d) -> Theory sig c r p -> d prettyTheory ppSig ppCache ppRule ppPrf thy = vsep $ - [ kwTheoryHeader $ L.get thyName thy + [ kwTheoryHeader $ text $ L.get thyName thy , lineComment_ "Function signature and definition of the equational theory E" , ppSig $ L.get thySignature thy , ppCache $ L.get thyCache thy @@ -698,7 +763,7 @@ [ kwEnd ] where ppItem = foldTheoryItem - ppRule (prettyLemma ppPrf) (\(h,c) -> prettyFormalComment h c) + ppRule prettyAxiom (prettyLemma ppPrf) (uncurry prettyFormalComment) -- | Pretty print the lemma name together with its attributes. prettyLemmaName :: HighlightDocument d => Lemma p -> d @@ -711,35 +776,31 @@ prettyLemmaAttribute ReuseLemma = text "reuse" prettyLemmaAttribute InvariantLemma = text "use_induction" +-- | Pretty print an axiom. +prettyAxiom :: HighlightDocument d => Axiom -> d +prettyAxiom ax = + kwAxiom <-> text (L.get axName ax) <> colon $-$ + (nest 2 $ doubleQuotes $ prettyLNFormula $ L.get axFormula ax) + -- | Pretty print a lemma. prettyLemma :: HighlightDocument d => (p -> d) -> Lemma p -> d -prettyLemma ppPrf l = - kwLemmaModulo "E" <-> prettyLemmaName l <> colon $-$ +prettyLemma ppPrf lem = + kwLemma <-> prettyLemmaName lem <> colon $-$ (nest 2 $ - sep [ prettyTraceQuantifier $ L.get lTraceQuantifier l - , doubleQuotes $ prettyFormulaE $ L.get lFormulaE l + sep [ prettyTraceQuantifier $ L.get lTraceQuantifier lem + , doubleQuotes $ prettyLNFormula $ L.get lFormula lem ] ) $-$ - maybe emptyDoc ppFormulaAC (L.get lFormulaAC l) - $-$ - maybe emptyDoc ppFormulaACGuarded (L.get lFormulaAC l) - -- $-$ - -- maybe emptyDoc ppFormulaACInduction (L.get lFormulaAC l) + ppLNFormulaGuarded (L.get lFormula lem) $-$ - ppPrf (L.get lProof l) + ppPrf (L.get lProof lem) where - ppFormulaAC fmAC - | fmAC == L.get lFormulaE l = multiComment_ ["proof based on the same lemma modulo AC"] - | otherwise = - multiComment - ( text "proof based on the following equivalent lemma modulo AC:" $-$ - doubleQuotes (prettyFormulaAC fmAC) ) - - ppFormulaACGuarded fmAC = case formulaToGuarded fmAC of - Left err -> multiComment_ - ["conversion to doubly-guarded formula failed:", err] - Right gf -> case toSystemTraceQuantifier $ L.get lTraceQuantifier l of + ppLNFormulaGuarded fm = case formulaToGuarded fm of + Left err -> multiComment $ + text "conversion to guarded formula failed:" $$ + nest 2 err + Right gf -> case toSystemTraceQuantifier $ L.get lTraceQuantifier lem of ExistsNoTrace -> multiComment ( text "guarded formula characterizing all counter-examples:" $-$ doubleQuotes (prettyGuarded (gnot gf)) ) @@ -747,16 +808,6 @@ ( text "guarded formula characterizing all satisfying traces:" $-$ doubleQuotes (prettyGuarded gf) ) - {- - ppFormulaACInduction fmAC = case fmInd of - Left err -> multiComment_ - ["formula cannot be proven by induction:", err] - Right gf -> multiComment - ( text "proof by induction possible over the formula:" $-$ - doubleQuotes (prettyGuarded gf) ) - where - fmInd = applyInduction =<< fromFormulaNegate fmAC - -} -- | Pretty-print a non-empty bunch of intruder rules. prettyIntruderVariants :: HighlightDocument d => [IntrRuleAC] -> d @@ -777,11 +828,13 @@ prettyIncrementalProof :: HighlightDocument d => IncrementalProof -> d prettyIncrementalProof = prettyProofWith ppStep (const id) where - ppStep step = - (if isNothing (psInfo step) then text "!" else emptyDoc) <-> - prettyProofMethod (psMethod step) + ppStep step = sep + [ prettyProofMethod (psMethod step) + , if isNothing (psInfo step) then multiComment_ ["unannotated"] + else emptyDoc + ] --- | Pretty print an closed rule together with its assertion soundness proof. +-- | Pretty print an closed rule. prettyClosedProtoRule :: HighlightDocument d => ClosedProtoRule -> d prettyClosedProtoRule cru = (prettyProtoRuleE ruE) $--$ @@ -804,17 +857,18 @@ prettyClosedTheory :: HighlightDocument d => ClosedTheory -> d prettyClosedTheory thy = prettyTheory prettySignatureWithMaude - ppUniqueFactInsts + ppInjectiveFactInsts -- (prettyIntrVariantsSection . intruderRules . L.get crcRules) prettyClosedProtoRule prettyIncrementalProof thy where - ppUniqueFactInsts crc = case S.toList $ L.get crcUniqueFactInsts crc of - [] -> emptyDoc - tags -> lineComment $ sep - [ text "looping facts with unique instances:" - , nest 2 $ fsepList (text . showFactTagArity) tags ] + ppInjectiveFactInsts crc = + case S.toList $ L.get crcInjectiveFactInsts crc of + [] -> emptyDoc + tags -> lineComment $ sep + [ text "looping facts with injective instances:" + , nest 2 $ fsepList (text . showFactTagArity) tags ] prettyClosedSummary :: Document d => ClosedTheory -> d prettyClosedSummary thy = @@ -822,6 +876,21 @@ where lemmaSummaries = do LemmaItem lem <- L.get thyItems thy + -- Note that here we are relying on the invariant that all proof steps + -- with a 'Just' annotation follow from the application of + -- 'execProofMethod' to their parent and are valid in the sense that + -- the application of 'execProofMethod' to their method and constraint + -- system is guaranteed to succeed. + -- + -- This is guaranteed initially by 'closeTheory' and is (must be) + -- maintained by the provers being applied to the theory using + -- 'modifyLemmaProof' or 'proveTheory'. Note that we could check the + -- proof right before computing its status. This is however quite + -- expensive, as it requires recomputing all intermediate constraint + -- systems. + -- + -- TODO: The whole consruction seems a bit hacky. Think of a more + -- principled constrution with better correctness guarantees. let (status, Sum siz) = foldProof proofStepSummary $ L.get lProof lem quantifier = (toSystemTraceQuantifier $ L.get lTraceQuantifier lem) analysisType = parens $ prettyTraceQuantifier $ L.get lTraceQuantifier lem @@ -844,6 +913,7 @@ $( derive makeBinary ''TheoryItem) $( derive makeBinary ''LemmaAttribute) $( derive makeBinary ''TraceQuantifier) +$( derive makeBinary ''Axiom) $( derive makeBinary ''Lemma) $( derive makeBinary ''ClosedProtoRule) $( derive makeBinary ''ClosedRuleCache) @@ -852,6 +922,7 @@ $( derive makeNFData ''TheoryItem) $( derive makeNFData ''LemmaAttribute) $( derive makeNFData ''TraceQuantifier) +$( derive makeNFData ''Axiom) $( derive makeNFData ''Lemma) $( derive makeNFData ''ClosedProtoRule) $( derive makeNFData ''ClosedRuleCache) diff --git a/src/Theory/Constraint/Solver.hs b/src/Theory/Constraint/Solver.hs --- a/src/Theory/Constraint/Solver.hs +++ b/src/Theory/Constraint/Solver.hs @@ -27,6 +27,7 @@ , pcUseInduction , pcCaseDistKind , pcTraceQuantifier + , pcInjectiveFactInsts , InductionHint(..) diff --git a/src/Theory/Constraint/Solver/CaseDistinctions.hs b/src/Theory/Constraint/Solver/CaseDistinctions.hs --- a/src/Theory/Constraint/Solver/CaseDistinctions.hs +++ b/src/Theory/Constraint/Solver/CaseDistinctions.hs @@ -67,19 +67,18 @@ -- given typing assumptions are justified. initialCaseDistinction :: ProofContext - -> [LNGuarded] -- ^ Typing assumptions. PRE: Must be closed formulas! + -> [LNFormula] -- ^ Axioms. -> Goal -> CaseDistinction -initialCaseDistinction ctxt typAsms goal = +initialCaseDistinction ctxt axioms goal = CaseDistinction goal cases where polish ((name, se), _) = ([name], se) - se0 = emptySystem UntypedCaseDist - cases = - fmap polish $ runReduction instantiate ctxt se0 (avoid (goal, typAsms)) + se0 = insertLemmas axioms $ emptySystem UntypedCaseDist + cases = fmap polish $ + runReduction instantiate ctxt se0 (avoid (goal, se0)) instantiate = do insertGoal goal False - mapM_ insertFormula typAsms solveGoal goal -- | Refine a source case distinction by applying the additional proof step. @@ -241,9 +240,9 @@ -- | Precompute a saturated set of case distinctions. precomputeCaseDistinctions :: ProofContext - -> [LNGuarded] -- ^ Typing assumptions. + -> [LNFormula] -- ^ Axioms. -> [CaseDistinction] -precomputeCaseDistinctions ctxt typAsms = +precomputeCaseDistinctions ctxt axioms = map cleanupCaseNames $ saturateCaseDistinctions ctxt rawCaseDists where cleanupCaseNames = modify cdCases $ fmap $ first $ @@ -251,7 +250,7 @@ . map (filter (`elem` '_' : ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'])) rawCaseDists = - initialCaseDistinction ctxt typAsms <$> (protoGoals ++ msgGoals) + initialCaseDistinction ctxt axioms <$> (protoGoals ++ msgGoals) -- construct case distinction starting from facts from non-special rules protoGoals = someProtoGoal <$> absProtoFacts @@ -270,8 +269,7 @@ PremiseG (someNodeId, PremIdx 0) (Fact tag (nMsgVars arity)) someKUGoal :: LNTerm -> Goal - someKUGoal m = - ActionG someNodeId (Fact KUFact [varTerm (LVar "f_" LSortMsg 0), m]) + someKUGoal m = ActionG someNodeId (kuFact m) someNodeId = LVar "i" LSortNode 0 @@ -296,20 +294,21 @@ -- | Refine a set of case distinction by exploiting additional typing -- assumptions. refineWithTypingAsms - :: [FormulaAC] -- ^ Typing assumptions to use. + :: [LNFormula] -- ^ Typing assumptions to use. -> ProofContext -- ^ Proof context to use. -> [CaseDistinction] -- ^ Original, untyped case distinctions. -> [CaseDistinction] -- ^ Refined, typed case distinctions. -refineWithTypingAsms typAsms0 ctxt cases0 = +refineWithTypingAsms assumptions0 ctxt cases0 = fmap (modifySystems removeFormulas) $ saturateCaseDistinctions ctxt $ modifySystems updateSystem <$> cases0 where - typAsms = map (either error id . formulaToGuarded) typAsms0 - modifySystems = modify cdCases . fmap . second + assumptions = + map (either (error . render) id . formulaToGuarded) assumptions0 + modifySystems = modify cdCases . fmap . second updateSystem se = - modify sFormulas (S.union (S.fromList typAsms)) $ - set sCaseDistKind TypedCaseDist $ se + modify sFormulas (S.union (S.fromList assumptions)) $ + set sCaseDistKind TypedCaseDist $ se removeFormulas = modify sGoals (M.filterWithKey isNoDisjGoal) . set sFormulas S.empty diff --git a/src/Theory/Constraint/Solver/Contradictions.hs b/src/Theory/Constraint/Solver/Contradictions.hs --- a/src/Theory/Constraint/Solver/Contradictions.hs +++ b/src/Theory/Constraint/Solver/Contradictions.hs @@ -31,8 +31,10 @@ import qualified Data.Foldable as F import Data.List import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Data.Monoid import qualified Data.Set as S +import Safe (headMay) import Control.Basics import Control.Category @@ -60,7 +62,7 @@ | NonNormalTerms -- ^ Has terms that are not in normal form. -- | NonLastNode -- ^ Has a non-silent node after the last node. | ForbiddenExp -- ^ Forbidden Exp-down rule instance - | NonUniqueFactInstance (NodeId, NodeId, NodeId) + | NonInjectiveFactInstance (NodeId, NodeId, NodeId) -- ^ Contradicts that certain facts have unique instances. | IncompatibleEqs -- ^ Incompatible equalities. | FormulasFalse -- ^ False in formulas @@ -95,7 +97,7 @@ -- require a unique fact to be present in the system state more than once. -- Unique facts are declared as part of the specification of the rule -- system. - (NonUniqueFactInstance <$> nonUniqueFactInstances ctxt sys) + (NonInjectiveFactInstance <$> nonInjectiveFactInstances ctxt sys) ++ -- TODO: Document corresponding constratint reduction rule. (NodeAfterLast <$> nodesAfterLast sys) @@ -142,43 +144,58 @@ -- [Fact KDFact [expTagToTerm IsExp, Exp p1 x2]] []) -- > True isForbiddenExp :: Rule a -> Bool -isForbiddenExp ru = maybe False id $ do - [_,p2] <- return $ L.get rPrems ru - [conc] <- return $ L.get rConcs ru - (UpK, _, b) <- kFactView p2 - (DnK, Just CannotExp, viewTerm2 -> FExp g c) <- kFactView conc +isForbiddenExp ru = fromMaybe False $ do + [p1,p2] <- return $ L.get rPrems ru + [conc] <- return $ L.get rConcs ru + (DnK, viewTerm2 -> FExp _ _) <- kFactView p1 + (UpK, b ) <- kFactView p2 + (DnK, viewTerm2 -> FExp g c) <- kFactView conc - -- g should be public and the required inputs for c already required by b - guard (sortOfLNTerm g == LSortPub && (inputTerms c \\ inputTerms b == [])) - return True - -- FIXME: change according to: guard p >> return True = return p + -- For a forbidden exp the following conditions must hold: g must be of + -- sort 'pub' and the required inputs for c are already required by b + return $ sortOfLNTerm g == LSortPub + && (inputTerms c \\ inputTerms b == []) --- | Compute all contradictions to unique fact instances. +-- | Compute all contradictions to injective fact instances. -- --- Constraint systems are contradictory, where 'f' is a fact symbol --- with unique instances and temporal variables i, j, and k are ordered --- according to i < j < k, j requires a premise f(t), and i provides a --- conclusion f(t) for the node k. Graphically, the edge from i to k is --- interrupted by the node j that requires the same fact carried on the edge. -nonUniqueFactInstances :: ProofContext -> System - -> [(NodeId, NodeId, NodeId)] -nonUniqueFactInstances ctxt se = do +-- Formally, they are computed as follows. Let 'f' be a fact symbol with +-- injective instances. Let i, j, and k be temporal variables ordered +-- according to +-- +-- i < j < k +-- +-- and let there be an edge from (i,u) to (k,w) for some indices u and v +-- +-- Then, we have a contradiction if both the premise (k,w) that requires a +-- fact 'f(t,...)' and there is a premise (j,v) requiring a fact 'f(t,...)'. +-- +-- These two premises would have to be merged, but cannot due to the ordering +-- constraint 'j < k'. +nonInjectiveFactInstances :: ProofContext -> System -> [(NodeId, NodeId, NodeId)] +nonInjectiveFactInstances ctxt se = do Edge c@(i, _) (k, _) <- S.toList $ L.get sEdges se - let tag = factTag (nodeConcFact c se) - guard (tag `S.member` L.get pcUniqueFactInsts ctxt) + let kFaPrem = nodeConcFact c se + kTag = factTag kFaPrem + kTerm = firstTerm kFaPrem + conflictingFact fa = factTag fa == kTag && firstTerm fa == kTerm + + guard (kTag `S.member` L.get pcInjectiveFactInsts ctxt) j <- S.toList $ D.reachableSet [i] less let isCounterExample = (j /= i) && (j /= k) && maybe False checkRule (M.lookup j $ L.get sNodes se) - checkRule jRu = any ((tag ==) . factTag) (L.get rPrems jRu) && + -- FIXME: There should be a weaker version of the rule that just + -- introduces the constraint 'k < j || k == j' here. + checkRule jRu = any conflictingFact (L.get rPrems jRu) && k `S.member` D.reachableSet [j] less guard isCounterExample return (i, j, k) -- counter-example to unique fact instances where - less = rawLessRel se + less = rawLessRel se + firstTerm = headMay . factTerms -- | The node-ids that must be instantiated to the trace, but are temporally -- after the last node. @@ -193,13 +210,13 @@ -- | Pretty-print a 'Contradiction'. prettyContradiction :: Document d => Contradiction -> d prettyContradiction contra = case contra of - Cyclic -> text "cyclic" - IncompatibleEqs -> text "incompatible equalities" - NonNormalTerms -> text "non-normal terms" - ForbiddenExp -> text "non-normal exponentiation instance" - NonUniqueFactInstance cex -> text $ "non-unique facts " ++ show cex - FormulasFalse -> text "from formulas" - SuperfluousLearn m v -> + Cyclic -> text "cyclic" + IncompatibleEqs -> text "incompatible equalities" + NonNormalTerms -> text "non-normal terms" + ForbiddenExp -> text "non-normal exponentiation instance" + NonInjectiveFactInstance cex -> text $ "non-injective facts " ++ show cex + FormulasFalse -> text "from formulas" + SuperfluousLearn m v -> doubleQuotes (prettyLNTerm m) <-> text ("derived before and after") <-> doubleQuotes (prettyNodeId v) @@ -211,15 +228,15 @@ ------------ instance HasFrees Contradiction where - foldFrees f (SuperfluousLearn t v) = foldFrees f t `mappend` foldFrees f v - foldFrees f (NonUniqueFactInstance x) = foldFrees f x - foldFrees f (NodeAfterLast x) = foldFrees f x - foldFrees _ _ = mempty + foldFrees f (SuperfluousLearn t v) = foldFrees f t `mappend` foldFrees f v + foldFrees f (NonInjectiveFactInstance x) = foldFrees f x + foldFrees f (NodeAfterLast x) = foldFrees f x + foldFrees _ _ = mempty - mapFrees f (SuperfluousLearn t v) = SuperfluousLearn <$> mapFrees f t <*> mapFrees f v - mapFrees f (NonUniqueFactInstance x) = NonUniqueFactInstance <$> mapFrees f x - mapFrees f (NodeAfterLast x) = NodeAfterLast <$> mapFrees f x - mapFrees _ c = pure c + mapFrees f (SuperfluousLearn t v) = SuperfluousLearn <$> mapFrees f t <*> mapFrees f v + mapFrees f (NonInjectiveFactInstance x) = NonInjectiveFactInstance <$> mapFrees f x + mapFrees f (NodeAfterLast x) = NodeAfterLast <$> mapFrees f x + mapFrees _ c = pure c $( derive makeBinary ''Contradiction) $( derive makeNFData ''Contradiction) diff --git a/src/Theory/Constraint/Solver/Goals.hs b/src/Theory/Constraint/Solver/Goals.hs --- a/src/Theory/Constraint/Solver/Goals.hs +++ b/src/Theory/Constraint/Solver/Goals.hs @@ -46,12 +46,27 @@ ------------------------------------------------------------------------------ data Usefulness = Useful | Useless - deriving (Show, Eq, Ord) + deriving (Show, Eq) -- | Goals annotated with their number and usefulness. type AnnotatedGoal = (Goal, (Integer, Usefulness)) +-- Instances +------------ + +-- We need a custom 'Ord' instance that guarantees that @Useful < Useless@. +instance Ord Usefulness where + compare a b = + check a b + where + check Useful Useful = EQ + check Useless Useless = EQ + check x y = compare (tag x) (tag y) + tag (Useful) = 0 :: Int + tag (Useless) = 1 :: Int + + -- | The list of goals that must be solved before a solution can be extracted. -- Each goal is annotated with its age and an indicator for its usefulness. openGoals :: System -> [AnnotatedGoal] @@ -60,7 +75,7 @@ let solved = get gsSolved status -- check whether the goal is still open guard $ case goal of - ActionG _ (kFactView -> Just (UpK, _, m)) -> + ActionG _ (kFactView -> Just (UpK, m)) -> not $ solved || isMsgVar m || sortOfLNTerm m == LSortPub -- handled by 'insertAction' @@ -74,8 +89,8 @@ ChainG c _ -> case kFactView (nodeConcFact c sys) of - Just (DnK, _, m) | isMsgVar m -> False - | otherwise -> not solved + Just (DnK, m) | isMsgVar m -> False + | otherwise -> not solved fa -> error $ "openChainGoals: impossible fact: " ++ show fa -- FIXME: Split goals may be duplicated, we always have to check @@ -86,7 +101,7 @@ -- Note that 'solveAllSafeGoals' in "CaseDistinctions" relies on -- looping goals being classified as 'Useless'. _ | get gsLoopBreaker status -> Useless - ActionG i (kFactView -> Just (UpK, _, m)) + ActionG i (kFactView -> Just (UpK, m)) | isSimpleTerm m || deducible i m -> Useless _ -> Useful @@ -112,7 +127,7 @@ guard (not $ isLast sys j) let derivedMsgs = concatMap toplevelTerms $ [ t | Fact OutFact [t] <- get rConcs ru] <|> - [ t | Just (DnK, _, t) <- kFactView <$> get rConcs ru] + [ t | Just (DnK, t) <- kFactView <$> get rConcs ru] -- m is deducible from j without an immediate contradiction -- if it is a derived message of 'ru' and the dependency does -- not make the graph cyclic. @@ -174,8 +189,8 @@ | isKDFact faPrem = do iLearn <- freshLVar "vl" LSortNode mLearn <- varTerm <$> freshLVar "t" LSortMsg - concLearn <- kdFact (Just CanExp) mLearn - let premLearn = outFact mLearn + let concLearn = kdFact mLearn + premLearn = outFact mLearn -- !! Make sure that you construct the correct rule! ruLearn = Rule (IntrInfo IRecvRule) [premLearn] [concLearn] [] cLearn = (iLearn, ConcIdx 0) @@ -199,24 +214,33 @@ faPrem <- gets $ nodePremFact p insertEdges [(c, faConc, faPrem, p)] let m = case kFactView faConc of - Just (DnK, _, m') -> m' - _ -> error $ "solveChain: impossible" + Just (DnK, m') -> m' + _ -> error $ "solveChain: impossible" caseName (viewTerm -> FApp o _) = show o caseName t = show t return $ caseName m `disjunction` do -- extend it with one step + cRule <- gets $ nodeRule (nodeConcNode c) (i, ru) <- insertFreshNode rules + -- contradicts normal form condition: + -- no edge from dexp to dexp KD premise + -- (this condition replaces the exp/noexp tags) + contradictoryIf (isDexpRule cRule && isDexpRule ru) (v, faPrem) <- disjunctionOfList $ enumPrems ru insertEdges [(c, faConc, faPrem, (i, v))] markGoalAsSolved "directly" (PremiseG (i, v) faPrem) insertChain (i, ConcIdx 0) p return $ showRuleCaseName ru ) + where + isDexpRule ru = case get rInfo ru of + IntrInfo (DestrRule n) | n == expSymString -> True + _ -> False -- | Solve an equation split. There is no corresponding CR-rule in the rule -- system on paper because there we eagerly split over all variants of a rule. --- In practice, this es too expensive and we therefore use the equation store +-- In practice, this is too expensive and we therefore use the equation store -- to delay these splits. solveSplit :: SplitId -> Reduction String solveSplit x = do diff --git a/src/Theory/Constraint/Solver/ProofMethod.hs b/src/Theory/Constraint/Solver/ProofMethod.hs --- a/src/Theory/Constraint/Solver/ProofMethod.hs +++ b/src/Theory/Constraint/Solver/ProofMethod.hs @@ -92,7 +92,7 @@ -- | Sound transformations of sequents. data ProofMethod = - Sorry String -- ^ Proof was not completed + Sorry (Maybe String) -- ^ Proof was not completed | Solved -- ^ An attack was fond | Simplify -- ^ A simplification step. | SolveGoal Goal -- ^ A goal that was solved. @@ -132,7 +132,9 @@ Solved | null (openGoals sys) -> return M.empty | otherwise -> Nothing - SolveGoal goal -> execSolveGoal goal + SolveGoal goal + | goal `M.member` L.get sGoals sys -> execSolveGoal goal + | otherwise -> Nothing Simplify -> singleCase (/=) simplifySystem Induction -> execInduction Contradiction _ @@ -183,14 +185,15 @@ pad cs = replicate (l - length cs) '0' ++ cs -- Apply induction: possible if the system contains only - -- a single formula. + -- a single, last-free, closed formula. execInduction | sys == sys0 = case S.toList $ L.get sFormulas sys of [gf] -> case ginduct gf of - Right gf' -> Just $ M.singleton "induction" - $ set sFormulas (S.singleton gf') sys - _ -> Nothing + Right (bc, sc) -> Just $ insCase "empty_trace" bc + $ insCase "non_empty_trace" sc + $ M.empty + _ -> Nothing _ -> Nothing | otherwise = Nothing @@ -199,6 +202,7 @@ $ set sLemmas (L.get sLemmas sys) $ emptySystem (L.get sCaseDistKind sys) + insCase name gf = M.insert name (set sFormulas (S.singleton gf) sys) ------------------------------------------------------------------------------ -- Heuristics @@ -341,7 +345,7 @@ isNonLoopBreakerProtoFactGoal (PremiseG _ fa, (_, Useful)) = not $ isKFact fa isNonLoopBreakerProtoFactGoal _ = False - msgPremise (ActionG _ fa) = do (UpK, _, m) <- kFactView fa; return m + msgPremise (ActionG _ fa) = do (UpK, m) <- kFactView fa; return m msgPremise _ = Nothing isFreshKnowsGoal goal = case msgPremise goal of @@ -380,7 +384,8 @@ prettyProofMethod method = case method of Solved -> keyword_ "SOLVED" <-> lineComment_ "trace found" Induction -> keyword_ "induction" - Sorry reason -> fsep [keyword_ "sorry", lineComment_ reason] + Sorry reason -> + fsep [keyword_ "sorry", maybe emptyDoc lineComment_ reason] SolveGoal goal -> keyword_ "solve(" <-> prettyGoal goal <-> keyword_ ")" Simplify -> keyword_ "simplify" diff --git a/src/Theory/Constraint/Solver/Reduction.hs b/src/Theory/Constraint/Solver/Reduction.hs --- a/src/Theory/Constraint/Solver/Reduction.hs +++ b/src/Theory/Constraint/Solver/Reduction.hs @@ -214,11 +214,10 @@ -- | Import a rule with all its variables renamed to fresh variables. importRule ru = someRuleACInst ru `evalBindT` noBindings - mkISendRuleAC m = do - faPrem <- kuFact Nothing m - return $ Rule (IntrInfo (ISendRule)) - [faPrem] [inFact m] [kLogFact m] + mkISendRuleAC m = return $ Rule (IntrInfo (ISendRule)) + [kuFact m] [inFact m] [kLogFact m] + mkFreshRuleAC m = Rule (ProtoInfo (ProtoRuleACInstInfo FreshRule [])) [] [freshFact m] [] @@ -280,13 +279,13 @@ then do return Unchanged else do insertGoal goal False case kFactView fa of - Just (UpK, _, viewTerm2 -> FPair m1 m2) -> + Just (UpK, viewTerm2 -> FPair m1 m2) -> requiresKU m1 *> requiresKU m2 *> return Changed - Just (UpK, _, viewTerm2 -> FInv m) -> + Just (UpK, viewTerm2 -> FInv m) -> requiresKU m *> return Changed - Just (UpK, _, viewTerm2 -> FMult ms) -> + Just (UpK, viewTerm2 -> FMult ms) -> mapM_ requiresKU ms *> return Changed _ -> return Unchanged @@ -296,7 +295,7 @@ -- loop due to generating new KU-nodes that are merged immediatly. requiresKU t = do j <- freshLVar "vk" LSortNode - faKU <- kuFact Nothing t + let faKU = kuFact t insertLess j i void (insertAction j faKU) @@ -533,7 +532,7 @@ sGoals =: M.empty changes <- forM goals $ \(goal, status) -> case goal of -- Look out for KU-actions that might need to be solved again. - ActionG i fa@(kFactView -> Just (UpK, _, m)) + ActionG i fa@(kFactView -> Just (UpK, m)) | (isMsgVar m || isProduct m) && (apply subst m /= m) -> insertAction i (apply subst fa) _ -> do modM sGoals $ @@ -638,6 +637,7 @@ contradictoryIf (not $ all evalEqual $ map (fmap (get rInfo)) eqs) solveListEqs (solveFactEqs split) $ map (fmap (get rConcs)) eqs ++ map (fmap (get rPrems)) eqs + ++ map (fmap (get rActs)) eqs -- | Solve a number of equalities between lists interpreted as free terms -- using the given solver for solving the entailed per-element equalities. diff --git a/src/Theory/Constraint/Solver/Simplify.hs b/src/Theory/Constraint/Solver/Simplify.hs --- a/src/Theory/Constraint/Solver/Simplify.hs +++ b/src/Theory/Constraint/Solver/Simplify.hs @@ -40,7 +40,6 @@ import Control.Monad.Reader import Control.Monad.State (gets) -import Text.PrettyPrint.Class import Extension.Data.Label import Extension.Prelude @@ -50,6 +49,7 @@ import Theory.Constraint.Solver.Types import Theory.Constraint.System import Theory.Model +import Theory.Text.Pretty -- | Apply CR-rules that don't result in case splitting until the constraint @@ -82,16 +82,27 @@ c8 <- insertImpliedFormulas -- Report on looping behaviour if necessary - let changes = [c1, c2, c3, c4, c5, c6, c7, c8] + let changes = filter ((Changed ==) . snd) $ + [ ("unique fresh instances (DG4)", c1) + , ("unique K↓-facts (N5↓)", c2) + , ("unique K↑-facts (N5↑)", c3) + , ("unique (linear) edges (DG2 and DG3)", c4) + , ("solve unambiguous actions (S_@)", c5) + , ("decompose trace formula", c6) + , ("propagate atom valuation to formula", c7) + , ("saturate under ∀-clauses (S_∀)", c8) + ] traceIfLooping | n <= 10 = id - | otherwise = trace $ render $ vcat + | otherwise = trace $ render $ vsep [ text "Simplifier iteration" <-> int n <> colon - , nest 2 (text (show changes)) + , fsep $ text "The reduction-rules for" : + (punctuate comma $ map (text . fst) changes) ++ + [text "were applied to the following constraint system."] , nest 2 (prettySystem se0) ] - traceIfLooping $ go (n + 1) changes + traceIfLooping $ go (n + 1) (map snd changes) -- | CR-rule *N6*: add ordering constraints between all KU-actions and diff --git a/src/Theory/Constraint/Solver/Types.hs b/src/Theory/Constraint/Solver/Types.hs --- a/src/Theory/Constraint/Solver/Types.hs +++ b/src/Theory/Constraint/Solver/Types.hs @@ -21,7 +21,7 @@ , pcSignature , pcRules - , pcUniqueFactInsts + , pcInjectiveFactInsts , pcCaseDists , pcCaseDistKind , pcUseInduction @@ -109,13 +109,13 @@ -- | A proof context contains the globally fresh facts, classified rewrite -- rules and the corresponding precomputed premise case distinction theorems. data ProofContext = ProofContext - { _pcSignature :: SignatureWithMaude - , _pcRules :: ClassifiedRules - , _pcUniqueFactInsts :: S.Set FactTag - , _pcCaseDistKind :: CaseDistKind - , _pcCaseDists :: [CaseDistinction] - , _pcUseInduction :: InductionHint - , _pcTraceQuantifier :: SystemTraceQuantifier + { _pcSignature :: SignatureWithMaude + , _pcRules :: ClassifiedRules + , _pcInjectiveFactInsts :: S.Set FactTag + , _pcCaseDistKind :: CaseDistKind + , _pcCaseDists :: [CaseDistinction] + , _pcUseInduction :: InductionHint + , _pcTraceQuantifier :: SystemTraceQuantifier } deriving( Eq, Ord, Show ) diff --git a/src/Theory/Constraint/System.hs b/src/Theory/Constraint/System.hs --- a/src/Theory/Constraint/System.hs +++ b/src/Theory/Constraint/System.hs @@ -29,6 +29,7 @@ , sNodes , allKDConcs + , nodeRule , nodeConcNode , nodePremNode , nodePremFact @@ -73,7 +74,7 @@ -- ** Lemmas , sLemmas - , insertLemma + , insertLemmas -- ** Keeping track of typing assumptions , CaseDistKind(..) @@ -99,6 +100,7 @@ import Data.Binary import qualified Data.DAG.Simple as D import Data.DeriveTH +import Data.List (foldl') import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) @@ -208,13 +210,19 @@ adapt = case traceQuantifier of ExistsSomeTrace -> id ExistsNoTrace -> gnot - gf = either error id (adapt <$> formulaToGuarded fm) + gf = either (error . render) id (adapt <$> formulaToGuarded fm) -- | Add a lemma / additional assumption to a constraint system. insertLemma :: LNFormula -> System -> System -insertLemma fm = - L.modify sLemmas (S.insert (either error id $ formulaToGuarded fm)) +insertLemma fm0 = + go (either (error . render) id $ formulaToGuarded fm0) + where + go (GConj conj) = foldr (.) id $ map go $ getConj conj + go fm = L.modify sLemmas (S.insert fm) +-- | Add lemmas / additional assumptions to a constraint system. +insertLemmas :: [LNFormula] -> System -> System +insertLemmas fms sys = foldl' (flip insertLemma) sys fms ------------------------------------------------------------------------------ -- Queries @@ -228,7 +236,7 @@ allKDConcs :: System -> [(NodeId, RuleACInst, LNTerm)] allKDConcs sys = do (i, ru) <- M.toList $ L.get sNodes sys - (_, kFactView -> Just (DnK, _, m)) <- enumConcs ru + (_, kFactView -> Just (DnK, m)) <- enumConcs ru return (i, ru, m) -- | @nodeRule v@ accesses the rule label of node @v@ under the assumption that @@ -291,7 +299,7 @@ -- | All actions that hold in a sequent. allKUActions :: System -> [(NodeId, LNFact, LNTerm)] allKUActions sys = do - (i, fa@(kFactView -> Just (UpK, _, m))) <- allActions sys + (i, fa@(kFactView -> Just (UpK, m))) <- allActions sys return (i, fa, m) -- | The standard actions, i.e., non-KU-actions. @@ -301,7 +309,7 @@ -- | All KU-actions. kuActionAtoms :: System -> [(NodeId, LNFact, LNTerm)] kuActionAtoms sys = do - (i, fa@(kFactView -> Just (UpK, _, m))) <- unsolvedActionAtoms sys + (i, fa@(kFactView -> Just (UpK, m))) <- unsolvedActionAtoms sys return (i, fa, m) -- Destruction chains @@ -382,11 +390,11 @@ prettyNonGraphSystem :: HighlightDocument d => System -> d prettyNonGraphSystem se = vsep $ map combine [ ("last", maybe (text "none") prettyNodeId $ L.get sLastAtom se) - , ("allowed cases", text $ show $ L.get sCaseDistKind se) , ("formulas", vsep $ map prettyGuarded $ S.toList $ L.get sFormulas se) , ("equations", prettyEqStore $ L.get sEqStore se) - , ("solved formulas", vsep $ map prettyGuarded $ S.toList $ L.get sSolvedFormulas se) , ("lemmas", vsep $ map prettyGuarded $ S.toList $ L.get sLemmas se) + , ("allowed cases", text $ show $ L.get sCaseDistKind se) + , ("solved formulas", vsep $ map prettyGuarded $ S.toList $ L.get sSolvedFormulas se) , ("solved goals", prettyGoals True se) ] where diff --git a/src/Theory/Constraint/System/Constraints.hs b/src/Theory/Constraint/System/Constraints.hs --- a/src/Theory/Constraint/System/Constraints.hs +++ b/src/Theory/Constraint/System/Constraints.hs @@ -45,6 +45,7 @@ import Control.DeepSeq import Text.PrettyPrint.Class +import Text.Unicode import Logic.Connectives import Theory.Constraint.System.Guarded @@ -189,10 +190,14 @@ prettyGoal (ActionG i fa) = prettyNAtom (Action (varTerm i) fa) prettyGoal (ChainG c p) = prettyNodeConc c <-> operator_ "~~>" <-> prettyNodePrem p -prettyGoal (PremiseG p fa) = - prettyNodePrem p <> brackets (prettyLNFact fa) -prettyGoal (DisjG (Disj gfs)) = (text "Disj" <>) $ fsep $ - punctuate (operator_ " |") (map (nest 1 . parens . prettyGuarded) gfs) +prettyGoal (PremiseG (i, (PremIdx v)) fa) = + -- Note that we can use "▷" for conclusions once we need them. + prettyLNFact fa <-> text ("▶" ++ subscript (show v)) <-> prettyNodeId i + -- prettyNodePrem p <> brackets (prettyLNFact fa) +prettyGoal (DisjG (Disj [])) = text "Disj" <-> operator_ "(⊥)" +prettyGoal (DisjG (Disj gfs)) = fsep $ + punctuate (operator_ " ∥") (map (nest 1 . parens . prettyGuarded) gfs) + -- punctuate (operator_ " |") (map (nest 1 . parens . prettyGuarded) gfs) prettyGoal (SplitG x) = text "splitEqs" <> parens (text $ show (unSplitId x)) diff --git a/src/Theory/Constraint/System/Dot.hs b/src/Theory/Constraint/System/Dot.hs --- a/src/Theory/Constraint/System/Dot.hs +++ b/src/Theory/Constraint/System/Dot.hs @@ -9,7 +9,8 @@ -- -- Conversion of the graph part of a sequent to a Graphviz Dot file. module Theory.Constraint.System.Dot ( - dotSystemLoose + nonEmptyGraph + , dotSystemLoose , dotSystemCompact , compressSystem , BoringNodeStyle(..) @@ -40,6 +41,13 @@ import Theory.Model import Theory.Text.Pretty (opAction) +-- | 'True' iff the dotted system will be a non-empty graph. +nonEmptyGraph :: System -> Bool +nonEmptyGraph sys = not $ + M.null (get sNodes sys) && null (unsolvedActionAtoms sys) && + null (unsolvedChains sys) && + S.null (get sEdges sys) && S.null (get sLessAtoms sys) + type NodeColorMap = M.Map (RuleInfo ProtoRuleACInstInfo IntrRuleACInfo) (HSV Double) type SeDot = ReaderT (System, NodeColorMap) (StateT DotState D.Dot) @@ -194,6 +202,8 @@ liftDot $ D.node $ [("label", label),("shape",shape)] ++ moreStyle + + -- | Convert the sequent to a 'D.Dot' action representing this sequent as a -- graph in the GraphViz format. The style is loose in the sense that each -- premise and conclusion gets its own node. @@ -216,6 +226,7 @@ (v, ru) <- M.toList $ get sNodes se (i, _) <- enumPrems ru return (dotPrem (v,i)) + -- FIXME: Also dot unsolved actions. mapM_ dotNode $ M.keys $ get sNodes se mapM_ dotEdge $ S.toList $ get sEdges se mapM_ dotChain $ unsolvedChains se @@ -240,22 +251,7 @@ tgtId <- dotPrem tgt liftDot $ D.edge srcId tgtId style - {- - dotProvides (SeProvides v fa) = do - vId <- dotNode v - faId <- liftDot $ D.node [("label",label),("shape","trapezium")] - dotNonFixedIntraRuleEdge vId faId - where - label = render $ prettyLNFact fa - dotRequires (SeRequires v _fa) = do - _vId <- dotNode v - return () - -- FIXME: Reenable - -- premId <- dotPrem (NodePremFact v fa) - -- dotNonFixedIntraRuleEdge premId vId - -} - -- | Set default attributes for nodes and edges. setDefaultAttributes :: D.Dot () setDefaultAttributes = do @@ -377,7 +373,8 @@ --- | Dot a sequent in compact form (one record per rule) +-- | Dot a sequent in compact form (one record per rule), if there is anything +-- to draw. dotSystemCompact :: BoringNodeStyle -> System -> D.Dot () dotSystemCompact boringStyle se = (`evalStateT` DotState M.empty M.empty M.empty M.empty) $ diff --git a/src/Theory/Constraint/System/Guarded.hs b/src/Theory/Constraint/System/Guarded.hs --- a/src/Theory/Constraint/System/Guarded.hs +++ b/src/Theory/Constraint/System/Guarded.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} -- | -- Copyright : (c) 2011 Benedikt Schmidt & Simon Meier -- License : GPL v3 (see LICENSE) @@ -56,26 +57,26 @@ ) where import Control.Applicative +import Control.Arrow import Control.DeepSeq import Control.Monad.Error +import Control.Monad.Fresh (MonadFresh, scopeFreshness) +import qualified Control.Monad.Trans.PreciseFresh as Precise (Fresh, evalFresh, evalFreshT) import Debug.Trace import Data.Binary import Data.DeriveTH -import Data.Either (partitionEithers) -import Data.Foldable (Foldable(..), foldMap) +import Data.Either (partitionEithers) +import Data.Foldable (Foldable(..), foldMap) import Data.List -import Data.Monoid (mappend, mconcat) -import Data.Traversable hiding (mapM, sequence) +import Data.Monoid (Monoid(..)) +import Data.Traversable hiding (mapM, sequence) import Logic.Connectives import Text.PrettyPrint.Highlight -import Control.Arrow -import Control.Monad.Fresh hiding (mapM) - import Theory.Model @@ -281,6 +282,10 @@ type LNGuarded = Guarded (String,LSort) Name LVar +instance Apply LNGuarded where + apply subst = mapGuardedAtoms (const $ apply subst) + + -- | @gtf b@ returns the guarded formula f with @b <-> f@. gtf :: Bool -> Guarded s c v gtf False = GDisj (Disj []) @@ -323,11 +328,13 @@ flatten (GDisj disj) = concatMap flatten $ getDisj disj flatten gf = [gf] --- @ A smart constructor for @GGuarded Ex@ that removes empty quantifications. +-- @ A smart constructor for @GGuarded Ex@ that removes empty quantifications +-- and conjunctions with 'gfalse'. gex :: (Ord s, Ord c, Ord v) => [s] -> [Atom (VTerm c (BVar v))] -> Guarded s c v -> Guarded s c v -gex [] as gf = gconj (map GAto as ++ [gf]) -gex ss as gf = GGuarded Ex ss as gf +gex [] as gf = gconj (map GAto as ++ [gf]) +gex _ _ gf | gf == gfalse = gfalse +gex ss as gf = GGuarded Ex ss as gf -- @ A smart constructor for @GGuarded All@ that drops implications to 'gtrue' -- and removes empty premises. @@ -337,112 +344,107 @@ gall _ _ gf | gf == gtrue = gtrue gall ss atos gf = GGuarded All ss atos gf + +-- Conversion of formulas to guarded formulas +--------------------------------------------- + +-- | Local newtype to avoid orphan instance. +newtype ErrorDoc d = ErrorDoc { unErrorDoc :: d } + deriving( Monoid, NFData, Document, HighlightDocument ) + +instance Document d => Error (ErrorDoc d) where + noMsg = emptyDoc + strMsg = text + -- | @formulaToGuarded fm@ returns a guarded formula @gf@ that is -- equivalent to @fm@ if possible. -formulaToGuarded :: LNFormula -> Either String LNGuarded -formulaToGuarded = convert False - --- | @convert neg f@ returns @Nothing@ if @f@ cannot be converted, --- @Just gf@ such that @mneg f <-> gf@ with @mneg = id@ if @neg@ is @False@ --- and @mneg=not@ if @neg@ is true. -convert :: Bool -> LNFormula -> Either String LNGuarded -convert True (Ato a) = pure $ gnotAtom a -convert False (Ato a) = pure $ GAto a +formulaToGuarded :: HighlightDocument d => LNFormula -> Either d LNGuarded +formulaToGuarded fmOrig = + either (Left . ppError . unErrorDoc) Right + $ Precise.evalFreshT (convert False fmOrig) (avoidPrecise fmOrig) + where + ppFormula :: HighlightDocument a => LNFormula -> a + ppFormula = nest 2 . doubleQuotes . prettyLNFormula -convert polarity (Not f) = convert (not polarity) f + ppError d = d $-$ text "in the formula" $-$ ppFormula fmOrig -convert True (Conn And f g) = gdisj <$> mapM (convert True) [f, g] -convert False (Conn And f g) = gconj <$> mapM (convert False) [f, g] + convert True (Ato a) = pure $ gnotAtom a + convert False (Ato a) = pure $ GAto a -convert True (Conn Or f g) = gconj <$> mapM (convert True) [f, g] -convert False (Conn Or f g) = gdisj <$> mapM (convert False) [f, g] + convert polarity (Not f) = convert (not polarity) f -convert True (Conn Imp f g ) = - gconj <$> sequence [convert False f, convert True g] -convert False (Conn Imp f g ) = - gdisj <$> sequence [convert True f, convert False g] + convert True (Conn And f g) = gdisj <$> mapM (convert True) [f, g] + convert False (Conn And f g) = gconj <$> mapM (convert False) [f, g] -convert polarity (TF b) = pure $ gtf (polarity /= b) + convert True (Conn Or f g) = gconj <$> mapM (convert True) [f, g] + convert False (Conn Or f g) = gdisj <$> mapM (convert False) [f, g] -convert polarity f0@(Qua qua0 _ _) = - -- The quantifier switch stems from our implicit negation of the formula. - case (qua0, polarity) of - (All, True ) -> convAll Ex - (All, False) -> convAll All - (Ex, True ) -> convEx All - (Ex, False) -> convEx Ex - where - convEx qua = do - (xs,_,f) <- openFormulaPrefix f0 `evalFreshT` avoid f0 - case partitionEithers $ partitionConj f of - (as, fs) -> do - let guardedvars = frees as - -- all existentially quantified variables must be guarded - unguarded = xs \\ guardedvars + convert True (Conn Imp f g ) = + gconj <$> sequence [convert False f, convert True g] + convert False (Conn Imp f g ) = + gdisj <$> sequence [convert True f, convert False g] - unless (null unguarded) $ throwError $ - "unguarded variables " ++ show unguarded ++ " in " ++ show f0 + convert polarity (TF b) = pure $ gtf (polarity /= b) - gf <- (if polarity then gdisj else gconj) - <$> mapM (convert polarity) fs - return $ closeGuarded qua xs as gf + convert polarity f0@(Qua qua0 _ _) = + -- The quantifier switch stems from our implicit negation of the formula. + case (qua0, polarity) of + (All, True ) -> convAll Ex + (All, False) -> convAll All + (Ex, True ) -> convEx All + (Ex, False) -> convEx Ex where - partitionConj (Conn And f1 f2) = partitionConj f1 ++ partitionConj f2 - partitionConj (Ato a@(Action _ _)) = [Left $ bvarToLVar a] - partitionConj (Ato e@(EqE _ _)) = [Left $ bvarToLVar e] - partitionConj f = [Right f] - - convAll qua = do - (xs,_,f) <- openFormulaPrefix f0 `evalFreshT` avoid f0 - case f of - Conn Imp ante suc -> do - allowedAtoms <- collectAllowedAtoms ante + noUnguardedVars [] = return () + noUnguardedVars unguarded = throwError $ vcat + [ fsep $ text "unguarded variable(s)" + : (punctuate comma $ + map (quotes . text . show) unguarded) + ++ map text ["in", "the", "subformula"] + , ppFormula f0 + ] - let guardedvars = frees [ a | a@(Action _ _) <- allowedAtoms ] - -- all universally quantified variables must be guarded - unguarded = xs \\ guardedvars + conjActions (Conn And f1 f2) = conjActions f1 ++ conjActions f2 + conjActions (Ato a@(Action _ _)) = [Left $ bvarToLVar a] + conjActions f = [Right f] - when (not $ null unguarded) $ throwError $ - "unguarded variables " ++ show unguarded ++ " in " ++ show f0 + convEx qua = do + (xs,_,f) <- openFormulaPrefix f0 + case partitionEithers $ conjActions f of + (as, fs) -> do + -- all existentially quantified variables must be guarded + noUnguardedVars (xs \\ frees as) + -- convert all other formulas + gf <- (if polarity then gdisj else gconj) + <$> mapM (convert polarity) fs + return $ closeGuarded qua xs as gf + where - g <- convert polarity suc - return $ closeGuarded qua xs allowedAtoms g + convAll qua = do + (xs,_,f) <- openFormulaPrefix f0 + case f of + Conn Imp ante suc -> case partitionEithers $ conjActions ante of + (as, fs) -> do + -- all universally quantified variables must be guarded + noUnguardedVars (xs \\ frees as) + -- negate formulas in antecedent and combine with body + gf <- (if polarity then gconj else gdisj) + <$> sequence ( map (convert (not polarity)) fs ++ + [convert polarity suc] ) - _ -> throwError $ show f ++ "outside guarded fragment" - where - collectAllowedAtoms (Conn And f1 f2) = - (++) <$> collectAllowedAtoms f1 <*> collectAllowedAtoms f2 - collectAllowedAtoms (Ato a@(Action _ _)) = return [bvarToLVar a] - collectAllowedAtoms (Ato e@(EqE _ _)) = return [bvarToLVar e] - collectAllowedAtoms na = - throwError $ show na ++ " not allowed in antecedent" + return $ closeGuarded qua xs as gf -convert _ (Conn Iff _ _) = - Left $ "`iff' not supported (yet)" + _ -> throwError $ + text "universal quantifier without toplevel implication" $-$ + ppFormula f0 -instance Apply LNGuarded where - apply subst = mapGuardedAtoms (const $ apply subst) + convert polarity (Conn Iff f1 f2) = + gconj <$> mapM (convert polarity) [Conn Imp f1 f2, Conn Imp f2 f1] ------------------------------------------------------------------------------ -- Induction over the trace ------------------------------------------------------------------------------ --- Note that we assume that the guarded formula describes the attack. --- Hence, we want to show that it is false. - -{- --- | Checks if a doubly guarded formula is last-free; i.e., does not contain a 'Last' --- atom. -lastFree :: Guarded s c v -> Bool -lastFree = error "lastFree: implement" - --- | Checks if a formula is doubly guarded; i.e., both universal and existential --- quantifiers are guarded. -doublyGuarded :: Guarded s c v -> Bool -doublyGuarded = either (const False) (const True) . satisfiedByEmptyTrace --} - -- | Negate a guarded formula. gnot :: (Ord s, Ord c, Ord v) => Guarded s c v -> Guarded s c v @@ -475,12 +477,13 @@ toInductionHypothesis = go where - go (GGuarded qua ss as gf) = do - gf' <- go gf - return $ case qua of - All -> gex ss as (gconj $ (gnotAtom <$> lastAtos) ++ [gf']) - Ex -> gall ss as (gdisj $ (GAto <$> lastAtos) ++ [gf']) - + go (GGuarded qua ss as gf) + | any isLastAtom as = throwError "formula not last-free" + | otherwise = do + gf' <- go gf + return $ case qua of + All -> gex ss as (gconj $ (gnotAtom <$> lastAtos) ++ [gf']) + Ex -> gall ss as (gdisj $ (GAto <$> lastAtos) ++ [gf']) where lastAtos :: [Atom (VTerm c (BVar LVar))] lastAtos = do @@ -494,15 +497,19 @@ go (GConj conj) = gdisj <$> traverse go (getConj conj) -- | Try to prove the formula by applying induction over the trace. --- Returns @'Left' errMsg@ if this is not possible. -ginduct :: Ord c => LGuarded c -> Either String (LGuarded c) +-- Returns @'Left' errMsg@ if this is not possible. Returns a tuple of +-- formulas: one formalzing the proof obligation of the base-case and one +-- formalizing the proof obligation of the step-case. +ginduct :: Ord c => LGuarded c -> Either String (LGuarded c, LGuarded c) ginduct gf = do + unless (null $ frees gf) (throwError "formula not closed") + unless (containsAction gf) (throwError "formula contains no action atom") baseCase <- satisfiedByEmptyTrace gf - if baseCase - then throwError "cannot apply induction: empty trace is an attack" - else do - gfIH <- toInductionHypothesis gf - return (gconj [gf, gfIH]) + gfIH <- toInductionHypothesis gf + return (gtf baseCase, gconj [gf, gfIH]) + where + containsAction = foldGuarded (const True) (or . getDisj) (or . getConj) + (\_ _ as body -> not (null as) || body) ------------------------------------------------------------------------------ -- Formula Simplification @@ -557,34 +564,46 @@ prettyGuarded :: HighlightDocument d => LNGuarded -- ^ Guarded Formula. -> d -- ^ Pretty printed formula. -prettyGuarded f = - pp f `evalFreshAvoiding` f +prettyGuarded fm = + Precise.evalFresh (pp fm) (avoidPrecise fm) where - pp :: HighlightDocument d => LNGuarded -> Fresh d + pp :: HighlightDocument d => LNGuarded -> Precise.Fresh d pp (GAto a) = return $ prettyNAtom $ bvarToLVar a - pp (GDisj (Disj [])) = return $ operator_ "F" + pp (GDisj (Disj [])) = return $ operator_ "⊥" -- "F" pp (GDisj (Disj xs)) = do ps <- mapM (\x -> opParens <$> pp x) xs - return $ sep $ punctuate (operator_ " |") ps + return $ sep $ punctuate (operator_ " ∨") ps + -- return $ sep $ punctuate (operator_ " |") ps - pp (GConj (Conj [])) = return $ operator_ "T" + pp (GConj (Conj [])) = return $ operator_ "⊤" -- "T" pp (GConj (Conj xs)) = do ps <- mapM (\x -> opParens <$> pp x) xs - return $ sep $ punctuate (operator_ " &") ps + return $ sep $ punctuate (operator_ " ∧") ps --- " &") ps - pp gf0@(GGuarded _ _ _ _) = do - Just (qua, vs, atoms, gf) <- openGuarded gf0 - dante <- pp (GConj (Conj (map (GAto . fmap (fmapTerm (fmap Free))) atoms))) - dsucc <- pp gf - return $ sep [ operator_ (show qua) <-> ppVars vs <> operator_ "." - , nest 1 dante - , operator_ (case qua of All -> "==>"; Ex -> "&") - , nest 1 dsucc] + pp gf0@(GGuarded _ _ _ _) = + -- variable names invented here can be reused otherwise + scopeFreshness $ do + Just (qua, vs, atoms, gf) <- openGuarded gf0 + let antecedent = (GAto . fmap (fmapTerm (fmap Free))) <$> atoms + connective = operator_ (case qua of All -> "⇒"; Ex -> "∧") + -- operator_ (case qua of All -> "==>"; Ex -> "&") + quantifier = operator_ (ppQuant qua) <-> ppVars vs <> operator_ "." + dante <- nest 1 <$> pp (GConj (Conj antecedent)) + case (qua, vs, gf) of + (Ex, _, GConj (Conj [])) -> + return $ sep $ [ quantifier, dante ] + (All, [], GDisj (Disj [])) | gf == gfalse -> + return $ operator_ "¬" <> dante + _ -> do + dsucc <- nest 1 <$> pp gf + return $ sep [ quantifier, sep [dante, connective, dsucc] ] where - ppVars = fsep . map (text . show) + ppVars = fsep . map (text . show) + ppQuant All = "∀" -- "All " + ppQuant Ex = "∃" -- "Ex " -- Derived instances diff --git a/src/Theory/Model.hs b/src/Theory/Model.hs --- a/src/Theory/Model.hs +++ b/src/Theory/Model.hs @@ -7,8 +7,7 @@ -- -- Security protocol model. module Theory.Model ( - module Term.LTerm - , module Term.Unification + module Term.Unification , module Theory.Model.Atom , module Theory.Model.Fact , module Theory.Model.Formula diff --git a/src/Theory/Model/Atom.hs b/src/Theory/Model/Atom.hs --- a/src/Theory/Model/Atom.hs +++ b/src/Theory/Model/Atom.hs @@ -24,8 +24,12 @@ , NAtom , LNAtom + , isActionAtom + , isLastAtom + , isLessAtom + , isEqAtom + -- * LFormula - , BLVar , BLAtom -- * Pretty-Printing @@ -111,6 +115,26 @@ apply subst (Last i) = Last (apply subst i) +-- Queries +---------- + +-- | True iff the atom is an action atom. +isActionAtom :: Atom t -> Bool +isActionAtom ato = case ato of Action _ _ -> True; _ -> False + +-- | True iff the atom is a last atom. +isLastAtom :: Atom t -> Bool +isLastAtom ato = case ato of Last _ -> True; _ -> False + +-- | True iff the atom is a temporal ordering atom. +isLessAtom :: Atom t -> Bool +isLessAtom ato = case ato of Less _ _ -> True; _ -> False + +-- | True iff the atom is an equality atom. +isEqAtom :: Atom t -> Bool +isEqAtom ato = case ato of EqE _ _ -> True; _ -> False + + ------------------------------------------------------------------------------ -- Pretty-Printing ------------------------------------------------------------------------------ @@ -122,7 +146,7 @@ sep [prettyNTerm l <-> opEqual, prettyNTerm r] -- sep [prettyNTerm l <-> text "≈", prettyNTerm r] prettyNAtom (Less u v) = text (show u) <-> opLess <-> text (show v) -prettyNAtom (Last i) = operator_ "Last" <> parens (text (show i)) +prettyNAtom (Last i) = operator_ "last" <> parens (text (show i)) -- derived instances diff --git a/src/Theory/Model/Fact.hs b/src/Theory/Model/Fact.hs --- a/src/Theory/Model/Fact.hs +++ b/src/Theory/Model/Fact.hs @@ -24,6 +24,7 @@ , isPersistentFact , isProtoFact + , factTagName , showFactTag , showFactTagArity , factTagArity @@ -31,16 +32,11 @@ , factArity , factMultiplicity - -- ** Message deduction facts - , ExpTag(..) - , expTagToTerm - , termToExpTag - , DirTag(..) - , kFactView - , dedFactView , kuFact , kdFact + , kFactView + , dedFactView , isKFact , isKUFact @@ -73,7 +69,6 @@ import Control.Basics import Control.DeepSeq -import Control.Monad.Fresh import Data.Binary import Data.DeriveTH @@ -142,47 +137,22 @@ -- KU and KD facts ------------------ --- | Message fact exponentation tag. -data ExpTag = CannotExp | CanExp - deriving( Eq, Ord, Show) - --- | Exponentiation-symbol to term. -expTagToTerm :: ExpTag -> LNTerm -expTagToTerm CannotExp = lit (Con (Name PubName (NameId ("noexp")))) -expTagToTerm CanExp = lit (Con (Name PubName (NameId ("exp")))) - --- | Term to exponentiation-symbol. -termToExpTag :: LNTerm -> Maybe ExpTag -termToExpTag (viewTerm -> Lit (Con (Name PubName (NameId ("noexp"))))) = return CannotExp -termToExpTag (viewTerm -> Lit (Con (Name PubName (NameId ("exp"))))) = return CanExp -termToExpTag _ = mzero - - -- | A direction tag data DirTag = UpK | DnK deriving( Eq, Ord, Show ) --- | Construct a message fact. If no 'ExpTag' is given, then --- a fresh variable that matches any 'ExpTag' is constructed. -kuFact, kdFact :: MonadFresh m => Maybe ExpTag -> LNTerm -> m LNFact -kuFact = mkFact KUFact -kdFact = mkFact KDFact - --- | A generic fact creation function. -mkFact :: MonadFresh m => FactTag -> Maybe ExpTag -> LNTerm -> m LNFact -mkFact tag (Just t) m = return $ Fact tag [expTagToTerm t, m] -mkFact tag Nothing m = do - v <- freshLVar "f_" LSortMsg - return $ Fact tag [varTerm v, m] +kdFact, kuFact :: t -> Fact t +kdFact = Fact KDFact . return +kuFact = Fact KUFact . return -- | View a message-deduction fact. -kFactView :: LNFact -> Maybe (DirTag, Maybe ExpTag, LNTerm) +kFactView :: LNFact -> Maybe (DirTag, LNTerm) kFactView fa = case fa of - Fact KUFact [e, m] -> Just (UpK, termToExpTag e, m) - Fact KUFact _ -> errMalformed "kFactView" fa - Fact KDFact [e, m] -> Just (DnK, termToExpTag e, m) - Fact KDFact _ -> errMalformed "kFactView" fa - _ -> Nothing + Fact KUFact [m] -> Just (UpK, m) + Fact KUFact _ -> errMalformed "kFactView" fa + Fact KDFact [m] -> Just (DnK, m) + Fact KDFact _ -> errMalformed "kFactView" fa + _ -> Nothing -- | View a deduction logging fact. dedFactView :: LNFact -> Maybe LNTerm @@ -265,10 +235,10 @@ -- | The arity of a 'FactTag'. factTagArity :: FactTag -> Int -factTagArity tag = case tag of +factTagArity tag = case tag of ProtoFact _ _ k -> k - KUFact -> 2 - KDFact -> 2 + KUFact -> 1 + KDFact -> 1 DedFact -> 1 FreshFact -> 1 InFact -> 1 @@ -332,19 +302,24 @@ -- Pretty Printing ------------------------------------------------------------------------------ --- | Show a fact tag as a 'String'. -showFactTag :: FactTag -> String -showFactTag tag = case tag of - KUFact -> "!KU" - KDFact -> "!KD" +-- | The name of a fact tag, e.g., @factTagName KUFact = "KU"@. +factTagName :: FactTag -> String +factTagName tag = case tag of + KUFact -> "KU" + KDFact -> "KD" DedFact -> "Ded" InFact -> "In" OutFact -> "Out" FreshFact -> "Fr" - (ProtoFact m n _) -> multi m ++ n - where - multi Linear = "" - multi Persistent = "!" + (ProtoFact _ n _) -> n + +-- | Show a fact tag as a 'String'. This is the 'factTagName' prefixed with +-- the multiplicity. +showFactTag :: FactTag -> String +showFactTag tag = + (++ factTagName tag) $ case factTagMultiplicity tag of + Linear -> "" + Persistent -> "!" -- | Show a fact tag together with its aritiy. showFactTagArity :: FactTag -> String diff --git a/src/Theory/Model/Formula.hs b/src/Theory/Model/Formula.hs --- a/src/Theory/Model/Formula.hs +++ b/src/Theory/Model/Formula.hs @@ -21,8 +21,6 @@ , Formula(..) , LNFormula , LFormula - , FormulaE - , FormulaAC , quantify , openFormula @@ -44,23 +42,23 @@ , foldFormula -- ** Pretty-Printing - , prettyFormulaE - , prettyFormulaAC + , prettyLNFormula ) where -import Prelude hiding (negate) +import Prelude hiding (negate) import Data.Binary import Data.DeriveTH -import Data.Foldable (Foldable, foldMap) +import Data.Foldable (Foldable, foldMap) import Data.Generics -import Data.Monoid hiding (All) +import Data.Monoid hiding (All) import Data.Traversable import Control.Basics import Control.DeepSeq import Control.Monad.Fresh +import qualified Control.Monad.Trans.PreciseFresh as Precise import Theory.Model.Atom @@ -244,9 +242,6 @@ -- Formulas modulo E and modulo AC ------------------------------------------------------------------------------ -type FormulaE = LFormula Name -type FormulaAC = LFormula Name - -- | Introduce a bound variable for a free variable. quantify :: (Ord c, Ord v, Eq v) => v -> Formula s c v -> Formula s c v quantify x = @@ -270,8 +265,8 @@ -- | Pretty print a formula. prettyLFormula :: (HighlightDocument d, MonadFresh m, Ord c) => (Atom (VTerm c LVar) -> d) -- ^ Function for pretty printing atoms - -> LFormula c -- ^ Formula to pretty print. - -> m d -- ^ Pretty printed formula. + -> LFormula c -- ^ Formula to pretty print. + -> m d -- ^ Pretty printed formula. prettyLFormula ppAtom = pp where @@ -279,43 +274,42 @@ extractFree (Bound i) = error $ "prettyFormula: illegal bound variable '" ++ show i ++ "'" pp (Ato a) = return $ ppAtom (fmap (mapLits (fmap extractFree)) a) - pp (TF True) = return $ operator_ "T" -- "⊤" - pp (TF False) = return $ operator_ "F" -- "⊥" + pp (TF True) = return $ operator_ "⊤" -- "T" + pp (TF False) = return $ operator_ "⊥" -- "F" pp (Not p) = do p' <- pp p - return $ operator_ "not" <> opParens p' -- text "¬" <> parens (pp a) + return $ operator_ "¬" <> opParens p' -- text "¬" <> parens (pp a) + -- return $ operator_ "not" <> opParens p' -- text "¬" <> parens (pp a) pp (Conn op p q) = do p' <- pp p q' <- pp q return $ sep [opParens p' <-> operator_ (ppOp op), opParens q'] where - ppOp And = "&" -- "∧" - ppOp Or = "|" -- "∨" - ppOp Imp = "==>" -- "⇒" - ppOp Iff = "<=>" -- "⇔" + ppOp And = "∧" -- "&" + ppOp Or = "∨" -- "|" + ppOp Imp = "⇒" -- "==>" + ppOp Iff = "⇔" -- "<=>" - pp fm@(Qua _ _ _) = do - (vs,qua,fm') <- openFormulaPrefix fm - d' <- pp fm' - return $ sep - [ operator_ (ppQuant qua) <> ppVars vs <> operator_ "." - , nest 1 d'] + pp fm@(Qua _ _ _) = + scopeFreshness $ do + (vs,qua,fm') <- openFormulaPrefix fm + d' <- pp fm' + return $ sep + [ operator_ (ppQuant qua) <> ppVars vs <> operator_ "." + , nest 1 d'] where ppVars = fsep . map (text . show) - ppQuant All = "All " -- "∀" - ppQuant Ex = "Ex " -- "∃" + ppQuant All = "∀ " -- "All " + ppQuant Ex = "∃ " -- "Ex " -prettyFormulaAC, prettyFormulaE :: HighlightDocument d => FormulaE -> d -prettyFormulaE = prettyLNFormula -prettyFormulaAC = prettyLNFormula -- | Pretty print a logical formula prettyLNFormula :: HighlightDocument d => LNFormula -> d prettyLNFormula fm = - prettyLFormula prettyNAtom fm `evalFreshAvoiding` fm + Precise.evalFresh (prettyLFormula prettyNAtom fm) (avoidPrecise fm) -- Derived instances diff --git a/src/Theory/Model/Rule.hs b/src/Theory/Model/Rule.hs --- a/src/Theory/Model/Rule.hs +++ b/src/Theory/Model/Rule.hs @@ -97,6 +97,7 @@ import Prelude hiding (id, (.)) import Data.Binary +import qualified Data.ByteString.Char8 as BC import Data.DeriveTH import Data.Foldable (foldMap) import Data.Generics @@ -304,8 +305,8 @@ -- | An intruder rule modulo AC is described by its name. data IntrRuleACInfo = - ConstrRule String - | DestrRule String + ConstrRule BC.ByteString + | DestrRule BC.ByteString | CoerceRule | IRecvRule | ISendRule @@ -560,8 +561,8 @@ CoerceRule -> "coerce" FreshConstrRule -> "fresh" PubConstrRule -> "pub" - ConstrRule name -> prefixIfReserved ('c' : name) - DestrRule name -> prefixIfReserved ('d' : name) + ConstrRule name -> prefixIfReserved ('c' : BC.unpack name) + DestrRule name -> prefixIfReserved ('d' : BC.unpack name) prettyNamedRule :: (HighlightDocument d, HasRuleName (Rule i)) => d -- ^ Prefix. @@ -573,7 +574,7 @@ , if null (L.get rActs ru) then operator_ "-->" else fsep [operator_ "--[", ppFacts rActs, operator_ "]->"] - , nest 1 $ ppFactsList rConcs]) $--$ + , nest 1 $ ppFactsList rConcs]) $-$ nest 2 (ppInfo $ L.get rInfo ru) where ppList pp = fsep . punctuate comma . map pp diff --git a/src/Theory/Model/Signature.hs b/src/Theory/Model/Signature.hs --- a/src/Theory/Model/Signature.hs +++ b/src/Theory/Model/Signature.hs @@ -46,7 +46,7 @@ import System.IO.Unsafe (unsafePerformIO) import Term.Maude.Process (MaudeHandle, mhFilePath, mhMaudeSig, startMaude) -import Term.Maude.Signature (MaudeSig, enableDH, minimalMaudeSig, prettyMaudeSig) +import Term.Maude.Signature (MaudeSig, minimalMaudeSig, prettyMaudeSig) import Theory.Text.Pretty @@ -162,12 +162,8 @@ -- | Pretty-print a signature with maude. prettySignaturePure :: HighlightDocument d => SignaturePure -> d -prettySignaturePure sig = vsep $ map combine $ - -- FIXME: Print Maude signature completely, this is only used for - -- intruder-variants for now. - [ ("builtin", text "diffie-hellman" ) | enableDH . L.get sigpMaudeSig $ sig ] - where - combine (header, d) = fsep [keyword_ header <> colon, nest 2 d] +prettySignaturePure sig = + prettyMaudeSig $ L.get sigpMaudeSig sig -- | Pretty-print a pure signature. prettySignatureWithMaude :: HighlightDocument d => SignatureWithMaude -> d diff --git a/src/Theory/Proof.hs b/src/Theory/Proof.hs --- a/src/Theory/Proof.hs +++ b/src/Theory/Proof.hs @@ -76,7 +76,6 @@ import Data.Maybe import Data.Monoid import Data.Traversable -import Safe import Debug.Trace @@ -182,12 +181,12 @@ -------------------- -- | A proof using the 'sorry' proof method. -sorry :: String -> a -> Proof a +sorry :: Maybe String -> a -> Proof a sorry reason ann = LNode (ProofStep (Sorry reason) ann) M.empty -- | A proof denoting an unproven part of the proof. unproven :: a -> Proof a -unproven = sorry "not yet proven" +unproven = sorry Nothing -- Paths in proofs @@ -236,7 +235,7 @@ where go n (LNode ps@(ProofStep _ info) cs) | 0 < n = LNode ps $ M.map (go (pred n)) cs - | otherwise = sorry ("bound " ++ show bound ++ " hit") info + | otherwise = sorry (Just $ "bound " ++ show bound ++ " hit") info -- | Fold a proof. foldProof :: Monoid m => (ProofStep a -> m) -> Proof a -> m @@ -261,24 +260,30 @@ -- | The status of a 'Proof'. data ProofStatus = - CompleteProof -- ^ The proof is complete: no sorry, no attack - | IncompleteProof -- ^ There is a sorry, but no attack. - | TraceFound -- ^ There is an attack + UndeterminedProof -- ^ All steps are unannotated + | CompleteProof -- ^ The proof is complete: no annotated sorry, + -- no annotated solved step + | IncompleteProof -- ^ There is a annotated sorry, + -- but no annotatd solved step. + | TraceFound -- ^ There is an annotated solved step instance Monoid ProofStatus where mempty = CompleteProof - mappend TraceFound _ = TraceFound - mappend _ TraceFound = TraceFound - mappend IncompleteProof _ = IncompleteProof - mappend _ IncompleteProof = IncompleteProof - mappend CompleteProof CompleteProof = CompleteProof + mappend TraceFound _ = TraceFound + mappend _ TraceFound = TraceFound + mappend IncompleteProof _ = IncompleteProof + mappend _ IncompleteProof = IncompleteProof + mappend _ CompleteProof = CompleteProof + mappend CompleteProof _ = CompleteProof + mappend UndeterminedProof UndeterminedProof = UndeterminedProof -- | The status of a 'ProofStep'. -proofStepStatus :: ProofStep a -> ProofStatus -proofStepStatus (ProofStep Solved _) = TraceFound -proofStepStatus (ProofStep (Sorry _) _) = IncompleteProof -proofStepStatus (ProofStep _ _) = CompleteProof +proofStepStatus :: ProofStep (Maybe a) -> ProofStatus +proofStepStatus (ProofStep _ Nothing ) = UndeterminedProof +proofStepStatus (ProofStep Solved (Just _)) = TraceFound +proofStepStatus (ProofStep (Sorry _) (Just _)) = IncompleteProof +proofStepStatus (ProofStep _ (Just _)) = CompleteProof {- TODO: Test and probably improve @@ -314,22 +319,45 @@ -> System -> Proof a -> Proof (Maybe a, Maybe System) -checkProof ctxt prover d se (LNode (ProofStep method info) cs) = - fromMaybe (node method (M.map noSystemPrf cs)) $ headMay $ do - cases <- maybe mzero return $ execProofMethod ctxt method se - return $ node method $ checkChildren cases - +checkProof ctxt prover d sys prf@(LNode (ProofStep method info) cs) = + case (method, execProofMethod ctxt method sys) of + (Sorry reason, _ ) -> sorryNode reason cs + (_ , Just cases) -> node method $ checkChildren cases + (_ , Nothing ) -> + sorryNode (Just "invalid proof step encountered") + (M.singleton "" prf) where - node m = LNode (ProofStep m (Just info, Just se)) - - noSystemPrf = mapProofInfo (\i -> (Just i, Nothing)) + node m = LNode (ProofStep m (Just info, Just sys)) + sorryNode reason cases = node (Sorry reason) (M.map noSystemPrf cases) + noSystemPrf = mapProofInfo (\i -> (Just i, Nothing)) - checkChildren cases = - mergeMapsWith unhandledCase noSystemPrf (checkProof ctxt prover (d + 1)) cases cs + checkChildren cases = mergeMapsWith + unhandledCase noSystemPrf (checkProof ctxt prover (d + 1)) cases cs where unhandledCase = mapProofInfo ((,) Nothing) . prover d +-- | Annotate a proof with the constraint systems of all intermediate steps +-- under the assumption that all proof steps are valid. If some proof steps +-- might be invalid, then you must use 'checkProof', which handles them +-- gracefully. +annotateWithSystems :: ProofContext -> System -> Proof () -> Proof System +annotateWithSystems ctxt = + go + where + -- Here we are careful to construct the result such that an inspection of + -- the proof does not force the recomputed constraint systems. + go sysOrig (LNode (ProofStep method _) csOrig) = + LNode (ProofStep method sysOrig) $ M.fromList $ do + (name, prf) <- M.toList csOrig + let sysAnn = extract ("case '" ++ name ++ "' non-existent") $ + M.lookup name csAnn + return (name, go sysAnn prf) + where + extract msg = fromMaybe (error $ "annotateWithSystems: " ++ msg) + csAnn = extract "proof method execution failed" $ + execProofMethod ctxt method sysOrig + ------------------------------------------------------------------------------ -- Provers: the interface to the outside world. ------------------------------------------------------------------------------ @@ -381,7 +409,7 @@ return $ LNode (ProofStep method (Just se)) (M.map (unproven . Just) cases) -- | Replace the current proof with a sorry step and the given reason. -sorryProver :: String -> Prover +sorryProver :: Maybe String -> Prover sorryProver reason = Prover $ \_ _ se _ -> return $ sorry reason (Just se) -- | Apply a prover only to a sub-proof, fails if the subproof doesn't exist. @@ -400,11 +428,11 @@ checkAndExtendProver prover0 = Prover $ \ctxt d se prf -> return $ mapProofInfo snd $ checkProof ctxt (prover ctxt) d se prf where - unhandledCase = sorry "unhandled case" Nothing + unhandledCase = sorry (Just "unhandled case") Nothing prover ctxt d se = fromMaybe unhandledCase $ runProver prover0 ctxt d se unhandledCase --- | Replace all annotated sorry steps with +-- | Replace all annotated sorry steps using the given prover. replaceSorryProver :: Prover -> Prover replaceSorryProver prover0 = Prover prover where @@ -433,6 +461,7 @@ ------------------------------------------------------------------------------ data SolutionExtractor = CutDFS | CutBFS | CutNothing + deriving( Eq, Ord, Show, Read ) data AutoProver = AutoProver { apHeuristic :: Heuristic @@ -452,8 +481,10 @@ -- | The standard automatic prover that ignores the existing proof and -- tries to find one by itself. autoProver :: Prover - autoProver = Prover $ \ctxt depth se _ -> - return $ fmap (fmap Just) $ proveSystemDFS heuristic ctxt depth se + autoProver = Prover $ \ctxt depth sys _ -> + return $ fmap (fmap Just) + $ annotateWithSystems ctxt sys + $ proveSystemDFS heuristic ctxt depth sys -- | Bound the depth of proofs generated by the given prover. boundProver :: Int -> Prover -> Prover @@ -479,7 +510,7 @@ -- -- FIXME: Note that this function may use a lot of space, as it holds onto the -- whole proof tree. -cutOnSolvedDFS :: Proof (Maybe System) -> Proof (Maybe System) +cutOnSolvedDFS :: Proof (Maybe a) -> Proof (Maybe a) cutOnSolvedDFS prf0 = go (4 :: Integer) $ insertPaths prf0 where @@ -491,10 +522,19 @@ findSolved d node | d >= dMax = MaybeNoSolution | otherwise = case node of - LNode (ProofStep Solved (_,path)) _ -> Solution path - LNode _ cs -> - foldMap (findSolved (succ d)) cs + -- do not search in nodes that are not annotated + LNode (ProofStep _ (Nothing, _ )) _ -> NoSolution + LNode (ProofStep Solved (Just _ , path)) _ -> Solution path + LNode (ProofStep _ (Just _ , _ )) cs -> + foldMap (findSolved (succ d)) + (cs `using` parTraversable nfProofMethod) + nfProofMethod node = do + void $ rseq (psMethod $ root node) + void $ rseq (psInfo $ root node) + void $ rseq (children node) + return node + extractSolved [] p = p extractSolved (label:ps) (LNode pstep m) = case M.lookup label m of Just subprf -> @@ -502,9 +542,8 @@ Nothing -> error "Theory.Constraint.cutOnSolvedDFS: impossible, extractSolved failed, invalid path" - -- | Search for attacks in a BFS manner. -cutOnSolvedBFS :: Proof a -> Proof a +cutOnSolvedBFS :: Proof (Maybe a) -> Proof (Maybe a) cutOnSolvedBFS = go (1::Int) where @@ -512,12 +551,13 @@ -- FIXME: See if that poor man's logging could be done better. trace ("searching for attacks at depth: " ++ show l) $ case S.runState (checkLevel l prf) CompleteProof of - (_, CompleteProof) -> prf - (_, IncompleteProof) -> go (l+1) prf - (prf', TraceFound) -> + (_, UndeterminedProof) -> error "cutOnSolvedBFS: impossible" + (_, CompleteProof) -> prf + (_, IncompleteProof) -> go (l+1) prf + (prf', TraceFound) -> trace ("attack found at depth: " ++ show l) prf' - checkLevel 0 (LNode step@(ProofStep Solved _) _) = + checkLevel 0 (LNode step@(ProofStep Solved (Just _)) _) = S.put TraceFound >> return (LNode step M.empty) checkLevel 0 prf@(LNode (ProofStep _ x) cs) | M.null cs = return prf @@ -526,18 +566,22 @@ msg <- case st of TraceFound -> return $ "ignored (attack exists)" _ -> S.put IncompleteProof >> return "bound reached" - return $ LNode (ProofStep (Sorry msg) x) M.empty - checkLevel l (LNode step cs) = - LNode step <$> traverse (checkLevel (l-1)) cs + return $ LNode (ProofStep (Sorry (Just msg)) x) M.empty + checkLevel l prf@(LNode step cs) + | isNothing (psInfo step) = return prf + | otherwise = LNode step <$> traverse (checkLevel (l-1)) cs --- | @proveSystemDFS rules se@ tries to construct a proof that @se@ is valid --- using a depth-first-search strategy to resolve the non-determinism wrt. what --- goal to solve next. This proof can be of infinite depth, if the proof --- strategy loops. Children at the same level are evaluated in parallel. -proveSystemDFS :: Heuristic -> ProofContext -> Int -> System -> Proof System +-- | @proveSystemDFS rules se@ explores all solutions of the initial +-- constraint system using a depth-first-search strategy to resolve the +-- non-determinism wrt. what goal to solve next. This proof can be of +-- infinite depth, if the proof strategy loops. +-- +-- Use 'annotateWithSystems' to annotate the proof tree with the constraint +-- systems. +proveSystemDFS :: Heuristic -> ProofContext -> Int -> System -> Proof () proveSystemDFS heuristic ctxt d0 sys0 = - prove d0 sys0 -- `using` parLTreeDFS + prove d0 sys0 where prove !depth sys = case rankProofMethods (useHeuristic heuristic depth) ctxt sys of @@ -545,28 +589,14 @@ (method, (cases, _expl)):_ -> node method cases where node method cases = - LNode (ProofStep method sys) (M.map (prove (succ depth)) cases) + LNode (ProofStep method ()) (M.map (prove (succ depth)) cases) + ------------------------------------------------------------------------------ -- Pretty printing ------------------------------------------------------------------------------ -{- NOT used anymore --- | Consistently simplify variable indices in the proof; i.e., rename all --- free variables in a top-down fashion using the 'Precise.FreshT' --- transformer. -simplifyVariableIndices :: HasFrees a => Proof a -> Proof a -simplifyVariableIndices = - go noBindings Precise.nothingUsed - where - go bindSt freshSt (LNode step cs) = - case Precise.runFresh (runBindT (someInst step) bindSt) freshSt of - ((step', bindSt'), freshSt') -> - LNode step' (M.map (go bindSt' freshSt') cs) --} - - prettyProof :: HighlightDocument d => Proof a -> d prettyProof = prettyProofWith (prettyProofMethod . psMethod) (const id) @@ -595,11 +625,12 @@ -- | Convert a proof status to a redable string. showProofStatus :: SystemTraceQuantifier -> ProofStatus -> String -showProofStatus ExistsNoTrace TraceFound = "falsified - found trace" -showProofStatus ExistsNoTrace CompleteProof = "verified" -showProofStatus ExistsSomeTrace CompleteProof = "falsified - no trace found" -showProofStatus ExistsSomeTrace TraceFound = "verified" -showProofStatus _ IncompleteProof = "analysis incomplete" +showProofStatus ExistsNoTrace TraceFound = "falsified - found trace" +showProofStatus ExistsNoTrace CompleteProof = "verified" +showProofStatus ExistsSomeTrace CompleteProof = "falsified - no trace found" +showProofStatus ExistsSomeTrace TraceFound = "verified" +showProofStatus _ IncompleteProof = "analysis incomplete" +showProofStatus _ UndeterminedProof = "analysis undetermined" -- Derived instances diff --git a/src/Theory/Text/Lexer.hs b/src/Theory/Text/Lexer.hs deleted file mode 100644 --- a/src/Theory/Text/Lexer.hs +++ /dev/null @@ -1,621 +0,0 @@ -{-# LANGUAGE CPP,MagicHash #-} -{-# LINE 1 "src/Theory/Lexer.x" #-} - -{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-missing-signatures -fno-warn-lazy-unlifted-bindings #-} -module Theory.Text.Lexer where - - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#elif defined(__GLASGOW_HASKELL__) -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -alex_base :: AlexAddr -alex_base = AlexA# "\x01\x00\x00\x00\xd9\x00\x00\x00\x4f\x01\x00\x00\x28\x00\x00\x00\x2c\x00\x00\x00\x2d\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x01\x00\x00\x6e\x02\x00\x00\x3e\x03\x00\x00\x0e\x04\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\xde\x04\x00\x00\xae\x05\x00\x00\x7e\x06\x00\x00\x4e\x07\x00\x00\x1e\x08\x00\x00\xee\x08\x00\x00\xbe\x09\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x8e\x0a\x00\x00\x5e\x0b\x00\x00\x2e\x0c\x00\x00\xfe\x0c\x00\x00\xce\x0d\x00\x00\x9e\x0e\x00\x00\x6e\x0f\x00\x00\x3e\x10\x00\x00\x0e\x11\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\xc7\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\xde\x11\x00\x00\xae\x12\x00\x00\x7e\x13\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x00\x4a\x00\x3d\x00\x44\x00\x42\x00\x45\x00\x4b\x00\x3c\x00\x08\x00\x35\x00\x46\x00\x50\x00\x34\x00\x4f\x00\x4d\x00\x06\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\xff\xff\xff\xff\x07\x00\x09\x00\x0b\x00\x41\x00\xff\xff\x47\x00\x40\x00\x48\x00\x49\x00\x43\x00\x0f\x00\x0d\x00\x30\x00\x10\x00\x12\x00\x04\x00\x03\x00\x14\x00\x16\x00\x1c\x00\x25\x00\x3a\x00\x00\x00\x53\x00\x52\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x00\x3b\x00\x37\x00\x3f\x00\x4e\x00\xff\xff\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x00\x4c\x00\x39\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x0a\x00\x15\x00\x0e\x00\x15\x00\x15\x00\x15\x00\x15\x00\x11\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x0c\x00\x32\x00\x31\x00\x32\x00\x32\x00\x32\x00\x32\x00\x13\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x18\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x19\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x1a\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x1e\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x26\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x1f\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x20\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x21\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x22\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x23\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x27\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x28\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x29\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x2a\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x2b\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x2c\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x2d\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x2e\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x00\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00\x57\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0a\x00\x2a\x00\x2a\x00\x2a\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x2a\x00\x29\x00\x7d\x00\x2a\x00\x2a\x00\x2f\x00\x20\x00\x2f\x00\x2a\x00\x2a\x00\x2a\x00\x5c\x00\xff\xff\x3e\x00\x2d\x00\x2d\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf7\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xff\xff\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\x56\x00\xff\xff\xff\xff\xff\xff\x05\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,88) [[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_29))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_23))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_20))],[(AlexAcc (alex_action_22))],[(AlexAcc (alex_action_24))],[(AlexAcc (alex_action_25))],[(AlexAcc (alex_action_26))],[(AlexAcc (alex_action_27))],[(AlexAcc (alex_action_28))],[(AlexAcc (alex_action_30))],[],[(AlexAcc (alex_action_31))],[(AlexAcc (alex_action_32))],[(AlexAcc (alex_action_33))],[(AlexAcc (alex_action_34))],[(AlexAcc (alex_action_35))],[(AlexAcc (alex_action_36))],[(AlexAcc (alex_action_37))],[(AlexAcc (alex_action_38))],[(AlexAcc (alex_action_39))],[(AlexAcc (alex_action_40))],[(AlexAcc (alex_action_41))],[(AlexAcc (alex_action_42))],[(AlexAcc (alex_action_43))],[(AlexAcc (alex_action_44))],[(AlexAcc (alex_action_45))],[(AlexAcc (alex_action_46))],[(AlexAcc (alex_action_47))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_49))],[(AlexAcc (alex_action_50))],[(AlexAcc (alex_action_51))],[(AlexAcc (alex_action_52))],[(AlexAcc (alex_action_53))],[(AlexAcc (alex_action_54))],[],[(AlexAcc (alex_action_55))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_56))]] -{-# LINE 84 "src/Theory/Lexer.x" #-} - - --- | Lex a keyword -keyword :: Keyword -> AlexAction Keyword -keyword kw input len = return kw - --- | Wrap a string into a keyword -scanString :: (String -> Keyword) -> AlexAction Keyword -scanString kw (_,_,input) len = return $ kw (take len input) - -{- --- | Scan a string until EOF is encountered. -alexScanTokens :: String -> Either String [Keyword] -alexScanTokens inp = runAlex inp gather - where - gather = do - t <- alexMonadScan - case trace (show t) t of - EOF -> return [EOF] - _ -> (t:) `liftM` gather - --- | Scan a file. -scanFile f = do - inp <- readFile f - return $ alexScanTokens inp --} - --- | Formal text types. -data TextType = - TextBegin String - | TextContent String - | TextEnd - deriving( Eq, Ord, Show ) - --- | Lexable Keywords -data Keyword = - IDENT String - | TEXT TextType - | SQUOTE - | DQUOTE - | RIGHTARROW - | LEFTARROW - | LONGRIGHTARROW - | LONGLEFTARROW - | COMMA - | DOT - | COLON - | QUESTIONMARK - | BANG - | AND - | MID - | DOLLAR - | AT - | SHARP - | PERCENT - | LPAREN - | RPAREN - | LBRACKET - | RBRACKET - | LBRACE - | RBRACE - | SLASH - | BACKSLASH - | TILDE - | HAT - | STAR - | UNDERSCORE - | MINUS - | PLUS - | EQUAL - | LESS - | GREATER - | EOF - | FORALL - | EXISTS - | LAND - | LOR - | LNOT - | APPROX - -- dummy keyword to get rid of overlapping pattern matches - | DUMMY_KEYWORD - deriving( Eq ) - -instance Show Keyword where - show kw = case kw of - IDENT i -> identifier i - TEXT t -> txt t - SQUOTE -> symbol "'" - DQUOTE -> symbol "\"" - RIGHTARROW -> symbol "->" - LEFTARROW -> symbol "<-" - LONGRIGHTARROW -> symbol "-->" - LONGLEFTARROW -> symbol "<--" - COMMA -> symbol "," - DOT -> symbol "." - COLON -> symbol ":" - QUESTIONMARK -> symbol "?" - BANG -> symbol "!" - AND -> symbol "&" - MID -> symbol "|" - DOLLAR -> symbol "$" - AT -> symbol "@" - SHARP -> symbol "#" - PERCENT -> symbol "%" - LPAREN -> symbol "(" - RPAREN -> symbol ")" - LBRACKET -> symbol "[" - RBRACKET -> symbol "]" - LBRACE -> symbol "{" - RBRACE -> symbol "}" - SLASH -> symbol "/" - BACKSLASH -> symbol "\\" - TILDE -> symbol "~" - HAT -> symbol "^" - STAR -> symbol "*" - UNDERSCORE -> symbol "_" - MINUS -> symbol "-" - PLUS -> symbol "+" - EQUAL -> symbol "=" - LESS -> symbol "<" - GREATER -> symbol ">" - EOF -> "end of file" - FORALL -> symbol "∀" - EXISTS -> symbol "∃" - LAND -> symbol "∧" - LOR -> symbol "∨" - LNOT -> symbol "¬" - APPROX -> symbol "≈" - DUMMY_KEYWORD -> "DUMMY_KEYWORD (this should not occur!)" - where - identifier i = "identifier `" ++ i ++ "'" - txt (TextBegin t) = "start of `" ++ t ++ "'" - txt (TextContent t) = "text `" ++ t ++ "'" - txt (TextEnd) = "start of text" - symbol s = "symbol `" ++ s ++ "'" - keyword s = "keyword `" ++ s ++ "'" - --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- The input type - - -type AlexInput = (AlexPosn, -- current position, - Char, -- previous char - String) -- current input string - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (p,c,s) = c - -alexGetChar :: AlexInput -> Maybe (Char,AlexInput) -alexGetChar (p,c,[]) = Nothing -alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq` - Just (c, (p', c, s)) - - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -data AlexPosn = AlexPn !Int !Int !Int - deriving (Eq) - -instance Show AlexPosn where - show (AlexPn _ l c) = "line "++show l++" column "++show c - -alexStartPos :: AlexPosn -alexStartPos = AlexPn 0 1 1 - -alexMove :: AlexPosn -> Char -> AlexPosn -alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1) -alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1 -alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) - - --- ----------------------------------------------------------------------------- --- Default monad - - -data AlexState = AlexState { - alex_pos :: !AlexPosn, -- position at current input location - alex_inp :: String, -- the current input - alex_chr :: !Char, -- the character before the input - alex_scd :: !Int, -- the current startcode - alex_ocd :: !Int, -- the old startcode before the comment started - alex_cmt :: [String] -- stack of begin comment identifiers - } - --- Compile with -funbox-strict-fields for best results! - -runAlex :: String -> Alex a -> Either String a -runAlex input (Alex f) - = case f (AlexState {alex_pos = alexStartPos, - alex_inp = input, - alex_chr = '\n', - alex_scd = 0, - alex_ocd = 0, - alex_cmt = [] - }) of - Left msg -> Left msg - Right ( _, a ) -> Right a - -newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } - -instance Monad Alex where - m >>= k = Alex $ \s -> case unAlex m s of - Left msg -> Left msg - Right (s',a) -> unAlex (k a) s' - return a = Alex $ \s -> Right (s,a) - -alexGetPos :: Alex AlexPosn -alexGetPos = Alex $ \s@AlexState{alex_pos=pos} -> Right (s, pos) - -alexGetInput :: Alex AlexInput -alexGetInput - = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_inp=inp} -> - Right (s, (pos,c,inp)) - -alexSetInput :: AlexInput -> Alex () -alexSetInput (pos,c,inp) - = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_inp=inp} of - s@(AlexState{}) -> Right (s, ()) - -alexError :: String -> Alex a -alexError message = Alex $ \s -> Left $ message ++ " in " ++ show (alex_pos s) - -alexGetStartCode :: Alex Int -alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc) - -alexSetStartCode :: Int -> Alex () -alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ()) - -alexGetOldStartCode :: Alex Int -alexGetOldStartCode = Alex $ \s@AlexState{alex_ocd=sc} -> Right (s, sc) - -alexSetOldStartCode :: Int -> Alex () -alexSetOldStartCode sc = Alex $ \s -> Right (s{alex_ocd=sc}, ()) - -alexGetComments :: Alex [String] -alexGetComments = Alex $ \s -> Right (s, alex_cmt s) - -alexSetComments :: [String] -> Alex () -alexSetComments cmt = Alex $ \s -> Right (s{alex_cmt=cmt}, ()) - -alexMonadScan = do - inp <- alexGetInput - sc <- alexGetStartCode - case alexScan inp sc of - AlexEOF -> alexEOF - AlexError inp' -> alexError "lexical error" - AlexSkip inp' len -> do - alexSetInput inp' - alexMonadScan - AlexToken inp' len action -> do - alexSetInput inp' - action inp len - --- ----------------------------------------------------------------------------- --- Useful token actions - -type AlexAction result = AlexInput -> Int -> Alex result - --- just ignore this token and scan another one -skip :: AlexAction Keyword -skip input len = alexMonadScan - --- ignore this token, but set the start code to a new value -begin :: Int -> AlexAction Keyword -begin code input len = do alexSetStartCode code; alexMonadScan - --- | Begin a text starting of the given type. -beginText :: String -> Int -> AlexAction Keyword -beginText ty code _ _ = do - alexSetStartCode code - return $ TEXT $ TextBegin ty - --- | End a text. -endText :: Int -> AlexAction Keyword -endText code _ _ = do - alexSetStartCode code - return $ TEXT TextEnd - --- | Begin a comment starting with the given sign. -beginComment :: String -> Int -> AlexAction Keyword -beginComment cmtBegin code input len = do - cmts <- alexGetComments - alexSetComments $ cmtBegin : cmts - if null cmts - then alexGetStartCode >>= alexSetOldStartCode - else return () - alexSetStartCode code - alexMonadScan - --- | End a comment that started with the given begin comment sign. -endComment :: String -> AlexAction Keyword -endComment cmtBegin input len = do - cmts <- alexGetComments - case cmts of - [] -> alexError $ "comment ended but no beginning '"++cmtBegin++"' marked." - (cmt:cmts') -> do - if cmt == cmtBegin - then do - alexSetComments cmts' - if null cmts' - then alexGetOldStartCode >>= alexSetStartCode - else return () - else return () - alexMonadScan - --- perform an action for this token, and set the start code to a new value --- andBegin :: AlexAction result -> Int -> AlexAction result -(action `andBegin` code) input len = do alexSetStartCode code; action input len - -alexEOF :: Alex Keyword -alexEOF = return EOF - - - - - -comment,text :: Int -comment = 1 -text = 2 -alex_action_2 = beginComment "(*" comment -alex_action_3 = beginComment "(*" comment -alex_action_4 = beginComment "(*" comment -alex_action_5 = endComment "(*" -alex_action_6 = beginComment "/*" comment -alex_action_7 = beginComment "/*" comment -alex_action_8 = beginComment "/*" comment -alex_action_9 = endComment "/*" -alex_action_10 = skip -alex_action_11 = beginText "text" text -alex_action_12 = beginText "section" text -alex_action_13 = beginText "subsection" text -alex_action_14 = endText 0 -alex_action_15 = scanString (TEXT . TextContent) -alex_action_16 = keyword FORALL -alex_action_17 = keyword EXISTS -alex_action_18 = keyword LAND -alex_action_19 = keyword LOR -alex_action_20 = keyword LNOT -alex_action_21 = keyword APPROX -alex_action_22 = keyword COMMA -alex_action_23 = keyword LPAREN -alex_action_24 = keyword RPAREN -alex_action_25 = keyword LBRACKET -alex_action_26 = keyword RBRACKET -alex_action_27 = keyword LBRACE -alex_action_28 = keyword RBRACE -alex_action_29 = keyword SLASH -alex_action_30 = keyword BACKSLASH -alex_action_31 = keyword SQUOTE -alex_action_32 = keyword DQUOTE -alex_action_33 = keyword TILDE -alex_action_34 = keyword HAT -alex_action_35 = keyword EQUAL -alex_action_36 = keyword COLON -alex_action_37 = keyword DOLLAR -alex_action_38 = keyword AT -alex_action_39 = keyword SHARP -alex_action_40 = keyword PERCENT -alex_action_41 = keyword STAR -alex_action_42 = keyword LESS -alex_action_43 = keyword GREATER -alex_action_44 = keyword QUESTIONMARK -alex_action_45 = keyword BANG -alex_action_46 = keyword AND -alex_action_47 = keyword MID -alex_action_48 = keyword DOT -alex_action_49 = keyword UNDERSCORE -alex_action_50 = keyword MINUS -alex_action_51 = keyword PLUS -alex_action_52 = keyword RIGHTARROW -alex_action_53 = keyword LEFTARROW -alex_action_54 = keyword LONGRIGHTARROW -alex_action_55 = keyword LONGLEFTARROW -alex_action_56 = scanString IDENT -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "templates/GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 37 "templates/GenericTemplate.hs" #-} - -{-# LINE 47 "templates/GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# - -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetChar input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input'' len, _) -> - - - - AlexSkip input'' len - - (AlexLastAcc k input''' len, _) -> - - - - AlexToken input''' len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = check_accs (alex_accept `quickIndex` (I# (s))) - in - new_acc `seq` - case alexGetChar input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - let - (base) = alexIndexInt32OffAddr alex_base s - ((I# (ord_c))) = ord c - (offset) = (base +# ord_c) - (check) = alexIndexInt16OffAddr alex_check offset - - (new_s) = if (offset >=# 0#) && (check ==# ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (len +# 1#) - new_input new_s new_acc - - where - check_accs [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) - check_accs (AlexAccPred a predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkipPred predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -data AlexAcc a user - = AlexAcc a - | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/src/Theory/Text/Parser.hs b/src/Theory/Text/Parser.hs --- a/src/Theory/Text/Parser.hs +++ b/src/Theory/Text/Parser.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TupleSections #-} -- | -- Copyright : (c) 2010-2012 Simon Meier, Benedikt Schmidt -- License : GPL v3 (see LICENSE) @@ -6,174 +5,56 @@ -- Maintainer : Simon Meier -- Portability : portable -- --- Parsing protocol theories. +-- Parsing protocol theories. See the MANUAL for a high-level description of +-- the syntax. module Theory.Text.Parser ( parseOpenTheory , parseOpenTheoryString - , parseProofMethod , parseLemma , parseIntruderRulesDH + + -- * Cached Message Deduction Rule Variants + , intruderVariantsFile + , addMessageDeductionRuleVariants ) where -import Prelude hiding (id, (.)) +import Prelude hiding (id, (.)) -import qualified Data.ByteString.Char8 as BC -import Data.Char (toUpper, isUpper, isDigit) -import Data.Foldable (asum) +import qualified Data.ByteString.Char8 as BC +import Data.Char (isUpper, toUpper) +import Data.Foldable (asum) import Data.Label -import qualified Data.Map as M -import Data.Monoid -import qualified Data.Set as S +import qualified Data.Map as M +import Data.Monoid hiding (Last) +import qualified Data.Set as S -import Control.Applicative hiding (empty, many, optional) +import Control.Applicative hiding (empty, many, optional) import Control.Category import Control.Monad -import Text.Parsec hiding (token, (<|>), string ) -import qualified Text.Parsec as P -import Text.Parsec.Pos -import Text.PrettyPrint.Class (render) +import Extension.Prelude (ifM) +import Text.Parsec hiding ((<|>)) +import Text.PrettyPrint.Class (render) + +import Paths_tamarin_prover +import System.Directory + import Term.Substitution import Term.SubtermRule import Theory -import Theory.Text.Lexer - ( Keyword(..), TextType(..), runAlex, AlexPosn(..) - , alexGetPos, alexMonadScan - ) +import Theory.Text.Parser.Token +import Theory.Tools.IntruderRules ------------------------------------------------------------------------------- --- Specializing Parsec to our needs ------------------------------------------------------------------------------- --- Scanner ----------- --- | The tokens delivered by our Alex based scanner -type Token = (SourcePos, Keyword) --- | Scan a string using the given filename in the error messages. --- --- NOTE: Lexical errors are thrown using 'error'. -scanString :: FilePath -> String -> [Token] -scanString filename s = - case runAlex s gatherUntilEOF of - Left err -> error err - Right kws -> kws - where - gatherUntilEOF = do - AlexPn _ line col <- alexGetPos - let pos = newPos filename line col - k <- alexMonadScan - case k of - EOF -> return [(pos,EOF)] - _ -> do kws <- gatherUntilEOF - return $ (pos,k) : kws --- Parser ---------- - --- | A parser for a stream of tokens. -type Parser a = Parsec [Token] MaudeSig a - --- | Parse a token based on the acceptance condition -token :: (Keyword -> Maybe a) -> Parser a -token p = P.token (show . snd) fst (p . snd) - --- | Parse a term. -kw :: Keyword -> Parser () -kw t = token check - where - check t' | t == t' = Just () | otherwise = Nothing - --- | Parse content between keywords. -betweenKWs :: Keyword -> Keyword -> Parser a -> Parser a -betweenKWs l r = between (kw l) (kw r) - -{- --- | Between braces. -braced :: Parser a -> Parser a -braced = betweenKWs LBRACE RBRACE --} - --- | Between parentheses. -parens :: Parser a -> Parser a -parens = betweenKWs LPAREN RPAREN - --- | Between single quotes. -singleQuoted :: Parser a -> Parser a -singleQuoted = betweenKWs SQUOTE SQUOTE - --- | Between double quotes. -doubleQuoted :: Parser a -> Parser a -doubleQuoted = betweenKWs DQUOTE DQUOTE - --- | Parse an identifier as a string -identifier :: Parser String -identifier = token extract - where extract (IDENT name) - -- don't allow certain reserved words as identifiers - | not (name `elem` ["in","let","rule"]) = Just name - extract _ = Nothing - --- | Parse an identifier as a string -string :: String -> Parser () -string cs = token extract - where extract (IDENT name) | cs == name = Just () - extract _ = Nothing - --- | Parse a sequence of fixed strings. -strings :: [String] -> Parser () -strings = mapM_ string - --- | Parse an integer. -integer :: Parser Int -integer = do i <- identifier - guard (all isDigit i) - return (read i) - --- | A comma separated list of elements. -commaSep :: Parser a -> Parser [a] -commaSep = (`sepBy` kw COMMA) - -{- --- | A comma separated non-empty list of elements. -commaSep1 :: Parser a -> Parser [a] -commaSep1 = (`sepBy1` kw COMMA) --} - --- | Parse a list of items '[' item ',' ... ',' item ']' -list :: Parser a -> Parser [a] -list p = kw LBRACKET *> commaSep p <* kw RBRACKET - --- | A formal comment; i.e., (header, body) -formalComment :: Parser (String, String) -formalComment = - (,) <$> text begin - <*> (concat <$> many (text content) <* text end) - where - text f = token (\t -> case t of TEXT ty -> f ty; _ -> mzero) - begin (TextBegin str) = return str - begin _ = mzero - content (TextContent str) = return str - content _ = mzero - end (TextEnd) = return () - end _ = mzero - - ------------------------------------------------------------------------------ -- Lexing and parsing theory files and proof methods ------------------------------------------------------------------------------ --- | Parser a file. -parseFile :: Parser a -> FilePath -> IO a -parseFile parser f = do - s <- readFile f - case runParser parser minimalMaudeSig f (scanString f s) of - Right p -> return p - Left err -> error $ show err - -- | Parse a security protocol theory file. parseOpenTheory :: [String] -- ^ Defined flags -> FilePath -> IO OpenTheory @@ -183,14 +64,6 @@ parseIntruderRulesDH :: FilePath -> IO [IntrRuleAC] parseIntruderRulesDH = parseFile (setState dhMaudeSig >> many intrRule) --- | Parse a security protocol theory file. --- TODO: This function seems to parse a string, not a file from a file path? -parseProofMethod :: FilePath -> Either ParseError ProofMethod -parseProofMethod = - runParser proofMethod minimalMaudeSig dummySource . scanString dummySource - where - dummySource = "" - -- | Parse a security protocol theory from a string. parseOpenTheoryString :: [String] -- ^ Defined flags. -> String -> Either ParseError OpenTheory @@ -200,106 +73,13 @@ parseLemma :: String -> Either ParseError (Lemma ProofSkeleton) parseLemma = parseFromString lemma --- | Run a given parser on a given string. -parseFromString :: Parser a -> String -> Either ParseError a -parseFromString parser = - runParser parser minimalMaudeSig dummySource . scanString dummySource - where - dummySource = "" - ------------------------------------------------------------------------------ -- Parsing Terms ------------------------------------------------------------------------------ - -{- -BNF: Not completely up to date... - -theory := 'theory' ident 'begin' protocol 'end' -protocol := rules -rules := rule | rule rules -intrrule := ident '[' intrinfo ']' ':' terms '-->' terms -intrinfo := 'Destr' | 'Constr' -protorule := ident ':' factList '-->' factList -factList := '[' [facts] ']' -facts := fact | fact ',' facts -protoFact := ident '(' terms ')' -terms := term | term ',' terms -term := lit | application | '<' term ',' terms '>' -- right assoc pairing -application := ident '(' terms ')' -lit := ident | '\'' ident '\'' -ident := ( - [ Init_1(I,R,ni), Send(encA(pk(R), )) ] - -// example intruder rule - - Exp [Constr]: - [ (x^_((x1*x2))), ((x3*x1)*_x4) ] - --> - [ (x^(x3*_((x4*x2)))) ] - --} - ------------------------------------------------------------------------------- --- Parsing Terms ------------------------------------------------------------------------------- - --- | Parse an identifier possibly indexed with a number. -indexedIdentifier :: Parser (String, Integer) -indexedIdentifier = do - (,) <$> identifier - <*> option 0 (try (kw DOT *> (fromIntegral <$> integer))) - --- | Parse a logical variable with the given sorts allowed. -sortedLVar :: [LSort] -> Parser LVar -sortedLVar ss = - asum $ map (try . mkSuffixParser) ss ++ map mkPrefixParser ss - where - mkSuffixParser s = do - (n, i) <- indexedIdentifier - kw COLON - string (sortSuffix s) - return (LVar n s i) - - mkPrefixParser s = do - case s of - LSortMsg -> pure () - LSortPub -> kw DOLLAR - LSortFresh -> kw TILDE - LSortNode -> kw SHARP - LSortMSet -> kw PERCENT - (n, i) <- indexedIdentifier - return (LVar n s i) - --- | An arbitrary logical variable. -lvar :: Parser LVar -lvar = sortedLVar [minBound..] - --- | Parse a non-node variable. -msgvar :: Parser LVar -msgvar = sortedLVar [LSortFresh, LSortPub, LSortMsg, LSortMSet] - --- | Parse a graph node variable. -nodevar :: Parser NodeId -nodevar = asum - [ sortedLVar [LSortNode] - , (\(n, i) -> LVar n LSortNode i) <$> indexedIdentifier ] - "node" - -- | Parse an lit with logical variables. llit :: Parser LNTerm -llit = asum - [ freshTerm <$> try (kw TILDE *> singleQuoted identifier) "fresh name" - , pubTerm <$> singleQuoted identifier "public name" - , varTerm <$> msgvar - ] +llit = asum [freshTerm <$> freshName, pubTerm <$> pubName, varTerm <$> msgvar] -- | Lookup the arity of a non-ac symbol. Fails with a sensible error message -- if the operator is not known. @@ -317,7 +97,7 @@ k <- lookupNonACArity op ts <- parens $ if k == 1 then return <$> tupleterm plit - else sepBy (multterm plit) (kw COMMA) + else commaSep (multterm plit) let k' = length ts when (k /= k') $ fail $ "operator `" ++ op ++"' has arity " ++ show k ++ @@ -329,7 +109,7 @@ binaryAlgApp plit = do op <- identifier k <- lookupNonACArity op - arg1 <- kw LBRACE *> tupleterm plit <* kw RBRACE + arg1 <- braced (tupleterm plit) arg2 <- term plit when (k /= 2) $ fail $ "only operators of arity 2 can be written using the `op{t1}t2' notation" @@ -340,7 +120,7 @@ term plit = asum [ pairing "pairs" , parens (multterm plit) - , string "1" *> pure fAppOne + , symbol "1" *> pure fAppOne , application "function application" , nullaryApp , plit @@ -348,40 +128,41 @@ "term" where application = asum $ map (try . ($ plit)) [naryOpApp, binaryAlgApp] - pairing = kw LESS *> tupleterm plit <* kw GREATER + pairing = angled (tupleterm plit) nullaryApp = do maudeSig <- getState - asum [ try (string (BC.unpack sym)) *> pure (fApp (NonAC (sym,0)) []) + -- FIXME: This try should not be necessary. + asum [ try (symbol (BC.unpack sym)) *> pure (fApp (NonAC (sym,0)) []) | (sym,0) <- S.toList $ allFunctionSymbols maudeSig ] -- | A left-associative sequence of exponentations. expterm :: Ord l => Parser (Term l) -> Parser (Term l) -expterm plit = chainl1 (term plit) ((\a b -> fAppExp (a,b)) <$ kw HAT) +expterm plit = chainl1 (term plit) ((\a b -> fAppExp (a,b)) <$ opExp) -- | A left-associative sequence of multiplications. multterm :: Ord l => Parser (Term l) -> Parser (Term l) multterm plit = do dh <- enableDH <$> getState if dh -- if DH is not enabled, do not accept 'multterm's and 'expterm's - then chainl1 (expterm plit) ((\a b -> fAppMult [a,b]) <$ kw STAR) + then chainl1 (expterm plit) ((\a b -> fAppMult [a,b]) <$ opMult) else term plit -- | A right-associative sequence of tuples. tupleterm :: Ord l => Parser (Term l) -> Parser (Term l) -tupleterm plit = chainr1 (multterm plit) ((\a b -> fAppPair (a,b))<$ kw COMMA) +tupleterm plit = chainr1 (multterm plit) ((\a b -> fAppPair (a,b)) <$ comma) -- | Parse a fact. fact :: Ord l => Parser (Term l) -> Parser (Fact (Term l)) -fact plit = - do multi <- option Linear (kw BANG *> pure Persistent) +fact plit = try ( + do multi <- option Linear (opBang *> pure Persistent) i <- identifier case i of [] -> fail "empty identifier" (c:_) | isUpper c -> return () | otherwise -> fail "facts must start with upper-case letters" - ts <- parens (sepBy (multterm plit) (kw COMMA)) + ts <- parens (commaSep (multterm plit)) mkProtoFact multi i ts - "protocol fact" + "fact" ) where singleTerm _ constr [t] = return $ constr t singleTerm f _ ts = fail $ "fact '" ++ f ++ "' used with arity " ++ @@ -390,7 +171,7 @@ mkProtoFact multi f = case map toUpper f of "OUT" -> singleTerm f outFact "IN" -> singleTerm f inFact - "KU" -> return . Fact KUFact + "KU" -> singleTerm f kuFact "KD" -> return . Fact KDFact "DED" -> return . Fact DedFact "FR" -> singleTerm f freshFact @@ -403,7 +184,7 @@ -- | Parse a "(modulo ..)" information. modulo :: String -> Parser () -modulo thy = parens $ strings ["modulo", thy] +modulo thy = parens $ symbol_ "modulo" *> symbol_ thy moduloE, moduloAC :: Parser () moduloE = modulo "E" @@ -413,12 +194,12 @@ -- | Parse a typing assertion modulo E. typeAssertions :: Parser TypingE typeAssertions = fmap TypingE $ - do try (strings ["type", "assertions"]) + do try (symbols ["type", "assertions"]) optional moduloE - kw COLON - many1 ((,) <$> (try (msgvar <* kw COLON)) + colon + many1 ((,) <$> (try (msgvar <* colon)) <*> ( commaSep1 (try $ multterm llit) <|> - (kw MINUS *> pure []) + (opMinus *> pure []) ) ) <|> pure [] @@ -429,7 +210,7 @@ -- contains them. protoRule :: Parser (ProtoRuleE) protoRule = do - name <- try (string "rule" *> optional moduloE *> identifier <* kw COLON) + name <- try (symbol "rule" *> optional moduloE *> identifier <* colon) subst <- option emptySubst letBlock (ps,as,cs) <- genericRule return $ apply subst $ Rule (StandRule name) ps cs as @@ -437,30 +218,30 @@ -- | Parse a let block with bottom-up application semantics. letBlock :: Parser LNSubst letBlock = do - toSubst <$> (string "let" *> many1 definition <* string "in") + toSubst <$> (symbol "let" *> many1 definition <* symbol "in") where toSubst = foldr1 compose . map (substFromList . return) - definition = (,) <$> (sortedLVar [LSortMsg] <* kw EQUAL) <*> multterm llit + definition = (,) <$> (sortedLVar [LSortMsg] <* equalSign) <*> multterm llit -- | Parse an intruder rule. intrRule :: Parser IntrRuleAC intrRule = do - info <- try (string "rule" *> moduloAC *> intrInfo <* kw COLON) + info <- try (symbol "rule" *> moduloAC *> intrInfo <* colon) (ps,as,cs) <- genericRule return $ Rule info ps cs as where intrInfo = do name <- identifier case name of - 'c':cname -> return $ ConstrRule cname - 'd':dname -> return $ DestrRule dname + 'c':cname -> return $ ConstrRule (BC.pack cname) + 'd':dname -> return $ DestrRule (BC.pack dname) _ -> fail $ "invalid intruder rule name '" ++ name ++ "'" genericRule :: Parser ([LNFact], [LNFact], [LNFact]) genericRule = (,,) <$> list (fact llit) - <*> ((pure [] <* kw LONGRIGHTARROW) <|> - (kw MINUS *> kw MINUS *> list (fact llit) <* kw RIGHTARROW)) + <*> ((pure [] <* symbol "-->") <|> + (symbol "--[" *> commaSep (fact llit) <* symbol "]->")) <*> list (fact llit) {- @@ -468,7 +249,7 @@ addFacts :: String -- ^ Command to be used: add_concs, add_prems -> Parser (String, [LNFact]) addFacts cmd = - (,) <$> (string cmd *> identifier <* kw COLON) <*> commaSep1 fact + (,) <$> (symbol cmd *> identifier <* colon) <*> commaSep1 fact -} ------------------------------------------------------------------------------ @@ -487,13 +268,13 @@ transfer :: Parser Transfer transfer = do tf <- (\l -> Transfer l Nothing Nothing) <$> identifier <* kw DOT - (do right <- kw RIGHTARROW *> identifier <* kw COLON + (do right <- kw RIGHTARROW *> identifier <* colon desc <- transferDesc return $ tf { tfRecv = Just (desc right) } <|> - do right <- kw LEFTARROW *> identifier <* kw COLON + do right <- kw LEFTARROW *> identifier <* colon descr <- transferDesc - (do left <- try $ identifier <* kw LEFTARROW <* kw COLON + (do left <- try $ identifier <* kw LEFTARROW <* colon descl <- transferDesc return $ tf { tfSend = Just (descr right) , tfRecv = Just (descl left) } @@ -503,13 +284,13 @@ <|> do left <- identifier (do kw RIGHTARROW - (do right <- identifier <* kw COLON + (do right <- identifier <* colon desc <- transferDesc return $ tf { tfSend = Just (desc left) , tfRecv = Just (desc right) } <|> - do descl <- kw COLON *> transferDesc - (do right <- kw RIGHTARROW *> identifier <* kw COLON + do descl <- colon *> transferDesc + (do right <- kw RIGHTARROW *> identifier <* colon descr <- transferDesc return $ tf { tfSend = Just (descl left) , tfRecv = Just (descr right) } @@ -519,10 +300,10 @@ ) <|> do kw LEFTARROW - (do desc <- kw COLON *> transferDesc + (do desc <- colon *> transferDesc return $ tf { tfRecv = Just (desc left) } <|> - do right <- identifier <* kw COLON + do right <- identifier <* colon desc <- transferDesc return $ tf { tfSend = Just (desc right) , tfRecv = Just (desc left) } @@ -532,7 +313,7 @@ where transferDesc = do ts <- tupleterm tlit - moreConcs <- (string "note" *> many1 (try $ fact tlit)) + moreConcs <- (symbol "note" *> many1 (try $ fact tlit)) <|> pure [] types <- typeAssertions return $ \a -> TransferDesc a ts moreConcs types @@ -541,138 +322,43 @@ -- | Parse a protocol in transfer notation transferProto :: Parser [ProtoRuleE] transferProto = do - name <- string "anb" *> kw MINUS *> string "proto" *> identifier + name <- symbol "anb-proto" *> identifier braced (convTransferProto name <$> abbrevs <*> many1 transfer) where - abbrevs = (string "let" *> many1 abbrev) <|> pure [] + abbrevs = (symbol "let" *> many1 abbrev) <|> pure [] abbrev = (,) <$> try (identifier <* kw EQUAL) <*> multterm tlit -} ------------------------------------------------------------------------------ --- Parsing Proofs ------------------------------------------------------------------------------- - -{- --- | Parse a node premise. -nodePrem :: Parser NodePrem -nodePrem = NodePrem <$> parens ((,) <$> nodevar <*> (kw COMMA *> integer)) - --- | Parse a node conclusion. -nodeConc :: Parser NodeConc -nodeConc = NodeConc <$> parens ((,) <$> nodevar <*> (kw COMMA *> integer)) --} - - --- | Parse the @\@@ requires operator. -actionOp :: Parser () -actionOp = try (kw AT) - --- | Parse the @<@ temporal less operator. -lessOp :: Parser () -lessOp = try (kw LESS) - --- | Parse the @=@ equal operator. -equalOp :: Parser () -equalOp = kw APPROX <|> kw EQUAL - -{- --- | Parse the @--|@ deduced before operator. -dedBeforeOp :: Parser () -dedBeforeOp = try (kw MINUS *> kw MINUS *> kw MID) - --- | Parse the @<@ temporal less operator. -edgeOp :: Parser () -edgeOp = try (kw GREATER *> kw RIGHTARROW) - --- | Parse the @~~>@ chain operator. -chainOp :: Parser () -chainOp = kw TILDE *> kw TILDE *> kw TILDE *> kw GREATER --} - --- | Parse a goal. -goal :: Parser Goal -goal = fail "SM: reimplement goal parsing" {- asum - [ splitGoal - , premiseGoal - , chainGoal - ] - where - premiseGoal = try $ do - v <- nodevar - i <- brackets integer <* requiresOp - fa <- fact llit - return $ PremiseGoal fa (NodePrem (v, i)) - - chainGoal = ChainGoal - <$> (try $ term llit <* kw COLON) - <*> (Chain <$> (nodeConc <* chainOp) <*> nodePrem) - - splitGoal = do - split <- (string "splitEqsOn" *> pure SplitEqs) <|> - (string "splitTypingOn" *> pure SplitTyping) - SplitGoal split <$> parens integer --} - --- | Parse a proof method. -proofMethod :: Parser ProofMethod -proofMethod = optional (kw BANG) *> asum - [ string "sorry" *> pure (Sorry "not yet proven") - , string "simplify" *> pure Simplify - , string "solve" *> (SolveGoal <$> parens goal) - , string "contradiction" *> pure (Contradiction Nothing) - ] - --- | Parse a proof skeleton. -proofSkeleton :: Parser ProofSkeleton -proofSkeleton = - finalProof <|> interProof - where - finalProof = do - method <- string "by" *> proofMethod - return (LNode (ProofStep method ()) M.empty) - - interProof = do - method <- proofMethod - cases <- (sepBy oneCase (string "next") <* string "qed") <|> - ((return . ("",)) <$> proofSkeleton ) - return (LNode (ProofStep method ()) (M.fromList cases)) - - oneCase = (,) <$> (string "case" *> identifier) <*> proofSkeleton - ------------------------------------------------------------------------------- --- Parsing Formulas and Lemmas +-- Parsing Standard and Guarded Formulas ------------------------------------------------------------------------------ -- | Parse an atom with possibly bound logical variables. blatom :: Parser BLAtom blatom = (fmap (fmapTerm (fmap Free))) <$> asum - [ flip Action <$> try (fact llit <* actionOp) <*> nodevarTerm "action" - , Less <$> try (nodevarTerm <* lessOp) <*> nodevarTerm "less" - , EqE <$> try (multterm llit <* equalOp) <*> multterm llit "term equality" - , EqE <$> (nodevarTerm <* equalOp) <*> nodevarTerm "node equality" + [ Last <$> try (symbol "last" *> parens nodevarTerm) "last atom" + , flip Action <$> try (fact llit <* opAt) <*> nodevarTerm "action atom" + , Less <$> try (nodevarTerm <* opLess) <*> nodevarTerm "less atom" + , EqE <$> try (multterm llit <* opEqual) <*> multterm llit "term equality" + , EqE <$> (nodevarTerm <* opEqual) <*> nodevarTerm "node equality" ] where nodevarTerm = (lit . Var) <$> nodevar - -- nodePrem = annNode PremIdx - -- nodeConc = annNode ConcIdx - -- annNode mkAnn = parens ((,) <$> (nodevarTerm <* kw COMMA) - -- <*> (mkAnn <$> integer)) -- | Parse an atom of a formula. -fatom :: Parser (LFormula Name) +fatom :: Parser LNFormula fatom = asum - [ pure lfalse <* string "F" - , pure ltrue <* string "T" + [ pure lfalse <* opLFalse + , pure ltrue <* opLTrue , Ato <$> try blatom , quantification , parens iff ] where quantification = do - q <- (pure forall <* (kw FORALL <|> string "All")) <|> - (pure exists <* (kw EXISTS <|> string "Ex") ) - vs <- many1 lvar <* kw DOT + q <- (pure forall <* opForall) <|> (pure exists <* opExists) + vs <- many1 lvar <* dot f <- iff return $ foldr (hinted q) f vs @@ -682,95 +368,201 @@ -- | Parse a negation. -negation :: Parser (LFormula Name) -negation = ((kw LNOT <|> string "not") *> (Not <$> fatom)) <|> fatom +negation :: Parser LNFormula +negation = opLNot *> (Not <$> fatom) <|> fatom -- | Parse a left-associative sequence of conjunctions. -conjuncts :: Parser (LFormula Name) -conjuncts = chainl1 negation ((.&&.) <$ (kw LAND <|> kw AND)) +conjuncts :: Parser LNFormula +conjuncts = chainl1 negation ((.&&.) <$ opLAnd) -- | Parse a left-associative sequence of disjunctions. -disjuncts :: Parser (LFormula Name) -disjuncts = chainl1 conjuncts ((.||.) <$ (kw LOR <|> kw MID)) +disjuncts :: Parser LNFormula +disjuncts = chainl1 conjuncts ((.||.) <$ opLOr) -- | An implication. -imp :: Parser (LFormula Name) +imp :: Parser LNFormula imp = do lhs <- disjuncts - asum [ try (kw EQUAL *> kw EQUAL *> kw GREATER) *> - ((lhs .==>.) <$> imp) + asum [ opImplies *> ((lhs .==>.) <$> imp) , pure lhs ] -- | An logical equivalence. -iff :: Parser (LFormula Name) +iff :: Parser LNFormula iff = do lhs <- imp - asum [ try (kw LESS *> kw EQUAL *> kw GREATER) *> - ((lhs .<=>.) <$> imp) - , pure lhs ] + asum [opLEquiv *> ((lhs .<=>.) <$> imp), pure lhs ] +-- | Parse a standard formula. +standardFormula :: Parser LNFormula +standardFormula = iff + +-- | Parse a guarded formula using the hack of parsing a standard formula and +-- converting it afterwards. +-- +-- FIXME: Write a proper parser. +guardedFormula :: Parser LNGuarded +guardedFormula = try $ do + res <- formulaToGuarded <$> standardFormula + case res of + Left d -> fail $ render d + Right gf -> return gf + + +------------------------------------------------------------------------------ +-- Parsing Axioms +------------------------------------------------------------------------------ + +-- | Parse an axiom. +axiom :: Parser Axiom +axiom = Axiom <$> (symbol "axiom" *> identifier <* colon) + <*> doubleQuoted standardFormula + + +------------------------------------------------------------------------------ +-- Parsing Lemmas +------------------------------------------------------------------------------ + -- | Parse a 'LemmaAttribute'. lemmaAttribute :: Parser LemmaAttribute lemmaAttribute = asum - [ string "typing" *> pure TypingLemma - , string "reuse" *> pure ReuseLemma - , string "use_induction" *> pure InvariantLemma + [ symbol "typing" *> pure TypingLemma + , symbol "reuse" *> pure ReuseLemma + , symbol "use_induction" *> pure InvariantLemma ] -- | Parse a 'TraceQuantifier'. traceQuantifier :: Parser TraceQuantifier traceQuantifier = asum - [ string "all" *> kw MINUS *> string "traces" *> pure AllTraces - , string "exists" *> kw MINUS *> string "trace" *> pure ExistsTrace + [ symbol "all-traces" *> pure AllTraces + , symbol "exists-trace" *> pure ExistsTrace ] -- | Parse a lemma. lemma :: Parser (Lemma ProofSkeleton) -lemma = skeletonLemma <$> (string "lemma" *> optional moduloE *> identifier) +lemma = skeletonLemma <$> (symbol "lemma" *> optional moduloE *> identifier) <*> (option [] $ list lemmaAttribute) - <*> (kw COLON *> option AllTraces traceQuantifier) - <*> doubleQuoted iff + <*> (colon *> option AllTraces traceQuantifier) + <*> doubleQuoted standardFormula <*> (proofSkeleton <|> pure (unproven ())) + +------------------------------------------------------------------------------ +-- Parsing Proofs +------------------------------------------------------------------------------ + +-- | Parse a node premise. +nodePrem :: Parser NodePrem +nodePrem = parens ((,) <$> nodevar + <*> (comma *> fmap (PremIdx . fromIntegral) natural)) + +-- | Parse a node conclusion. +nodeConc :: Parser NodeConc +nodeConc = parens ((,) <$> nodevar + <*> (comma *> fmap (ConcIdx .fromIntegral) natural)) + +-- | Parse a goal. +goal :: Parser Goal +goal = asum + [ premiseGoal + , actionGoal + , chainGoal + , disjSplitGoal + , eqSplitGoal + ] + where + actionGoal = do + fa <- try (fact llit <* opAt) + i <- nodevar + return $ ActionG i fa + + premiseGoal = do + (fa, v) <- try ((,) <$> fact llit <*> opRequires) + i <- nodevar + return $ PremiseG (i, v) fa + + chainGoal = ChainG <$> (try (nodeConc <* opChain)) <*> nodePrem + + disjSplitGoal = (DisjG . Disj) <$> sepBy1 guardedFormula (symbol "∥") + + eqSplitGoal = try $ do + symbol_ "split" + parens $ (SplitG . SplitId . fromIntegral) <$> natural + + +-- | Parse a proof method. +proofMethod :: Parser ProofMethod +proofMethod = asum + [ symbol "sorry" *> pure (Sorry Nothing) + , symbol "simplify" *> pure Simplify + , symbol "solve" *> (SolveGoal <$> parens goal) + , symbol "contradiction" *> pure (Contradiction Nothing) + , symbol "induction" *> pure Induction + ] + +-- | Parse a proof skeleton. +proofSkeleton :: Parser ProofSkeleton +proofSkeleton = + solvedProof <|> finalProof <|> interProof + where + solvedProof = + symbol "SOLVED" *> pure (LNode (ProofStep Solved ()) M.empty) + + finalProof = do + method <- symbol "by" *> proofMethod + return (LNode (ProofStep method ()) M.empty) + + interProof = do + method <- proofMethod + cases <- (sepBy oneCase (symbol "next") <* symbol "qed") <|> + ((return . (,) "") <$> proofSkeleton ) + return (LNode (ProofStep method ()) (M.fromList cases)) + + oneCase = (,) <$> (symbol "case" *> identifier) <*> proofSkeleton + +------------------------------------------------------------------------------ +-- Parsing Signatures +------------------------------------------------------------------------------ + -- | Builtin signatures. builtins :: Parser () builtins = - string "builtins" *> kw COLON *> sepBy1 builtinTheory (kw COMMA) *> pure () + symbol "builtins" *> colon *> commaSep1 builtinTheory *> pure () where extendSig msig = modifyState (`mappend` msig) builtinTheory = asum - [ try (string "diffie" *> kw MINUS *> string "hellman") + [ try (symbol "diffie-hellman") *> extendSig dhMaudeSig - , try (string "symmetric" *> kw MINUS *> string "encryption") + , try (symbol "symmetric-encryption") *> extendSig symEncMaudeSig - , try (string "asymmetric" *> kw MINUS *> string "encryption") + , try (symbol "asymmetric-encryption") *> extendSig asymEncMaudeSig - , try (string "signing") + , try (symbol "signing") *> extendSig signatureMaudeSig - , string "hashing" + , symbol "hashing" *> extendSig hashMaudeSig ] functions :: Parser () functions = - string "functions" *> kw COLON *> sepBy1 functionSymbol (kw COMMA) *> pure () + symbol "functions" *> colon *> commaSep1 functionSymbol *> pure () where functionSymbol = do - funsym <- (,) <$> (BC.pack <$> identifier) <*> (kw SLASH *> integer) + f <- BC.pack <$> identifier <* opSlash + k <- fromIntegral <$> natural sig <- getState - case lookup (fst funsym) (S.toList $ allFunctionSymbols sig) of - Just k | k /= snd funsym -> + case lookup f (S.toList $ allFunctionSymbols sig) of + Just k' | k' /= k -> fail $ "conflicting arities " ++ - show k ++ " and " ++ show (snd funsym) ++ - " for `" ++ BC.unpack (fst funsym) - _ -> setState (addFunctionSymbol funsym sig) + show k' ++ " and " ++ show k ++ + " for `" ++ BC.unpack f + _ -> setState (addFunctionSymbol (f,k) sig) equations :: Parser () equations = - string "equations" *> kw COLON *> sepBy1 equation (kw COMMA) *> pure () + symbol "equations" *> colon *> commaSep1 equation *> pure () where equation = do - rrule <- RRule <$> term llit <*> (kw EQUAL *> term llit) + rrule <- RRule <$> term llit <*> (equalSign *> term llit) case rRuleToStRule rrule of Just str -> modifyState (addStRule str) @@ -786,11 +578,11 @@ theory :: [String] -- ^ Defined flags. -> Parser OpenTheory theory flags0 = do - string "theory" + symbol_ "theory" thyId <- identifier - string "begin" + symbol_ "begin" *> addItems (S.fromList flags0) (set thyName thyId defaultOpenTheory) - <* string "end" + <* symbol "end" where addItems :: S.Set String -> OpenTheory -> Parser OpenTheory addItems flags thy = asum @@ -805,6 +597,8 @@ addItems flags $ set (sigpMaudeSig . thySignature) msig thy -- , do thy' <- foldM liftedAddProtoRule thy =<< transferProto -- addItems flags thy' + , do thy' <- liftedAddAxiom thy =<< axiom + addItems flags thy' , do thy' <- liftedAddLemma thy =<< lemma addItems flags thy' , do ru <- protoRule @@ -821,14 +615,14 @@ define :: S.Set String -> OpenTheory -> Parser OpenTheory define flags thy = do - flag <- try (kw SHARP *> string "define") *> identifier + flag <- try (symbol "#define") *> identifier addItems (S.insert flag flags) thy ifdef :: S.Set String -> OpenTheory -> Parser OpenTheory ifdef flags thy = do - flag <- try (kw SHARP *> string "ifdef") *> identifier + flag <- symbol_ "#ifdef" *> identifier thy' <- addItems flags thy - try (kw SHARP *> string "endif") + symbol_ "#endif" if flag `S.member` flags then addItems flags thy' else addItems flags thy @@ -837,6 +631,38 @@ Just thy' -> return thy' Nothing -> fail $ "duplicate rule: " ++ render (prettyRuleName ru) - liftedAddLemma thy l = case addLemma l thy of + liftedAddLemma thy lem = case addLemma lem thy of Just thy' -> return thy' - Nothing -> fail $ "duplicate lemma: " ++ get lName l + Nothing -> fail $ "duplicate lemma: " ++ get lName lem + + liftedAddAxiom thy ax = case addAxiom ax thy of + Just thy' -> return thy' + Nothing -> fail $ "duplicate axiom: " ++ get axName ax + + +------------------------------------------------------------------------------ +-- Message deduction variants cached in files +------------------------------------------------------------------------------ + +-- | The name of the intruder variants file. +intruderVariantsFile :: FilePath +intruderVariantsFile = "intruder_variants_dh.spthy" + +-- | Add the variants of the message deduction rule. Uses the cached version +-- of the @"intruder_variants_dh.spthy"@ file for the variants of the message +-- deduction rules for Diffie-Hellman exponentiation. +addMessageDeductionRuleVariants :: OpenTheory -> IO OpenTheory +addMessageDeductionRuleVariants thy0 + | enableDH msig = do + variantsFile <- getDataFileName intruderVariantsFile + ifM (doesFileExist variantsFile) + (do dhVariants <- parseIntruderRulesDH variantsFile + return $ addIntrRuleACs dhVariants thy + ) + (error $ "could not find intruder message deduction theory '" + ++ variantsFile ++ "'") + | otherwise = return thy + where + msig = get (sigpMaudeSig . thySignature) thy0 + rules = subtermIntruderRules msig ++ specialIntruderRules + thy = addIntrRuleACs rules thy0 diff --git a/src/Theory/Text/Parser/Token.hs b/src/Theory/Text/Parser/Token.hs new file mode 100644 --- /dev/null +++ b/src/Theory/Text/Parser/Token.hs @@ -0,0 +1,398 @@ +{-# LANGUAGE TupleSections #-} +-- | +-- Copyright : (c) 2010-2012 Simon Meier, Benedikt Schmidt +-- License : GPL v3 (see LICENSE) +-- +-- Maintainer : Simon Meier +-- Portability : portable +-- +-- Tokenizing infrastructure +module Theory.Text.Parser.Token ( + -- * Symbols + symbol + , symbol_ + , dot + , comma + , colon + + , natural + , naturalSubscript + + -- ** Formal comments + , formalComment + + -- * Identifiers and Variables + , identifier + , indexedIdentifier + + , freshName + , pubName + + , sortedLVar + , lvar + , msgvar + , nodevar + + -- * Operators + , opExp + , opMult + + , opEqual + , opLess + , opAt + , opForall + , opExists + , opImplies + , opLEquiv + , opLAnd + , opLOr + , opLNot + , opLFalse + , opLTrue + + , opRequires + , opChain + + -- ** Pseudo operators + , equalSign + , opSharp + , opBang + , opSlash + , opMinus + , opLeftarrow + , opRightarrow + , opLongleftarrow + , opLongrightarrow + + -- * Parentheses/quoting + , braced + , parens + , angled + , brackets + , singleQuoted + , doubleQuoted + + -- * List parsing + , commaSep + , commaSep1 + , list + + -- * Basic Parsing + , Parser + , parseFile + , parseFromString + ) where + +import Prelude hiding (id, (.)) + +import Data.Foldable (asum) +import Data.List (foldl') + +import Control.Applicative hiding (empty, many, optional) +import Control.Category +import Control.Monad + +import Text.Parsec hiding ((<|>)) +import qualified Text.Parsec.Token as T + +import Theory + + + + + + +------------------------------------------------------------------------------ +-- Parser +------------------------------------------------------------------------------ + +-- | A parser for a stream of tokens. +type Parser a = Parsec String MaudeSig a + +-- Use Parsec's support for defining token parsers. +spthy :: T.TokenParser MaudeSig +spthy = + T.makeTokenParser spthyStyle + where + spthyStyle = T.LanguageDef + { T.commentStart = "/*" + , T.commentEnd = "*/" + , T.commentLine = "//" + , T.nestedComments = True + , T.identStart = alphaNum + , T.identLetter = alphaNum <|> oneOf "_" + , T.reservedNames = ["in","let","rule"] + , T.opStart = oneOf ":!$%&*+./<=>?@\\^|-" + , T.opLetter = oneOf ":!$%&*+./<=>?@\\^|-" + , T.reservedOpNames= [] + , T.caseSensitive = True + } + +-- | Parse a file. +parseFile :: Parser a -> FilePath -> IO a +parseFile parser f = do + s <- readFile f + case runParser (T.whiteSpace spthy *> parser) minimalMaudeSig f s of + Right p -> return p + Left err -> error $ show err + +-- | Run a given parser on a given string. +parseFromString :: Parser a -> String -> Either ParseError a +parseFromString parser = + runParser (T.whiteSpace spthy *> parser) minimalMaudeSig dummySource + where + dummySource = "" + + +-- Token parsers +---------------- + +-- | Parse a symbol. +symbol :: String -> Parser String +symbol = try . T.symbol spthy + +-- | Parse a symbol without returning the parsed string. +symbol_ :: String -> Parser () +symbol_ = void . symbol + +-- | Between braces. +braced :: Parser a -> Parser a +braced = T.braces spthy + +-- | Between brackets. +brackets :: Parser a -> Parser a +brackets = T.brackets spthy + +-- | Between parentheses. +parens :: Parser a -> Parser a +parens = T.parens spthy + +-- | Between angular brackets. +angled :: Parser a -> Parser a +angled = T.angles spthy + +-- | Between single quotes. +singleQuoted :: Parser a -> Parser a +singleQuoted = between (symbol "'") (symbol "'") + +-- | Between double quotes. +doubleQuoted :: Parser a -> Parser a +doubleQuoted = between (symbol "\"") (symbol "\"") + +-- | A dot @.@. +dot :: Parser () +dot = void $ T.dot spthy + +-- | A comma @,@. +comma :: Parser () +comma = void $ T.comma spthy + +-- | A colon @:@. +colon :: Parser () +colon = void $ T.colon spthy + +-- | Parse an natural. +natural :: Parser Integer +natural = T.natural spthy + +-- | Parse a Unicode-subscripted natural number. +naturalSubscript :: Parser Integer +naturalSubscript = T.lexeme spthy $ do + digits <- many1 (oneOf "₀₁₂₃₄₅₆₇₈₉") + let n = foldl' (\x d -> 10*x + subscriptDigitToInteger d) 0 digits + seq n (return n) + where + subscriptDigitToInteger d = toInteger $ fromEnum d - fromEnum '₀' + +-- | A comma separated list of elements. +commaSep :: Parser a -> Parser [a] +commaSep = T.commaSep spthy + +-- | A comma separated non-empty list of elements. +commaSep1 :: Parser a -> Parser [a] +commaSep1 = T.commaSep1 spthy + +-- | Parse a list of items '[' item ',' ... ',' item ']' +list :: Parser a -> Parser [a] +list = brackets . commaSep + +-- | A formal comment; i.e., (header, body) +formalComment :: Parser (String, String) +formalComment = T.lexeme spthy $ do + header <- try (many1 letter <* string "{*") + body <- many bodyChar <* string "*}" + return (header, body) + where + bodyChar = try $ do + c <- anyChar + case c of + '\\' -> char '\\' <|> char '*' + '*' -> mzero + _ -> return c + +-- Identifiers and Variables +---------------------------- + +-- | Parse an identifier as a string +identifier :: Parser String +identifier = T.identifier spthy + +-- | Parse an identifier possibly indexed with a number. +indexedIdentifier :: Parser (String, Integer) +indexedIdentifier = do + (,) <$> identifier + <*> option 0 (try (dot *> (fromIntegral <$> natural))) + +-- | Parse a logical variable with the given sorts allowed. +sortedLVar :: [LSort] -> Parser LVar +sortedLVar ss = + asum $ map (try . mkSuffixParser) ss ++ map mkPrefixParser ss + where + mkSuffixParser s = do + (n, i) <- indexedIdentifier <* colon + symbol_ (sortSuffix s) + return (LVar n s i) + + mkPrefixParser s = do + case s of + LSortMsg -> pure () + LSortPub -> void $ char '$' + LSortFresh -> void $ char '~' + LSortNode -> void $ char '#' + LSortMSet -> void $ char '%' + (n, i) <- indexedIdentifier + return (LVar n s i) + +-- | An arbitrary logical variable. +lvar :: Parser LVar +lvar = sortedLVar [minBound..] + +-- | Parse a non-node variable. +msgvar :: Parser LVar +msgvar = sortedLVar [LSortFresh, LSortPub, LSortMsg, LSortMSet] + +-- | Parse a graph node variable. +nodevar :: Parser NodeId +nodevar = asum + [ sortedLVar [LSortNode] + , (\(n, i) -> LVar n LSortNode i) <$> indexedIdentifier ] + "timepoint variable" + +-- | Parse a literal fresh name, e.g., @~'n'@. +freshName :: Parser String +freshName = try (symbol "~" *> singleQuoted identifier) + +-- | Parse a literal public name, e.g., @'n'@. +pubName :: Parser String +pubName = singleQuoted identifier + + +-- Term Operators +------------ + +-- | The exponentiation operator @^@. +opExp :: Parser () +opExp = symbol_ "^" + +-- | The multiplication operator @*@. +opMult :: Parser () +opMult = symbol_ "*" + +-- | The timepoint comparison operator @<@. +opLess :: Parser () +opLess = symbol_ "<" + +-- | The action-at-timepoint operator \@. +opAt :: Parser () +opAt = symbol_ "@" + +-- | The equality operator @=@. +opEqual :: Parser () +opEqual = symbol_ "=" + +-- | The logical-forall operator @All@ or @∀@. +opForall :: Parser () +opForall = symbol_ "All" <|> symbol_ "∀" + +-- | The logical-exists operator @Ex@ or @∃@. +opExists :: Parser () +opExists = symbol_ "Ex" <|> symbol_ "∃" + +-- | The logical-implies operator @==>@. +opImplies :: Parser () +opImplies = symbol_ "==>" <|> symbol_ "⇒" + +-- | The logical-equivalence operator @<=>@. +opLEquiv :: Parser () +opLEquiv = symbol_ "<=>" <|> symbol_ "⇔" + +-- | The logical-and operator @&@ or @∧@. +opLAnd :: Parser () +opLAnd = symbol_ "&" <|> symbol_ "∧" + +-- | The logical-or operator @|@ or @∨@. +opLOr :: Parser () +opLOr = symbol_ "|" <|> symbol_ "∨" + +-- | The logical not operator @not@ or @¬@. +opLNot :: Parser () +opLNot = symbol_ "¬" <|> symbol_ "not" + +-- | A logical false, @F@ or @⊥@. +opLFalse :: Parser () +opLFalse = symbol_ "⊥" <|> T.reserved spthy "F" + +-- | A logical false, @T@ or @⊥@. +opLTrue :: Parser () +opLTrue = symbol_ "⊤" <|> T.reserved spthy "T" + +-- Operators for constraints +---------------------------- + +-- | The requires-a-premise operator, @▶ subscript-idx@. +opRequires :: Parser PremIdx +opRequires = (PremIdx . fromIntegral) <$> (symbol "▶" *> naturalSubscript) + +-- | The chain operator @~~>@. +opChain :: Parser () +opChain = symbol_ "~~>" + + +-- Pseudo operators (to be replaced by usage of proper tokens) +-------------------------------------------------------------- + +-- | The equal sign @=@. +equalSign :: Parser () +equalSign = symbol_ "=" + +-- | The slash operator @/@. +opSlash :: Parser () +opSlash = symbol_ "/" + +-- | The bang operator @!@. +opBang :: Parser () +opBang = symbol_ "!" + +-- | The sharp operator @#@. +opSharp :: Parser () +opSharp = symbol_ "#" + +-- | The minus operator @-@. +opMinus :: Parser () +opMinus = symbol_ "-" + +-- | The leftarrow operator @<--@. +opLeftarrow :: Parser () +opLeftarrow = symbol_ "<-" + +-- | The rightarrow operator @-->@. +opRightarrow :: Parser () +opRightarrow = symbol_ "->" + +-- | The longleftarrow operator @<--@. +opLongleftarrow :: Parser () +opLongleftarrow = symbol_ "<--" + +-- | The longrightarrow operator @-->@. +opLongrightarrow :: Parser () +opLongrightarrow = symbol_ "-->" diff --git a/src/Theory/Text/Parser/UnitTests.hs b/src/Theory/Text/Parser/UnitTests.hs new file mode 100644 --- /dev/null +++ b/src/Theory/Text/Parser/UnitTests.hs @@ -0,0 +1,91 @@ +-- | +-- Copyright : (c) 2012 Simon Meier +-- License : GPL v3 (see LICENSE) +-- +-- Maintainer : Simon Meier +-- +-- Unit tests for checking that all examples parse properly. +module Theory.Text.Parser.UnitTests ( + + testParseFile + , testParseDirectory + ) where + +import Test.HUnit + +import Control.Basics + +import System.Directory +import System.FilePath + +import Theory +import Theory.Text.Parser +import Theory.Text.Pretty (render) + +-- | Test wether a given file exists, can be parsed, and can still be parsed +-- after being pretty printed. +testParseFile :: Maybe (FilePath, Prover) + -- ^ Path to maude and prover for testing whether proof parsing + -- works properly. + -> FilePath + -- ^ File on which to test parsing (and proving) + -> Test +testParseFile optionalProver inpFile = TestLabel inpFile $ TestCase $ do + thyString <- readFile inpFile + thy0 <- parse "original file:" thyString + -- add proofs and pretty print closed theory, if desired + (thy, thyPretty) <- case optionalProver of + Nothing -> + return (thy0, prettyOpenTheory thy0) + Just (maudePath, prover) -> do + closedThy <- proveTheory prover <$> closeTheory maudePath thy0 + return $ ( normalizeTheory $ openTheory closedThy + , prettyClosedTheory closedThy) + thy' <- parse "pretty printed theory:" (render thyPretty) + unless (thy == thy') $ do + let (diff1, diff2) = + unzip $ dropWhile (uncurry (==)) $ zip (show thy) (show thy') + assertFailure $ unlines + [ "Original theory", "", render (prettyOpenTheory thy), "" + , "Pretty printed and parsed" , "", render (prettyOpenTheory thy'), "" + , "Original theory (diff)", "", indent diff1, "" + , "Pretty printed and parsed (diff)" , "", indent diff2, "", "DIFFER" + ] + return () + where + indent = unlines . map (' ' :) . lines + + parse msg str = case parseOpenTheoryString [] str of + Left err -> do assertFailure $ withLineNumbers $ indent $ show err + return (error "testParseFile: dead code") + Right thy -> normalizeTheory <$> addMessageDeductionRuleVariants thy + where + withLineNumbers err = + unlines $ zipWith (\i l -> nr (show i) ++ l) [(1::Int)..] ls + ++ ["", "Parse error when parsing the " ++ msg, err] + where + ls = lines str + n = length (show (length ls)) + nr i = replicate (1 + max 0 (n - length i)) ' ' ++ i ++ ": " + +-- | Create the test whether 'testParseFile' succeeds on all @*.spthy@ files +-- in a given directory and all its subdirectories of depth n. +testParseDirectory :: (FilePath -> Test) -- ^ Test creation function. + -> Int -- ^ Maximal depth of traversal. + -> FilePath -- ^ Starting directory. + -> IO [Test] +testParseDirectory mkTest n dir + | n < 0 = return [] + | otherwise = do + rawContents <- getDirectoryContents dir + let contents = [ dir content + | content <- rawContents + , content /= ".", content /= ".." ] + subDirs <- filterM doesDirectoryExist contents + innerTests <- mapM (testParseDirectory mkTest (n - 1)) subDirs + let tests = [ file + | file <- contents, takeExtension file == ".spthy" ] + mapM_ (putStrLn . (" peparing: " ++)) tests + return $ map mkTest tests ++ map TestList innerTests + + diff --git a/src/Theory/Text/Pretty.hs b/src/Theory/Text/Pretty.hs --- a/src/Theory/Text/Pretty.hs +++ b/src/Theory/Text/Pretty.hs @@ -29,9 +29,10 @@ , kwCase , kwNext , kwQED + , kwLemma + , kwAxiom -- ** Composed forms - , kwLemmaModulo , kwRuleModulo , kwInstanceModulo , kwVariantsModulo @@ -86,15 +87,17 @@ -- Keywords ------------------------------------------------------------------------------ -kwTheoryHeader :: HighlightDocument d => String -> d -kwTheoryHeader name = keyword_ "theory" <-> text name <-> keyword_ "begin" +kwTheoryHeader :: HighlightDocument d => d -> d +kwTheoryHeader name = keyword_ "theory" <-> name <-> keyword_ "begin" -kwEnd, kwBy, kwCase, kwNext, kwQED :: HighlightDocument d => d -kwEnd = keyword_ "end" -kwBy = keyword_ "by" -kwCase = keyword_ "case" -kwNext = keyword_ "next" -kwQED = keyword_ "qed" +kwEnd, kwBy, kwCase, kwNext, kwQED, kwAxiom, kwLemma :: HighlightDocument d => d +kwEnd = keyword_ "end" +kwBy = keyword_ "by" +kwCase = keyword_ "case" +kwNext = keyword_ "next" +kwQED = keyword_ "qed" +kwAxiom = keyword_ "axiom" +kwLemma = keyword_ "lemma" kwModulo :: HighlightDocument d => String -- ^ What @@ -102,9 +105,8 @@ -> d kwModulo what thy = keyword_ what <-> parens (keyword_ "modulo" <-> text thy) -kwLemmaModulo, kwRuleModulo, kwInstanceModulo, kwTypesModulo, kwVariantsModulo +kwRuleModulo, kwInstanceModulo, kwTypesModulo, kwVariantsModulo :: HighlightDocument d => String -> d -kwLemmaModulo = kwModulo "lemma" kwRuleModulo = kwModulo "rule" kwInstanceModulo = kwModulo "instance" kwTypesModulo = kwModulo "type assertions" diff --git a/src/Theory/Tools/InjectiveFactInstances.hs b/src/Theory/Tools/InjectiveFactInstances.hs new file mode 100644 --- /dev/null +++ b/src/Theory/Tools/InjectiveFactInstances.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +-- | +-- Copyright : (c) 2012 Simon Meier +-- License : GPL v3 (see LICENSE) +-- +-- Maintainer : Simon Meier +-- Portability : portable +-- +-- Computate an under-approximation to the set of all facts with unique +-- instances, i.e., fact whose instances never occur more than once in a +-- state. We use this information to reason about protocols that exploit +-- exclusivity of linear facts. +module Theory.Tools.InjectiveFactInstances ( + + -- * Computing injective fact instances. + simpleInjectiveFactInstances + ) where + +import Extension.Prelude (sortednub) + +import Control.Applicative +import Control.Monad.Fresh +import Data.Label +import qualified Data.Set as S +import Safe (headMay) + +import Theory.Model + +-- | Compute a simple under-approximation to the set of facts with injective +-- instances. A fact-tag is has injective instances, if there is no state of +-- the protocol with more than one instance with the same term as a first +-- argument of the fact-tag. +-- +-- We compute the under-approximation by checking that +-- (1) the fact-tag is linear, +-- (2) every introduction of such a fact-tag is protected by a Fr-fact of the +-- first term, and +-- (3) every rule has at most one copy of this fact-tag in the conlcusion and +-- the first term arguments agree. +-- +-- We exclude facts that are not copied in a rule, as they are already handled +-- properly by the naive backwards reasoning. +simpleInjectiveFactInstances :: [ProtoRuleE] -> S.Set FactTag +simpleInjectiveFactInstances rules = S.fromList $ do + tag <- candidates + guard (all (guardedSingletonCopy tag) rules) + return tag + where + candidates = sortednub $ do + ru <- rules + tag <- factTag <$> get rConcs ru + guard $ (factTagMultiplicity tag == Linear) + && (tag `elem` (factTag <$> get rPrems ru)) + return tag + + guardedSingletonCopy tag ru = + length copies <= 1 && all guardedCopy copies + where + prems = get rPrems ru + copies = filter ((tag ==) . factTag) (get rConcs ru) + firstTerm = headMay . factTerms + + -- True if there is a first term and a premise guarding it + guardedCopy faConc = case firstTerm faConc of + Nothing -> False + Just tConc -> freshFact tConc `elem` prems || guardedInPrems tConc + + -- True if there is a premise with the same tag and first term + guardedInPrems tConc = (`any` prems) $ \faPrem -> + factTag faPrem == tag && maybe False (tConc ==) (firstTerm faPrem) + diff --git a/src/Theory/Tools/IntruderRules.hs b/src/Theory/Tools/IntruderRules.hs --- a/src/Theory/Tools/IntruderRules.hs +++ b/src/Theory/Tools/IntruderRules.hs @@ -13,14 +13,11 @@ subtermIntruderRules , dhIntruderRules , specialIntruderRules --- , xorIntruderRules -- there are no multiset intruder rules ) where import Control.Basics -import Control.Monad.Fresh import Control.Monad.Reader -import qualified Data.ByteString.Char8 as BC import Data.List import qualified Data.Set as S @@ -30,9 +27,9 @@ import Term.Maude.Signature import Term.Narrowing.Variants.Compute -import Term.Positions import Term.Rewriting.Norm import Term.SubtermRule +import Term.Positions import Theory.Model @@ -65,24 +62,19 @@ [ Out( x) ] --> [ KD( 'exp', x) ] -} +-- | @specialIntruderRules@ returns the special intruder rules that are +-- included independently of the message theory specialIntruderRules :: [IntrRuleAC] specialIntruderRules = - [ kuRule CoerceRule [Fact KDFact [f_var, x_var]] [f_var, x_var] - , kuRule PubConstrRule [] [f_var, x_pub_var] - , kuRule FreshConstrRule [Fact FreshFact [x_fresh_var]] [f_var, x_fresh_var] - , Rule ISendRule - [Fact KUFact [f_var, x_var]] - [Fact InFact [x_var]] - [kLogFact x_var] - , Rule IRecvRule - [Fact OutFact [x_var]] - [Fact KDFact [expTagToTerm CanExp, x_var]] - [] + [ kuRule CoerceRule [kdFact x_var] (x_var) + , kuRule PubConstrRule [] (x_pub_var) + , kuRule FreshConstrRule [Fact FreshFact [x_fresh_var]] (x_fresh_var) + , Rule ISendRule [kuFact x_var] [Fact InFact [x_var]] [kLogFact x_var] + , Rule IRecvRule [Fact OutFact [x_var]] [Fact KDFact [x_var]] [] ] where - kuRule name prems ts = Rule name prems [Fact KUFact ts] [Fact KUFact ts] + kuRule name prems t = Rule name prems [kuFact t] [kuFact t] - f_var = varTerm (LVar "f_" LSortMsg 0) x_var = varTerm (LVar "x" LSortMsg 0) x_pub_var = varTerm (LVar "x" LSortPub 0) x_fresh_var = varTerm (LVar "x" LSortFresh 0) @@ -92,6 +84,8 @@ -- Subterm Intruder theory ------------------------------------------------------------------------------ +-- | @destuctionRules st@ returns the destruction rules for the given +-- subterm rule @st@ destructionRules :: StRule -> [IntrRuleAC] destructionRules (StRule lhs@(viewTerm -> FApp (NonAC (f,_)) _) (RhsPosition pos)) = go [] lhs pos @@ -106,18 +100,16 @@ uprems' = uprems++[ t | (j, t) <- zip [0..] as, i /= j ] t' = as!!i irule = if (t' /= rhs && rhs `notElem` uprems') - then (`evalFresh` avoid ([rhs,t']++uprems')) $ do - dfact <- kdFact Nothing t' - ufacts <- mapM (kuFact Nothing) uprems' - concfact <- kdFact (Just CanExp) rhs - return [ Rule (DestrRule (BC.unpack f)) (dfact:ufacts) [concfact] [] ] - else [] + then [ Rule (DestrRule f) + ((kdFact t'):(map kuFact uprems')) + [kdFact rhs] [] ] + else [] go _ (viewTerm -> Lit _) (_:_) = error "IntruderRules.destructionRules: impossible, position invalid" destructionRules _ = [] --- | Simple removal of subsumed rules for auto-generated free intruder rules. +-- | Simple removal of subsumed rules for auto-generated subterm intruder rules. minimizeIntruderRules :: [IntrRuleAC] -> [IntrRuleAC] minimizeIntruderRules rules = go [] rules @@ -126,39 +118,35 @@ go checked (r@(Rule _ prems concs _):unchecked) = go checked' unchecked where checked' = if any (\(Rule _ prems' concs' _) - -> map dropExpTag concs' == map dropExpTag concs && - map dropExpTag prems' `subsetOf` map dropExpTag prems) + -> concs' == concs && prems' `subsetOf` prems) (checked++unchecked) then checked - else (r:checked) + else r:checked --- | @freeIntruderRules rus@ returns the set of intruder rules for --- the free (not Xor, DH, and MSet) part of the given signature. +-- | @subtermIntruderRules maudeSig@ returns the set of intruder rules for +-- the subterm (not Xor, DH, and MSet) part of the given signature. subtermIntruderRules :: MaudeSig -> [IntrRuleAC] subtermIntruderRules maudeSig = minimizeIntruderRules $ concatMap destructionRules (S.toList $ stRules maudeSig) ++ constructionRules (functionSymbols maudeSig) +-- | @constructionRules fSig@ returns the construction rules for the given +-- function signature @fSig@ constructionRules :: FunSig -> [IntrRuleAC] constructionRules fSig = [ createRule s k | (s,k) <- S.toList fSig ] where - createRule s k = (`evalFresh` nothingUsed) $ do - vars <- map varTerm <$> (sequence $ replicate k (freshLVar "x" LSortMsg)) - pfacts <- mapM (kuFact Nothing) vars - let m = fApp (NonAC (s,k)) vars - concfact <- kuFact (Just CanExp) m - return $ Rule (ConstrRule (BC.unpack s)) pfacts [concfact] [concfact] + createRule s k = Rule (ConstrRule s) (map kuFact vars) [concfact] [concfact] + where vars = take k [ varTerm (LVar "x" LSortMsg i) | i<- [0..] ] + m = fApp (NonAC (s,k)) vars + concfact = kuFact m -dropExpTag :: Fact a -> Fact a -dropExpTag (Fact KUFact [_e,m]) = Fact KUFact [m] -dropExpTag (Fact KDFact [_e,m]) = Fact KDFact [m] -dropExpTag t = t ------------------------------------------------------------------------------ -- Diffie-Hellman Intruder Rules ------------------------------------------------------------------------------ +-- | @dhIntruderRules@ computes the intruder rules for DH dhIntruderRules :: WithMaude [IntrRuleAC] dhIntruderRules = reader $ \hnd -> minimizeIntruderRules $ [ expRule ConstrRule kuFact return @@ -169,70 +157,49 @@ , invRule DestrRule kdFact (const []) ] where - expRule mkInfo kudFact mkAction = (`evalFresh` nothingUsed) $ do - b <- varTerm <$> freshLVar "x" LSortMsg - e <- varTerm <$> freshLVar "x" LSortMsg - bfact <- kudFact (Just CanExp) b - efact <- kuFact Nothing e - let conc = fAppExp (b, e) - concfact <- kudFact (Just CannotExp) conc - return $ Rule (mkInfo "exp") [bfact, efact] [concfact] (mkAction concfact) + x_var_0 = varTerm (LVar "x" LSortMsg 0) + x_var_1 = varTerm (LVar "x" LSortMsg 1) - invRule mkInfo kudFact mkAction = (`evalFresh` nothingUsed) $ do - x <- varTerm <$> freshLVar "x" LSortMsg - bfact <- kudFact Nothing x - let conc = fAppInv x - concfact <- kudFact (Just CanExp) conc - return $ Rule (mkInfo "inv") [bfact] [concfact] (mkAction concfact) + expRule mkInfo kudFact mkAction = + Rule (mkInfo expSymString) [bfact, efact] [concfact] (mkAction concfact) + where + bfact = kudFact x_var_0 + efact = kuFact x_var_1 + conc = fAppExp (x_var_0, x_var_1) + concfact = kudFact conc + invRule mkInfo kudFact mkAction = + Rule (mkInfo invSymString) [bfact] [concfact] (mkAction concfact) + where + bfact = kudFact x_var_0 + conc = fAppInv x_var_0 + concfact = kudFact conc + +-- | @variantsIntruder mh irule@ computes the deconstruction-variants +-- of a given intruder rule @irule@ variantsIntruder :: MaudeHandle -> IntrRuleAC -> [IntrRuleAC] variantsIntruder hnd ru = do - let concTerms = concatMap factTerms + let ruleTerms = concatMap factTerms (get rPrems ru++get rConcs ru++get rActs ru) - fsigma <- computeVariants (fAppList concTerms) `runReader` hnd - let sigma = freshToFree fsigma `evalFreshAvoiding` concTerms + fsigma <- computeVariants (fAppList ruleTerms) `runReader` hnd + let sigma = freshToFree fsigma `evalFreshAvoiding` ruleTerms ruvariant = normRule' (apply sigma ru) `runReader` hnd guard (frees (get rConcs ruvariant) /= [] && -- ground terms are already deducible by applying construction rules ruvariant /= ru && -- this is a construction rule - (map dropExpTag (get rConcs ruvariant)) - \\ (map dropExpTag (get rPrems ruvariant)) /= [] + (get rConcs ruvariant) \\ (get rPrems ruvariant) /= [] -- The conclusion is included in the premises ) case concatMap factTerms $ get rConcs ruvariant of - [_, viewTerm -> FApp (AC Mult) _] -> + [viewTerm -> FApp (AC Mult) _] -> fail "Rules with product conclusion are redundant" - _ -> return ruvariant - + _ -> return ruvariant +-- | @normRule irule@ computes the normal form of @irule@ normRule' :: IntrRuleAC -> WithMaude IntrRuleAC normRule' (Rule i ps cs as) = reader $ \hnd -> let normFactTerms = map (fmap (\t -> norm' t `runReader` hnd)) in Rule i (normFactTerms ps) (normFactTerms cs) (normFactTerms as) - - - -{- ------------------------------------------------------------------------------- --- Xor Intruder Rules ------------------------------------------------------------------------------- - -xorIntruderRules :: WithMaude [IntrRuleAC] -xorIntruderRules = return [] - -- TODO: extend XOR tagging - -maude :: IO MaudeHandle -maude = startMaude "maude" allMaudeSig - -t :: IO () -t = do - m <- maude - let rules = dhIntruderRules `runReader` m - mapM_ (putStrLn . render . prettyIntrRuleAC) rules - writeFile "/tmp/dhrules" $ unlines (map ((++"\n"). render . prettyIntrRuleAC) rules) - putStrLn ("\nThere are " ++ show (length rules) - ++ " and " ++ show (length rules - 3) ++ " of these are exp-down rules") --} diff --git a/src/Theory/Tools/UniqueFactInstances.hs b/src/Theory/Tools/UniqueFactInstances.hs deleted file mode 100644 --- a/src/Theory/Tools/UniqueFactInstances.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} --- | --- Copyright : (c) 2012 Simon Meier --- License : GPL v3 (see LICENSE) --- --- Maintainer : Simon Meier --- Portability : portable --- --- Computate an under-approximation to the set of all facts with unique --- instances, i.e., fact whose instances never occur more than once in a --- state. We use this information to reason about protocols that exploit --- exclusivity of linear facts. -module Theory.Tools.UniqueFactInstances ( - - -- * Computing unique fact instances. - simpleUniqueFactInstances - ) where - -import Extension.Prelude (sortednub) - -import Control.Applicative -import Control.Monad.Fresh -import Data.Label -import qualified Data.Set as S - -import Theory.Model - --- | Compute a simple under-approximation to the set of facts with uniqe --- instances. A fact-tag is guaranteed to have uniqe instances, if it never --- occurs twice in the conclusions of a rule and each of its occurrences in --- the conclusion of a rule is guarded by an equal premise or a Fr-fact --- generating one of the terms used in the fact that we are analyzing. --- --- We exclude facts that are not copied in a rule, as they are already handled --- properly by the naive backwards reasoning. -simpleUniqueFactInstances :: [ProtoRuleE] -> S.Set FactTag -simpleUniqueFactInstances rules = S.fromList $ do - tag <- candidates - guard (all (guardedSingletonCopy tag) rules) - return tag - where - candidates = sortednub $ do - ru <- rules - filter (`elem` (factTag <$> get rPrems ru)) (factTag <$> get rConcs ru) - - guardedSingletonCopy tag ru = and $ do - copy <- filter ((tag ==) . factTag) (get rConcs ru) - return $ - (length copies <= 1) - && ( (copy `elem` get rPrems ru) - || any (\t -> freshFact t `elem` get rPrems ru) (factTerms copy) - ) - where - copies = filter ((tag ==) . factTag) (get rConcs ru) diff --git a/src/Theory/Tools/Wellformedness.hs b/src/Theory/Tools/Wellformedness.hs --- a/src/Theory/Tools/Wellformedness.hs +++ b/src/Theory/Tools/Wellformedness.hs @@ -79,8 +79,8 @@ import Extension.Prelude import Term.LTerm import Term.Maude.Signature -import Text.PrettyPrint.Class import Theory +import Theory.Text.Pretty ------------------------------------------------------------------------------ -- Types for error reports @@ -91,12 +91,8 @@ type WfErrorReport = [WfError] prettyWfErrorReport :: WfErrorReport -> Doc -prettyWfErrorReport [] = text "All well-formedness checks were successful." -prettyWfErrorReport report = foldr1 ($-$) - [ text "Error: the following well-formedness checks failed!" - , text "" - , vcat . intersperse (text "") . map ppTopic $ groupOn fst report - ] +prettyWfErrorReport = + vcat . intersperse (text "") . map ppTopic . groupOn fst where ppTopic [] = error "prettyWfErrorReport: groupOn returned empty list" ppTopic errs@((topic,_):_) = @@ -236,7 +232,7 @@ return $ ruleFacts ru <|> do LemmaItem l <- get thyItems thy return $ (,) ("lemma " ++ quote (get lName l)) $ do - fa <- formulaFacts (get lFormulaE l) + fa <- formulaFacts (get lFormula l) return $ (text (show fa), factInfo fa) -- we must compute all important information up-front in order to @@ -291,13 +287,13 @@ return $ (,) "fact usage" $ numbered' $ do (origin, (ppFa, info@(tag, _, _))) <- clash return $ text (origin ++ - ", fact " ++ show (map toLower $ showFactTag tag) ++ + ", fact " ++ show (map toLower $ factTagName tag) ++ ": " ++ showInfo info) $-$ nest 2 ppFa where showInfo (tag, k, multipl) = show $ (showFactTag tag, k, multipl) theoryFacts' = [ (ru, fa) | (ru, fas) <- theoryFacts, fa <- fas ] - factIdentifier (_, (_, (tag, _, _))) = map toLower $ showFactTag tag + factIdentifier (_, (_, (tag, _, _))) = map toLower $ factTagName tag -- Check that every fact referenced in a formula is present as an action @@ -306,12 +302,12 @@ ruleActions = S.fromList $ map factInfo $ kLogFact undefined : dedLogFact undefined - : Fact KUFact [undefined, undefined] + : kuFact undefined : (do RuleItem ru <- get thyItems thy; get rActs ru) inexistentActions = do LemmaItem l <- get thyItems thy - fa <- sortednub $ formulaFacts (get lFormulaE l) + fa <- sortednub $ formulaFacts (get lFormula l) let info = factInfo fa name = get lName l if info `S.member` ruleActions @@ -352,14 +348,21 @@ -- of facts, term, and atom constructors explicit. formulaReports :: OpenTheory -> WfErrorReport formulaReports thy = do - LemmaItem l <- get thyItems thy - let header = "lemma " ++ quote (get lName l) - fmE = get lFormulaE l - msum [ ((,) "quantifier sorts") <$> checkQuantifiers header fmE - , ((,) "formula terms") <$> checkTerms header fmE - , ((,) "guardedness") <$> checkGuarded header fmE + (header, fm) <- annFormulas + msum [ ((,) "quantifier sorts") <$> checkQuantifiers header fm + , ((,) "formula terms") <$> checkTerms header fm + , ((,) "guardedness") <$> checkGuarded header fm ] where + annFormulas = do LemmaItem l <- get thyItems thy + let header = "lemma " ++ quote (get lName l) + fm = get lFormula l + return (header, fm) + <|> do AxiomItem ax <- get thyItems thy + let header = "axiom " ++ quote (get axName ax) + fm = get axFormula ax + return (header, fm) + -- check that only message and node variables are used checkQuantifiers header fm | null disallowed = [] @@ -383,7 +386,7 @@ "The only allowed terms are public names and bound node and message\ \ variables. If you encounter free message variables, then you might\ \ have forgotten a #-prefix. Sort prefixes can only be dropped where\ - \ this is unambiguous" + \ this is unambiguous." where offenders = filter (not . allowed) $ formulaTerms fm allowed (viewTerm -> Lit (Var (Bound _))) = True @@ -394,7 +397,7 @@ checkGuarded header fm = case formulaToGuarded fm of Left err -> return $ text (header ++ " cannot be converted to a guarded formula:") $-$ - nest 2 (text err) + nest 2 err Right _ -> [] @@ -492,5 +495,13 @@ -- | Adds a note to the end of the theory, if it is not well-formed. noteWellformedness :: WfErrorReport -> OpenTheory -> OpenTheory -noteWellformedness report thy = addComment (prettyWfErrorReport report) thy +noteWellformedness report thy = + addComment wfErrorReport thy + where + wfErrorReport + | null report = text "All well-formedness checks were successful." + | otherwise = vsep + [ text "WARNING: the following wellformedness checks failed!" + , prettyWfErrorReport report + ] diff --git a/src/Web/Dispatch.hs b/src/Web/Dispatch.hs --- a/src/Web/Dispatch.hs +++ b/src/Web/Dispatch.hs @@ -65,6 +65,7 @@ -- | Initialization function for the web application. withWebUI :: String -- ^ Message to output once the sever is ready. + -> FilePath -- ^ Cache directory. -> FilePath -- ^ Working directory. -> Bool -- ^ Load last proof state if present -> Bool -- ^ Automatically save proof state @@ -78,7 +79,7 @@ -> AutoProver -- ^ The default autoprover. -> (Application -> IO b) -- ^ Function to execute -> IO b -withWebUI readyMsg thDir loadState autosave thLoader thParser thCloser debug' +withWebUI readyMsg cacheDir_ thDir loadState autosave thLoader thParser thCloser debug' stPath dotCmd' imgFormat' defaultAutoProver' f = do thy <- getTheos @@ -86,9 +87,12 @@ thyVar <- newMVar thy st <- static stPath when autosave $ createDirectoryIfMissing False autosaveDir + -- Don't create parent dirs, as temp-dir should be created by OS. + createDirectoryIfMissing False cacheDir_ (`E.finally` shutdownThreads thrVar) $ f =<< toWaiApp WebUI { workDir = thDir + , cacheDir = cacheDir_ , parseThy = liftIO . thParser , closeThy = thCloser , getStatic = st diff --git a/src/Web/Hamlet.hs b/src/Web/Hamlet.hs --- a/src/Web/Hamlet.hs +++ b/src/Web/Hamlet.hs @@ -26,70 +26,22 @@ import Web.Types import Yesod.Core --- import Yesod.Form --- import Text.Hamlet -import Control.Monad.IO.Class (liftIO) import Data.List import qualified Data.Map as M import Data.Ord import Data.Time.Format import Data.Version (showVersion) --- import qualified Data.Text as T import Text.Blaze.Html5 (preEscapedString) --- import Control.Monad.RWS (runRWST) -import qualified Control.Exception as E import System.Locale import Paths_tamarin_prover (version) --- Quasi-quotation syntax changed from GHC 6 to 7, --- so we need this switch in order to support both -#if __GLASGOW_HASKELL__ >= 700 -#define HAMLET whamlet -#else -#define HAMLET $whamlet -#endif - -- --- Wrappers --- - --- | Wrapper for @HtmlDoc@ values. -wrapHtmlDoc :: HtmlDoc Doc -> Widget -wrapHtmlDoc doc - | null res = exceptionTpl err - | otherwise = [HAMLET|#{preEscapedString res}|] - where - res = renderHtmlDoc doc - err = "Trying to render document yielded empty string. This is a bug." - --- | Run a ThHtml value, catch exceptions. -wrapThHtml :: HtmlDoc Doc -> IO Widget -wrapThHtml th = - E.catch (return $ wrapHtmlDoc th) handleEx - where - -- handleEx :: HamletValue h => E.SomeException -> IO h - handleEx :: E.SomeException -> IO Widget - handleEx e = do - putStrLn "----------------" - putStrLn "Caught exception" - putStrLn "----------------" - print e - return (exceptionTpl (show e)) - --- -- Templates -- --- | Exception/error template. -exceptionTpl :: String -> Widget -exceptionTpl err = [HAMLET| -

Caught exception! - \#{err} - |] - {- -- | Simple template for serving sites which are loaded through -- AJAX instead of a normal request (no html/head/body tags). @@ -100,7 +52,7 @@ ajaxLayout w = error "ajaxLayout" $ fmap fst $ unGWidget w -- do -- (body, _, _) <- runRWST (unGWidget $ extractBody w) () 0 -- (body, _, _) <- unGWidget $ w -- () 0 - -- hamletToRepHtml [HAMLET|^{body}|] + -- hamletToRepHtml [whamlet|^{body}|] -} -- | Template for root/welcome page. @@ -165,7 +117,7 @@ -- | Template for single line in table on root page. theoryTpl :: (TheoryIdx, TheoryInfo) -> Widget -theoryTpl th = [HAMLET| +theoryTpl th = [whamlet| @@ -186,7 +138,7 @@ -- | Template for listing threads. -- threadsTpl :: (HamletValue h, HamletUrl h ~ WebUIRoute) => [T.Text] -> h {- -threadsTpl threads = [HAMLET| +threadsTpl threads = [whamlet|

Threads

This page lists all threads that are currently registered as @@ -208,7 +160,7 @@ -- | Template for header frame (various information) headerTpl :: TheoryInfo -> Widget -headerTpl info = [HAMLET| +headerTpl info = [whamlet|

Running @@ -246,7 +198,9 @@ -- | Template for proof state (tree) frame. proofStateTpl :: RenderUrl -> TheoryInfo -> IO Widget -proofStateTpl renderUrl ti = wrapThHtml $ theoryIndex renderUrl (tiIndex ti) (tiTheory ti) +proofStateTpl renderUrl ti = do + let res = renderHtmlDoc $ theoryIndex renderUrl (tiIndex ti) (tiTheory ti) + return [whamlet| #{preEscapedString res} |] -- | Framing/UI-layout template (based on JavaScript/JQuery) overviewTpl :: RenderUrl @@ -256,7 +210,7 @@ overviewTpl renderUrl info path = do proofState <- proofStateTpl renderUrl info mainView <- pathTpl renderUrl info path - return [HAMLET| + return [whamlet|
^{headerTpl info}
@@ -280,57 +234,12 @@ -> TheoryInfo -- ^ The theory -> TheoryPath -- ^ Path to display on load -> IO Widget -pathTpl _ info TheoryHelp = return [whamlet| -

Theory information

-
    -
  • Theory: #{get thyName $ tiTheory info} -
  • Loaded at #{formatTime defaultTimeLocale "%T" $ tiTime info} -
  • Origin: #{show $ tiOrigin info} -
    -

    Quick introduction -