Changeset 14830
- Timestamp:
- 10/03/08 13:16:02 (5 years ago)
- Location:
- src
- Files:
-
- 30 edited
-
cg/genalpha.ml (modified) (1 diff)
-
cg/genckind.ml (modified) (1 diff)
-
cg/gencompile.ml (modified) (1 diff)
-
cg/genfunctions.ml (modified) (1 diff)
-
cg/genkinding.ml (modified) (1 diff)
-
cg/genlexer.ml (modified) (1 diff)
-
cg/genparser.ml (modified) (1 diff)
-
cg/genprint.ml (modified) (1 diff)
-
cg/genreplace.ml (modified) (1 diff)
-
cg/gensubtype.ml (modified) (1 diff)
-
cg/gensyntax.ml (modified) (1 diff)
-
cg/gentemplate.ml (modified) (1 diff)
-
cg/gentypeterm.ml (modified) (1 diff)
-
cg/genunify.ml (modified) (1 diff)
-
cg/main.ml (modified) (1 diff)
-
default.config (modified) (1 diff)
-
typechecker/alpha.ml (modified) (6 diffs)
-
typechecker/ckind.ml (modified) (2 diffs)
-
typechecker/compile.ml (modified) (3 diffs)
-
typechecker/functions.ml (modified) (5 diffs)
-
typechecker/kinding.ml (modified) (2 diffs)
-
typechecker/lexer.mll (modified) (5 diffs)
-
typechecker/parser.mly (modified) (7 diffs)
-
typechecker/print.ml (modified) (12 diffs)
-
typechecker/replace.ml (modified) (9 diffs)
-
typechecker/subtype.ml (modified) (2 diffs)
-
typechecker/syntax.ml (modified) (6 diffs)
-
typechecker/template.spass (modified) (2 diffs)
-
typechecker/typeterm.ml (modified) (5 diffs)
-
typechecker/unify.ml (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/cg/genalpha.ml
r14219 r14830 26 26 let gen config str = 27 27 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 28 " <Types>", (String.concat "\r\n" (List.map (fun tcons -> generateRule "free_type" (genPatternT "\t| T" tcons)) config.type_constructors));29 " <Constructors>", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_m'" (genPatternICA "\t| " cons)) config.constructors));30 " <SConstructors>", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_s'" (genPatternS "\t| " cons)) config.constructors));31 " <Destructors>", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_m'" (genPatternICA "\t| " cons)) config.destr_types));32 " <SDestructors>", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_s'" (genPatternS "\t| " cons)) config.destr_types));28 "(*<Types>*)", (String.concat "\r\n" (List.map (fun tcons -> generateRule "free_type" (genPatternT "\t| T" tcons)) config.type_constructors)); 29 "(*<Constructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_m'" (genPatternICA "\t| " cons)) config.constructors)); 30 "(*<SConstructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_s'" (genPatternS "\t| " cons)) config.constructors)); 31 "(*<Destructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_m'" (genPatternICA "\t| " cons)) config.destr_types)); 32 "(*<SDestructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateRule "free_s'" (genPatternS "\t| " cons)) config.destr_types)); 33 33 ] -
src/cg/genckind.ml
r14219 r14830 45 45 let gen config str = 46 46 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 47 " <Types>", (String.concat "" (List.map generateRule config.type_constructors));47 "(*<Types>*)", (String.concat "" (List.map generateRule config.type_constructors)); 48 48 ] -
src/cg/gencompile.ml
r14219 r14830 25 25 let gen config str = 26 26 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 27 " <Compile>", config.compile27 "(*<Compile>*)", config.compile 28 28 ] -
src/cg/genfunctions.ml
r14589 r14830 44 44 let gen config str = 45 45 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 46 " <Ground>", (String.concat "\r\n" (List.map generateGround config.type_constructors));47 " <Generative>", (String.concat "\r\n" (List.map generateGenerative (List.filter (fun tcons->tcons.generative) config.type_constructors)));48 " <SConstructors>", (String.concat "\r\n" (List.map generateSConstructors config.constructors));49 " <SDestructors>", (String.concat "\r\n" (List.map generateSDestructors config.destr_types))46 "(*<Ground>*)", (String.concat "\r\n" (List.map generateGround config.type_constructors)); 47 "(*<Generative>*)", (String.concat "\r\n" (List.map generateGenerative (List.filter (fun tcons->tcons.generative) config.type_constructors))); 48 "(*<SConstructors>*)", (String.concat "\r\n" (List.map generateSConstructors config.constructors)); 49 "(*<SDestructors>*)", (String.concat "\r\n" (List.map generateSDestructors config.destr_types)) 50 50 ] -
src/cg/genkinding.ml
r14264 r14830 35 35 let gen config str = 36 36 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 37 " <Kindings>", (String.concat "\r\n" (List.map generateRule config.type_constructors));37 "(*<Kindings>*)", (String.concat "\r\n" (List.map generateRule config.type_constructors)); 38 38 ] -
src/cg/genlexer.ml
r14219 r14830 29 29 let gen config str = 30 30 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 31 " <Types>", (String.concat "\r\n" (List.map (fun x -> generateToken2 x.namet ("T"^x.namet)) config.type_constructors));32 " <Constructors>", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec)) config.constructors));33 " <Destructors>", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec)) config.destr_types));34 " <SDestructors>", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec^"h")) config.destr_types))31 "(*<Types>*)", (String.concat "\r\n" (List.map (fun x -> generateToken2 x.namet ("T"^x.namet)) config.type_constructors)); 32 "(*<Constructors>*)", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec)) config.constructors)); 33 "(*<Destructors>*)", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec)) config.destr_types)); 34 "(*<SDestructors>*)", (String.concat "\r\n" (List.map (fun x -> generateToken (x.namec^"h")) config.destr_types)) 35 35 ] -
src/cg/genparser.ml
r14219 r14830 39 39 let gen config str = 40 40 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 41 " <Tokens>", generateTokens config;42 " <Types>", (String.concat "\r\n" (List.map (fun x -> generateRule "typedef" ("T"^x.namet) "" "" (List.length x.arguments)) config.type_constructors));43 " <Constructors>", (String.concat "\r\n" (List.map (fun x -> generateRuleConfArg "term" (x.namec) "C" "" (List.length x.domain)) config.constructors));44 " <Destructors>", (String.concat "\r\n" (List.map (fun x -> generateRuleConfArg "term" (x.namec) "C" "" (List.length x.domain)) config.destr_types));45 " <SConstructors>", (String.concat "\r\n" (List.map (fun x -> generateRule "stm" (x.namec) "S" "" (List.length x.domain)) config.constructors));46 " <SDestructors>", (String.concat "\r\n" (List.map (fun x -> generateRule "stm" (x.namec) "S" "H" (List.length x.domain)) config.destr_types))41 "(*<Tokens>*)", generateTokens config; 42 "(*<Types>*)", (String.concat "\r\n" (List.map (fun x -> generateRule "typedef" ("T"^x.namet) "" "" (List.length x.arguments)) config.type_constructors)); 43 "(*<Constructors>*)", (String.concat "\r\n" (List.map (fun x -> generateRuleConfArg "term" (x.namec) "C" "" (List.length x.domain)) config.constructors)); 44 "(*<Destructors>*)", (String.concat "\r\n" (List.map (fun x -> generateRuleConfArg "term" (x.namec) "C" "" (List.length x.domain)) config.destr_types)); 45 "(*<SConstructors>*)", (String.concat "\r\n" (List.map (fun x -> generateRule "stm" (x.namec) "S" "" (List.length x.domain)) config.constructors)); 46 "(*<SDestructors>*)", (String.concat "\r\n" (List.map (fun x -> generateRule "stm" (x.namec) "S" "H" (List.length x.domain)) config.destr_types)) 47 47 ] -
src/cg/genprint.ml
r14219 r14830 34 34 let gen config str = 35 35 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 36 " <ConstructorTrans>", (String.concat "\r\n" (List.map generateSTrans config.constructors));37 " <DestructorTrans>", (String.concat "\r\n" (List.map generateSTrans config.destr_types));38 " <Types>", (String.concat "\r\n" (List.map (fun tcons -> generatePrint "print_type_b b" tcons.namet (genPatternT "\t| T" tcons)) config.type_constructors));39 " <Constructors>", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_term_b b" cons.namec (genPatternICA "\t| " cons)) config.constructors));40 " <Destructors>", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_term_b b" cons.namec (genPatternICA "\t| " cons)) config.destr_types));41 " <SConstructors>", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_stmt_b b" cons.namec (genPatternS "\t| " cons)) config.constructors));42 " <SDestructors>", (String.concat "\r\n" (List.map (fun cons -> generatePrintSDes "print_stmt_b b" cons.namec (genPatternS "\t| " cons)) config.destr_types))36 "(*<ConstructorTrans>*)", (String.concat "\r\n" (List.map generateSTrans config.constructors)); 37 "(*<DestructorTrans>*)", (String.concat "\r\n" (List.map generateSTrans config.destr_types)); 38 "(*<Types>*)", (String.concat "\r\n" (List.map (fun tcons -> generatePrint "print_type_b b" tcons.namet (genPatternT "\t| T" tcons)) config.type_constructors)); 39 "(*<Constructors>*)", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_term_b b" cons.namec (genPatternICA "\t| " cons)) config.constructors)); 40 "(*<Destructors>*)", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_term_b b" cons.namec (genPatternICA "\t| " cons)) config.destr_types)); 41 "(*<SConstructors>*)", (String.concat "\r\n" (List.map (fun cons -> generatePrint "print_stmt_b b" cons.namec (genPatternS "\t| " cons)) config.constructors)); 42 "(*<SDestructors>*)", (String.concat "\r\n" (List.map (fun cons -> generatePrintSDes "print_stmt_b b" cons.namec (genPatternS "\t| " cons)) config.destr_types)) 43 43 ] -
src/cg/genreplace.ml
r14597 r14830 28 28 let gen config str = 29 29 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 30 " <SConstructors>", (String.concat "\r\n" (List.map (fun cons -> generateReplace "replaceab_stmt xs ys" ("S"^cons.namec) (genPatternS "\t| " cons)) config.constructors));31 " <SDestructors>", (String.concat "\r\n" (List.map (fun cons -> generateReplace "replaceab_stmt xs ys" ("S"^cons.namec) (genPatternS "\t| " cons)) config.destr_types));32 " <Types>", (String.concat "\r\n" (List.map (fun tcons -> generateReplace "rename_type old fresh" ("T"^tcons.namet) (genPatternT "\t| T" tcons)) config.type_constructors));33 " <Constructors>", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "rename_term old fresh" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.constructors));34 " <Destructors>", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "rename_term old fresh" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.destr_types));35 " <Types2>", (String.concat "\r\n" (List.map (fun tcons -> generateReplace "replace_stmt_in_type' x s free" ("T"^tcons.namet) (genPatternT "\t| T" tcons)) config.type_constructors));36 " <Constructors2>", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "replace_term x m" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.constructors));30 "(*<SConstructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateReplace "replaceab_stmt xs ys" ("S"^cons.namec) (genPatternS "\t| " cons)) config.constructors)); 31 "(*<SDestructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateReplace "replaceab_stmt xs ys" ("S"^cons.namec) (genPatternS "\t| " cons)) config.destr_types)); 32 "(*<Types>*)", (String.concat "\r\n" (List.map (fun tcons -> generateReplace "rename_type old fresh" ("T"^tcons.namet) (genPatternT "\t| T" tcons)) config.type_constructors)); 33 "(*<Constructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "rename_term old fresh" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.constructors)); 34 "(*<Destructors>*)", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "rename_term old fresh" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.destr_types)); 35 "(*<Types2>*)", (String.concat "\r\n" (List.map (fun tcons -> generateReplace "replace_stmt_in_type' x s free" ("T"^tcons.namet) (genPatternT "\t| T" tcons)) config.type_constructors)); 36 "(*<Constructors2>*)", (String.concat "\r\n" (List.map (fun cons -> generateReplaceCA "replace_term x m" ("C"^cons.namec) (genPatternCA "\t| " cons)) config.constructors)); 37 37 ] -
src/cg/gensubtype.ml
r14245 r14830 34 34 let gen config str = 35 35 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 36 " <Typing>", (String.concat "\r\n" (List.map generateRule (List.filter (fun tcons -> List.length tcons.arguments >=1) config.type_constructors)));36 "(*<Typing>*)", (String.concat "\r\n" (List.map generateRule (List.filter (fun tcons -> List.length tcons.arguments >=1) config.type_constructors))); 37 37 ] -
src/cg/gensyntax.ml
r14219 r14830 32 32 let gen config str = 33 33 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 34 " <Types>", (String.concat "\r\n" (List.map generateTCons config.type_constructors));35 " <Constructors>", (String.concat "\r\n" (List.map generateCons config.constructors));36 " <Destructors>", (String.concat "\r\n" (List.map generateCons config.destr_types));37 " <SConstructors>", (String.concat "\r\n" (List.map generateSCons config.constructors));38 " <SDestructors>", (String.concat "\r\n" (List.map generateSCons config.destr_types))34 "(*<Types>*)", (String.concat "\r\n" (List.map generateTCons config.type_constructors)); 35 "(*<Constructors>*)", (String.concat "\r\n" (List.map generateCons config.constructors)); 36 "(*<Destructors>*)", (String.concat "\r\n" (List.map generateCons config.destr_types)); 37 "(*<SConstructors>*)", (String.concat "\r\n" (List.map generateSCons config.constructors)); 38 "(*<SDestructors>*)", (String.concat "\r\n" (List.map generateSCons config.destr_types)) 39 39 ] -
src/cg/gentemplate.ml
r14219 r14830 34 34 let gen config str = 35 35 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 36 " <Constructors>", (String.concat ", " (List.map (genCons "") config.constructors));37 " <Destructors>", (String.concat ", " (List.map (genCons "h") config.destr_types));38 " <DestRules>", (String.concat "\r\n" (List.map genRule config.destructors));36 "(*<Constructors>*)", (String.concat ", " (List.map (genCons "") config.constructors)); 37 "(*<Destructors>*)", (String.concat ", " (List.map (genCons "h") config.destr_types)); 38 "(*<DestRules>*)", (String.concat "\r\n" (List.map genRule config.destructors)); 39 39 ] -
src/cg/gentypeterm.ml
r14219 r14830 44 44 let gen config str = 45 45 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 46 " <ConsInput>", (String.concat "\r\n" (List.map generateInput config.constructors));47 " <ConsResult>", (String.concat "\r\n" (List.map generateResult config.constructors));48 " <ConsCompute>", (String.concat "\r\n" (List.map generateCompute config.constructors));49 " <DestInput>", (String.concat "\r\n" (List.map generateInput config.destr_types));50 " <DestResult>", (String.concat "\r\n" (List.map generateResult config.destr_types));51 " <DestCompute>", (String.concat "\r\n" (List.map generateCompute config.destr_types));46 "(*<ConsInput>*)", (String.concat "\r\n" (List.map generateInput config.constructors)); 47 "(*<ConsResult>*)", (String.concat "\r\n" (List.map generateResult config.constructors)); 48 "(*<ConsCompute>*)", (String.concat "\r\n" (List.map generateCompute config.constructors)); 49 "(*<DestInput>*)", (String.concat "\r\n" (List.map generateInput config.destr_types)); 50 "(*<DestResult>*)", (String.concat "\r\n" (List.map generateResult config.destr_types)); 51 "(*<DestCompute>*)", (String.concat "\r\n" (List.map generateCompute config.destr_types)); 52 52 ] -
src/cg/genunify.ml
r14219 r14830 48 48 let gen config str = 49 49 List.fold_left (fun str1 (rep_from, rep_to) -> replace rep_from rep_to str1) str [ 50 " <Constraints>", (String.concat "" (List.map generateConstraint config.type_constructors));51 " <Applys>", (String.concat "\r\n" (List.map generateApply config.type_constructors));50 "(*<Constraints>*)", (String.concat "" (List.map generateConstraint config.type_constructors)); 51 "(*<Applys>*)", (String.concat "\r\n" (List.map generateApply config.type_constructors)); 52 52 ] -
src/cg/main.ml
r14264 r14830 72 72 let blindSig = ref false 73 73 74 let blindSigStart = " >>blindSig>>"75 let blindSigEnd = " <<blindSig<<"74 let blindSigStart = "(*>>blindSig>>*)" 75 let blindSigEnd = "(*<<blindSig<<*)" 76 76 77 77 (* read file, call f to replace strings, write string back to same file *) -
src/default.config
r14589 r14830 15 15 *) 16 16 17 type gen PrivKey( x1[0]) :: tnt if x1::pub, :: pub if x1::pub18 type PubKey( x1[-]) :: pub, :: tnt if x1::pub19 type PubEnc( x1[0]) :: pub, :: tnt if x1::tnt20 type gen SigKey( x1[0]) :: tnt if x1::tnt, :: pub if x1::tnt21 type VerKey( x1[+]) :: pub, :: tnt if x1::tnt22 type Signed( x1[0]) :: tnt, :: pub if x1::pub23 type Hash( x1[0]) :: pub, :: tnt if x1::tnt24 type HashPrivate( x1[0]) :: pub if x1::pub and x1::tnt, :: tnt if x1::pub and x1::tnt17 type gen PrivKey(t1[0]) :: tnt if t1::pub, :: pub if t1::pub 18 type PubKey(t1[-]) :: pub, :: tnt if t1::pub 19 type PubEnc(t1[0]) :: pub, :: tnt if t1::tnt 20 type gen SigKey(t1[0]) :: tnt if t1::tnt, :: pub if t1::tnt 21 type VerKey(t1[+]) :: pub, :: tnt if t1::tnt 22 type Signed(t1[0]) :: tnt, :: pub if t1::pub 23 type Hash(t1[0]) :: pub, :: tnt if t1::tnt 24 type HashPrivate(t1[0]) :: pub if t1::pub and t1::tnt, :: tnt if t1::pub and t1::tnt 25 25 26 26 (* an artificial contravariant type constructor *) 27 type gen GMinus( x1[-]) :: pub if x1::tnt, :: tnt if x1::pub27 type gen GMinus(t1[-]) :: pub if t1::tnt, :: tnt if t1::pub 28 28 29 fun pk[ x] : PrivKey(x) -> PubKey(x)30 fun enc[ x] : (x,PubKey(x)) -> PubEnc(x)31 fun vk[ x] : SigKey(x) -> VerKey(x)32 fun sign[ x] : (x,SigKey(x)) -> Signed(x)33 fun hash[ x] : x -> Hash(x)34 fun hashPrivate[ x] : x -> HashPrivate(x)29 fun pk[t] : PrivKey(t) -> PubKey(t) 30 fun enc[t] : (t,PubKey(t)) -> PubEnc(t) 31 fun vk[t] : SigKey(t) -> VerKey(t) 32 fun sign[t] : (t,SigKey(t)) -> Signed(t) 33 fun hash[t] : t -> Hash(t) 34 fun hashPrivate[t] : t -> HashPrivate(t) 35 35 36 36 reduc [x,m] dec(enc(m,pk(x)),x) = m 37 37 reduc [x,m] check(sign(m,x),vk(x)) = m 38 38 39 fun dec[ x] : (PubEnc(x),PrivKey(x)) -> x40 fun check[ x] : (Signed(x),VerKey(x)) -> x39 fun dec[t] : (PubEnc(t),PrivKey(t)) -> t 40 fun check[t] : (Signed(t),VerKey(t)) -> t 41 41 42 42 compile: -
src/typechecker/alpha.ml
r14264 r14830 99 99 | TStm t1 -> free_type t1 bf 100 100 | TVar _ -> bf 101 >>blindSig>> 101 (*>>blindSig>>*) 102 102 | TBlind t1 -> free_type t1 bf 103 103 | TBlindSigKey t1 -> free_type t1 bf … … 105 105 | TBlindSigned t1 -> free_type t1 bf 106 106 | TBlinder t1 -> free_type t1 bf 107 <<blindSig<< 107 (*<<blindSig<<*) 108 108 | TTop -> bf 109 <Types> 109 (*<Types>*) 110 110 111 111 and free_destr g bf = match g with … … 118 118 | Ver (_, _, _, _, m, l) -> List.fold_left (fun a b -> tupleat (free_m' b bf) a) (free_m' m bf) l 119 119 | Exercise m -> free_m' m bf 120 >>blindSig>> 120 (*>>blindSig>>*) 121 121 | Unblind(t, m, n, o) -> List.fold_left (fun a b -> tupleat (free_m' b bf) a) (free_type t bf) [m; n; o] 122 122 | Bcheck(t, m, n) -> List.fold_left (fun a b -> tupleat (free_m' b bf) a) (free_type t bf) [m; n] 123 <<blindSig<< 123 (*<<blindSig<<*) 124 124 | Id m -> free_m' m bf 125 <Destructors> 125 (*<Destructors>*) 126 126 127 127 and free_constr f ((bound, free) as bf) = match f with … … 131 131 | Zk (_, _, _, tl) -> 132 132 List.fold_left (fun a b -> tupleat a (free_m' b bf)) bf tl 133 >>blindSig>> 133 (*>>blindSig>>*) 134 134 | Blind(m, n) -> tupleat (free_m' m bf) (free_m' n bf) 135 135 | Bvk(m) -> free_m' m bf 136 136 | Bsign(t, m, n) -> tupleat (free_type t bf) (tupleat (free_m' m bf) (free_m' n bf)) 137 <<blindSig<< 138 <Constructors> 137 (*<<blindSig<<*) 138 (*<Constructors>*) 139 139 140 140 and free_m' m (bound, free) = match m with … … 153 153 | SPublic(_, _, m) -> free_s' m bf 154 154 | SExercise m -> free_s' m bf 155 >>blindSig>> 155 (*>>blindSig>>*) 156 156 | SUnblind(m, n, o) -> List.fold_left (fun a b -> tupleat (free_s' b bf) a) ([],[]) [m; n; o] 157 157 | SBcheck(m, n) -> List.fold_left (fun a b -> tupleat (free_s' b bf) a) ([],[]) [m; n] 158 <<blindSig<< 158 (*<<blindSig<<*) 159 159 | SId m -> free_s' m bf 160 <SDestructors> 160 (*<SDestructors>*) 161 161 162 162 and free_sconstr sc ((bound, free) as bf) = match sc with … … 166 166 | SZk (_, _, _, tl) -> 167 167 List.fold_left (fun a b -> tupleat a (free_s' b bf)) bf tl 168 >>blindSig>> 168 (*>>blindSig>>*) 169 169 | SBlind(m, n) -> tupleat (free_s' m bf) (free_s' n bf) 170 170 | SBvk(m) -> free_s' m bf 171 171 | SBsign(m, n) -> tupleat (free_s' m bf) (free_s' n bf) 172 <<blindSig<< 173 <SConstructors> 172 (*<<blindSig<<*) 173 (*<SConstructors>*) 174 174 175 175 and free_s' s (bound, free) = match s with -
src/typechecker/ckind.ml
r14219 r14830 73 73 ckind t1 l f @ ckind (rename_type x fresh_name t2) l (EBind(fresh_name, t1) :: f) 74 74 | TZKProof(_, _, _, t1), _ -> ckind t1 l f 75 >>blindSig>> 75 (*>>blindSig>>*) 76 76 | TBlind t, _ -> if well_formed f && subset (kft t) (dom f) then 77 77 [] … … 89 89 | TBlindVerKey t, Ktnt -> ckind t Ktnt f 90 90 | TBlindSigKey t, _ -> ckind t Ktnt f 91 <<blindSig<< 92 <Types> 91 (*<<blindSig<<*) 92 (*<Types>*) 93 93 | _ -> (Printf.printf "cannot ckind: "; print_type t; Printf.printf "\n"; 94 94 raise (Invalid_argument "ckind: got something it cannot kind")) -
src/typechecker/compile.ml
r14589 r14830 150 150 EFormula(S_Symbol_Term(S_Or, [and_forms (forms gamma1); and_forms (forms gamma2)])) :: (join_gamma (binds gamma1) (binds gamma2)) 151 151 152 <Compile> 152 (*<Compile>*) 153 153 154 154 (* vm = fst(vn) *) … … 176 176 | _ -> raise (DefaultCaseException (Printf.sprintf "The \"vm = exercise(vn)\" case does not apply because %s doesn't have an OK type\n" vn))) 177 177 178 >>blindSig>> 178 (*>>blindSig>>*) 179 179 (* bcheck(vm,vk) = vn *) 180 180 | SDestr(SEq(SDestr(SBcheck(SIdent vm, SIdent vk)), SIdent(vn))) … … 196 196 | _ -> 197 197 raise (DefaultCaseException (Printf.sprintf "The \"bcheck(vm,vk) = vn\" case does not apply because %s doesn't have a Hash type\n" vk))) 198 <<blindSig<< 198 (*<<blindSig<<*) 199 199 (* default case *) 200 200 | _ -> EFormula(create_form_from_stmt s) :: gamma' -
src/typechecker/functions.ml
r14616 r14830 54 54 | TStm t -> is_ground t 55 55 | TVar _ -> false 56 >>blindSig>> 56 (*>>blindSig>>*) 57 57 | TBlind t -> is_ground t 58 58 | TBlindSigKey t -> is_ground t … … 60 60 | TBlindSigned t -> is_ground t 61 61 | TBlinder t -> is_ground t 62 <<blindSig<< 62 (*<<blindSig<<*) 63 63 | TTop -> true 64 <Ground> 64 (*<Ground>*) 65 65 66 66 let is_generative t = match t with … … 69 69 | TPrivate -> true 70 70 | TUntainted -> true 71 >>blindSig>> 71 (*>>blindSig>>*) 72 72 | TBlinder _ -> true 73 73 | TBlindSigKey _ -> true 74 <<blindSig<< 75 <Generative> 74 (*<<blindSig<<*) 75 (*<Generative>*) 76 76 | _ -> (Printf.printf "t is not generative: "; print_type t; false) 77 77 … … 109 109 | STrue -> S_Symbol(S_Sym_Ident("true")) 110 110 | SZk(n,m,_,stmlist) -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "zk_%d_%d" n m), List.map create_form_from_stmt stmlist) 111 >>blindSig>>111 (*>>blindSig>>*) 112 112 | SBlind (s1, s2) -> S_Symbol_Term(S_Sym_Ident("blind"), [create_form_from_stmt s1; create_form_from_stmt s2]) 113 113 | SBvk s1 -> S_Symbol_Term(S_Sym_Ident("bvk"), [create_form_from_stmt s1]) 114 114 | SBsign (s1, s2) -> S_Symbol_Term(S_Sym_Ident("bsign"), [create_form_from_stmt s1; create_form_from_stmt s2]) 115 <<blindSig<<116 <SConstructors> 115 (*<<blindSig<<*) 116 (*<SConstructors>*) 117 117 118 118 (* Taking modif as an argument is quite useless here (not passed recursively) *) … … 125 125 | SPublic (_,_,s1) -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "public%s" modif), [create_form_from_stmt s1]) 126 126 | SExercise s1 -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "exercise%s" modif), [create_form_from_stmt s1]) 127 >>blindSig>>127 (*>>blindSig>>*) 128 128 | SUnblind (s1,s2,s3) -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "unblind%s" modif), 129 129 [create_form_from_stmt s1; create_form_from_stmt s2; create_form_from_stmt s3]) 130 130 | SBcheck (s1,s2) -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "bcheck%s" modif), 131 131 [create_form_from_stmt s1; create_form_from_stmt s2]) 132 <<blindSig<<132 (*<<blindSig<<*) 133 133 | SId s1 -> S_Symbol_Term(S_Sym_Ident(Printf.sprintf "id%s" modif), [create_form_from_stmt s1]) 134 <SDestructors> 134 (*<SDestructors>*) 135 135 136 136 and create_form_from_sdestr d = create_form_from_sdestr' "h" d -
src/typechecker/kinding.ml
r14268 r14830 38 38 kind' t1 l f foo && kind' (rename_type x fresh_name t2) l (EBind(fresh_name,t1) :: f) foo 39 39 | TZKProof(_, _, _, t), _ -> kind' t l f foo 40 >>blindSig>> 40 (*>>blindSig>>*) 41 41 | TBlind t, _ -> well_formed f && subset (kft t) (dom f) 42 42 | TBlinder t, _ -> kind' t Kpub f foo && kind' t Ktnt f foo … … 45 45 | TBlindVerKey t, Ktnt -> kind' t Ktnt f foo 46 46 | TBlindSigKey t, _ -> kind' t Ktnt f foo 47 <<blindSig<< 48 <Kindings> 47 (*<<blindSig<<*) 48 (*<Kindings>*) 49 49 | _ -> false 50 50 -
src/typechecker/lexer.mll
r14264 r14830 47 47 "alpha", ALPHA; 48 48 "beta", BETA; 49 >>blindSig>> 49 (*>>blindSig>>*) 50 50 "blind", BLIND; 51 51 "bvk", BVK; 52 52 "bsign", BSIGN; 53 <<blindSig<< 53 (*<<blindSig<<*) 54 54 "hashprivate", HASHPRIVATE; 55 <Constructors> 55 (*<Constructors>*) 56 56 57 57 "fst", FST; … … 63 63 "ver", VER; 64 64 "exercise", EXERCISE; 65 >>blindSig>> 65 (*>>blindSig>>*) 66 66 "unblind", UNBLIND; 67 67 "bcheck", BCHECK; 68 <<blindSig<< 68 (*<<blindSig<<*) 69 69 "id", ID; 70 <Destructors> 70 (*<Destructors>*) 71 71 72 72 "fsth", FSTH; … … 77 77 "publich", PUBLICH; 78 78 "exerciseh", EXERCISEH; 79 >>blindSig>> 79 (*>>blindSig>>*) 80 80 "unblindh", UNBLINDH; 81 81 "bcheckh", BCHECKH; 82 <<blindSig<< 82 (*<<blindSig<<*) 83 83 "idh", IDH; 84 <SDestructors> 84 (*<SDestructors>*) 85 85 86 86 "Un", TUN; … … 94 94 "Stm", TSTM; 95 95 "Private", TPRIVATE; 96 >>blindSig>> 96 (*>>blindSig>>*) 97 97 "Blind", TBLIND; 98 98 "BlindSigKey", TBLINDSIGKEY; … … 100 100 "BlindSigned", TBLINDSIGNED; 101 101 "Blinder", TBLINDER; 102 <<blindSig<< 103 <Types> 102 (*<<blindSig<<*) 103 (*<Types>*) 104 104 105 105 "predicate", PREDICATE; -
src/typechecker/parser.mly
r14817 r14830 69 69 %token TUN TBOOL TCH TOK TPAIR THASHPRIVATE 70 70 %token TZKPROOF TSTM TPRIVATE TSECRET TUNTAINTED 71 >>blindSig>> 71 (*>>blindSig>>*) 72 72 %token BLIND BVK BSIGN 73 73 %token UNBLIND BCHECK UNBLINDH BCHECKH 74 74 %token TBLIND TBLINDSIGKEY TBLINDVERKEY TBLINDSIGNED TBLINDER 75 <<blindSig<< 76 <Tokens> 75 (*<<blindSig<<*) 76 (*<Tokens>*) 77 77 78 78 %start main … … 125 125 | OK { SOk } 126 126 | TRUE { STrue } 127 >>blindSig>>127 (*>>blindSig>>*) 128 128 | BLIND LPAREN stm COMMA stm RPAREN { SBlind($3, $5) } 129 129 | BVK LPAREN stm RPAREN { SBvk($3) } 130 130 | BSIGN LPAREN stm COMMA stm RPAREN { SBsign($3, $5) } 131 <<blindSig<< 132 <SConstructors> 131 (*<<blindSig<<*) 132 (*<SConstructors>*) 133 133 ; 134 134 … … 155 155 { SPublic($4, $6, $10) } 156 156 | EXERCISEH LPAREN stm RPAREN { SExercise($3) } 157 >>blindSig>> 157 (*>>blindSig>>*) 158 158 | UNBLINDH LPAREN stm COMMA stm COMMA stm RPAREN 159 159 { SUnblind($3, $5, $7) } 160 160 | BCHECKH LPAREN stm COMMA stm RPAREN { SBcheck($3, $5) } 161 <<blindSig<< 161 (*<<blindSig<<*) 162 162 | IDH LPAREN stm RPAREN { SId($3) } 163 <SDestructors> 163 (*<SDestructors>*) 164 164 ; 165 165 … … 254 254 { TZKProof($4, $6, $8, $12) } 255 255 | TSTM LPAREN typedef RPAREN { TStm($3) } 256 >>blindSig>> 256 (*>>blindSig>>*) 257 257 | TBLIND LPAREN typedef RPAREN { TBlind($3) } 258 258 | TBLINDSIGKEY LPAREN typedef RPAREN { TBlindSigKey($3) } … … 260 260 | TBLINDSIGNED LPAREN typedef RPAREN { TBlindSigned($3) } 261 261 | TBLINDER LPAREN typedef RPAREN { TBlinder($3) } 262 <<blindSig<< 262 (*<<blindSig<<*) 263 263 | LANGLE RANGLE LBRACKET STAR c STAR RBRACKET { TOk($5) } 264 264 | LANGLE RANGLE { TOk(parse_spass "true") } /* SPASS specific */ 265 265 | LANGLE tytyty RANGLE LBRACKET STAR c STAR RBRACKET { fun654 $2 (TOk($6))} 266 266 | LANGLE tytyty RANGLE { fun654 $2 (TOk(parse_spass "true"))} /* SPASS specific */ 267 <Types> 267 (*<Types>*) 268 268 | TYPE_NAME { if Hashtbl.mem Preparser.named_types $1 then Hashtbl.find Preparser.named_types $1 else 269 269 raise (Invalid_argument ("Parse Error: type name " ^ $1 ^ " used without declaration at " ^ pos_of_position (symbol_start_pos ()))) } … … 285 285 { Ver($4, $6, $8, $10, $14, $16) } 286 286 | EXERCISE LPAREN term RPAREN { Exercise($3) } 287 >>blindSig>> 287 (*>>blindSig>>*) 288 288 | UNBLIND LPAREN STAR COLON typedef STAR RPAREN LPAREN term COMMA term COMMA term RPAREN { Unblind($5, $9, $11, $13) } 289 289 | BCHECK LPAREN STAR COLON typedef STAR RPAREN LPAREN term COMMA term RPAREN {Bcheck($5, $9, $11) } 290 <<blindSig<< 290 (*<<blindSig<<*) 291 291 | ID LPAREN term RPAREN { Id($3) } 292 <Destructors> 292 (*<Destructors>*) 293 293 | error 294 294 { raise (Invalid_argument ("parse error: cannot read destructor at " ^ … … 302 302 | OK LPAREN STAR COLON typedef STAR RPAREN { Ok($5) } 303 303 | TRUE { True } 304 >>blindSig>> 304 (*>>blindSig>>*) 305 305 | BLIND LPAREN term COMMA term RPAREN { Blind($3, $5) } 306 306 | BVK LPAREN term RPAREN { Bvk($3) } 307 307 | BSIGN LPAREN STAR COLON typedef STAR RPAREN LPAREN term COMMA term RPAREN { Bsign($5, $9, $11) } 308 <<blindSig<< 308 (*<<blindSig<<*) 309 309 | ZK LPAREN STAR NUMBER COMMA NUMBER COMMA IDENT STAR RPAREN LPAREN ttt RPAREN 310 310 { Zk($4, $6, $8, $12) } 311 <Constructors> 311 (*<Constructors>*) 312 312 | error 313 313 { raise (Invalid_argument ("parse error: cannot read constructor at " ^ -
src/typechecker/print.ml
r14559 r14830 28 28 | True -> STrue 29 29 | Zk (i1, i2, s, tlist) -> SZk (i1, i2, s, List.map term_to_stmt tlist) 30 >>blindSig>> 30 (*>>blindSig>>*) 31 31 | Blind (t1, t2) -> SBlind (term_to_stmt t1, term_to_stmt t2) 32 32 | Bvk t -> SBvk (term_to_stmt t) 33 33 | Bsign (ty, t1, t2) -> SBsign (term_to_stmt t1, term_to_stmt t2) 34 <<blindSig<< 35 <ConstructorTrans> 34 (*<<blindSig<<*) 35 (*<ConstructorTrans>*) 36 36 37 37 and dstr_to_sdstr d = match d with … … 44 44 | Ver _ -> raise (Invalid_argument "dstr_to_sdstr: Ver destructor does not exists in statements") 45 45 | Exercise t -> SExercise (term_to_stmt t) 46 >>blindSig>> 46 (*>>blindSig>>*) 47 47 | Unblind (ty, t1, t2, t3) -> SUnblind (term_to_stmt t1, term_to_stmt t2, term_to_stmt t3) 48 48 | Bcheck (ty, t1, t2) -> SBcheck (term_to_stmt t1, term_to_stmt t2) 49 <<blindSig<< 49 (*<<blindSig<<*) 50 50 | Id t -> SId (term_to_stmt t) 51 <DestructorTrans> 51 (*<DestructorTrans>*) 52 52 53 53 let rec print_type_b b t = match t with … … 64 64 | TStm(t1) -> (Printf.bprintf b "Stm("; print_type_b b t1; Printf.bprintf b ")") 65 65 | TVar x -> Printf.bprintf b "T%s" x 66 >>blindSig>> 66 (*>>blindSig>>*) 67 67 | TBlind x -> Printf.bprintf b "Blind("; print_type_b b x; Printf.bprintf b ")" 68 68 | TBlindSigKey x -> Printf.bprintf b "BlindSigKey("; print_type_b b x; Printf.bprintf b ")" … … 70 70 | TBlindSigned x -> Printf.bprintf b "BlindSigned("; print_type_b b x; Printf.bprintf b ")" 71 71 | TBlinder x -> Printf.bprintf b "Blinder("; print_type_b b x; Printf.bprintf b ")" 72 <<blindSig<< 72 (*<<blindSig<<*) 73 73 | TTop -> Printf.bprintf b "Top" 74 <Types> 74 (*<Types>*) 75 75 76 76 and print_term_b b t = match t with … … 92 92 List.iter (fun x -> Printf.bprintf b ", "; print_term_b b x) ts; 93 93 Printf.bprintf b ")") 94 >>blindSig>> 94 (*>>blindSig>>*) 95 95 | Blind(x, y) -> Printf.bprintf b "blind("; print_term_b b x; 96 96 Printf.bprintf b ","; print_term_b b y; … … 104 104 Printf.bprintf b ","; print_term_b b y; 105 105 Printf.bprintf b ")" 106 <<blindSig<< 107 <Constructors> 106 (*<<blindSig<<*) 107 (*<Constructors>*) 108 108 109 109 (* this function now prints type annotations too *) … … 118 118 List.iter (fun t -> print_term_b b t; Printf.bprintf b ", ") tl; Printf.bprintf b ")") 119 119 | Exercise t -> (Printf.bprintf b "exercise("; print_term_b b t; Printf.bprintf b ")") 120 >>blindSig>> 120 (*>>blindSig>>*) 121 121 | Unblind(ty, t1, t2, t3) -> (Printf.bprintf b "unblind(*"; 122 122 print_type_b b ty; … … 132 132 Printf.bprintf b ","; print_term_b b t2; 133 133 Printf.bprintf b ")") 134 <<blindSig<< 134 (*<<blindSig<<*) 135 135 | Id t -> (Printf.bprintf b "id("; print_term_b b t; Printf.bprintf b ")") 136 <Destructors> 136 (*<Destructors>*) 137 137 138 138 let rec print_stmt_b b s = match s with … … 150 150 List.iter (fun x -> print_stmt_b b x; Printf.bprintf b ", ") tl; 151 151 Printf.bprintf b ")") 152 >>blindSig>> 152 (*>>blindSig>>*) 153 153 | SBlind(x, y) -> Printf.bprintf b "blind("; print_stmt_b b x; 154 154 Printf.bprintf b ","; print_stmt_b b y; … … 161 161 Printf.bprintf b ","; print_stmt_b b y; 162 162 Printf.bprintf b ")" 163 <<blindSig<< 164 <SConstructors> 163 (*<<blindSig<<*) 164 (*<SConstructors>*) 165 165 166 166 and print_sdestr_b b modif sd = match sd with … … 173 173 (* TODO Is there a bug here? Why is not exercise followed by an "h"? *) 174 174 | SExercise t -> (Printf.bprintf b "exercise("; print_stmt_b b t; Printf.bprintf b ")") 175 >>blindSig>> 175 (*>>blindSig>>*) 176 176 | SUnblind(t1, t2, t3) -> (Printf.bprintf b "unblind%s(" modif; 177 177 print_stmt_b b t1; … … 183 183 Printf.bprintf b ","; print_stmt_b b t2; 184 184 Printf.bprintf b ")") 185 <<blindSig<< 185 (*<<blindSig<<*) 186 186 | SId t -> (Printf.bprintf b "id%s(" modif; print_stmt_b b t; Printf.bprintf b ")") 187 <SDestructors> 187 (*<SDestructors>*) 188 188 189 189 let rec print_process_b b p = match p with -
src/typechecker/replace.ml
r14598 r14830 32 32 | SPublic(a, b, t) -> SPublic(a, b, replaceab_stmt xs ys t) 33 33 | SExercise t -> SExercise(replaceab_stmt xs ys t) 34 >>blindSig>> 34 (*>>blindSig>>*) 35 35 | SUnblind(m, n, o) -> SUnblind(replaceab_stmt xs ys m, replaceab_stmt xs ys n, replaceab_stmt xs ys o) 36 36 | SBcheck(m, n) -> SBcheck(replaceab_stmt xs ys m, replaceab_stmt xs ys n) 37 <<blindSig<< 37 (*<<blindSig<<*) 38 38 | SId t -> SId(replaceab_stmt xs ys t) 39 <SDestructors> 39 (*<SDestructors>*) 40 40 41 41 and replaceab_sconstr xs ys f = match f with … … 44 44 | STrue -> STrue 45 45 | SZk(a, b, c, tl) -> SZk(a, b, c, List.map (fun z -> replaceab_stmt xs ys z) tl) 46 >>blindSig>> 46 (*>>blindSig>>*) 47 47 | SBlind(m, n) -> SBlind(replaceab_stmt xs ys m, replaceab_stmt xs ys n) 48 48 | SBvk(m) -> SBvk(replaceab_stmt xs ys m) 49 49 | SBsign(m, n) -> SBsign(replaceab_stmt xs ys m, replaceab_stmt xs ys n) 50 <<blindSig<< 51 <SConstructors> 50 (*<<blindSig<<*) 51 (*<SConstructors>*) 52 52 53 53 and replaceab_stmt xs ys s = match s with … … 80 80 | TStm t1 -> TStm(rename_type old fresh t1) 81 81 | TVar _ -> t 82 >>blindSig>> 82 (*>>blindSig>>*) 83 83 | TBlind t1 -> TBlind(rename_type old fresh t1) 84 84 | TBlindSigKey t1 -> TBlindSigKey(rename_type old fresh t1) … … 86 86 | TBlindSigned t1 -> TBlindSigned(rename_type old fresh t1) 87 87 | TBlinder t1 -> TBlinder(rename_type old fresh t1) 88 <<blindSig<< 89 <Types> 88 (*<<blindSig<<*) 89 (*<Types>*) 90 90 91 91 and rename_destr old fresh g = match g with … … 98 98 | Ver(a, b, c, d, m, l) -> Ver(a, b, c, d, rename_term old fresh m, List.map (fun a -> rename_term old fresh a) l) 99 99 | Exercise m -> Exercise(rename_term old fresh m) 100 >>blindSig>> 100 (*>>blindSig>>*) 101 101 | Unblind(t, m, n, o) -> Unblind(rename_type old fresh t, rename_term old fresh m, rename_term old fresh n, rename_term old fresh o) 102 102 | Bcheck(t, m, n) -> Bcheck(rename_type old fresh t, rename_term old fresh m, rename_term old fresh n) 103 <<blindSig<< 103 (*<<blindSig<<*) 104 104 | Id m -> Id(rename_term old fresh m) 105 <Destructors> 105 (*<Destructors>*) 106 106 107 107 and rename_constr old fresh f = match f with … … 114 114 | True -> f 115 115 | Zk(a, b, c, tl) -> Zk(a, b, c, List.map (fun a -> rename_term old fresh a) tl) 116 >>blindSig>> 116 (*>>blindSig>>*) 117 117 | Blind(m, n) -> Blind(rename_term old fresh m, rename_term old fresh n) 118 118 | Bvk(m) -> Bvk(rename_term old fresh m) 119 119 | Bsign(t, m, n) -> Bsign(rename_type old fresh t, rename_term old fresh m, rename_term old fresh n) 120 <<blindSig<< 121 <Constructors> 120 (*<<blindSig<<*) 121 (*<Constructors>*) 122 122 123 123 and rename_term old fresh m = match m with … … 209 209 | TStm t1 -> TStm(replace_stmt_in_type' x s free t1) 210 210 | TVar _ -> t 211 >>blindSig>> 211 (*>>blindSig>>*) 212 212 | TBlind t1 -> TBlind(replace_stmt_in_type' x s free t1) 213 213 | TBlindSigKey t1 -> TBlindSigKey(replace_stmt_in_type' x s free t1) … … 215 215 | TBlindSigned t1 -> TBlindSigned(replace_stmt_in_type' x s free t1) 216 216 | TBlinder t1 -> TBlinder(replace_stmt_in_type' x s free t1) 217 <<blindSig<< 218 <Types2> 217 (*<<blindSig<<*) 218 (*<Types2>*) 219 219 in 220 220 Logmanager.log "results in $t\n" ~types:[res] ~loglevel:2; res … … 229 229 | True -> True 230 230 | Zk(a, b, s, nl) -> Zk(a, b, s, List.map (fun a -> replace_term x m a) nl) 231 >>blindSig>> 231 (*>>blindSig>>*) 232 232 | Blind(m1, m2) -> Blind(replace_term x m m1, replace_term x m m2) 233 233 | Bvk(m1) -> Bvk(replace_term x m m1) 234 234 | Bsign(t, m1, m2) -> Bsign(replace_type x m t, replace_term x m m1, replace_term x m m2) 235 <<blindSig<< 236 <Constructors2> 235 (*<<blindSig<<*) 236 (*<Constructors2>*) 237 237 238 238 and replace_term x m n = match n with -
src/typechecker/subtype.ml
r14264 r14830 41 41 | TCh t, TCh u -> subtype t u f && subtype u t f 42 42 | TZKProof(_, _, _, t), TZKProof(_, _, _, u) -> subtype t u f 43 >>blindSig>> 43 (*>>blindSig>>*) 44 44 | TBlind t, TBlind u -> subtype t u f && subtype u t f 45 45 | TBlinder t, TBlinder u -> subtype t u f && subtype u t f … … 47 47 | TBlindSigKey t, TBlindSigKey u -> subtype t u f && subtype u t f 48 48 | TBlindVerKey t, TBlindVerKey u -> subtype t u f 49 <<blindSig<< 50 <Typing> 49 (*<<blindSig<<*) 50 (*<Typing>*) 51 51 | _ -> kind t1 Kpub f && kind t2 Ktnt f 52 52 in -
src/typechecker/syntax.ml
r14817 r14830 30 30 | TStm of types 31 31 | TVar of string 32 >>blindSig>> 32 (*>>blindSig>>*) 33 33 | TBlind of types 34 34 | TBlindSigKey of types … … 36 36 | TBlindSigned of types 37 37 | TBlinder of types 38 <<blindSig<< 38 (*<<blindSig<<*) 39 39 | TTop 40 <Types> 40 (*<Types>*) 41 41 42 42 and destr = Fst of term … … 48 48 | Ver of int * int * int * string * term * term list 49 49 | Exercise of term 50 >>blindSig>> 50 (*>>blindSig>>*) 51 51 | Unblind of types * term * term * term 52 52 | Bcheck of types * term * term 53 <<blindSig<< 53 (*<<blindSig<<*) 54 54 | Id of term 55 <Destructors> 55 (*<Destructors>*) 56 56 57 57 and constr = Pair of term * term * term * types option … … 59 59 | True 60 60 | Zk of int * int * string * term list 61 >>blindSig>> 61 (*>>blindSig>>*) 62 62 | Blind of term * term 63 63 | Bvk of term 64 64 | Bsign of types * term * term 65 <<blindSig<< 66 <Constructors> 65 (*<<blindSig<<*) 66 (*<Constructors>*) 67 67 68 68 and term = Ident of name … … 83 83 | SPublic of int * int * stmt 84 84 | SExercise of stmt 85 >>blindSig>> 85 (*>>blindSig>>*) 86 86 | SUnblind of stmt * stmt * stmt 87 87 | SBcheck of stmt * stmt 88 <<blindSig<< 88 (*<<blindSig<<*) 89 89 | SId of stmt 90 <SDestructors> 90 (*<SDestructors>*) 91 91 92 92 and sconstr = SPair of stmt * stmt … … 94 94 | STrue 95 95 | SZk of int * int * string * stmt list 96 >>blindSig>> 96 (*>>blindSig>>*) 97 97 | SBlind of stmt * stmt 98 98 | SBvk of stmt 99 99 | SBsign of stmt * stmt 100 <<blindSig<< 101 <SConstructors> 100 (*<<blindSig<<*) 101 (*<SConstructors>*) 102 102 103 103 and kinding = Ktnt -
src/typechecker/template.spass
r14264 r14830 28 28 functions[ 29 29 % constructors 30 (pair,2), (ok,0), <Constructors>,31 >>blindSig>> 30 (pair,2), (ok,0), (*<Constructors>*), 31 (*>>blindSig>>*) 32 32 (blind,2), (bvk,1), (bsign,2), 33 <<blindSig<< 33 (*<<blindSig<<*) 34 34 % zk constructor - one for each zk arity 35 35 $#ZKCONSTS$ 36 36 37 37 % destructors inside statements 38 (fsth,1), (sndh,1), (publich,1), (exerciseh,1), (idh,1), <Destructors>,39 >>blindSig>> 38 (fsth,1), (sndh,1), (publich,1), (exerciseh,1), (idh,1), (*<Destructors>*), 39 (*>>blindSig>>*) 40 40 (exerciseh,1), (unblindh,3), (bcheckh,2), (idh,1), 41 <<blindSig<<41 (*<<blindSig<<*) 42 42 % variables and names in Gamma (transformed to constants) 43 43 % for some reason they really need the c in front of their name … … 57 57 formula(forall([x,y], equal(sndh(pair(x,y)),y) )). 58 58 formula(forall([x], equal(exerciseh(x),x) )). 59 >>blindSig>> 59 (*>>blindSig>>*) 60 60 formula(forall([x,y], equal(dech(enc(x,pk(y)),y),x) )). 61 61 formula(forall([x,y], equal(checkh(sign(x,y),vk(y)),x) )). 62 62 formula(forall([x,y,z], equal(unblindh(bsign(pair(blind(x,y), ok), z), y, bvk(z)), sign(pair(x, ok), z)))). 63 63 formula(forall([x,z], equal(bcheckh(sign(x, z), bvk(z)), x))). 64 <<blindSig<< 64 (*<<blindSig<<*) 65 65 formula(forall([x], equal(idh(x), x))). 66 <DestRules> 66 (*<DestRules>*) 67 67 68 68 % Needed for tuples -
src/typechecker/typeterm.ml
r14616 r14830 108 108 | Public(n, m, _) -> [build_f_type n m] 109 109 | Exercise(_) -> [TVar("x")] (* XXX correct? *) 110 >>blindSig>> 110 (*>>blindSig>>*) 111 111 | Unblind(TPair(Ident x, TBlind(tvar), _) as t, _, _, _) -> [TBlindSigned(t); TBlinder(tvar); TBlindVerKey(t)] 112 112 | Bcheck(TPair(Ident z, TBlind(tvar), _) as t, _, _) -> [TSigned(tvar); TBlindVerKey(t)] 113 <<blindSig<< 113 (*<<blindSig<<*) 114 114 | Id(_) -> [TVar("x")] 115 <DestInput> 115 (*<DestInput>*) 116 116 | _ -> raise (Invalid_argument "get_types: type requested that should not be in this table") 117 117 … … 124 124 | Public(n, m, _) -> gen_pairs m (Spasssyntax.S_Symbol(Spasssyntax.S_True)) 125 125 | Exercise(_) -> TVar("x") (* XXX correct? *) 126 >>blindSig>> 126 (*>>blindSig>>*) 127 127 | Unblind(TPair(_, TBlind(tvar), _), _, _, _) -> TSigned(tvar) 128 128 | Bcheck(TPair(Ident z, TBlind(tvar), TOk c), _, _) -> let _, free = … … 132 132 TPair(Ident x, tvar, TOk(Spasssyntax.S_Term(Spasssyntax.S_Exists, 133 133 [S_Symbol(Spasssyntax.S_Sym_Ident y)], replace_formula z (F(Blind(Ident x, Ident y))) c))) 134 <<blindSig<< 134 (*<<blindSig<<*) 135 135 | Id(_) -> TVar("x") 136 <DestResult> 136 (*<DestResult>*) 137 137 | _ -> raise (Invalid_argument "get_type: type requested that should not be 138 138 in this table") … … 147 147 | Ver(_, _, _, _, t1, tl) -> [type_term t1 f] @ (List.map (fun a -> type_term a f) tl) 148 148 | Exercise(t) -> [type_term t f] 149 >>blindSig>> 149 (*>>blindSig>>*) 150 150 | Unblind(_, m, n, o) -> [type_term m f; type_term n f; type_term o f] 151 151 | Bcheck(_, m, n) -> [type_term m f; type_term n f] 152 <<blindSig<< 152 (*<<blindSig<<*) 153 153 | Id(t) -> [type_term t f] 154 <DestCompute> 154 (*<DestCompute>*) 155 155 156 156 and get_input_types_f f = match f with 157 157 True -> [] 158 >>blindSig>> 158 (*>>blindSig>>*) 159 159 | Blind(_, _) -> [TVar("x"); TBlinder(TVar("x"))] 160 160 | Bvk _ -> [TBlindSigKey(TVar("x"))] 161 161 | Bsign(TPair(Ident x, TBlind(tvar), _) as t, _, _) -> [t; TBlindSigKey(t)] 162 <<blindSig<< 163 <ConsInput> 162 (*<<blindSig<<*) 163 (*<ConsInput>*) 164 164 | _ -> raise (Invalid_argument "get_type: type requested that should not be in this table") 165 165 166 166 and get_result_type_f f = match f with 167 167 True -> TBool 168 >>blindSig>> 168 (*>>blindSig>>*) 169 169 | Blind(m, n) -> TBlind(TVar("x")) 170 170 | Bvk _ -> TBlindVerKey(TVar("x")) 171 171 | Bsign(TPair(Ident x, TBlind(tvar), _) as t, _, _) -> TBlindSigned(t) 172 <<blindSig<< 173 <ConsResult> 172 (*<<blindSig<<*) 173 (*<ConsResult>*) 174 174 | _ -> raise (Invalid_argument "get_type: type requested that should not be in this table") 175 175 … … 177 177 True -> [] 178 178 | Zk(_, _, _, t) -> List.map (fun a -> type_term a f) t 179 >>blindSig>> 179 (*>>blindSig>>*) 180 180 | Blind(m1, m2) -> [type_term m1 f; type_term m2 f] 181 181 | Bvk(m1) -> [type_term m1 f] 182 182 | Bsign(t, m1, m2) -> [type_term m1 f; type_term m2 f] 183 <<blindSig<< 184 <ConsCompute> 183 (*<<blindSig<<*) 184 (*<ConsCompute>*) 185 185 186 186 and alg_env u f = ( -
src/typechecker/unify.ml
r14271 r14830 146 146 | TZKProof(_, _, _, ts), TZKProof(_, _, _, ts'), _ -> 147 147 generate_constraint ts ts' f b 148 >>blindSig>> 148 (*>>blindSig>>*) 149 149 | TBlind t, TBlind u, _-> 150 150 generate_constraint t u f true @ generate_constraint t u f false … … 157 157 | TBlindVerKey t, TBlindVerKey u, n -> 158 158 generate_constraint t u f n 159 <<blindSig<< 160 <Constraints> 159 (*<<blindSig<<*) 160 (*<Constraints>*) 161 161 162 162 | _, _, true -> con_gen_pub_tnt_plus t t' f … … 191 191 (TVar y, tr) -> if String.compare y x = 0 then tr else 192 192 a) (TVar(x)) sigma 193 >>blindSig>> 193 (*>>blindSig>>*) 194 194 | TBlind t' -> TBlind(apply sigma t') 195 195 | TBlindSigKey t' -> TBlindSigKey(apply sigma t') … … 197 197 | TBlindSigned t' -> TBlindSigned(apply sigma t') 198 198 | TBlinder t' -> TBlinder(apply sigma t') 199 <<blindSig<< 200 <Applys> 199 (*<<blindSig<<*) 200 (*<Applys>*)
Note: See TracChangeset
for help on using the changeset viewer.
