diff options
| author |  Rustan Leino <leino@microsoft.com> | 2012-10-04 13:32:50 -0700 |
|---|---|---|
| committer | Rustan Leino <leino@microsoft.com> | 2012-10-04 13:32:50 -0700 |
| commit | 8911e5c95d4715c2e2626aef67f19793d6f43201 (patch) | |
| tree | d703bfd931802e780430e32f1339cf77adc342a4 /Source/Jennisys | |
| parent | 1c375d1889e628fcd2a1a0fc041673a5f4230d84 (diff) | |
Put all sources under \Source directory
Diffstat (limited to 'Source/Jennisys')
64 files changed, 11928 insertions, 0 deletions
diff --git a/Source/Jennisys/Analyzer.fs b/Source/Jennisys/Analyzer.fs new file mode 100644 index 00000000..db4887ed --- /dev/null +++ b/Source/Jennisys/Analyzer.fs @@ -0,0 +1,953 @@ +module Analyzer
+
+open Ast
+open Getters
+open AstUtils
+open CodeGen
+open DafnyModelUtils
+open DafnyPrinter
+open FixpointSolver
+open MethodUnifier
+open Modularizer
+open Options
+open PipelineUtils
+open PrintUtils
+open Resolver
+open TypeChecker
+open Utils
+
+open Microsoft.Boogie
+
+let Rename suffix vars =
+ vars |> List.map (function Var(nm,tp,old) -> nm, Var(nm + suffix, tp, old))
+
+let ReplaceName substMap nm =
+ match Map.tryFind nm substMap with
+ | Some(Var(name,_,_)) -> name
+ | None -> nm
+
+let rec Substitute substMap = function
+ | IdLiteral(s) -> IdLiteral(ReplaceName substMap s)
+ | Dot(e,f) -> Dot(Substitute substMap e, ReplaceName substMap f)
+ | UnaryExpr(op,e) -> UnaryExpr(op, Substitute substMap e)
+ | BinaryExpr(n,op,e0,e1) -> BinaryExpr(n, op, Substitute substMap e0, Substitute substMap e1)
+ | SelectExpr(e0,e1) -> SelectExpr(Substitute substMap e0, Substitute substMap e1)
+ | UpdateExpr(e0,e1,e2) -> UpdateExpr(Substitute substMap e0, Substitute substMap e1, Substitute substMap e2)
+ | SequenceExpr(ee) -> SequenceExpr(List.map (Substitute substMap) ee)
+ | SeqLength(e) -> SeqLength(Substitute substMap e)
+ | ForallExpr(vv,e) -> ForallExpr(vv, Substitute substMap e)
+ | expr -> expr
+
+let GenMethodAnalysisCode comp m assertion genOld =
+ let methodName = GetMethodName m
+ let signature = GetMethodSig m
+ let ppre,ppost = GetMethodPrePost m
+ let pre = Desugar ppre
+ let post = Desugar ppost |> RewriteOldExpr
+ let ghostPre = GetMethodGhostPrecondition m |> Desugar
+ //let sigStr = PrintSig signature
+ let sigVarsDecl =
+ match signature with
+ | Sig(ins,outs) -> ins @ outs |> List.fold (fun acc vd -> acc + (sprintf " var %s;" (PrintVarDecl vd)) + newline) ""
+
+ " method " + methodName + "()" + newline +
+ " modifies this;" + newline +
+ " {" + newline +
+ // print signature as local variables
+ sigVarsDecl +
+ " // assume precondition" + newline +
+ " assume " + (PrintExpr 0 pre) + ";" + newline +
+ " // assume ghost precondition" + newline +
+ " assume " + (PrintExpr 0 ghostPre) + ";" + newline +
+ " // assume invariant and postcondition" + newline +
+ " assume Valid();" + newline +
+ (if genOld then " assume Valid_old();" + newline else "") +
+ " assume " + (PrintExpr 0 post) + ";" + newline +
+ " // assume user defined invariant again because assuming Valid() doesn't always work" + newline +
+ (GetInvariantsAsList comp |> PrintSep newline (fun e -> " assume " + (PrintExpr 0 e) + ";")) + newline +
+ // if the following assert fails, the model hints at what code to generate; if the verification succeeds, an implementation would be infeasible
+ " // assert false to search for a model satisfying the assumed constraints" + newline +
+ " assert " + (PrintExpr 0 assertion) + ";" + newline +
+ " }" + newline
+
+let rec MethodAnalysisPrinter onlyForThese assertion genOld comp =
+ let cname = GetComponentName comp
+ match onlyForThese with
+ | (c,m) :: rest when GetComponentName c = cname ->
+ match m with
+ | Method(_) ->
+ (GenMethodAnalysisCode c m assertion genOld) + newline +
+ (MethodAnalysisPrinter rest assertion genOld comp)
+ | _ -> ""
+ | _ :: rest -> MethodAnalysisPrinter rest assertion genOld comp
+ | [] -> ""
+
+// =========================================================================
+/// For a given constant "objRefName" (which is an object, something like
+/// "gensym32"), finds a path of field references from "this" (e.g. something
+/// like "this.next.next").
+///
+/// Implements a backtracking search over the heap entries to find that
+/// path. It starts from the given object, and follows the backpointers
+/// until it reaches the root ("this")
+// =========================================================================
+// let objRef2ExprCache = new System.Collections.Generic.Dictionary<string, Expr>()
+let GetObjRefExpr objRefName (heapInst: HeapInstance) =
+ let rec __GetObjRefExpr objRefName visited =
+ if Set.contains objRefName visited then
+ None
+ else
+ let newVisited = Set.add objRefName visited
+ match objRefName with
+ | "this" -> Some(ObjLiteral("this"))
+ | _ ->
+ let rec __fff lst =
+ match lst with
+ | ((o,var),_) :: rest ->
+ match __GetObjRefExpr o.name newVisited with
+ | Some(expr) -> Some(Dot(expr, GetExtVarName var))
+ | None -> __fff rest
+ | [] -> None
+ let backPointers = heapInst.concreteValues |> List.choose (function
+ FieldAssignment (x,l) ->
+ if l = ObjLiteral(objRefName) then Some(x,l) else None
+ |_ -> None)
+ __fff backPointers
+ (* --- function body starts here --- *)
+ __GetObjRefExpr objRefName (Set.empty)
+// THIS DOESN'T WORK BECAUSE THE CACHE HAS TO BE PURGED AFTER EVERY METHOD
+// if objRef2ExprCache.ContainsKey(objRefName) then
+// Some(objRef2ExprCache.[objRefName])
+// else
+// let res = __GetObjRefExpr objRefName (Set.empty)
+// match res with
+// | Some(e) -> objRef2ExprCache.Add(objRefName, e)
+// | None -> ()
+// res
+
+// =============================================================================
+/// Returns an expression that combines the post-condition of a given method with
+/// invariants for all objects present on the heap
+// =============================================================================
+let GetHeapExpr prog mthd heapInst includePreState =
+ // get expressions to evaluate:
+ // - add post (and pre?) conditions
+ // - go through all objects on the heap and assert their invariants
+ let pre,post = GetMethodPrePost mthd
+ let prepostExpr = post //TODO: do we need the "pre" here as well?
+ let heapObjs = heapInst.assignments |> List.fold (fun acc asgn ->
+ match asgn with
+ | FieldAssignment((o,_),_) -> acc |> Set.add o
+ | _ -> acc) Set.empty
+ heapObjs |> Set.fold (fun acc o ->
+ let receiverOpt = GetObjRefExpr o.name heapInst
+ let receiver = Utils.ExtractOption receiverOpt
+ let objComp = FindComponent prog (GetTypeShortName o.objType) |> Utils.ExtractOption
+ let objInvs = GetInvariantsAsList objComp
+ let objInvsUpdated = objInvs |> List.map (ChangeThisReceiver receiver)
+ let objInvFinal = objInvsUpdated |> List.fold BinaryAnd TrueLiteral
+ let objAllInvs =
+ if includePreState then
+ let objInvPre = MakeOld objInvFinal
+ BinaryAnd objInvFinal objInvPre
+ else
+ objInvFinal
+ BinaryAnd prepostExpr objAllInvs
+ ) prepostExpr
+
+let IsUnmodConcrOnly prog (comp,meth) expr =
+ let isConstr = IsModifiableObj (ThisObj comp) (comp,meth)
+ let rec __IsUnmodOnly args expr =
+ let __IsUnmodOnlyLst elist =
+ elist |> List.fold (fun acc e -> acc && (__IsUnmodOnly args e)) true
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarDeclExpr(_)
+ | ObjLiteral(_) -> true
+ | VarLiteral(id) -> args |> List.exists (fun var -> GetExtVarName var = id)
+ | IdLiteral("null") | IdLiteral("this") -> true
+ | IdLiteral(id) ->
+ not (isConstr || IsAbstractField comp id)
+ | Dot(e, fldName) -> //if isConstr then false else __IsUnmodOnlyLst [e]
+ if isConstr then
+ false
+ else
+ // assume it is unmodifiable, because it is a method, so just check if it's concrete
+ let lhsType = InferType prog comp (MethodArgChecker prog meth) e |> Utils.ExtractOptionMsg (sprintf "Inference failed for %s" (PrintExpr 0 e))
+ IsConcreteField lhsType fldName
+ | AssertExpr(e)
+ | AssumeExpr(e)
+ | SeqLength(e)
+ | LCIntervalExpr(e)
+ | MethodOutSelect(e,_)
+ | OldExpr(e)
+ | UnaryExpr(_,e) -> __IsUnmodOnlyLst [e]
+ | SelectExpr(e1, e2)
+ | BinaryExpr(_,_,e1,e2) -> __IsUnmodOnlyLst [e1; e2]
+ | IteExpr(e3, e1, e2)
+ | UpdateExpr(e1, e2, e3) -> __IsUnmodOnlyLst [e1; e2; e3]
+ | SequenceExpr(exprs) | SetExpr(exprs) -> __IsUnmodOnlyLst exprs
+ | MethodCall(rcv,_,_,aparams) -> __IsUnmodOnlyLst (rcv :: aparams)
+ | ForallExpr(vars,e) -> __IsUnmodOnly (args @ vars) e
+ (* --- function body starts here --- *)
+ __IsUnmodOnly (GetMethodInArgs meth) expr
+
+let AddUnif indent e v unifMap =
+ let idt = Indent indent
+ let builder = new CascadingBuilder<_>(unifMap)
+ builder {
+ let! notAlreadyAdded = Map.tryFind e unifMap |> Utils.IsNoneOption |> Utils.BoolToOption
+ Logger.DebugLine (idt + " - adding unification " + (PrintExpr 0 e) + " <--> " + (PrintConst v))
+ return Map.add e v unifMap
+ }
+
+//TODO: unifications should probably by "Expr <--> Expr" instead of "Expr <--> Const"
+let rec GetUnifications prog indent (comp,meth) heapInst unifs expr =
+ let idt = Indent indent
+ // - first looks if the give expression talks only about method arguments (args)
+ // - then it tries to evaluate it to a constant
+ // - if all of these succeed, it adds a unification rule e <--> val(e) to the given unifMap map
+ let __AddUnif e unifsAcc =
+ if IsConstExpr e then
+ unifsAcc
+ else
+ let builder = new CascadingBuilder<_>(unifsAcc)
+ builder {
+ let! argsOnly = IsUnmodConcrOnly prog (comp,meth) e |> Utils.BoolToOption
+ let! v = try Some(EvalFull heapInst e |> Expr2Const) with ex -> None
+ return AddUnif indent e v unifsAcc
+ }
+ (* --- function body starts here --- *)
+ AstUtils.DescendExpr2 __AddUnif expr unifs
+
+// =======================================================
+/// Returns a map (Expr |--> Const) containing unifications
+/// found for the given method wrt to heapInst.
+///
+/// The list of potential unifications include:
+/// (1) arg-value pairs for all method arguments,
+/// (2) field-value pairs for all unmodifiable fields,
+/// (3) expr-value pairs where expr are unmodifiable
+/// expressions found in the spec.
+// =======================================================
+let GetUnificationsForMethod indent prog comp m heapInst =
+ let idt = Indent indent
+ let rec GetArgValueUnifications args =
+ match args with
+ | var :: rest ->
+ let name = GetExtVarName var
+ match Map.tryFind name heapInst.methodArgs with
+ | Some(c) ->
+ GetArgValueUnifications rest |> AddUnif indent (VarLiteral(name)) c
+ | None -> failwith ("couldn't find value for argument " + name)
+ | [] -> Map.empty
+ let rec GetFldValueUnifications unifs =
+ heapInst.assignments |> List.fold (fun acc asgn ->
+ match asgn with
+ | FieldAssignment((obj,var), fldVal) ->
+ try
+ let vname = GetExtVarName var
+ let comp = obj.objType |> FindComponentForType prog |> Utils.ExtractOption
+ if IsConcreteField comp vname then
+ let path = GetObjRefExpr obj.name heapInst |> Utils.ExtractOption
+ let c = Expr2Const fldVal
+ AddUnif indent (Dot(path, vname)) c acc
+ else
+ acc
+ with
+ | ex ->
+ Logger.WarnLine ("[WARN]: error during getting field value unifications: " + ex.Message)
+ acc
+ | _ -> acc
+ ) unifs
+
+ (* --- function body starts here --- *)
+ let unifs = GetArgValueUnifications (GetMethodInArgs m)
+ let unifs =
+ //TODO: it should really read the "modifies" clause and figure out modifiable fields from there
+ if not (IsConstructor m) then
+ GetFldValueUnifications unifs
+ else
+ unifs
+ GetUnifications prog indent (comp,m) heapInst unifs (GetMethodPrePost m |> fun x -> BinaryAnd (fst x) (snd x))
+
+// =======================================================
+/// Applies given unifications onto a given heapInstance
+///
+/// If "conservative" is true, applies only those that
+/// can be verified to hold, otherwise applies all of them
+// =======================================================
+let rec ApplyUnifications indent prog comp mthd unifs heapInst conservative =
+ let idt = Indent indent
+ ///
+ let __CheckUnif o f e idx =
+ if not conservative || not Options.CONFIG.checkUnifications then
+ true
+ else
+ let lhs = if o = NoObj then
+ VarLiteral(GetVarName f)
+ else
+ let objRefExpr = GetObjRefExpr o.name heapInst |> Utils.ExtractOptionMsg ("Couldn't find a path from 'this' to " + o.name)
+ let fldName = GetVarName f
+ Dot(objRefExpr, fldName)
+ let assertionExpr = match GetVarType f with
+ | Some(SeqType(_)) when not (idx = -1) -> BinaryEq (SelectExpr(lhs, IntLiteral(idx))) e
+ | Some(SetType(_)) when not (idx = -1) -> BinaryIn e lhs
+ | _ -> BinaryEq lhs e
+ // check if the assertion follows and if so update the env
+ let genOld = false
+ let code = PrintDafnyCodeSkeleton prog (MethodAnalysisPrinter [comp,mthd] assertionExpr genOld) true genOld
+ Logger.Debug (idt + " - checking assertion: " + (PrintExpr 0 assertionExpr) + " ... ")
+ let ok = CheckDafnyProgram code ("unif_" + (GetMethodFullName comp mthd))
+ if ok then
+ Logger.DebugLine " HOLDS"
+ else
+ Logger.DebugLine " DOESN'T HOLD"
+ ok
+ ///
+ let __Apply (o,f) c e value=
+ if value = Const2Expr c then
+ if __CheckUnif o f e -1 then
+ // change the value to expression
+ //Logger.TraceLine (sprintf "%s - applied: %s.%s --> %s" idt (PrintConst o) (GetVarName f) (PrintExpr 0 e) )
+ e
+ else
+ value
+ else
+ let rec __UnifyOverLst lst cnt =
+ match lst with
+ | lstElem :: rest when lstElem = Const2Expr c ->
+ if __CheckUnif o f e cnt then
+ //Logger.TraceLine (sprintf "%s - applied: %s.%s[%d] --> %s" idt (PrintConst o) (GetVarName f) cnt (PrintExpr 0 e) )
+ e :: __UnifyOverLst rest (cnt+1)
+ else
+ lstElem :: __UnifyOverLst rest (cnt+1)
+ | lstElem :: rest ->
+ lstElem :: __UnifyOverLst rest (cnt+1)
+ | [] -> []
+ // see if it's a list, then try to match its elements, otherwise leave it as is
+ match value with
+ | SequenceExpr(elist) ->
+ let newExprList = __UnifyOverLst elist 0
+ SequenceExpr(newExprList)
+ | SetExpr(elist) ->
+ let newExprList = __UnifyOverLst elist 0
+ SetExpr(newExprList)
+ | _ ->
+ value
+
+ (* --- function body starts here --- *)
+ match unifs with
+ | (e,c) :: rest ->
+ let heapInst = ApplyUnifications indent prog comp mthd rest heapInst conservative
+ let newHeap = heapInst.assignments|> List.fold (fun acc asgn ->
+ match asgn with
+ | FieldAssignment((o,f),value) when heapInst.modifiableObjs |> Set.contains o ->
+ let e2 = __Apply (o,f) c e value
+ acc @ [FieldAssignment((o,f),e2)]
+ | _ -> acc @ [asgn]
+ ) []
+ let newRetVals = heapInst.methodRetVals |> Map.fold (fun acc key value ->
+ let e2 = __Apply (NoObj,Var(key, None, false)) c e value
+ acc |> Map.add key e2
+ ) Map.empty
+ {heapInst with assignments = newHeap; methodRetVals = newRetVals}
+ | [] -> heapInst
+
+// ====================================================================================
+/// Returns whether the code synthesized for the given method can be verified with Dafny
+// ====================================================================================
+let VerifySolution prog solutions genRepr =
+ // print the solution to file and try to verify it with Dafny
+ //let prog = Program(solutions |> Utils.MapKeys |> Map.ofList |> Utils.MapKeys)
+ let code = PrintImplCode prog solutions genRepr false
+ CheckDafnyProgram code dafnyVerifySuffix
+
+let rec DiscoverAliasing exprList heapInst =
+ match exprList with
+ | e1 :: rest ->
+ let eqExpr = rest |> List.fold (fun acc e ->
+ if EvalFull heapInst (BinaryEq e1 e) = TrueLiteral then
+ BinaryAnd acc (BinaryEq e1 e)
+ else
+ acc
+ ) TrueLiteral
+ BinaryAnd eqExpr (DiscoverAliasing rest heapInst)
+ | [] -> TrueLiteral
+
+//
+let DontResolveUnmodifiableStuff prog comp meth expr =
+ let methodArgs = GetMethodInArgs meth
+ let __IsMethodArg argName = methodArgs |> List.exists (fun var -> GetExtVarName var = argName)
+ let isMod = IsModifiableObj (ThisObj comp) (comp,meth)
+ match expr with
+ | VarLiteral(id) when __IsMethodArg id -> false
+ | IdLiteral(id) when id = "this" || id = "null" -> true
+ | IdLiteral(id) | Dot(_, id) ->
+ // this must be a field, so resolve it only if modifiable
+ isMod
+ | _ -> true
+
+/// Descends down a given expression and returns bunch of sub-expressions that all evaluate to true
+let FindClauses trueOnly resolverFunc heapInst expr =
+ let MyFun expr acc =
+ try
+ match expr with
+ // skip binary logical operators because we want to find smallest sub-expressions
+ | BinaryExpr(_,op,_,_) when IsLogicalOp op -> acc
+ | _ ->
+ let exprEval = Eval heapInst resolverFunc expr
+ match exprEval with
+ | _ when exprEval = TrueLiteral -> acc
+ | _ ->
+ let exprAllResolved = EvalFull heapInst expr
+ match exprAllResolved with
+ | BoolLiteral(true) -> acc @ (exprEval |> SplitIntoConjunts)
+ | BoolLiteral(false) -> acc //if trueOnly then acc else acc @ (UnaryNot exprEval |> SplitIntoConjunts)
+ | _ -> acc
+ with
+ | _ -> acc
+ (* --- function body starts here --- *)
+ DescendExpr2 MyFun expr []
+
+/// Descends down a given expression and returns all sub-expressions that evaluate to TrueLiteral
+let FindTrueClauses resolverFunc heapInst expr =
+ FindClauses true resolverFunc heapInst expr
+
+/// Returns a list of boolean expressions obtained by combining (in some way)
+/// the two given list of conditions conditions
+let GetAllPossibleConditions specConds argConds aliasingConds =
+ let __Conjoin lst = lst |> List.fold (fun acc e -> BinaryAnd acc e) TrueLiteral
+ let __Preproc lst = lst |> List.map SplitIntoConjunts |> List.concat |> Utils.ListDeduplicate
+
+ // 0. aliasing conditions
+ // 1. conjunction of spec conditions
+ // 2. individual arg conditions
+ // 3. conjunction of arg conditions
+ // 4. individual spec conditions
+ let aliasing = aliasingConds |> __Preproc
+ let specIndi = specConds |> __Preproc
+ let specConj = [__Conjoin specIndi]
+ let argsIndi = argConds |> __Preproc
+ let argsConj = [__Conjoin argsIndi]
+
+ let allConds = aliasing @ specConj @ argsIndi @ specIndi @ argsConj
+ allConds |> List.filter (fun e -> not (e = TrueLiteral))
+ |> Utils.ListDeduplicate
+
+// check whther a given solution (in the form of heapInst) verifies assuming a given guard
+let rec CheckGuard prog comp m candCond indent idt heapInst callGraph =
+ let rec __MinGuard guard idx m2 sol =
+ let conjs = SplitIntoConjunts guard
+ let len = List.length conjs
+ if idx >= 0 && idx < len && len > 1 then
+ let guard' = conjs |> Utils.ListRemoveIdx (len - idx - 1) |> List.fold BinaryAnd TrueLiteral
+ match CheckGuard prog comp m guard' indent idt heapInst callGraph with
+ | Some(x) -> x
+ | None -> __MinGuard guard (idx+1) m2 sol
+ else
+ guard, m2, sol
+
+ let m2 = AddPrecondition m candCond
+ let sol = MakeModular (indent+2) prog comp m2 candCond heapInst callGraph
+ Logger.Info (idt + " - verifying partial solution ... ")
+ let verified =
+ if Options.CONFIG.verifyPartialSolutions then
+ VerifySolution prog sol Options.CONFIG.genRepr
+ else
+ true
+ if verified then
+ if Options.CONFIG.verifyPartialSolutions then Logger.InfoLine "VERIFIED" else Logger.InfoLine "SKIPPED"
+ if Options.CONFIG.minimizeGuards then
+ Logger.InfoLine(idt + " - minimizing guard ... " + (PrintExpr 0 candCond))
+ Some(__MinGuard candCond 0 m2 sol)
+ else
+ Some(candCond,m2,sol)
+ else
+ Logger.InfoLine ("NOT VERIFIED")
+ None
+
+// iteratively tries to remove conjunts and check whether the solutions still verifies
+//let MinimizeGuard guard prog comp m heapInst callGraph indent =
+
+
+// ============================================================================
+/// Attempts to synthesize the initialization code for the given constructor "m"
+///
+/// Returns a (heap,env,ctx) tuple
+// ============================================================================
+let rec AnalyzeConstructor indent prog comp m callGraph =
+ let idt = Indent indent
+ let TryFindAndVerify m =
+ match TryFindExistingAndConvertToSolution indent comp m TrueLiteral callGraph with
+ | Some(sol) ->
+ if VerifySolution prog sol Options.CONFIG.genRepr then
+ Logger.InfoLine (idt + " ~~~ VERIFIED ~~~")
+ Some(sol)
+ else
+ Logger.InfoLine (idt + " !!! NOT VERIFIED !!!")
+ None
+ | None -> None
+
+ (* --- function body starts here --- *)
+ Logger.InfoLine (idt + "[*] Analyzing constructor")
+ Logger.InfoLine (idt + "------------------------------------------")
+ Logger.InfoLine (Printer.PrintMethodSignFull (indent + 4) comp m)
+ Logger.InfoLine (idt + "------------------------------------------")
+ match TryFindAndVerify m with
+ | Some(sol) -> sol
+ | None ->
+ let methodName = GetMethodName m
+ let pre,post = GetMethodPrePost m
+ // generate Dafny code for analysis first
+ let genOld = true
+ let code = PrintDafnyCodeSkeleton prog (MethodAnalysisPrinter [comp,m] FalseLiteral genOld) true genOld
+ Logger.Info (idt + " - searching for an instance ...")
+ let models = RunDafnyProgram code (dafnyScratchSuffix + "_" + (GetMethodFullName comp m))
+ if models.Count = 0 then
+ // no models means that the "assert false" was verified, which means that the spec is inconsistent
+ Logger.WarnLine (idt + " !!! SPEC IS INCONSISTENT !!!")
+ Map.empty
+ else
+ if models.Count > 1 then
+ Logger.WarnLine " FAILED "
+ failwith "internal error (more than one model for a single constructor analysis)"
+ Logger.InfoLine " OK "
+ let model = models.[0]
+ let hModel = ReadFieldValuesFromModel model prog comp m
+ let heapInst = ResolveModel hModel (comp,m)
+ let unifs = GetUnificationsForMethod indent prog comp m heapInst |> Map.toList
+ let heapInst = ApplyUnifications indent prog comp m unifs heapInst true
+
+ // split into method calls
+ let sol = MakeModular indent prog comp m TrueLiteral heapInst callGraph |> FixSolution comp m
+
+ if Options.CONFIG.verifySolutions then
+ Logger.InfoLine (idt + " - verifying synthesized solution ... ")
+ let verified = VerifySolution prog sol Options.CONFIG.genRepr
+ Logger.Info (idt + " ")
+ if verified then
+ Logger.InfoLine "~~~ VERIFIED ~~~"
+ sol
+ else
+ Logger.InfoLine "!!! NOT VERIFIED !!!"
+ if Options.CONFIG.inferConditionals then
+ TryRecursion (indent + 4) prog comp m unifs heapInst callGraph
+ else
+ sol
+ else
+ sol
+and TryRecursion indent prog comp m unifs heapInst callGraph =
+ let idt = Indent indent
+
+ /// checks whether an expression is ok, meaning
+ /// - only immediate concrete fields of the "this" object are used,
+ /// - no recursion on the same object with the same parameters
+ let __IsOk hInst expr =
+ let compName = GetComponentName comp
+ let methName = GetMethodName m
+ let myVisitor =
+ fun expr acc ->
+ if not acc then
+ false
+ else
+ match expr with
+ | Dot(discr, fldName) ->
+ let obj = EvalFull heapInst discr
+ match obj with
+ | ObjLiteral(id) when id = "this" ->
+ try
+ let fname = RenameFromOld fldName
+ IsConcreteField (InferType prog comp (MethodArgChecker prog m) discr |> Utils.ExtractOption) fname
+ with
+ | _ -> false
+ | ObjLiteral(id) -> false
+ | _ -> failwithf "Didn't expect the discriminator of a Dot to not be ObjLiteral"
+ | MethodCall(receiver, cn, mn, elst) when receiver = ThisLiteral && cn = compName && mn = methName ->
+ elst |> List.exists (function VarLiteral(_) -> false | _ -> true)
+ | _ -> true
+ DescendExpr2 myVisitor expr true
+
+ /// Finds all modifiable fields in a given hInst, and checks if an "ok"
+ /// expression exists for each one of them.
+ ///
+ /// Returns all possible combinations of "ok" solutions (these are not verified yet).
+ let __GetAllAssignments hInst premises =
+ let rec __IterVars vars =
+ match vars with
+ | lhs :: [] ->
+ let lhsOptions = premises |> Set.toList
+ |> List.choose (function
+ | BinaryExpr(_,"=",l,r) -> if l = lhs then Some(r) elif r = lhs then Some(l) else None
+ | _ -> None)
+ |> List.filter (__IsOk hInst)
+ |> List.map (fun e -> [lhs,e])
+ lhsOptions
+ | lhs :: rest ->
+ let lhsOptions = __IterVars [lhs]
+ if List.isEmpty lhsOptions then
+ List.empty
+ else
+ let restOptions = __IterVars rest
+ Utils.ListCombine (fun t1 t2 -> t1 @ t2) lhsOptions restOptions
+ | [] -> List.empty
+
+ let stmts = ConvertToStatements hInst true
+ let modVars = stmts |> List.choose (function
+ | Assign(lhs,_) -> Some(lhs)
+ | _ -> None)
+ __IterVars modVars
+
+ /// Print a given list of assignments
+ let rec __PrintSol indent s =
+ let idt = Indent indent
+ match s with
+ | (l,r) :: [] ->
+ sprintf "%s%s := %s" idt (PrintExpr 0 l) (PrintExpr 0 r)
+ | (l,r) :: rest ->
+ let str = __PrintSol indent [l,r]
+ str + newline + (__PrintSol indent rest)
+ | [] -> ""
+
+ /// Returns a given method's postcondition where
+ /// - all input variables are renamed so that their names start with "$" and
+ /// (so that the unifier know that it's ok to try to unify those variables)
+ /// - all output variables are rewritten as $this.<method_name>(<args>)["<out_var_name>"]
+ /// (so that it is clear that they are results of a method call)
+ let __GetMethodPostTemplate comp m =
+ let compName = GetComponentName comp
+ let methName = GetMethodName m
+ let ins = GetMethodInArgs m
+ let outs = GetMethodOutArgs m
+ let post = GetMethodPrePost m |> snd
+ post |> RewriteWithCtx (fun ctx e ->
+ match e with
+ | VarLiteral(id) when not (IsInVarList ctx id) ->
+ if IsInVarList outs id then
+ let mcall = MethodCall(ThisLiteral, compName, methName, ins |> List.map (function var -> VarLiteral("$" + (GetExtVarName var))))
+ let outSel = MethodOutSelect(mcall, id)
+ Some(outSel)
+ else
+ Some(VarLiteral("$" + id))
+ | _ -> None) []
+ |> ChangeThisReceiver (VarLiteral("$this"))
+
+ /// Merges ...
+ let __MergeSolutions hInst s =
+ let __FindRhs lhs = s |> List.choose (fun (l,r) -> if l = lhs then Some(r) else None) |> Utils.ListToOption
+ let rec __FixAssignments asgs =
+ match asgs with
+ | asg :: rest ->
+ let newAsg =
+ match asg with
+ | FieldAssignment((obj,var) as discr,valExpr) ->
+ let objPath = GetObjRefExpr obj.name hInst |> Utils.ExtractOption
+ let lhs = Dot(objPath, GetExtVarName var)
+ match __FindRhs lhs with
+ | Some(rhs) -> FieldAssignment(discr,rhs)
+ | None -> asg
+ | _ -> asg
+ newAsg :: (__FixAssignments rest)
+ | [] -> []
+ let rec __FixRetValues retVals =
+ match retVals with
+ | (varName,varExpr) :: rest ->
+ let lhs = VarLiteral(varName)
+ let newVarExpr =
+ match __FindRhs lhs with
+ | Some(rhs) -> rhs
+ | None -> varExpr
+ __FixRetValues rest |> Map.add varName newVarExpr
+ | [] -> Map.empty
+ if s = [] then
+ hInst
+ else
+ // fix assignments
+ let newAsgs = __FixAssignments hInst.assignments
+ // fix return values
+ let newRetVals = __FixRetValues (hInst.methodRetVals |> Map.toList)
+ {hInst with assignments = newAsgs;
+ methodRetVals = newRetVals}
+
+
+ /// For a given heap instance and a list of possible solutions, it iterates
+ /// trough all of them and returns whichever verifies first.
+ let rec __IterSolutions hInst premises wrongSol sList =
+ match sList with
+ | s :: rest ->
+ Logger.InfoLine (idt + "Candidate solution:")
+ Logger.InfoLine (__PrintSol (indent + 4) s)
+ let hInst' = __MergeSolutions hInst s
+ let sol = Utils.MapSingleton (comp,m) [TrueLiteral, hInst']
+ if not (hInst' = hInst) && VerifySolution prog sol Options.CONFIG.genRepr then
+ Logger.InfoLine (idt + " ~~~ VERIFIED ~~~")
+ sol
+ else
+ Logger.InfoLine (idt + " !!! NOT VERIFIED !!!")
+ match TryInferConditionals indent prog comp m unifs hInst' callGraph premises with
+ | Some(candCond,solThis) ->
+ let m' = AddPrecondition m (UnaryNot(candCond))
+ let solRest = AnalyzeConstructor (indent + 2) prog comp m' callGraph
+ MergeSolutions solThis solRest |> FixSolution comp m
+ | None ->
+ __IterSolutions hInst premises wrongSol rest
+ | [] -> wrongSol
+
+ (* --- function body starts here --- *)
+ let loggerFunc = fun e -> Logger.TraceLine (sprintf "%s --> %s" idt (PrintExpr 0 e))
+
+ //TODO
+ let expandOnlyModVarsFunc = fun e ->
+ true
+// let __CheckExpr l =
+// //TODO: FIX THIS!!!!!
+// match l with
+// | VarLiteral(vname) -> GetMethodOutArgs m |> List.exists (fun var -> GetVarName var = vname)
+// | IdLiteral(_) -> true
+// | Dot(_,_) -> true
+// | _ -> false
+// match e with
+// | BinaryExpr(_,"=",l,_) ->
+// //TODO: it should really check both lhs and rhs
+// __CheckExpr l
+// | BinaryExpr(_,op,l,_) when IsRelationalOp op ->
+// __CheckExpr l
+// | _ -> __CheckExpr e
+
+ let wrongSol = Utils.MapSingleton (comp,m) [TrueLiteral, heapInst]
+ let heapInst = ApplyUnifications indent prog comp m unifs heapInst false
+ let methodArgs = GetMethodInArgs m
+ let heapExpr = GetHeapExpr prog m heapInst true
+
+ //Logger.TraceLine (PrintExpr 0 heapExpr)
+
+ // find set of premises (don't resolve anything)
+ let premises = heapExpr |> FindClauses false (fun e -> false) heapInst
+
+ Logger.TraceLine (sprintf "%s Premises:" idt)
+ premises |> List.iter loggerFunc
+
+ // add only recursive call for now
+ let post = __GetMethodPostTemplate comp m
+
+ let premiseSet = premises |> Set.ofList |> Set.add post
+ let closedPremises = ComputeClosure heapInst expandOnlyModVarsFunc premiseSet
+
+ Logger.TraceLine (idt + "Closed premises with methods")
+ closedPremises |> Set.iter loggerFunc
+
+ let s = __GetAllAssignments heapInst closedPremises
+ if s = [] then
+ // have at least one empty sol so that the original heapInst is not missed
+ __IterSolutions heapInst closedPremises wrongSol [[]]
+ else
+ __IterSolutions heapInst closedPremises wrongSol s
+
+and TryInferConditionals indent prog comp m unifs heapInst callGraph premises =
+ let idt = Indent indent
+ let loggerFunc = fun e -> Logger.TraceLine (sprintf "%s --> %s" idt (PrintExpr 0 e))
+ let methodArgs = GetMethodInArgs m
+
+ /// Iterates through a given list of boolean conditions and checks
+ /// which one suffices. If it finds such a condition, it returns
+ /// the following three things:
+ /// - the condition itself
+ /// - the method with this condition added to its preconditions
+ /// - a solution
+ /// Otherwise returns None.
+ let rec __TryOutConditions heapInst candidateConditions =
+ let idt = Indent indent
+ match candidateConditions with
+ | [] ->
+ Logger.InfoLine (sprintf "%s - no more interesting pre-conditions" idt)
+ None
+ | candCond :: rest ->
+ Logger.InfoLine (sprintf "%s ________________________" idt)
+ Logger.InfoLine (sprintf "%s candidate pre-condition: %s" idt (PrintExpr 0 candCond))
+ Logger.InfoLine (sprintf "%s ------------------------" idt)
+ let idt = idt + " "
+ match CheckGuard prog comp m candCond indent idt heapInst callGraph with
+ | Some(guard, m2, sol) -> Some(guard, m2, sol)
+ | None -> __TryOutConditions heapInst rest
+
+ if IsSolution1stLevelOnly heapInst then
+ // try to find a non-recursive solution
+ Logger.InfoLine (idt + "Strengthening the pre-condition")
+ let expr = GetHeapExpr prog m heapInst false
+ let specConds1 = expr |> FindTrueClauses (DontResolveUnmodifiableStuff prog comp m) heapInst
+ let specConds2 = premises |> Set.toList
+
+ let isConstFunc = fun e -> try
+ EvalNone heapInst e |> Expr2Const |> ignore
+ true
+ with
+ | _ -> false
+ let unmodConcrFunc = IsUnmodConcrOnly prog (comp,m)
+ let is1stLevelFunc = __Is1stLevelExpr false heapInst
+
+ let specConds = (specConds1 @ specConds2)
+ |> List.map SimplifyExpr
+ |> List.filter (fun e -> is1stLevelFunc e && unmodConcrFunc e && not (isConstFunc e))
+
+ let aliasingCond = lazy(DiscoverAliasing (methodArgs |> List.map (function var -> VarLiteral(GetExtVarName var))) heapInst)
+ let argConds = heapInst.methodArgs |> Map.fold (fun acc name value -> acc @ [BinaryEq (VarLiteral(name)) (Const2Expr value)]) []
+ let allConds = GetAllPossibleConditions specConds argConds [aliasingCond.Force()]
+ allConds |> List.iter loggerFunc
+
+ match __TryOutConditions heapInst allConds with
+ | Some(candCond,m2,sol) ->
+ Logger.InfoLine (idt + " - guard found: " + (PrintExpr 0 candCond))
+ let solThis = match TryFindExistingAndConvertToSolution indent comp m2 candCond callGraph with
+ | Some(sol2) -> sol2
+ | None -> sol
+ let solThis = solThis |> FixSolution comp m
+ Some(candCond,solThis)
+ | None ->
+ Logger.InfoLine (idt + "!!! Giving up !!!")
+ None
+ else
+ // the solution is not immediate
+ None
+
+
+
+// ===========================================================
+/// Reads CONFIG.methodToSynth to return a list of methods
+/// that Jennisys should attempt to synthesize.
+// ===========================================================
+let GetMethodsToAnalyze prog =
+ let __ReadMethodsParam =
+ let mOpt = Options.CONFIG.methodToSynth;
+ if mOpt = "*" then
+ (* all *)
+ FilterMembers prog FilterMethodMembers
+ else
+ let allMethods,neg =
+ if mOpt.StartsWith("~") then
+ mOpt.Substring(1), true
+ else
+ mOpt, false
+ (* exact list *)
+ let methods = allMethods.Split([|','|])
+ let lst = methods |> Array.fold (fun acc m ->
+ let idx = m.LastIndexOf(".")
+ if idx = -1 || idx = m.Length - 1 then
+ raise (InvalidCmdLineArg("Invalid method full name: " + m))
+ let compName = m.Substring(0, idx)
+ let methName = m.Substring(idx + 1)
+ let c = FindComponent prog compName |> Utils.ExtractOptionMsg ("Cannot find component " + compName)
+ let mthd = FindMethod c methName |> Utils.ExtractOptionMsg ("Cannot find method " + methName + " in component " + compName)
+ (c,mthd) :: acc
+ ) []
+ if neg then
+ FilterMembers prog FilterMethodMembers |> List.filter (fun e -> not (Utils.ListContains e lst))
+ else
+ lst
+ (* --- function body starts here --- *)
+ let meths = __ReadMethodsParam
+ if Options.CONFIG.constructorsOnly then
+ meths |> List.filter (fun (c,m) -> IsConstructor m)
+ else
+ meths
+
+// ============================================================================
+/// Goes through a given list of methods of the given program and attempts to
+/// synthesize code for each one of them.
+///
+/// Returns a map from (component * method) |--> Expr * HeapInstance
+// ============================================================================
+let rec AnalyzeMethods prog members solutionsSoFar =
+ let __IsAlreadySolved c m solutionMap =
+ let existingKey = solutionMap |> Map.tryFindKey (fun (cc,mm) v -> CheckSameMethods (c,m) (cc,mm) && not (v = []))
+ match existingKey with
+ | Some(_) -> true
+ | None -> false
+
+ let rec __AnalyzeConstructorDeep prog mList solutionsSoFar =
+ let callGraph = GetCallGraph (solutionsSoFar |> Map.toList) Map.empty
+ match mList with
+ | (comp,mthd) :: rest ->
+ if not (__IsAlreadySolved comp mthd solutionsSoFar) then
+ let sol = AnalyzeConstructor 2 prog comp mthd callGraph
+ let unsolved = sol |> Map.filter (fun (c,m) lst -> lst = [] && not(__IsAlreadySolved c m solutionsSoFar)) |> Utils.MapKeys
+ let newSols = solutionsSoFar |> MergeSolutions sol
+ __AnalyzeConstructorDeep prog (rest@unsolved) newSols
+ else
+ __AnalyzeConstructorDeep prog rest solutionsSoFar
+ | [] -> solutionsSoFar
+
+ (* --- function body starts here --- *)
+ match members with
+ | (comp,m) :: rest ->
+ match m with
+ | Method(_,_,_,_,_) ->
+ let sol = __AnalyzeConstructorDeep prog [comp,m] solutionsSoFar
+ Logger.InfoLine ""
+ AnalyzeMethods prog rest sol
+ | _ -> AnalyzeMethods prog rest solutionsSoFar
+ | [] -> solutionsSoFar
+
+let Analyze prog filename =
+ let rec __AddMethodsFromProg methods solutions =
+ match methods with
+ | (c,m) :: rest ->
+ let exists = solutions |> Map.tryFindKey (fun (c1,m1) _ -> CheckSameMethods (c,m) (c1,m1))
+ match exists with
+ | Some(_) -> __AddMethodsFromProg rest solutions
+ | None -> __AddMethodsFromProg rest (solutions |> Map.add (c,m) [])
+ | [] -> solutions
+
+ /// Prints given solutions to a file
+ let __PrintSolution prog outFileName solutions =
+ use file = System.IO.File.CreateText(outFileName)
+ file.AutoFlush <- true
+ //let prog = Program(solutions |> Utils.MapKeys |> Map.ofList |> Utils.MapKeys)
+ // add all other methods (those for which we don't have synthesized solution) as well
+ let allMethods = FilterMembers prog FilterConstructorMembers
+ let extSolutions = solutions //__AddMethodsFromProg allMethods solutions
+ let synthCode = PrintImplCode prog extSolutions Options.CONFIG.genRepr false
+ fprintfn file "%s" synthCode
+
+ (* --- function body starts here --- *)
+ let solutions = AnalyzeMethods prog (GetMethodsToAnalyze prog) Map.empty
+ let progName = System.IO.Path.GetFileNameWithoutExtension(filename)
+ let outFlatSolFileName = dafnySynthFileNameTemplate.Replace("###", progName)
+ Logger.InfoLine "Printing synthesized code"
+ __PrintSolution prog outFlatSolFileName solutions
+ ()
+
+//let AnalyzeComponent_rustan c =
+// match c with
+// | Component(Class(name,typeParams,members), Model(_,_,cVars,frame,inv), code) ->
+// let aVars = Fields members
+// let aVars0 = Rename "0" aVars
+// let aVars1 = Rename "1" aVars
+// let allVars = List.concat [aVars; List.map (fun (a,b) -> b) aVars0; List.map (fun (a,b) -> b) aVars1; cVars]
+// let inv0 = Substitute (Map.ofList aVars0) inv
+// let inv1 = Substitute (Map.ofList aVars1) inv
+// // Now print it as a Dafny program
+// printf "class %s" name
+// match typeParams with
+// | [] -> ()
+// | _ -> printf "<%s>" (typeParams |> PrintSep ", " (fun tp -> tp))
+// printfn " {"
+// // the fields: original abstract fields plus two more copies thereof, plus and concrete fields
+// allVars |> List.iter (function Var(nm,None) -> printfn " var %s;" nm | Var(nm,Some(tp)) -> printfn " var %s: %s;" nm (PrintType tp))
+// // the method
+// printfn " method %s_checkInjective() {" name
+// printf " assume " ; (VarsAreDifferent aVars0 aVars1) ; printfn ";"
+// printfn " assume %s;" (PrintExpr 0 inv0)
+// printfn " assume %s;" (PrintExpr 0 inv1)
+// printfn " assert false;" // {:msg "Two abstract states map to the same concrete state"}
+// printfn " }"
+// // generate code
+// members |> List.iter (function
+// | Constructor(methodName,signature,pre,stmts) -> printf "%s" (GenerateCode methodName signature pre stmts inv false)
+// | Method(methodName,signature,pre,stmts) -> printf "%s" (GenerateCode methodName signature pre stmts inv true)
+// | _ -> ())
+// // the end of the class
+// printfn "}"
+// | _ -> assert false // unexpected case
\ No newline at end of file diff --git a/Source/Jennisys/Ast.fs b/Source/Jennisys/Ast.fs new file mode 100644 index 00000000..d355023a --- /dev/null +++ b/Source/Jennisys/Ast.fs @@ -0,0 +1,95 @@ +// ####################################################################
+/// The AST of a Jennisy program
+///
+/// author: Rustan Leino (leino@microsoft.com)
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+namespace Ast
+
+open System
+open System.Numerics
+
+type Type =
+ | IntType
+ | BoolType
+ | SetType of Type (* type parameter *)
+ | SeqType of Type (* type parameter *)
+ | NamedType of string * string list (* type parameters *)
+ | InstantiatedType of string * Type list (* type parameters *)
+
+type VarDecl =
+ | Var of string * Type option * (* isOld *) bool
+
+(*
+ the difference between IdLiteral and VarLiteral is that the VarLiteral is more specific,
+ it always referes to a local variable (either method parameter or quantification variable)
+
+ ObjLiteral is a concrete object, so if two ObjLiterals have different names,
+ they are different objects (as opposed to IdLiterals and VarLiterals, which can alias).
+ *)
+type Expr =
+ | IntLiteral of int
+ | BoolLiteral of bool
+ | BoxLiteral of string
+ | VarLiteral of string
+ | IdLiteral of string
+ | ObjLiteral of string
+ | Star
+ | Dot of Expr * string
+ | UnaryExpr of string * Expr
+ | OldExpr of Expr
+ | LCIntervalExpr of Expr
+ | BinaryExpr of int * string * Expr * Expr
+ | IteExpr of (* cond *) Expr * (* thenExpr *) Expr * (* elseExpr *) Expr
+ | SelectExpr of Expr * Expr
+ | UpdateExpr of Expr * Expr * Expr
+ | SequenceExpr of Expr list
+ | SeqLength of Expr
+ | SetExpr of Expr list //TODO: maybe this should really be a set instead of a list
+ | ForallExpr of VarDecl list * Expr
+ | MethodCall of (* receiver *) Expr * (* component name *) string * (* method name *) string * (* actual parameters *) Expr list
+ | MethodOutSelect of (* method *) Expr * (* out param name *) string
+ | VarDeclExpr of (* var list *) VarDecl list * (* declareAlso *) bool
+ | AssertExpr of Expr
+ | AssumeExpr of Expr
+
+type Const =
+ | IntConst of int
+ | BoolConst of bool
+ | BoxConst of string
+ | SetConst of Set<Const>
+ | SeqConst of Const list
+ | NullConst
+ | NoneConst
+ | ThisConst of (* loc id *) string * Type option
+ | VarConst of string
+ | NewObj of (* loc id *) string * Type option
+ | Unresolved of (* loc id *) string
+
+type Stmt =
+ | Block of Stmt list
+ | ExprStmt of Expr
+ | Assign of Expr * Expr
+
+type Signature =
+ | Sig of (* ins *) VarDecl list * (* outs *) VarDecl list
+
+type Member =
+ | Field of VarDecl
+ | Method of (* name *) string * Signature * (* pre *) Expr * (* post *) Expr * (* isConstructor *) bool
+ | Invariant of Expr list
+
+type TopLevelDecl =
+ | Interface of string * string list * Member list
+ | DataModel of string * string list * VarDecl list * (* frame *) Expr list * (* invariant *) Expr
+ | Code of string * string list
+
+type SyntacticProgram =
+ | SProgram of TopLevelDecl list
+
+type Component =
+ | Component of (*interface*)TopLevelDecl * (*datamodel*)TopLevelDecl * (*code*)TopLevelDecl
+
+type Program =
+ | Program of Component list
diff --git a/Source/Jennisys/AstUtils.fs b/Source/Jennisys/AstUtils.fs new file mode 100644 index 00000000..6aac59e2 --- /dev/null +++ b/Source/Jennisys/AstUtils.fs @@ -0,0 +1,1033 @@ +// ####################################################################
+/// Utility functions for manipulating AST elements
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+module AstUtils
+
+open Ast
+open Getters
+open Logger
+open Utils
+
+let ThisLiteral = ObjLiteral("this")
+let NullLiteral = ObjLiteral("null")
+
+let IsLogicalOp op = [ "&&"; "||"; "==>"; "<==>" ] |> Utils.ListContains op
+let IsRelationalOp op = [ "="; "!="; "<"; "<="; ">"; ">="; "in"; "!in" ] |> Utils.ListContains op
+
+let AreInverseOps op1 op2 = match op1, op2 with "<" , ">" | ">" , "<" | "<=", ">=" | ">=", "<=" -> true | _ -> false
+
+let DoesImplyOp op1 op2 =
+ match op1, op2 with
+ | "<" , "!=" | ">" , "!=" -> true
+ | "=" , ">=" | "=" , "<=" -> true
+ | ">" , ">=" | "<" , "<=" -> true
+ | _ -> false
+let IsCommutativeOp op = match op with "=" | "!=" -> true | _ -> false
+
+exception ExprConvFailed of string
+
+let Expr2Int e =
+ match e with
+ | IntLiteral(n) -> n
+ | _ -> raise (ExprConvFailed(sprintf "not an int but: %O" e))
+
+let Expr2Bool e =
+ match e with
+ | BoolLiteral(b) -> b
+ | _ -> raise (ExprConvFailed(sprintf "not a bool but: %O" e))
+
+let Expr2List e =
+ match e with
+ | SequenceExpr(elist) -> elist
+ | _ -> raise (ExprConvFailed(sprintf "not a Seq but: %O" e))
+
+let rec MyRewrite rewriterFunc rewriteRecurseFunc expr =
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> match rewriterFunc expr with
+ | Some(e) -> e
+ | None -> expr
+ | Dot(e, id) -> Dot(rewriteRecurseFunc e, id)
+ | ForallExpr(vars,e) -> ForallExpr(vars, rewriteRecurseFunc e)
+ | UnaryExpr(op,e) -> UnaryExpr(op, rewriteRecurseFunc e)
+ | OldExpr(e) -> OldExpr(rewriteRecurseFunc e)
+ | LCIntervalExpr(e) -> LCIntervalExpr(rewriteRecurseFunc e)
+ | SeqLength(e) -> SeqLength(rewriteRecurseFunc e)
+ | SelectExpr(e1, e2) -> SelectExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2)
+ | BinaryExpr(p,op,e1,e2) -> BinaryExpr(p, op, rewriteRecurseFunc e1, rewriteRecurseFunc e2)
+ | IteExpr(e1,e2,e3) -> IteExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2, rewriteRecurseFunc e3)
+ | UpdateExpr(e1,e2,e3) -> UpdateExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2, rewriteRecurseFunc e3)
+ | SequenceExpr(exs) -> SequenceExpr(exs |> List.map rewriteRecurseFunc)
+ | SetExpr(exs) -> SetExpr(exs |> List.map rewriteRecurseFunc)
+ | MethodCall(rcv,cname,mname,ins) -> MethodCall(rewriteRecurseFunc rcv, cname, mname, ins |> List.map rewriteRecurseFunc)
+ | MethodOutSelect(mth,name) -> MethodOutSelect(rewriteRecurseFunc mth, name)
+ | AssertExpr(e) -> AssertExpr(rewriteRecurseFunc e)
+ | AssumeExpr(e) -> AssumeExpr(rewriteRecurseFunc e)
+
+let rec Rewrite rewriterFunc expr =
+ let __RewriteOrRecurse e =
+ match rewriterFunc e with
+ | Some(ee) -> ee
+ | None -> Rewrite rewriterFunc e
+ MyRewrite rewriterFunc __RewriteOrRecurse expr
+
+// TODO: double check this!
+let rec RewriteBU rewriterFunc expr =
+ let rewriteRecurseFunc e =
+ RewriteBU rewriterFunc e
+// let e' = Rewrite rewriterFunc e
+// match rewriterFunc e' with
+// | Some(ee) -> ee
+// | None -> e'
+ let rewriteFunc e =
+ match rewriterFunc e with
+ | Some(ee) -> ee
+ | None -> e
+ let expr' =
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> expr
+ | Dot(e, id) -> Dot(rewriteRecurseFunc e, id)
+ | ForallExpr(vars,e) -> ForallExpr(vars, rewriteRecurseFunc e)
+ | UnaryExpr(op,e) -> UnaryExpr(op, rewriteRecurseFunc e)
+ | OldExpr(e) -> OldExpr(rewriteRecurseFunc e)
+ | LCIntervalExpr(e) -> LCIntervalExpr(rewriteRecurseFunc e)
+ | SeqLength(e) -> SeqLength(rewriteRecurseFunc e)
+ | SelectExpr(e1, e2) -> SelectExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2)
+ | BinaryExpr(p,op,e1,e2) -> BinaryExpr(p, op, rewriteRecurseFunc e1, rewriteRecurseFunc e2)
+ | IteExpr(e1,e2,e3) -> IteExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2, rewriteRecurseFunc e3)
+ | UpdateExpr(e1,e2,e3) -> UpdateExpr(rewriteRecurseFunc e1, rewriteRecurseFunc e2, rewriteRecurseFunc e3)
+ | SequenceExpr(exs) -> SequenceExpr(exs |> List.map rewriteRecurseFunc)
+ | SetExpr(exs) -> SetExpr(exs |> List.map rewriteRecurseFunc)
+ | MethodCall(rcv,cname,mname,ins) -> MethodCall(rewriteRecurseFunc rcv, cname, mname, ins |> List.map rewriteRecurseFunc)
+ | MethodOutSelect(mth,name) -> MethodOutSelect(rewriteRecurseFunc mth, name)
+ | AssertExpr(e) -> AssertExpr(rewriteRecurseFunc e)
+ | AssumeExpr(e) -> AssumeExpr(rewriteRecurseFunc e)
+ expr' |> rewriteFunc
+
+let rec RewriteWithCtx rewriterFunc ctx expr =
+ let __RewriteOrRecurse ctx e =
+ match rewriterFunc ctx e with
+ | Some(ee) -> ee
+ | None -> RewriteWithCtx rewriterFunc ctx e
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> match rewriterFunc ctx expr with
+ | Some(e) -> e
+ | None -> expr
+ | Dot(e, id) -> Dot(__RewriteOrRecurse ctx e, id)
+ | ForallExpr(vars,e) -> ForallExpr(vars, __RewriteOrRecurse (ctx @ vars) e)
+ | UnaryExpr(op,e) -> UnaryExpr(op, __RewriteOrRecurse ctx e)
+ | OldExpr(e) -> OldExpr(__RewriteOrRecurse ctx e)
+ | LCIntervalExpr(e) -> LCIntervalExpr(__RewriteOrRecurse ctx e)
+ | SeqLength(e) -> SeqLength(__RewriteOrRecurse ctx e)
+ | SelectExpr(e1, e2) -> SelectExpr(__RewriteOrRecurse ctx e1, __RewriteOrRecurse ctx e2)
+ | BinaryExpr(p,op,e1,e2) -> BinaryExpr(p, op, __RewriteOrRecurse ctx e1, __RewriteOrRecurse ctx e2)
+ | IteExpr(e1,e2,e3) -> IteExpr(__RewriteOrRecurse ctx e1, __RewriteOrRecurse ctx e2, __RewriteOrRecurse ctx e3)
+ | UpdateExpr(e1,e2,e3) -> UpdateExpr(__RewriteOrRecurse ctx e1, __RewriteOrRecurse ctx e2, __RewriteOrRecurse ctx e3)
+ | SequenceExpr(exs) -> SequenceExpr(exs |> List.map (__RewriteOrRecurse ctx))
+ | SetExpr(exs) -> SetExpr(exs |> List.map (__RewriteOrRecurse ctx))
+ | MethodCall(rcv,cname,mname,ins) -> MethodCall(__RewriteOrRecurse ctx rcv, cname, mname, ins |> List.map (__RewriteOrRecurse ctx))
+ | MethodOutSelect(mth,name) -> MethodOutSelect(__RewriteOrRecurse ctx mth, name)
+ | AssertExpr(e) -> AssertExpr(__RewriteOrRecurse ctx e)
+ | AssumeExpr(e) -> AssumeExpr(__RewriteOrRecurse ctx e)
+
+// ====================================================
+/// Substitutes all occurences of all IdLiterals having
+/// the same name as one of the variables in "vars" with
+/// VarLiterals, in "expr".
+// ====================================================
+let RewriteVars vars expr =
+ let __IdIsArg id = vars |> List.exists (fun var -> GetVarName var = id)
+ Rewrite (fun e ->
+ match e with
+ | IdLiteral(id) when __IdIsArg id -> Some(VarLiteral(id))
+ | _ -> None) expr
+
+// ================================================
+/// Substitutes all occurences of e1 with e2 in expr
+// ================================================
+let Substitute e1 e2 expr =
+ Rewrite (fun e ->
+ if e = e1 then
+ Some(e2)
+ else
+ None) expr
+
+// ================================================
+/// Distributes the negation operator over
+/// arithmetic relations
+// ================================================
+let rec DistributeNegation expr =
+ let __Neg op =
+ match op with
+ | "=" -> Some("!=")
+ | "!=" -> Some("=")
+ | "<" -> Some(">=")
+ | ">" -> Some("<=")
+ | ">=" -> Some("<")
+ | "<=" -> Some(">")
+ | _ -> None
+ Rewrite (fun e ->
+ match e with
+ | UnaryExpr("!", sub) ->
+ match sub with
+ | BinaryExpr(p,op,lhs,rhs) ->
+ match __Neg op with
+ | Some(op') -> Some(BinaryExpr(p, op', DistributeNegation lhs, DistributeNegation rhs))
+ | None -> None
+ | _ -> None
+ | _ -> None) expr
+
+let rec DescendExpr visitorFunc composeFunc leafVal expr =
+ let __Compose elist =
+ match elist with
+ | [] -> leafVal
+ | fs :: rest -> rest |> List.fold (fun acc e -> composeFunc (composeFunc acc (visitorFunc e)) (DescendExpr visitorFunc composeFunc leafVal e)) (visitorFunc fs)
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> leafVal
+ | AssertExpr(e)
+ | AssumeExpr(e)
+ | Dot(e, _)
+ | ForallExpr(_,e)
+ | LCIntervalExpr(e)
+ | OldExpr(e)
+ | UnaryExpr(_,e)
+ | MethodOutSelect(e,_)
+ | SeqLength(e) -> __Compose (e :: [])
+ | SelectExpr(e1, e2)
+ | BinaryExpr(_,_,e1,e2) -> __Compose (e1 :: e2 :: [])
+ | IteExpr(e1,e2,e3)
+ | UpdateExpr(e1,e2,e3) -> __Compose (e1 :: e2 :: e3 :: [])
+ | MethodCall(rcv,_,_,aparams) -> __Compose (rcv :: aparams)
+ | SequenceExpr(exs)
+ | SetExpr(exs) -> __Compose exs
+
+let rec DescendExpr2 visitorFunc expr acc =
+ let newAcc = acc |> visitorFunc expr
+ let __Pipe elist = elist |> List.fold (fun a e -> a |> DescendExpr2 visitorFunc e) newAcc
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> newAcc
+ | AssertExpr(e)
+ | AssumeExpr(e)
+ | Dot(e, _)
+ | ForallExpr(_,e)
+ | LCIntervalExpr(e)
+ | OldExpr(e)
+ | UnaryExpr(_,e)
+ | MethodOutSelect(e,_)
+ | SeqLength(e) -> __Pipe (e :: [])
+ | SelectExpr(e1, e2)
+ | BinaryExpr(_,_,e1,e2) -> __Pipe (e1 :: e2 :: [])
+ | IteExpr(e1,e2,e3)
+ | UpdateExpr(e1,e2,e3) -> __Pipe (e1 :: e2 :: e3 :: [])
+ | MethodCall(rcv,_,_,aparams) -> __Pipe (rcv :: aparams)
+ | SequenceExpr(exs)
+ | SetExpr(exs) -> __Pipe exs
+
+let rec DescendExpr2BU visitorFunc expr acc =
+ let __Pipe elist =
+ let newAcc = elist |> List.fold (fun a e -> a |> DescendExpr2 visitorFunc e) acc
+ newAcc |> visitorFunc expr
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_) -> __Pipe []
+ | AssertExpr(e)
+ | AssumeExpr(e)
+ | Dot(e, _)
+ | ForallExpr(_,e)
+ | LCIntervalExpr(e)
+ | OldExpr(e)
+ | UnaryExpr(_,e)
+ | MethodOutSelect(e,_)
+ | SeqLength(e) -> __Pipe (e :: [])
+ | SelectExpr(e1, e2)
+ | BinaryExpr(_,_,e1,e2) -> __Pipe (e1 :: e2 :: [])
+ | IteExpr(e1,e2,e3)
+ | UpdateExpr(e1,e2,e3) -> __Pipe (e1 :: e2 :: e3 :: [])
+ | MethodCall(rcv,_,_,aparams) -> __Pipe (rcv :: aparams)
+ | SequenceExpr(exs)
+ | SetExpr(exs) -> __Pipe exs
+
+//TODO: if names in dafny models contain funky characters,
+// these gensym variables might not be valid identifiers
+let PrintGenSym (name: string) =
+ if name.StartsWith("gensym") then
+ name
+ else
+ let idx = name.LastIndexOf("!")
+ if idx <> -1 then
+ sprintf "gensym%s" (name.Substring(idx+1))
+ else
+ sprintf "gensym%s" name
+
+// =====================
+/// Returns TRUE literal
+// =====================
+let TrueLiteral = BoolLiteral(true)
+
+// =====================
+/// Returns FALSE literal
+// =====================
+let FalseLiteral = BoolLiteral(false)
+
+let UnaryNeg sub =
+ match sub with
+ | UnaryExpr("-", s) -> s
+ | _ -> UnaryExpr("-", sub)
+
+let UnaryNot sub =
+ match sub with
+ | UnaryExpr("!", s) -> s
+ | BoolLiteral(b) -> BoolLiteral(not b)
+ | BinaryExpr(p,"=",l,r) -> BinaryExpr(p,"!=",l,r)
+ | BinaryExpr(p,"!=",l,r) -> BinaryExpr(p,"=",l,r)
+ | BinaryExpr(p,"in",l,r) -> BinaryExpr(p,"!in",l,r)
+ | BinaryExpr(p,"!in=",l,r) -> BinaryExpr(p,"in",l,r)
+ | BinaryExpr(p,"<",l,r) -> BinaryExpr(p,">=",l,r)
+ | BinaryExpr(p,"<=",l,r) -> BinaryExpr(p,">",l,r)
+ | BinaryExpr(p,">",l,r) -> BinaryExpr(p,"<=",l,r)
+ | BinaryExpr(p,">=",l,r) -> BinaryExpr(p,"<",l,r)
+ | _ -> UnaryExpr("!", sub)
+
+// =======================================================================
+/// Returns a binary AND of the two given expressions with short-circuiting
+// =======================================================================
+let BinaryAnd (lhs: Expr) (rhs: Expr) =
+ match lhs, rhs with
+ | BoolLiteral(true), _ -> rhs
+ | BoolLiteral(false), _ -> FalseLiteral
+ | _, BoolLiteral(true) -> lhs
+ | _, BoolLiteral(false) -> FalseLiteral
+ | _, _ -> BinaryExpr(30, "&&", lhs, rhs)
+
+// =======================================================================
+/// Returns a binary OR of the two given expressions with short-circuiting
+// =======================================================================
+let BinaryOr (lhs: Expr) (rhs: Expr) =
+ match lhs, rhs with
+ | BoolLiteral(true), _ -> TrueLiteral
+ | BoolLiteral(false), _ -> rhs
+ | _, BoolLiteral(true) -> TrueLiteral
+ | _, BoolLiteral(false) -> lhs
+ | _, _ -> BinaryExpr(30, "||", lhs, rhs)
+
+// ===================================================================================
+/// Returns a binary IMPLIES of the two given expressions
+// ===================================================================================
+let BinaryImplies lhs rhs =
+ match lhs, rhs with
+ | BoolLiteral(false), _ -> TrueLiteral
+ | BoolLiteral(true), _ -> rhs
+ | _, BoolLiteral(true) -> lhs
+ | _, BoolLiteral(false) -> UnaryNot(lhs)
+ | _ -> BinaryExpr(20, "==>", lhs, rhs)
+
+// =======================================================
+/// Constructors for binary EQ/NEQ of two given expressions
+// =======================================================
+let BinaryNeq lhs rhs =
+ match lhs, rhs with
+ | BoolLiteral(true), x | x, BoolLiteral(true) -> UnaryNot x
+ | BoolLiteral(false), x | x, BoolLiteral(false) -> x
+ | _ -> BinaryExpr(40, "!=", lhs, rhs)
+
+let BinaryEq lhs rhs =
+ match lhs, rhs with
+ | BoolLiteral(true), x | x, BoolLiteral(true) -> x
+ | BoolLiteral(false), x | x, BoolLiteral(false) -> UnaryNot x
+ | _ when lhs = rhs -> TrueLiteral
+ | _ -> BinaryExpr(40, "=", lhs, rhs)
+
+// =======================================================
+/// Constructor for binary GETS
+// =======================================================
+let BinaryGets lhs rhs = Assign(lhs, rhs)
+
+let BinaryAdd lhs rhs = BinaryExpr(55, "+", lhs, rhs)
+let BinarySub lhs rhs = BinaryExpr(55, "-", lhs, rhs)
+
+// =======================================================
+/// Constructors for binary IN/!IN of two given expressions
+// =======================================================
+let BinaryIn lhs rhs =
+ match lhs, rhs with
+ | _, SequenceExpr(elist) | _, SetExpr(elist) when elist |> List.length = 0 -> FalseLiteral
+ | _, SequenceExpr(elist) | _, SetExpr(elist) when elist |> List.length = 1 -> BinaryEq lhs (elist.[0])
+ | _ -> BinaryExpr(40, "in", lhs, rhs)
+
+let BinaryNotIn lhs rhs =
+ match lhs, rhs with
+ | _, SequenceExpr(elist) | _, SetExpr(elist) when elist |> List.length = 0 -> TrueLiteral
+ | _, SequenceExpr(elist) | _, SetExpr(elist) when elist |> List.length = 1 -> BinaryNeq lhs (elist.[0])
+ | _ -> BinaryExpr(40, "!in", lhs, rhs)
+
+// ==========================================
+/// Splits "expr" into a list of its conjuncts
+// ==========================================
+let rec SplitIntoConjunts expr =
+ match expr with
+ | BoolLiteral(true) -> []
+ | BinaryExpr(_,"&&",e0,e1) -> List.concat [SplitIntoConjunts e0 ; SplitIntoConjunts e1]
+ | _ -> [expr]
+
+// ======================================
+/// Applies "f" to each conjunct of "expr"
+// ======================================
+let rec ForeachConjunct f expr =
+ SplitIntoConjunts expr |> List.fold (fun acc e -> acc + (f e)) ""
+
+// =======================================
+/// Converts a given constant to expression
+// =======================================
+let rec Const2Expr c =
+ match c with
+ | IntConst(n) -> IntLiteral(n)
+ | BoolConst(b) -> BoolLiteral(b)
+ | BoxConst(id) -> BoxLiteral(id)
+ | SeqConst(clist) ->
+ let expList = clist |> List.fold (fun acc c -> Const2Expr c :: acc) [] |> List.rev
+ SequenceExpr(expList)
+ | SetConst(cset) ->
+ let expSet = cset |> Set.fold (fun acc c -> Set.add (Const2Expr c) acc) Set.empty
+ SetExpr(Set.toList expSet)
+ | VarConst(id) -> VarLiteral(id)
+ | ThisConst(_,_) -> ObjLiteral("this")
+ | NewObj(name,_) -> ObjLiteral(PrintGenSym name)
+ | NullConst -> ObjLiteral("null")
+ | Unresolved(id) -> BoxLiteral(id) // failwithf "don't want to convert Unresolved(%s) to expr" name //
+ | _ -> failwithf "not implemented or not supported: %O" c
+
+let rec Expr2Const e =
+ match e with
+ | IntLiteral(n) -> IntConst(n)
+ | BoolLiteral(b) -> BoolConst(b)
+ | BoxLiteral(id) -> BoxConst(id)
+ | ObjLiteral("this") -> ThisConst("this",None)
+ | ObjLiteral("null") -> NullConst
+ | ObjLiteral(name) -> NewObj(name, None)
+ | IdLiteral(id) -> Unresolved(id)
+ | VarLiteral(id) -> VarConst(id)
+ | SequenceExpr(elist) -> SeqConst(elist |> List.map Expr2Const)
+ | SetExpr(elist) -> SetConst(elist |> List.map Expr2Const |> Set.ofList)
+ | _ -> failwithf "Not a constant: %O" e
+
+let rec Expr2ConstStrict e =
+ match e with
+ | IntLiteral(n) -> IntConst(n)
+ | BoolLiteral(b) -> BoolConst(b)
+ | BoxLiteral(id) -> BoxConst(id)
+ | ObjLiteral("this") -> ThisConst("this",None)
+ | ObjLiteral("null") -> NullConst
+ | ObjLiteral(name) -> NewObj(name, None)
+ | SequenceExpr(elist) -> SeqConst(elist |> List.map Expr2ConstStrict)
+ | SetExpr(elist) -> SetConst(elist |> List.map Expr2ConstStrict |> Set.ofList)
+ | _ -> failwithf "Not a constant: %O" e
+
+let TryExpr2Const e =
+ try
+ Some(Expr2Const e)
+ with
+ | ex -> None
+
+let IsConstExpr e =
+ try
+ Expr2Const e |> ignore
+ true
+ with
+ | _ -> false
+
+///////
+
+let GetMethodPre mthd =
+ match mthd with
+ | Method(_,_,pre,_,_) -> pre
+ | _ -> failwith ("not a method" + mthd.ToString())
+
+let GetMethodPrePost mthd =
+ let __FilterOutAssumes e = e |> SplitIntoConjunts |> List.filter (function AssumeExpr(_) -> false | _ -> true) |> List.fold BinaryAnd TrueLiteral
+ match mthd with
+ | Method(_,_,pre,post,_) -> __FilterOutAssumes pre,post
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+let GetMethodGhostPrecondition mthd =
+ match mthd with
+ | Method(_,_,pre,_,_) ->
+ pre |> SplitIntoConjunts |> List.choose (function AssumeExpr(e) -> Some(e) | _ -> None) |> List.fold BinaryAnd TrueLiteral
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+// ==============================================================
+/// Returns all invariants of a component as a list of expressions
+// ==============================================================
+let GetInvariantsAsList comp =
+ match comp with
+ | Component(Interface(_,_,members), DataModel(_,_,_,_,inv), _) ->
+ let clsInvs = members |> List.choose (function Invariant(exprList) -> Some(exprList) | _ -> None) |> List.concat
+ List.append (SplitIntoConjunts inv) clsInvs
+ | _ -> failwithf "unexpected kind of component: %O" comp
+
+/// Replaces all Old nodes with IdLiteral with name = "old_" + <name>
+let RewriteOldExpr expr =
+ expr |> RewriteBU (fun e -> match e with
+ | OldExpr(IdLiteral(name)) -> Some(IdLiteral(RenameToOld name))
+ | _ -> None)
+
+let MakeOldVar var =
+ match var with
+ | Var(name, ty, _) -> Var(name, ty, true)
+
+let MakeOldVars varLst =
+ varLst |> List.map MakeOldVar
+
+/// renames ALL variables to "old_"+<varname>
+let MakeOld expr =
+ expr |> RewriteBU (fun e -> match e with
+ | IdLiteral(name) when not (name="this") -> Some(IdLiteral(RenameToOld name))
+ | Dot(e, name) -> Some(Dot(e, RenameToOld name))
+ | _ -> None)
+
+let BringToPost expr =
+ expr |> RewriteBU (fun e -> match e with
+ | IdLiteral(name) -> Some(IdLiteral(RenameFromOld name))
+ | Dot(e, name) -> Some(Dot(e, RenameFromOld name))
+ | _ -> None)
+
+////////////////////////
+
+let AddReplaceMethod prog comp newMthd oldMethod =
+ match prog, comp with
+ | Program(clist), Component(Interface(cname, ctypeParams, members), model, code) ->
+ let newMembers =
+ match oldMethod with
+ | None -> members @ [newMthd]
+ | Some(m) -> Utils.ListReplace m newMthd members
+ let newCls = Interface(cname, ctypeParams, newMembers)
+ let newComp = Component(newCls, model, code)
+ let newProg = Program(Utils.ListReplace comp newComp clist)
+ newProg, newComp
+ | _ -> failwithf "Invalid component: %O" comp
+
+let UnwrapAssumes e = e |> SplitIntoConjunts |> List.map (function AssumeExpr(e) -> e | x -> x) |> List.fold BinaryAnd TrueLiteral
+
+let AddPrecondition m e =
+ match m with
+ | Method(mn, sgn, pre, post, cstr) -> Method(mn, sgn, BinaryAnd pre (AssumeExpr(e |> UnwrapAssumes)), post, cstr)
+ | _ -> failwithf "Not a method: %O" m
+
+let SetPrecondition m e =
+ match m with
+ | Method(mn, sgn, pre, post, cstr) -> Method(mn, sgn, AssumeExpr(e |> UnwrapAssumes), post, cstr)
+ | _ -> failwithf "Not a method: %O" m
+
+////////////////////
+
+exception EvalFailed of string
+exception DomainNotInferred
+
+let DefaultResolver e fldOpt =
+ match fldOpt with
+ | None -> e
+ | Some(fldName) -> Dot(e, fldName)
+
+let DefaultFallbackResolver resolverFunc e =
+ match resolverFunc e with
+ | Some(e') -> e'
+ | None -> e
+
+let __CheckEqual e1 e2 =
+ match e1, e2 with
+ | BoolLiteral(b1), BoolLiteral(b2) -> Some(b1 = b2)
+ | IntLiteral(n1), IntLiteral(n2) -> Some(n1 = n2)
+ | ObjLiteral(o1), ObjLiteral(o2) -> Some(o1 = o2)
+ | SetExpr(elist1), SetExpr(elist2) -> Some(Set.ofList elist1 = Set.ofList elist2)
+ | SequenceExpr(elist1), SequenceExpr(elist2) -> Some(elist1 = elist2)
+ | UnaryExpr("-", sub1), sub2
+ | sub1, UnaryExpr("-", sub2) when sub1 = sub2 -> Some(false)
+ | UnaryExpr("-", sub1), UnaryExpr("-", sub2) when sub1 = sub2 -> Some(true)
+ | UnaryExpr("!", sub1), sub2
+ | sub1, UnaryExpr("!", sub2) when sub1 = sub2 -> Some(false)
+ | UnaryExpr("!", sub1), UnaryExpr("-", sub2) when sub1 = sub2 -> Some(true)
+ | _ when e1 = e2 -> Some(true)
+ | _ -> None
+
+let EvalSym2 fullResolverFunc otherResolverFunc returnFunc ctx expr =
+ let rec __EvalSym resolverFunc returnFunc ctx expr =
+ let expr' =
+ match expr with
+ | IntLiteral(_) -> expr
+ | BoolLiteral(_) -> expr
+ | BoxLiteral(_) -> expr
+ | ObjLiteral(_) -> expr
+ | Star -> expr //TODO: can we do better?
+ | VarDeclExpr(_) -> expr
+ | AssertExpr(e) -> AssertExpr(__EvalSym resolverFunc returnFunc ctx e)
+ | AssumeExpr(e) -> AssumeExpr(__EvalSym resolverFunc returnFunc ctx e)
+ | VarLiteral(id) ->
+ try
+ let _,e = ctx |> List.find (fun (v,e) -> GetVarName v = id)
+ e
+ with
+ | ex -> resolverFunc expr None
+ | IdLiteral(_) -> resolverFunc expr None
+ | Dot(e, str) ->
+ let discr = __EvalSym resolverFunc returnFunc ctx e
+ resolverFunc discr (Some(str))
+ | SeqLength(e) ->
+ let e' = __EvalSym resolverFunc returnFunc ctx e
+ match e' with
+ | SequenceExpr(elist) -> IntLiteral(List.length elist)
+ | _ -> SeqLength(e')
+ | SequenceExpr(elist) ->
+ let elist' = elist |> List.map (__EvalSym resolverFunc returnFunc ctx) // List.fold (fun acc e -> (__EvalSym resolverFunc returnFunc ctx e) :: acc) [] |> List.rev
+ SequenceExpr(elist')
+ | SetExpr(elist) ->
+ let elist' = elist |> List.map (__EvalSym resolverFunc returnFunc ctx) //List.fold (fun acc e -> Set.add (__EvalSym resolverFunc returnFunc ctx e) acc) Set.empty
+ SetExpr(elist' |> Set.ofList |> Set.toList)
+ | MethodOutSelect(e,name) ->
+ MethodOutSelect(__EvalSym resolverFunc returnFunc ctx e, name)
+ | MethodCall(rcv,cname, mname,aparams) ->
+ let rcv' = __EvalSym resolverFunc returnFunc ctx rcv
+ let aparams' = aparams |> List.fold (fun acc e -> __EvalSym resolverFunc returnFunc ctx e :: acc) [] |> List.rev
+ MethodCall(rcv', cname, mname, aparams')
+ | LCIntervalExpr(_) -> expr
+ | SelectExpr(lst, idx) ->
+ let lst' = __EvalSym resolverFunc returnFunc ctx lst
+ let idx' = __EvalSym resolverFunc returnFunc ctx idx
+ match lst', idx' with
+ | SequenceExpr(elist), IntLiteral(n) -> elist.[n]
+ | SequenceExpr(elist), LCIntervalExpr(startIdx) ->
+ let startIdx' = __EvalSym resolverFunc returnFunc ctx startIdx
+ match startIdx' with
+ | IntLiteral(startIdxInt) ->
+ let rec __Skip n l = if n = 0 then l else __Skip (n-1) (List.tail l)
+ SequenceExpr(__Skip startIdxInt elist)
+ | _ -> SelectExpr(lst', idx')
+ | _ -> SelectExpr(lst', idx')
+ | UpdateExpr(lst,idx,v) ->
+ let lst', idx', v' = __EvalSym resolverFunc returnFunc ctx lst, __EvalSym resolverFunc returnFunc ctx idx, __EvalSym resolverFunc returnFunc ctx v
+ match lst', idx', v' with
+ | SequenceExpr(elist), IntLiteral(n), _ -> SequenceExpr(Utils.ListSet n v' elist)
+ | _ -> UpdateExpr(lst', idx', v')
+ | IteExpr(c, e1, e2) ->
+ let c' = __EvalSym fullResolverFunc returnFunc ctx c
+ match c' with
+ | BoolLiteral(b) -> if b then __EvalSym resolverFunc returnFunc ctx e1 else __EvalSym resolverFunc returnFunc ctx e2
+ | _ -> IteExpr(c', __EvalSym resolverFunc returnFunc ctx e1, __EvalSym resolverFunc returnFunc ctx e2)
+ | BinaryExpr(p,op,e1,e2) ->
+ let e1' = lazy (__EvalSym resolverFunc returnFunc ctx e1)
+ let e2' = lazy (__EvalSym resolverFunc returnFunc ctx e2)
+ let recomposed = lazy (BinaryExpr(p, op, e1'.Force(), e2'.Force()))
+ match op with
+ | "=" ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ let eq = __CheckEqual e1'' e2''
+ match eq with
+ | Some(b) -> BoolLiteral(b)
+ | None -> recomposed.Force()
+ | "!=" ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ let eq = __CheckEqual e1'' e2''
+ match eq with
+ | Some(b) -> BoolLiteral(not b)
+ | None -> recomposed.Force()
+ | "<" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> BoolLiteral(n1 < n2)
+ | _ -> recomposed.Force()
+ | "<=" ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ let eq = __CheckEqual e1'' e2''
+ match eq with
+ | Some(true) -> TrueLiteral
+ | _ -> match e1'', e2'' with
+ | IntLiteral(n1), IntLiteral(n2) -> BoolLiteral(n1 <= n2)
+ | _ -> recomposed.Force()
+ | ">" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> BoolLiteral(n1 > n2)
+ | _ -> recomposed.Force()
+ | ">=" ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ let eq = __CheckEqual e1'' e2''
+ match eq with
+ | Some(true) -> TrueLiteral
+ | _ -> match e1'', e2'' with
+ | IntLiteral(n1), IntLiteral(n2) -> BoolLiteral(n1 >= n2)
+ | _ -> recomposed.Force()
+ | ".." ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ match e1'', e2'' with
+ | IntLiteral(lo), IntLiteral(hi) -> SequenceExpr([lo .. hi] |> List.map (fun n -> IntLiteral(n)))
+ | _ -> recomposed.Force();
+ | "in" ->
+ match e1'.Force(), e2'.Force() with
+ | _, SetExpr(s)
+ | _, SequenceExpr(s) -> //BoolLiteral(Utils.ListContains (e1'.Force()) s)
+ if Utils.ListContains (e1'.Force()) s then
+ TrueLiteral
+ else
+ try
+ let contains = s |> List.map Expr2ConstStrict |> Utils.ListContains (e1'.Force() |> Expr2ConstStrict)
+ BoolLiteral(contains)
+ with
+ | _ -> recomposed.Force()
+ | _ -> recomposed.Force()
+ | "!in" ->
+ match e1'.Force(), e2'.Force() with
+ | _, SetExpr(s)
+ | _, SequenceExpr(s) -> //BoolLiteral(not (Utils.ListContains (e1'.Force()) s))
+ if Utils.ListContains (e1'.Force()) s then
+ FalseLiteral
+ else
+ try
+ let contains = s |> List.map Expr2ConstStrict |> Utils.ListContains (e1'.Force() |> Expr2ConstStrict)
+ BoolLiteral(not contains)
+ with
+ | _ -> recomposed.Force()
+ | _ -> recomposed.Force()
+ | "+" ->
+ let e1'' = e1'.Force();
+ let e2'' = e2'.Force();
+ match e1'', e2'' with
+ | IntLiteral(n1), IntLiteral(n2) -> IntLiteral(n1 + n2)
+ | SequenceExpr(l1), SequenceExpr(l2) -> SequenceExpr(List.append l1 l2)
+ | SetExpr(s1), SetExpr(s2) -> SetExpr(Set.union (Set.ofList s1) (Set.ofList s2) |> Set.toList)
+ | _ -> recomposed.Force()
+ | "-" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> IntLiteral(n1 - n2)
+ | SetExpr(s1), SetExpr(s2) -> SetExpr(Set.difference (Set.ofList s1) (Set.ofList s2) |> Set.toList)
+ | _ -> recomposed.Force()
+ | "*" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> IntLiteral(n1 * n2)
+ | _ -> recomposed.Force()
+ | "div" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> IntLiteral(n1 / n2)
+ | _ -> recomposed.Force()
+ | "mod" ->
+ match e1'.Force(), e2'.Force() with
+ | IntLiteral(n1), IntLiteral(n2) -> IntLiteral(n1 % n2)
+ | _ -> recomposed.Force()
+ | "&&" ->
+ // shortcircuit
+ match e1'.Force() with
+ | BoolLiteral(false) -> BoolLiteral(false)
+ | _ ->
+ match e1'.Force(), e2'.Force() with
+ | _, BoolLiteral(false) -> BoolLiteral(false)
+ | BoolLiteral(b1), BoolLiteral(b2) -> BoolLiteral(b1 && b2)
+ | _ -> BinaryAnd (e1'.Force()) (e2'.Force())
+ | "||" ->
+ // shortcircuit
+ match e1'.Force() with
+ | BoolLiteral(true) -> BoolLiteral(true)
+ | _ ->
+ match e1'.Force(), e2'.Force() with
+ | _, BoolLiteral(true) -> BoolLiteral(true)
+ | BoolLiteral(b1), BoolLiteral(b2) -> BoolLiteral(b1 || b2)
+ | _ -> BinaryOr (e1'.Force()) (e2'.Force())
+ | "==>" ->
+ // shortcircuit
+ match e1'.Force() with
+ | BoolLiteral(false) -> BoolLiteral(true)
+ | _ ->
+ let e1'' = e1'.Force()
+ let e2'' = e2'.Force()
+ BinaryImplies e1'' e2''
+ | "<==>" ->
+ match e1'.Force(), e2'.Force() with
+ | BoolLiteral(b1), BoolLiteral(b2) -> BoolLiteral(b1 = b2)
+ | x, BoolLiteral(b)
+ | BoolLiteral(b), x -> if b then x else UnaryNot(x)
+ | _ -> recomposed.Force()
+ | _ -> recomposed.Force()
+ | OldExpr(e) ->
+ let e' = __EvalSym resolverFunc returnFunc ctx e
+ let recomposed = OldExpr(e')
+ match e with
+ | IdLiteral(name) -> resolverFunc (IdLiteral(RenameToOld name)) None
+ | _ -> recomposed
+ | UnaryExpr(op, e) ->
+ let e' = __EvalSym resolverFunc returnFunc ctx e
+ let recomposed = UnaryExpr(op, e')
+ match op with
+ | "!" ->
+ match e' with
+ | BoolLiteral(b) -> BoolLiteral(not b)
+ | _ -> recomposed
+ | "-" ->
+ match e' with
+ | IntLiteral(n) -> IntLiteral(-n)
+ | _ -> recomposed
+ | _ -> recomposed
+ | ForallExpr(vars, e) ->
+ let rec __ExhaustVar v restV vDomain =
+ match vDomain with
+ | vv :: restD ->
+ let ctx' = (v,vv) :: ctx
+ let e' = __EvalSym resolverFunc returnFunc ctx' (ForallExpr(restV, e))
+ let erest = __ExhaustVar v restV restD
+ BinaryAnd e' erest
+ | [] -> BoolLiteral(true)
+ let rec __TraverseVars vars =
+ match vars with
+ | v :: restV ->
+ try
+ let vDom = GetVarDomain resolverFunc returnFunc ctx v e
+ __ExhaustVar v restV vDom
+ with
+ | ex -> ForallExpr([v], __TraverseVars restV)
+ | [] -> __EvalSym resolverFunc returnFunc ctx e
+ (* --- function body starts here --- *)
+ __TraverseVars vars
+ if expr' = FalseLiteral then
+ Logger.Debug ""
+ expr' |> returnFunc
+ and GetVarDomain resolverFunc returnFunc ctx var expr =
+ match expr with
+ | BinaryExpr(_, "==>", lhs, rhs) ->
+ let conjs = SplitIntoConjunts lhs
+ conjs |> List.fold (fun acc e ->
+ match e with
+ | BinaryExpr(_, "in", VarLiteral(vn), rhs) when GetVarName var = vn ->
+ match __EvalSym resolverFunc returnFunc ctx rhs with
+ | SetExpr(elist)
+ | SequenceExpr(elist) -> elist |> List.append acc
+ | x -> raise DomainNotInferred
+ | BinaryExpr(_, op, VarLiteral(vn),oth)
+ | BinaryExpr(_, op, oth, VarLiteral(vn)) when GetVarName var = vn && Set.ofList ["<"; "<="; ">"; ">="] |> Set.contains op ->
+ failwith "Not implemented yet"
+ | _ -> raise DomainNotInferred) []
+ | _ ->
+ Logger.WarnLine ("unknown pattern for a quantified expression; cannot infer domain of quantified variable \"" + (GetVarName var) + "\"")
+ raise DomainNotInferred
+ (* --- function body starts here --- *)
+ __EvalSym otherResolverFunc returnFunc ctx expr
+
+let EvalSym resolverFunc expr =
+ EvalSym2 resolverFunc resolverFunc (fun e -> e) [] expr
+
+let EvalSymRet fullResolverFunc resolverFunc returnFunc expr =
+ EvalSym2 fullResolverFunc resolverFunc returnFunc [] expr
+
+// ==========================================================
+/// Desugars a given expression so that all list constructors
+/// are expanded into explicit assignments to indexed elements
+// ==========================================================
+let MyDesugar expr removeOriginal =
+ let rec __Desugar expr =
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | VarDeclExpr(_)
+ | IdLiteral(_)
+ | VarLiteral(_)
+ | ObjLiteral(_)
+ | Star
+ | Dot(_)
+ | SelectExpr(_)
+ | SeqLength(_)
+ | UpdateExpr(_)
+ | SetExpr(_)
+ | MethodCall(_)
+ | MethodOutSelect(_)
+ | SequenceExpr(_) -> expr
+ // forall v :: v in {a1 a2 ... an} ==> e ~~~> e[v/a1] && e[v/a2] && ... && e[v/an]
+ // forall v :: v in [a1 a2 ... an] ==> e ~~~> e[v/a1] && e[v/a2] && ... && e[v/an]
+ | ForallExpr([Var(vn1,ty1,old1)] as v, (BinaryExpr(_, "==>", BinaryExpr(_, "in", VarLiteral(vn2), rhsCol), sub) as ee)) when vn1 = vn2 ->
+ match rhsCol with
+ | SetExpr(elist)
+ | SequenceExpr(elist) -> elist |> List.fold (fun acc e -> BinaryAnd acc (__Desugar (Substitute (VarLiteral(vn2)) e sub))) TrueLiteral
+ | _ -> ForallExpr(v, __Desugar ee)
+ | ForallExpr(v,e) -> ForallExpr(v, __Desugar e)
+ | LCIntervalExpr(e) -> LCIntervalExpr(__Desugar e)
+ | OldExpr(e) -> OldExpr(__Desugar e)
+ | UnaryExpr(op,e) -> UnaryExpr(op, __Desugar e)
+ | AssertExpr(e) -> AssertExpr(__Desugar e)
+ | AssumeExpr(e) -> AssumeExpr(__Desugar e)
+ | IteExpr(c,e1,e2) -> IteExpr(c, __Desugar e1, __Desugar e2)
+ // lst = [a1 a2 ... an] ~~~> lst = [a1 a2 ... an] && lst[0] = a1 && lst[1] = a2 && ... && lst[n-1] = an && |lst| = n
+ | BinaryExpr(p,op,e1,e2) ->
+ let be = BinaryExpr(p, op, __Desugar e1, __Desugar e2)
+ let fs = if removeOriginal then TrueLiteral else be
+ try
+ match op with
+ | "=" ->
+ match EvalSym DefaultResolver e1, EvalSym DefaultResolver e2 with
+ | SequenceExpr(l1), SequenceExpr(l2) ->
+ let rec __fff lst1 lst2 cnt =
+ match lst1, lst2 with
+ | fs1 :: rest1, fs2 :: rest2 -> BinaryEq l1.[cnt] l2.[cnt] :: __fff rest1 rest2 (cnt+1)
+ | [], [] -> []
+ | _ -> failwith "Lists are of different sizes"
+ __fff l1 l2 0 |> List.fold (fun acc e -> BinaryAnd acc e) fs
+ | e, SequenceExpr(elist)
+ | SequenceExpr(elist), e ->
+ let rec __fff lst cnt =
+ match lst with
+ | fs :: rest -> BinaryEq (SelectExpr(e, IntLiteral(cnt))) elist.[cnt] :: __fff rest (cnt+1)
+ | [] -> [BinaryEq (SeqLength(e)) (IntLiteral(cnt))]
+ __fff elist 0 |> List.fold (fun acc e -> BinaryAnd acc e) fs
+ | _ -> be
+ | _ -> be
+ with
+ | EvalFailed(_) as ex -> (* printfn "%O" (ex.StackTrace); *) be
+ __Desugar expr
+
+let Desugar expr = MyDesugar expr false
+let DesugarAndRemove expr = MyDesugar expr true
+
+let rec DesugarLst exprLst =
+ match exprLst with
+ | expr :: rest -> Desugar expr :: DesugarLst rest
+ | [] -> []
+
+let ChangeThisReceiver receiver expr =
+ let rec __ChangeThis locals expr =
+ match expr with
+ | IntLiteral(_)
+ | BoolLiteral(_)
+ | BoxLiteral(_)
+ | Star
+ | VarDeclExpr(_)
+ | VarLiteral(_) -> expr
+ | ObjLiteral("this") -> receiver
+ | ObjLiteral(_) -> expr
+ | IdLiteral("null") -> failwith "should never happen anymore" //TODO
+ | IdLiteral("this") -> failwith "should never happen anymore"
+ | IdLiteral(id) -> if Set.contains id locals then VarLiteral(id) else __ChangeThis locals (Dot(ObjLiteral("this"), id))
+ | Dot(e, id) -> Dot(__ChangeThis locals e, id)
+ | AssertExpr(e) -> AssertExpr(__ChangeThis locals e)
+ | AssumeExpr(e) -> AssumeExpr(__ChangeThis locals e)
+ | ForallExpr(vars,e) -> let newLocals = vars |> List.map GetVarName |> Set.ofList |> Set.union locals
+ ForallExpr(vars, __ChangeThis newLocals e)
+ | LCIntervalExpr(e) -> LCIntervalExpr(__ChangeThis locals e)
+ | OldExpr(e) -> OldExpr(__ChangeThis locals e)
+ | UnaryExpr(op,e) -> UnaryExpr(op, __ChangeThis locals e)
+ | SeqLength(e) -> SeqLength(__ChangeThis locals e)
+ | SelectExpr(e1, e2) -> SelectExpr(__ChangeThis locals e1, __ChangeThis locals e2)
+ | BinaryExpr(p,op,e1,e2) -> BinaryExpr(p, op, __ChangeThis locals e1, __ChangeThis locals e2)
+ | IteExpr(e1,e2,e3) -> IteExpr(__ChangeThis locals e1, __ChangeThis locals e2, __ChangeThis locals e3)
+ | UpdateExpr(e1,e2,e3) -> UpdateExpr(__ChangeThis locals e1, __ChangeThis locals e2, __ChangeThis locals e3)
+ | SequenceExpr(exs) -> SequenceExpr(exs |> List.map (__ChangeThis locals))
+ | SetExpr(exs) -> SetExpr(exs |> List.map (__ChangeThis locals))
+ | MethodOutSelect(e, name) -> MethodOutSelect(__ChangeThis locals e, name)
+ | MethodCall(rcv,cname, mname,aparams) -> MethodCall(__ChangeThis locals rcv, cname, mname, aparams |> List.map (__ChangeThis locals))
+ (* --- function body starts here --- *)
+ __ChangeThis Set.empty expr
+
+let rec SimplifyExpr expr =
+ let __Simplify expr =
+ match expr with
+ | UnaryExpr("!", sub) -> Some(UnaryNot sub)
+ | BinaryExpr(_, "&&", l, r) -> Some(BinaryAnd l r)
+ | BinaryExpr(_, "||", l, r) -> Some(BinaryOr l r)
+ | BinaryExpr(_, "in", l, r) -> Some(BinaryIn l r)
+ | BinaryExpr(_, "!in", l, r) -> Some(BinaryNotIn l r)
+ | BinaryExpr(_, "==>", l, r) -> Some(BinaryImplies l r)
+ | BinaryExpr(_, "=", l, r) -> Some(BinaryEq l r)
+ | BinaryExpr(_, "!=", l, r) -> Some(BinaryNeq l r)
+ | _ -> None
+ RewriteBU __Simplify expr
+
+let rec ExtractTopLevelExpressions stmt =
+ match stmt with
+ | ExprStmt(e) -> [e]
+ | Assign(e1, e2) -> [e1; e2]
+ | Block(slist) -> slist |> List.fold (fun acc s -> acc @ ExtractTopLevelExpressions s) []
+
+let rec PullUpMethodCalls stmt =
+ let stmtList = new System.Collections.Generic.LinkedList<_>()
+ let rec __PullUpMethodCalls expr =
+ let newExpr = RewriteBU (fun expr ->
+ match expr with
+ | MethodOutSelect(_) ->
+ let vname = SymGen.NewSymFake expr
+ let e' = VarLiteral(vname)
+ let var = VarDeclExpr([Var(vname,None,false)], true)
+ let asgn = BinaryGets var expr
+ stmtList.AddLast asgn |> ignore
+ Some(e')
+ | _ -> None
+ ) expr
+ newExpr, (stmtList |> List.ofSeq)
+ stmtList.Clear()
+ match stmt with
+ | ExprStmt(e) ->
+ let e', slist = __PullUpMethodCalls e
+ slist @ [ExprStmt(e')]
+ | Assign(e1, e2) ->
+ let e2', slist = __PullUpMethodCalls e2
+ slist @ [Assign(e1, e2')]
+ | Block(slist) -> slist |> List.fold (fun acc s -> acc @ PullUpMethodCalls s) []
+
+// ==========================================================
+/// Very simple for now:
+/// - if "m" is a constructor, everything is modifiable
+/// - if the method's post condition contains assignments to fields, everything is modifiable
+/// - otherwise, all objects are immutable
+///
+/// (TODO: instead it should read the "modifies" clause of a method and figure out what's modifiable from there)
+// ==========================================================
+let IsModifiableObj obj (c,m) =
+ let __IsFld name = FindVar c name |> Utils.OptionToBool
+ match m with
+ | Method(name,_,_,_,_) when name.EndsWith("__mod__") -> true
+ | Method(_,_,_,_,true) -> true
+ | Method(_,_,_,post,false) ->
+ DescendExpr2 (fun e acc ->
+ match e with
+ | BinaryExpr(_,"=",IdLiteral(name),r) when __IsFld name -> true
+ | Dot(_,name) when __IsFld name -> true
+ | _ -> acc
+ ) post false
+ | _ -> failwithf "expected a Method but got %O" m
\ No newline at end of file diff --git a/Source/Jennisys/CodeGen.fs b/Source/Jennisys/CodeGen.fs new file mode 100644 index 00000000..8df4ca60 --- /dev/null +++ b/Source/Jennisys/CodeGen.fs @@ -0,0 +1,429 @@ +module CodeGen
+
+open Ast
+open Getters
+open AstUtils
+open Utils
+open Resolver
+open TypeChecker
+open PrintUtils
+open DafnyPrinter
+open DafnyModelUtils
+open Options
+
+let validFuncName = "Valid()"
+let validSelfFuncName = "Valid_self()"
+let validReprFuncName = "Valid_repr()"
+
+/// requires: numUnrols >= 0
+/// requires: |fldExprs| = |fldNames|
+let rec GetUnrolledFieldValidExpr fldExprs fldNames validFuncToUse numUnrolls =
+ let rec __Combine exprLst strLst =
+ match exprLst with
+ | e :: rest ->
+ let resLst1 = strLst |> List.map (fun s -> Dot(e, s))
+ List.concat [resLst1; __Combine rest strLst]
+ | [] -> []
+ let rec __NotNull e =
+ match e with
+ | IdLiteral(_)
+ | ObjLiteral(_) -> BinaryNeq e (ObjLiteral("null"))
+ | Dot(sub, str) -> BinaryAnd (__NotNull sub) (BinaryNeq e (ObjLiteral("null")))
+ | _ -> failwith "not supposed to happen"
+ (* --- function body starts here --- *)
+ assert (numUnrolls >= 0)
+ if numUnrolls = 0 then
+ [TrueLiteral]
+ else
+ let exprList = fldExprs |> List.map (fun e -> BinaryImplies (__NotNull e) (Dot(e, validFuncToUse)))
+ if numUnrolls = 1 then
+ exprList
+ else
+ let fldExprs = __Combine fldExprs fldNames
+ List.append exprList (GetUnrolledFieldValidExpr fldExprs fldNames validFuncToUse (numUnrolls - 1))
+
+let GetFieldValidExpr flds validFunName numUnrolls =
+ let fldExprs = flds |> List.map (fun var -> IdLiteral(GetExtVarName var))
+ let fldNames = flds |> List.map GetExtVarName
+ let unrolledExprs = GetUnrolledFieldValidExpr fldExprs fldNames validFunName numUnrolls
+ // add the recursive definition as well
+ let recExprs =
+ if not (validFunName = validFuncName) && Options.CONFIG.recursiveValid then
+ flds //|> List.filter (fun var -> not ((GetExtVarName var).StartsWith("_back_"))) //don't use back pointers
+ |> List.map (fun var ->
+ let name = GetExtVarName var
+ BinaryImplies (BinaryNeq (IdLiteral(name)) NullLiteral) (Dot(IdLiteral(name), validFuncName)))
+ else
+ []
+ recExprs @ unrolledExprs
+
+let GetFieldsForValidExpr allFields prog comp : VarDecl list =
+ let frameVars = GetFrameFields comp
+ allFields |> List.filter (fun var -> IsUserType prog (GetVarType var))
+ |> List.filter (fun var -> Utils.ListContains var frameVars)
+
+let GetFieldsValidExprList clsName allFields prog : Expr list =
+ let fields = GetFieldsForValidExpr allFields prog (FindComponent prog clsName |> ExtractOption)
+ let fieldsByType = GroupFieldsByType fields
+ fieldsByType |> Map.fold (fun acc t varSet ->
+ let validFunName, numUnrolls =
+ match t with
+ | Some(ty) when clsName = (GetTypeShortName ty) -> validSelfFuncName, Options.CONFIG.numLoopUnrolls
+ | _ -> validFuncName, 1
+ acc |> List.append (GetFieldValidExpr (Set.toList varSet) validFunName numUnrolls)
+ ) []
+
+let PrintValidFunctionCode comp prog vars allInvs genRepr nameSuffix: string =
+ let validFuncName = "Valid" + nameSuffix + "()"
+ let validReprFuncName = "Valid_repr" + nameSuffix + "()"
+ let validSelfFuncName = "Valid_self" + nameSuffix + "()"
+ let idt = " "
+ let __PrintInvs invs =
+ invs |> List.fold (fun acc e -> List.concat [acc ; SplitIntoConjunts e]) []
+ |> PrintSep (" &&" + newline) (fun e -> sprintf "%s(%s)" idt (PrintExpr 0 e))
+ |> fun s -> if s = "" then (idt + "true") else s
+ let clsName = GetClassName comp
+ let compTypeName = GetClassType comp |> PrintType
+ let hasLoop = vars |> List.exists (fun var -> match GetVarType var with Some(ty) when compTypeName = PrintType ty -> true | _ -> false)
+ let fieldsValid = GetFieldsValidExprList clsName vars prog
+
+ let frameFldNames = GetFrameFields comp |> List.map GetExtVarName
+ let validReprBody =
+ " this in Repr &&" + newline +
+ " null !in Repr" +
+ (PrintSep "" (fun x -> " &&" + newline + " ($x != null ==> $x in Repr && $x.Repr <= Repr && this !in $x.Repr)".Replace("$x", x)) frameFldNames)
+
+ let vr =
+ if genRepr then
+ " function " + validReprFuncName + ": bool" + newline +
+ " reads *;" + newline +
+ " {" + newline +
+ validReprBody + newline +
+ " }" + newline + newline
+ else
+ ""
+
+ let decreasesStr =
+ if Options.CONFIG.recursiveValid then
+ if hasLoop then
+ if genRepr then
+ " decreases Repr;" + newline
+ else
+ // TODO: Dafny currently doesn't accept "decreases *" on methods
+ " decreases *;" + newline
+ else
+ ""
+ else ""
+ vr +
+ " function " + validSelfFuncName + ": bool" + newline +
+ " reads *;" + newline +
+ " {" + newline +
+ (if genRepr then " " + validReprFuncName + " &&" + newline else "") +
+ (__PrintInvs allInvs) + newline +
+ " }" + newline +
+ newline +
+ " function " + validFuncName + ": bool" + newline +
+ " reads *;" + newline +
+ decreasesStr +
+ " {" + newline +
+ " this." + validSelfFuncName + " &&" + newline +
+ (__PrintInvs fieldsValid) + newline +
+ " }" + newline
+
+let PrintDafnyCodeSkeleton prog methodPrinterFunc genRepr genOld =
+ match prog with
+ | Program(components) -> components |> List.fold (fun acc comp ->
+ match comp with
+ | Component(Interface(name,typeParams,members), DataModel(_,_,cVars,frame,inv), code) as comp ->
+ let aVars = FilterFieldMembers members
+ let aOldVars = MakeOldVars aVars
+ let cOldVars = MakeOldVars cVars
+ let allInvs = GetInvariantsAsList comp |> DesugarLst
+ let allOldInvs = MakeOld (allInvs |> List.fold BinaryAnd TrueLiteral) |> SplitIntoConjunts
+ let aVarsAndRepr = aVars |> List.append (Utils.Ite genRepr [Var("Repr", Some(SetType(NamedType("object", []))), false)] [])
+ let compMethods = FilterConstructorMembers members
+ // Now print it as a Dafny program
+ acc +
+ (sprintf "class %s%s {" name (PrintTypeParams typeParams)) + newline +
+ // the fields: original abstract fields plus concrete fields
+ (sprintf "%s" (PrintFields aVarsAndRepr 2 true)) + newline +
+ (sprintf "%s" (PrintFields cVars 2 false)) + newline +
+ (if genOld then
+ (sprintf "%s" (PrintFields aOldVars 2 true)) + newline +
+ (sprintf "%s" (PrintFields cOldVars 2 false)) + newline
+ else
+ "") +
+ // generate the Valid function
+ (sprintf "%s" (PrintValidFunctionCode comp prog (aVars @ cVars) allInvs genRepr "")) + newline +
+ (if genOld then
+ (sprintf "%s" (PrintValidFunctionCode comp prog (aOldVars @ cOldVars) allOldInvs genRepr "_old")) + newline
+ else
+ "") +
+ // call the method printer function on all methods of this component
+ (methodPrinterFunc comp) +
+ // the end of the class
+ "}" + newline + newline
+ | _ -> assert false; "") ""
+
+let PrintPrePost pfix expr =
+ SplitIntoConjunts expr |> PrintSep "" (fun e -> pfix + (PrintExpr 0 e) + ";")
+
+let GetPreconditionForMethod m =
+ let validExpr = IdLiteral(validFuncName);
+ if IsConstructor m then
+ GetMethodPrePost m |> fst
+ else
+ BinaryAnd validExpr (GetMethodPrePost m |> fst)
+
+let GetPostconditionForMethod prog m genRepr =
+ let validExpr = IdLiteral(validFuncName);
+ match m with
+ | Method(_,_,_,post,isConstr) ->
+ // this.Valid() and user-defined post-condition
+ let postExpr = BinaryAnd validExpr post
+ // method out args are valid
+ let postExpr = (GetMethodOutArgs m) |> List.fold (fun acc var ->
+ if IsUserType prog (GetVarType var) then
+ let varExpr = VarLiteral(GetExtVarName var)
+ let argValidExpr = BinaryImplies (BinaryNeq varExpr NullLiteral) (Dot(varExpr, validFuncName))
+ BinaryAnd acc argValidExpr
+ else
+ acc
+ ) postExpr
+ // fresh Repr
+ if genRepr then
+ let freshExpr = if isConstr then "fresh(Repr - {this})" else "fresh(Repr - old(Repr))";
+ BinaryAnd (IdLiteral(freshExpr)) postExpr
+ else
+ postExpr
+ | _ -> failwithf "expected a method, got %O" m
+
+let PrintAssumePostcondition prog m genRepr prefix =
+ PrintPrePost prefix (GetPostconditionForMethod prog m genRepr |> Desugar) + newline
+
+let GetAllocObjects heapInst =
+ heapInst.assignments |> List.fold (fun acc a ->
+ match a with
+ | FieldAssignment((obj,fld),_) when not (obj.name = "this") ->
+ acc |> Set.add obj
+ | FieldAssignment(_, ObjLiteral(name)) when not (name = "this" || name = "null") ->
+ acc |> Set.add (heapInst.objs |> Map.find name)
+ | _ -> acc
+ ) Set.empty
+
+let PrintAllocNewObjects heapInst indent =
+ let idt = Indent indent
+ GetAllocObjects heapInst |> Set.fold (fun acc obj -> acc + (sprintf "%svar %s := new %s;%s" idt obj.name (PrintType obj.objType) newline)) ""
+
+let PrintVarAssignments heapInst indent =
+ let idt = Indent indent
+ let stmts = ConvertToStatements heapInst true
+ let str = stmts |> PrintSep (newline) (fun s -> (PrintStmt s indent false))
+ str + newline
+
+///
+let PrintReprAssignments prog heapInst indent =
+ let __FollowsFunc o1 o2 =
+ heapInst.assignments |> List.fold (fun acc assgn ->
+ match assgn with
+ | FieldAssignment ((srcObj,fld),value) -> acc || (srcObj = o1 && value = ObjLiteral(o2.name))
+ | _ -> false
+ ) false
+ let idt = Indent indent
+ let objs = heapInst.assignments |> List.fold (fun acc assgn ->
+ match assgn with
+ | FieldAssignment((obj,var),_) -> if GetVarName var = "" then acc else acc |> Set.add obj
+ | _ -> acc
+ ) Set.empty
+ |> Set.toList
+ |> Utils.TopSort __FollowsFunc
+ |> List.rev
+ let rec __GetReprConcrete obj =
+ let expr = SetExpr([ObjLiteral(obj.name)])
+ let builder = CascadingBuilder<_>(expr)
+ builder {
+ let typeName = GetTypeShortName obj.objType
+ let! comp = FindComponent prog typeName
+ let vars = GetFrameFields comp
+ let nonNullVars = vars |> List.choose (fun v ->
+ let lst = heapInst.assignments |> List.choose (function FieldAssignment(x,y) -> Some(x,y) | _ -> None)
+ match Utils.ListMapTryFind (obj,v) lst with
+ | Some(ObjLiteral(n)) when not (n = "null" || n = obj.name) -> Some(v,n)
+ | _ -> None)
+ return nonNullVars |> List.map (fun (var,objName) -> var,(Map.find objName heapInst.objs))
+ |> List.fold (fun acc (var,varValObj) ->
+ if Options.CONFIG.genMod then
+ BinaryAdd acc (Dot(Dot(ObjLiteral(obj.name), (GetVarName var)), "Repr"))
+ else
+ BinaryAdd acc (__GetReprConcrete varValObj)
+ ) expr
+ }
+
+ let reprGetsList = objs |> List.fold (fun acc obj ->
+ let objStmt = BinaryGets (Dot(ObjLiteral(obj.name), "Repr")) (__GetReprConcrete obj)
+ objStmt :: acc
+// let expr = SetExpr([ObjLiteral(obj.name)])
+// let builder = CascadingBuilder<_>(expr)
+// let fullRhs = builder {
+// let typeName = GetTypeShortName obj.objType
+// let! comp = FindComponent prog typeName
+// let vars = GetFrameFields comp
+// let nonNullVars = vars |> List.filter (fun v ->
+// let lst = heapInst.assignments |> List.choose (function FieldAssignment(x,y) -> Some(x,y) | _ -> None)
+// match Utils.ListMapTryFind (obj,v) lst with
+// | Some(ObjLiteral(n)) when not (n = "null") -> true
+// | _ -> false)
+// return nonNullVars |> List.fold (fun a v ->
+// BinaryAdd a (Dot(Dot(ObjLiteral(obj.name), (GetVarName v)), "Repr"))
+// ) expr
+// }
+// let fullReprExpr = BinaryGets (Dot(ObjLiteral(obj.name), "Repr")) fullRhs
+// fullReprExpr :: acc
+ ) []
+
+ let reprStr = if not (reprGetsList = []) then
+ idt + "// repr stuff" + newline +
+ (PrintStmtList reprGetsList indent true)
+ else
+ ""
+
+ let reprValidExpr = GetAllocObjects heapInst |> Set.fold (fun acc obj -> BinaryAnd acc (Dot(ObjLiteral(obj.name), validFuncName))) TrueLiteral
+
+ let assertValidStr = if not (reprValidExpr = TrueLiteral) then
+ idt + "// assert repr objects are valid (helps verification)" + newline +
+ (PrintStmt (ExprStmt(AssertExpr(reprValidExpr))) indent true)
+ else
+ ""
+ let outStr = reprStr + assertValidStr
+ if outStr = "" then
+ outStr
+ else
+ newline + outStr
+
+let rec PrintHeapCreationCodeOld prog (comp,meth) sol indent genRepr =
+ let rec __RewriteOldStmt stmt =
+ match stmt with
+ | Assign(l, r) -> Assign(l, BringToPost r)
+ | ExprStmt(e) -> ExprStmt(BringToPost e)
+ | Block(slist) -> Block(slist |> List.map __RewriteOldStmt)
+
+ let __RewriteOldAsgn a =
+ match a with
+ | FieldAssignment((o,f),e) -> FieldAssignment((o,f), BringToPost e)
+ | ArbitraryStatement(stmt) -> ArbitraryStatement(__RewriteOldStmt stmt)
+
+ /// inserts an assignments into a list of assignments such that the list remains
+ /// topologically sorted wrt field dependencies between different assignments
+ let rec __InsertSorted asgsLst asg =
+ let ___DependsOn dependentAsg asg =
+ match asg, dependentAsg with
+ | FieldAssignment((o,f),_), FieldAssignment(_,e) ->
+ let mf = fun e acc ->
+ match e with
+ | IdLiteral(name) when name = GetVarName f && o.name = "this" -> true
+ | Dot(discr, name) ->
+ let t1 = InferType prog comp (fun s -> None) discr
+ let t2 = FindComponentForType prog o.objType
+ acc || (name = GetVarName f && t1 = t2)
+ | _ -> acc
+ DescendExpr2 (mf
+ ) e false
+ | _ -> false
+ match asgsLst with
+ | [] -> [asg]
+ | a :: rest -> if ___DependsOn a asg then asg :: a :: rest else a :: __InsertSorted rest asg
+
+ /// - removes all FieldAssignments to unmodifiable objects and old variables
+ /// - rewrites expressions not to use old fields
+ let __RemoveUnmodifiableStuff heapInst =
+ let newAsgs = heapInst.assignments |> List.fold (fun acc a ->
+ match a with
+ | FieldAssignment((obj,_),_) when not (Set.contains obj heapInst.modifiableObjs) -> acc
+ | FieldAssignment((_,var),_) when IsOldVar var -> acc
+ | _ -> __InsertSorted acc (__RewriteOldAsgn a)
+ ) []
+ { heapInst with assignments = newAsgs }
+
+ let idt = Indent indent
+ match sol with
+ | (c, hi) :: rest ->
+ let heapInstMod = __RemoveUnmodifiableStuff hi
+ let __ReprAssignments ind =
+ if genRepr then
+ (PrintReprAssignments prog heapInstMod ind)
+ else
+ ""
+ if c = TrueLiteral then
+ (PrintAllocNewObjects heapInstMod indent) +
+ (PrintVarAssignments heapInstMod indent) +
+ (__ReprAssignments indent) +
+ (PrintHeapCreationCodeOld prog (comp,meth) rest indent genRepr)
+ else
+ if List.length rest > 0 then
+ idt + "if (" + (PrintExpr 0 c) + ") {" + newline +
+ (PrintAllocNewObjects heapInstMod (indent+2)) +
+ (PrintVarAssignments heapInstMod (indent+2)) +
+ (__ReprAssignments (indent+2)) +
+ idt + "} else {" + newline +
+ (PrintHeapCreationCodeOld prog (comp,meth) rest (indent+2) genRepr) +
+ idt + "}" + newline
+ else
+ (PrintAllocNewObjects heapInstMod indent) +
+ (PrintVarAssignments heapInstMod indent) +
+ (__ReprAssignments indent)
+ | [] -> ""
+
+let PrintHeapCreationCode prog (comp,meth) sol indent genRepr =
+ let idt = Indent indent
+ let ghostPre = GetMethodGhostPrecondition meth
+ if ghostPre = TrueLiteral then
+ PrintHeapCreationCodeOld prog (comp,meth) sol indent genRepr
+ else
+ (ghostPre |> SplitIntoConjunts |> PrintSep newline (fun e -> idt + "assume " + (PrintExpr 0 e) + ";")) + newline +
+ (PrintHeapCreationCodeOld prog (comp,meth) sol indent genRepr)
+
+let GenConstructorCode prog comp mthd decreasesClause body genRepr =
+ let validExpr = IdLiteral(validFuncName);
+ match mthd with
+ | Method(methodName,sign,_,_,isConstr) ->
+ let preExpr = GetPreconditionForMethod mthd |> Desugar
+ let postExpr = GetPostconditionForMethod prog mthd genRepr |> Desugar
+ let thisObj = ThisObj comp
+ " method " + methodName + (PrintSig sign) +
+ (if IsModifiableObj thisObj (comp,mthd) then newline + " modifies this;" else "") +
+ (PrintPrePost (newline + " requires ") preExpr) +
+ (PrintPrePost (newline + " ensures ") postExpr) +
+ newline +
+ decreasesClause +
+ " {" + newline +
+ body +
+ " }" + newline
+ | _ -> ""
+
+let GetDecreasesClause (c,m) sol =
+ if IsRecursiveSol (c,m) sol then
+ " decreases Repr;" + newline
+ else
+ ""
+
+// solutions: (comp, constructor) |--> condition * heapInst
+let PrintImplCode prog solutions genRepr =
+ PrintDafnyCodeSkeleton prog (fun comp ->
+ let cname = GetComponentName comp
+ solutions |> Map.fold (fun acc (c,m) sol ->
+ if (GetComponentName c) = cname then
+ let mthdBody,decr =
+ match sol with
+ | [] ->
+ let body = " //unable to synthesize" +
+ (PrintAssumePostcondition prog m genRepr (newline + " assume "))
+ let decr = ""
+ body,decr
+ | _ ->
+ let body = PrintHeapCreationCode prog (c,m) sol 4 genRepr
+ let decr = GetDecreasesClause (c,m) sol
+ body,decr
+ acc + newline + (GenConstructorCode prog comp m decr mthdBody genRepr) + newline
+
+ else
+ acc) "") genRepr
\ No newline at end of file diff --git a/Source/Jennisys/DafnyModelUtils.fs b/Source/Jennisys/DafnyModelUtils.fs new file mode 100644 index 00000000..e734f3bb --- /dev/null +++ b/Source/Jennisys/DafnyModelUtils.fs @@ -0,0 +1,455 @@ +// #########################################################################
+/// Utilities for reading/building models from Boogie Visual Debugger files
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// #########################################################################
+
+module DafnyModelUtils
+
+(*
+ The heap maps objects and fields to locations.
+ heap: Const * VarDecl option |--> Const
+
+ The environment maps locations to values (except that it can also
+ be locations to locations, because not all values are explicitly
+ present in the model.
+ envMap: Const |--> Const
+
+ The context is just a list of equality constraints collected on the way
+ ctx: Set<Set<Const>>, where the inner set contains exactly two constants
+*)
+
+open Ast
+open Getters
+open AstUtils
+open Utils
+
+open Microsoft.Boogie
+
+let HEAP_SELECT_FNAME = "MapType1Select"
+let SEQ_BUILD_FNAME = "Seq#Build"
+let SEQ_APPEND_FNAME = "Seq#Append"
+let SEQ_LENGTH_FNAME = "Seq#Length"
+let SEQ_INDEX_FNAME = "Seq#Index"
+let SET_EMPTY_FNAME = "Set#Empty"
+let SET_SELECT_FNAME = "MapType0Select"
+let UNBOX_FNAME = "$Unbox"
+let BOOL_2_U_FNAME = "bool_2_U"
+let U_2_BOOL_FNAME = "U_2_bool"
+let INT_2_U_FNAME = "int_2_U"
+let U_2_INT_FNAME = "U_2_int"
+let DTYPE_FNAME = "dtype"
+let NULL_FNAME = "null"
+
+type HeapModel = {
+ heap : Map<Const * VarDecl, Const>;
+ env : Map<Const, Const>;
+ ctx : Set<Set<Const>>;
+}
+
+let MkHeapModel heap env ctx =
+ { heap = heap; env = env; ctx = ctx }
+
+let GetElemFullName (elem: Model.Element) =
+ elem.Names |> Seq.filter (fun ft -> ft.Func.Arity = 0)
+ |> Seq.choose (fun ft -> Some(ft.Func.Name))
+ |> Utils.SeqToOption
+
+let GetRefName (ref: Model.Element) =
+ match ref with
+ | :? Model.Uninterpreted as uref -> uref.Name
+ | _ -> failwith ("not a ref (Uninterpreted) but: " + ref.GetType().Name)
+
+let GetInt (elem: Model.Element) =
+ let __NotIntFail e = failwith ("not an int element: " + elem.ToString())
+ let rec __GetIntStrict (e: Model.Element) cont =
+ match e with
+ | :? Model.Number as ival -> ival.AsInt()
+ | _ -> cont e
+ __GetIntStrict elem (fun e ->
+ let f = e.Model.MkFunc(U_2_INT_FNAME, 1)
+ let matches = f.Apps |> Seq.filter (fun ft -> ft.Args.[0] = e) |> Seq.map (fun ft -> ft.Result)
+ if matches |> Seq.isEmpty then
+ __NotIntFail e
+ else
+ __GetIntStrict (matches |> Seq.nth 0) __NotIntFail)
+
+let GetBool (elem: Model.Element) =
+ let __NotBoolFail e = failwith ("not a bool element: " + elem.ToString())
+ let rec __GetBoolStrict (e: Model.Element) cont =
+ match e with
+ | :? Model.Boolean as bval -> bval.Value
+ | _ -> cont e
+ __GetBoolStrict elem (fun e ->
+ let f = e.Model.MkFunc(U_2_BOOL_FNAME, 1)
+ let matches = f.Apps |> Seq.filter (fun ft -> ft.Args.[0] = e) |> Seq.map (fun ft -> ft.Result)
+ if matches |> Seq.isEmpty then
+ __NotBoolFail e
+ else
+ __GetBoolStrict (matches |> Seq.nth 0) __NotBoolFail)
+
+let ConvertValue (refVal: Model.Element) =
+ match refVal with
+ | :? Model.Number as ival -> IntConst(ival.AsInt())
+ | :? Model.Boolean as bval -> BoolConst(bval.Value)
+ | :? Model.Array as aval -> failwith "reading array values from model not implemented"
+ | :? Model.Uninterpreted as uval ->
+ try BoolConst(GetBool refVal)
+ with _ -> try IntConst(GetInt refVal)
+ with _ -> Unresolved(uval.Name) (* just a symbolic name for now, which we'll hopefully resolve later*)
+ | _ -> failwith ("unexpected model element kind: " + refVal.ToString())
+
+let LastDotSplit (str: string) =
+ let dotIdx = str.LastIndexOf(".")
+ let s1 = if dotIdx = -1 then "" else str.Substring(0, dotIdx)
+ let s2 = str.Substring(dotIdx + 1)
+ s1,s2
+
+let GetType (e: Model.Element) prog =
+ let fNameOpt = GetElemFullName e
+ match fNameOpt with
+ | Some(fname) -> match fname with
+ | "intType" -> Some(IntType)
+ | Prefix "class." clsName ->
+ let _,shortClsName = LastDotSplit clsName
+ match FindComponent prog shortClsName with
+ | Some(comp) -> Some(GetClassType comp)
+ | None -> None
+ | _ -> None
+ | None -> None
+
+let GetLoc (e: Model.Element) =
+ Unresolved(GetRefName e)
+
+let FindOrCreateSeq env key len =
+ match Map.tryFind key env with
+ | Some(SeqConst(lst)) -> lst,env
+ | None ->
+ let emptyList = Utils.GenList len NoneConst
+ let newSeq = SeqConst(emptyList)
+ let newMap = env |> Map.add key newSeq
+ emptyList,newMap
+ | Some(_) as x-> failwith ("not a SeqConst but: " + x.ToString())
+
+let FindSeqInEnv env key =
+ match Map.find key env with
+ | SeqConst(lst) -> lst
+ | _ as x-> failwith ("not a SeqConst but: " + x.ToString())
+
+let TryFindSetInEnv env key =
+ match Map.tryFind key env with
+ | Some(SetConst(s)) -> Some(s)
+ | Some(x) -> failwith ("not a SetConst but: " + x.ToString())
+ | None -> None
+
+let AddConstr c1 c2 ctx =
+ if c1 = c2 then
+ ctx
+ else
+ match c1, c2 with
+ | Unresolved(_), _ | _, Unresolved(_) ->
+ // find partitions
+ let s1Opt = ctx |> Set.filter (fun ss -> Set.contains c1 ss) |> Utils.SetToOption
+ let s2Opt = ctx |> Set.filter (fun ss -> Set.contains c2 ss) |> Utils.SetToOption
+ match s1Opt, s2Opt with
+ // both already exist --> so just merge them
+ | Some(s1), Some(s2) -> ctx |> Set.remove s1 |> Set.remove s2 |> Set.add (Set.union s1 s2)
+ // exactly one already exists --> add to existing
+ | Some(s1), None -> ctx |> Set.remove s1 |> Set.add (Set.add c2 s1)
+ | None, Some(s2) -> ctx |> Set.remove s2 |> Set.add (Set.add c1 s2)
+ // neither exists --> create a new one
+ | None, None -> ctx |> Set.add (Set.ofList [c1; c2])
+ | _ -> failwith ("trying to add an equality constraint between two constants: " + c1.ToString() + ", and " + c2.ToString())
+
+let rec UpdateContext lst1 lst2 ctx =
+ match lst1, lst2 with
+ | fs1 :: rest1, fs2 :: rest2 ->
+ match fs1, fs2 with
+ | NoneConst,_ | _,NoneConst -> UpdateContext rest1 rest2 ctx
+ | _ -> UpdateContext rest1 rest2 (AddConstr fs1 fs2 ctx)
+ | [], [] -> ctx
+ | _ -> failwith "lists are not of the same length"
+
+let UnboxIfNeeded (model: Microsoft.Boogie.Model) (e: Model.Element) =
+ let f_unbox = model.MkFunc(UNBOX_FNAME, 2)
+ let unboxed = f_unbox.Apps |> Seq.filter (fun ft -> if (GetLoc ft.Args.[1]) = (GetLoc e) then true else false)
+ |> Seq.choose (fun ft -> Some(ft.Result))
+ |> Utils.SeqToOption
+ match unboxed with
+ | Some(e) -> ConvertValue e
+ | None -> GetLoc e
+
+let ReadHeap (model: Microsoft.Boogie.Model) prog =
+ let f_heap_select = model.MkFunc(HEAP_SELECT_FNAME, 3)
+ let values = f_heap_select.Apps
+ values |> Seq.fold (fun acc ft ->
+ assert (ft.Args.Length = 3)
+ let ref = ft.Args.[1]
+ let fld = ft.Args.[2]
+ assert (Seq.length fld.Names = 1)
+ let fldFullName = (Seq.nth 0 fld.Names).Func.Name
+ let pfix,fldName = LastDotSplit fldFullName
+ let _,clsName = LastDotSplit pfix
+ let refVal = ft.Result
+ let refObj = Unresolved(GetRefName ref)
+ let nonebuilder = CascadingBuilder<_>(None)
+ let fldVarOpt = nonebuilder {
+ let! comp = FindComponent prog clsName
+ if fldName.StartsWith("old_") then
+ let fn = RenameFromOld fldName
+ let! var = FindVar comp fn
+ return Some(MakeOldVar var)
+ else
+ return FindVar comp fldName
+ }
+ match fldVarOpt with
+ | Some(fldVar) ->
+ let fldType = GetVarType fldVar
+ let fldVal = ConvertValue refVal
+ acc |> Map.add (refObj, fldVar) fldVal
+ | None -> acc
+ ) Map.empty
+
+// ====================================================================
+/// Reads values that were assigned to given arguments. Those values
+/// can be in functions with the same name as the argument name appended
+/// with an "#" and some number after it.
+// ====================================================================
+let rec ReadArgValues (model: Microsoft.Boogie.Model) args =
+ match args with
+ | v :: rest ->
+ let name = GetVarName v
+ let farg = model.Functions |> Seq.filter (fun f -> f.Arity = 0 && f.Name.StartsWith(name + "#")) |> Utils.SeqToOption
+ match farg with
+ | Some(func) ->
+ let fldVar = v
+ assert (Seq.length func.Apps = 1)
+ let ft = Seq.head func.Apps
+ let fldVal = ConvertValue (ft.Result)
+ ReadArgValues model rest |> Map.add (VarConst(name)) fldVal
+ | None -> failwith ("cannot find corresponding function for parameter " + name)
+ | [] -> Map.empty
+
+// ==============================================================
+/// Reads stuff about sequences from a given model and ads it to
+/// the given "envMap" map and a "ctx" set. The relevant stuff is
+/// fetched from the following functions:
+/// Seq#Length, Seq#Index, Seq#Build, Seq#Append
+// ==============================================================
+let ReadSeq (model: Microsoft.Boogie.Model) (envMap,ctx) =
+ // reads stuff from Seq#Length
+ let rec __ReadSeqLen (model: Microsoft.Boogie.Model) (len_tuples: Model.FuncTuple list) (envMap,ctx) =
+ match len_tuples with
+ | ft :: rest ->
+ let len = GetInt ft.Result
+ let emptyList = Utils.GenList len NoneConst
+ let newMap = envMap |> Map.add (GetLoc ft.Args.[0]) (SeqConst(emptyList))
+ __ReadSeqLen model rest (newMap,ctx)
+ | _ -> (envMap,ctx)
+
+ // reads stuff from Seq#Index
+ let rec __ReadSeqIndex (model: Microsoft.Boogie.Model) (idx_tuples: Model.FuncTuple list) (envMap,ctx) =
+ match idx_tuples with
+ | ft :: rest ->
+ let srcLstKey = GetLoc ft.Args.[0]
+ let idx = GetInt ft.Args.[1]
+ let oldLst,envMap = FindOrCreateSeq envMap srcLstKey (idx+1)
+ let lstElem = UnboxIfNeeded model ft.Result
+ let newLst = Utils.ListSet idx lstElem oldLst
+ let newCtx = UpdateContext oldLst newLst ctx
+ let newEnv = envMap |> Map.add srcLstKey (SeqConst(newLst))
+ __ReadSeqIndex model rest (newEnv,newCtx)
+ | _ -> (envMap,ctx)
+
+ // reads stuff from Seq#Build
+ let rec __ReadSeqBuild (model: Microsoft.Boogie.Model) (bld_tuples: Model.FuncTuple list) (envMap,ctx) =
+ match bld_tuples with
+ | ft :: rest ->
+ let srcLstLoc = GetLoc ft.Args.[0]
+ let lstElemVal = UnboxIfNeeded model ft.Args.[1]
+ let dstLstLoc = GetLoc ft.Result
+ let oldLst = FindSeqInEnv envMap srcLstLoc
+ let dstLst = FindSeqInEnv envMap dstLstLoc
+ let newLst = oldLst @ [lstElemVal]
+ let newCtx = UpdateContext dstLst newLst ctx
+ let newEnv = envMap |> Map.add dstLstLoc (SeqConst(newLst))
+ __ReadSeqBuild model rest (newEnv,newCtx)
+ | _ -> (envMap,ctx)
+
+ // reads stuff from Seq#Append
+ let rec __ReadSeqAppend (model: Microsoft.Boogie.Model) (app_tuples: Model.FuncTuple list) (envMap,ctx) =
+ match app_tuples with
+ | ft :: rest ->
+ let srcLst1Loc = GetLoc ft.Args.[0]
+ let srcLst2Loc = GetLoc ft.Args.[1]
+ let dstLstLoc = GetLoc ft.Result
+ let oldLst1 = FindSeqInEnv envMap srcLst1Loc
+ let oldLst2 = FindSeqInEnv envMap srcLst2Loc
+ let dstLst = FindSeqInEnv envMap dstLstLoc
+ let newLst = oldLst1 @ oldLst2
+ let newCtx = UpdateContext dstLst newLst ctx
+ let newEnv = envMap |> Map.add dstLstLoc (SeqConst(newLst))
+ __ReadSeqAppend model rest (newEnv,newCtx)
+ | _ -> (envMap,ctx)
+
+ // keeps reading from Seq#Build and Seq#Append until fixpoint
+ let rec __ReadUntilFixpoint hmodel =
+ let f_seq_bld = model.MkFunc(SEQ_BUILD_FNAME, 2)
+ let f_seq_app = model.MkFunc(SEQ_APPEND_FNAME, 2)
+ let hmodel' = hmodel |> __ReadSeqBuild model (List.ofSeq f_seq_bld.Apps)
+ |> __ReadSeqAppend model (List.ofSeq f_seq_app.Apps)
+ if hmodel' = hmodel then
+ hmodel'
+ else
+ __ReadUntilFixpoint hmodel'
+
+ let f_seq_len = model.MkFunc(SEQ_LENGTH_FNAME, 1)
+ let f_seq_idx = model.MkFunc(SEQ_INDEX_FNAME, 2)
+ let hmodel = (envMap,ctx)
+ let hmodel' = hmodel |> __ReadSeqLen model (List.ofSeq f_seq_len.Apps)
+ |> __ReadSeqIndex model (List.ofSeq f_seq_idx.Apps)
+ __ReadUntilFixpoint hmodel'
+
+
+
+// =====================================================
+/// Reads stuff about sets from a given model and adds it
+/// to the given "envMap" map and "ctx" set.
+// =====================================================
+let ReadSet (model: Microsoft.Boogie.Model) (envMap,ctx) =
+ // reads stuff from Set#Empty
+ let rec __ReadSetEmpty (empty_tuples: Model.FuncTuple list) (envMap,ctx) =
+ match empty_tuples with
+ | ft :: rest ->
+ let newMap = envMap |> Map.add (GetLoc ft.Result) (SetConst(Set.empty))
+ __ReadSetEmpty rest (newMap,ctx)
+ | [] -> (envMap,ctx)
+
+ // reads stuff from [2]
+ let rec __ReadSetMembership (set_tuples: Model.FuncTuple list) (env,ctx) =
+ match set_tuples with
+ | ft :: rest ->
+ if GetBool ft.Result then
+ let srcSetKey = GetLoc ft.Args.[0]
+ let srcSet = match TryFindSetInEnv env srcSetKey with
+ | Some(s) -> s
+ | None -> Set.empty
+ let elem = UnboxIfNeeded model ft.Args.[1]
+ let newEnv = env |> Map.add srcSetKey (SetConst(Set.add elem srcSet))
+ __ReadSetMembership rest (newEnv,ctx)
+ else
+ __ReadSetMembership rest (env,ctx)
+ | [] -> (env,ctx)
+
+ let t_set_empty = Seq.toList (model.MkFunc(SET_EMPTY_FNAME, 1).Apps)
+ let t_set = Seq.toList (model.MkFunc(SET_SELECT_FNAME, 2).Apps)
+ (envMap,ctx) |> __ReadSetEmpty t_set_empty
+ |> __ReadSetMembership t_set
+
+(* More complicated way which now doesn't seem to be necessary *)
+//let ReadSet (model: Microsoft.Boogie.Model) (envMap,ctx) =
+// // reads stuff from Set#Empty
+// let rec __ReadSetEmpty (empty_tuples: Model.FuncTuple list) (envMap,ctx) =
+// match empty_tuples with
+// | ft :: rest ->
+// let newMap = envMap |> Map.add (GetLoc ft.Result) (SetConst(Set.empty))
+// __ReadSetEmpty rest (newMap,ctx)
+// | [] -> (envMap,ctx)
+//
+// // reads stuff from Set#UnionOne and Set#Union
+// let rec __ReadSetUnions (envMap,ctx) =
+// // this one goes through a given list of "UnionOne" tuples, updates
+// // the env for those set that it was able to resolve, and returns a
+// // list of tuples for which it wasn't able to resolve sets
+// let rec ___RSU1 (tuples: Model.FuncTuple list) env unprocessed =
+// match tuples with
+// | ft :: rest ->
+// let srcSetKey = GetLoc ft.Args.[0]
+// match TryFindSetInEnv env srcSetKey with
+// | Some(oldSet) ->
+// let elem = UnboxIfNeeded model ft.Args.[1]
+// let newSet = Set.add elem oldSet
+// // update contex?
+// let newEnv = env |> Map.add (GetLoc ft.Result) (SetConst(newSet))
+// ___RSU1 rest newEnv unprocessed
+// | None -> ___RSU1 rest env (ft :: unprocessed)
+// | [] -> (env,unprocessed)
+// // this one goes through a given list of "Union" tuples, updates
+// // the env for those set that it was able to resolve, and returns a
+// // list of tuples for which it wasn't able to resolve sets
+// let rec ___RSU (tuples: Model.FuncTuple list) env unprocessed =
+// match tuples with
+// | ft :: rest ->
+// let set1Key = GetLoc ft.Args.[0]
+// let set2Key = GetLoc ft.Args.[1]
+// match TryFindSetInEnv env set1Key, TryFindSetInEnv env set2Key with
+// | Some(oldSet1), Some(oldSet2) ->
+// let newSet = Set.union oldSet1 oldSet2
+// // update contex?
+// let newEnv = env |> Map.add (GetLoc ft.Result) (SetConst(newSet))
+// ___RSU rest newEnv unprocessed
+// | _ -> ___RSU rest env (ft :: unprocessed)
+// | [] -> (env,unprocessed)
+// // this one keeps looping as loong as the list of unprocessed tuples
+// // is decreasing, it ends when if falls down to 0, or fails if
+// // the list stops decreasing
+// let rec ___RSU_until_fixpoint u1tuples utuples env =
+// let newEnv1,unprocessed1 = ___RSU1 u1tuples env []
+// let newEnv2,unprocessed2 = ___RSU utuples newEnv1 []
+// let oldLen = (List.length u1tuples) + (List.length utuples)
+// let totalUnprocLen = (List.length unprocessed1) + (List.length unprocessed2)
+// if totalUnprocLen = 0 then
+// newEnv2
+// elif totalUnprocLen < oldLen then
+// ___RSU_until_fixpoint unprocessed1 unprocessed2 newEnv2
+// else
+// failwith "cannot resolve all sets in Set#UnionOne/Set#Union"
+// // finally, just invoke the fixpoint function for UnionOne and Union tuples
+// let t_union_one = Seq.toList (model.MkFunc("Set#UnionOne", 2).Apps)
+// let t_union = Seq.toList (model.MkFunc("Set#Union", 2).Apps)
+// let newEnv = ___RSU_until_fixpoint t_union_one t_union envMap
+// (newEnv,ctx)
+//
+// let f_set_empty = model.MkFunc("Set#Empty", 1)
+// (envMap,ctx) |> __ReadSetEmpty (List.ofSeq f_set_empty.Apps)
+// |> __ReadSetUnions
+
+// ======================================================
+/// Reads staff about the null constant from a given model
+/// and adds it to the given "envMap" map and "ctx" set.
+// ======================================================
+let ReadNull (model: Microsoft.Boogie.Model) (envMap,ctx) =
+ let f_null = model.MkFunc(NULL_FNAME, 0)
+ assert (f_null.AppCount = 1)
+ let e = (f_null.Apps |> Seq.nth 0).Result
+ let newEnv = envMap |> Map.add (GetLoc e) NullConst
+ (newEnv,ctx)
+
+// ============================================================================================
+/// Reads the evinronment map and the context set.
+///
+/// It starts by reading the model for the "dtype" function to discover all objects on the heap,
+/// and then proceeds by reading stuff about the null constant, about sequences, and about sets.
+// ============================================================================================
+let ReadEnv (model: Microsoft.Boogie.Model) prog =
+ let f_dtype = model.MkFunc(DTYPE_FNAME, 1)
+ let refs = f_dtype.Apps |> Seq.choose (fun ft -> Some(ft.Args.[0]))
+ let envMap = f_dtype.Apps |> Seq.fold (fun acc ft ->
+ let locName = GetRefName ft.Args.[0]
+ let elemName = GetElemFullName ft.Args.[0]
+ let loc = Unresolved(locName)
+ let locType = GetType ft.Result prog
+ let value = match elemName with
+ | Some(n) when n.StartsWith("this") -> ThisConst(locName.Replace("*", ""), locType)
+ | _ -> NewObj(locName.Replace("*", ""), locType)
+ acc |> Map.add loc value
+ ) Map.empty
+ (envMap, Set.ofList([])) |> ReadNull model
+ |> ReadSeq model
+ |> ReadSet model
+
+let ReadFieldValuesFromModel (model: Microsoft.Boogie.Model) prog comp meth =
+ let heap = ReadHeap model prog
+ let env0,ctx = ReadEnv model prog
+ let env = env0 |> Utils.MapAddAll (ReadArgValues model (GetMethodArgs meth))
+ MkHeapModel heap env ctx
\ No newline at end of file diff --git a/Source/Jennisys/DafnyPrinter.fs b/Source/Jennisys/DafnyPrinter.fs new file mode 100644 index 00000000..f2e71e8b --- /dev/null +++ b/Source/Jennisys/DafnyPrinter.fs @@ -0,0 +1,135 @@ +module DafnyPrinter
+
+open Ast
+open Getters
+open AstUtils
+open PrintUtils
+
+let rec PrintType ty =
+ match ty with
+ | IntType -> "int"
+ | BoolType -> "bool"
+ | SeqType(t) -> sprintf "seq<%s>" (PrintType t)
+ | SetType(t) -> sprintf "set<%s>" (PrintType t)
+ | NamedType(id,args) -> if List.isEmpty args then id else sprintf "%s<%s>" id (PrintSep ", " (fun s -> s) args)
+ | InstantiatedType(id,args) -> if List.isEmpty args then id else sprintf "%s<%s>" id (PrintSep ", " (fun t -> PrintType t) args)
+
+let PrintVarDecl vd =
+ let name = GetExtVarName vd
+ match GetVarType vd with
+ | None -> name
+ | Some(ty) -> sprintf "%s: %s" name (PrintType ty)
+
+let rec PrintExpr ctx expr =
+ match expr with
+ | IntLiteral(d) -> sprintf "%d" d
+ | BoolLiteral(b) -> sprintf "%b" b
+ | BoxLiteral(id) -> sprintf "box_%s" id
+ | ObjLiteral(id)
+ | VarLiteral(id)
+ | IdLiteral(id) -> id
+ | VarDeclExpr(vlist, declare) ->
+ let decl = if declare then "var " else ""
+ let vars = PrintSep ", " PrintVarDecl vlist
+ sprintf "%s%s" decl vars
+ | Star -> "*"
+ | Dot(e,id) -> sprintf "%s.%s" (PrintExpr 100 e) id
+ | LCIntervalExpr(e) -> sprintf "%s.." (PrintExpr 90 e)
+ | OldExpr(e) -> sprintf "old(%s)" (PrintExpr 90 e)
+ | UnaryExpr(op,UnaryExpr(op2, e2)) -> sprintf "%s(%s)" op (PrintExpr 90 (UnaryExpr(op2, e2)))
+ | UnaryExpr(op,e) -> sprintf "%s%s" op (PrintExpr 90 e)
+ | BinaryExpr(strength,"in",lhs,BinaryExpr(_,"...",lo,hi)) ->
+ let needParens = strength <= ctx
+ let openParen = if needParens then "(" else ""
+ let closeParen = if needParens then ")" else ""
+ let loStr = PrintExpr strength lo
+ let hiStr = PrintExpr strength hi
+ let lhsStr = PrintExpr strength lhs
+ sprintf "%s%s <= %s && %s <= %s%s" openParen loStr lhsStr lhsStr hiStr closeParen
+ | BinaryExpr(strength,op,e0,e1) ->
+ let op =
+ match op with
+ | "=" -> "=="
+ | "div" -> "/"
+ | "mod" -> "%"
+ | _ -> op
+ let needParens = strength <= ctx
+ let openParen = if needParens then "(" else ""
+ let closeParen = if needParens then ")" else ""
+ sprintf "%s%s %s %s%s" openParen (PrintExpr strength e0) op (PrintExpr strength e1) closeParen
+ | IteExpr(c,e1,e2) -> sprintf "(if %s then %s else %s)" (PrintExpr 25 c) (PrintExpr 25 e1) (PrintExpr 25 e2)
+ | SelectExpr(e,i) -> sprintf "%s[%s]" (PrintExpr 100 e) (PrintExpr 0 i)
+ | UpdateExpr(e,i,v) -> sprintf "%s[%s := %s]" (PrintExpr 100 e) (PrintExpr 0 i) (PrintExpr 0 v)
+ | SequenceExpr(ee) -> sprintf "[%s]" (ee |> PrintSep ", " (PrintExpr 0))
+ | SeqLength(e) -> sprintf "|%s|" (PrintExpr 0 e)
+ | SetExpr(ee) -> sprintf "{%s}" (ee |> PrintSep ", " (PrintExpr 0))
+ | AssertExpr(e) -> sprintf "assert %s" (PrintExpr 0 e)
+ | AssumeExpr(e) -> sprintf "assume %s" (PrintExpr 0 e)
+ | ForallExpr(vv,e) ->
+ let needParens = true
+ let openParen = if needParens then "(" else ""
+ let closeParen = if needParens then ")" else ""
+ sprintf "%sforall %s :: %s%s" openParen (vv |> PrintSep ", " PrintVarDecl) (PrintExpr 0 e) closeParen
+ | MethodCall(rcv,_,name,aparams) ->
+ sprintf "%s.%s(%s)" (PrintExpr 0 rcv) name (aparams |> PrintSep ", " (PrintExpr 0))
+ | MethodOutSelect(mth,name) ->
+ // TODO: this can only work if there is only 1 out parameter
+ sprintf "%s" (PrintExpr 0 mth)
+
+let rec PrintConst cst =
+ match cst with
+ | IntConst(v) -> sprintf "%d" v
+ | BoolConst(b) -> sprintf "%b" b
+ | BoxConst(id) -> sprintf "box_%s" id
+ | VarConst(v) -> sprintf "%s" v
+ | SetConst(cset) -> sprintf "{%s}" (PrintSep ", " (fun c -> PrintConst c) (Set.toList cset))
+ | SeqConst(cseq) -> sprintf "[%s]" (PrintSep ", " (fun c -> PrintConst c) cseq)
+ | NullConst -> "null"
+ | NoneConst -> "<none>"
+ | ThisConst(_,_) -> "this"
+ | NewObj(name,_) -> PrintGenSym name
+ | Unresolved(name) -> sprintf "Unresolved(%s)" name
+
+let PrintSig signature =
+ match signature with
+ | Sig(ins, outs) ->
+ let returnClause =
+ if outs <> [] then sprintf " returns (%s)" (outs |> PrintSep ", " PrintVarDecl)
+ else ""
+ sprintf "(%s)%s" (ins |> PrintSep ", " PrintVarDecl) returnClause
+
+let PrintTypeParams typeParams =
+ match typeParams with
+ | [] -> ""
+ | _ -> sprintf "<%s>" (typeParams |> PrintSep ", " (fun tp -> tp))
+
+let PrintFields vars indent ghost =
+ let ghostStr = if ghost then "ghost " else ""
+ vars |> List.fold (fun acc v -> match GetVarType v with
+ | None -> acc + (sprintf "%s%svar %s;%s" (Indent indent) ghostStr (GetExtVarName v) newline)
+ | Some(tp) -> acc + (sprintf "%s%svar %s: %s;%s" (Indent indent) ghostStr (GetExtVarName v) (PrintType tp) newline)) ""
+
+let rec _PrintStmt stmt indent printNewline =
+ let idt = Indent indent
+ let nl = if printNewline then newline else ""
+ match stmt with
+ | Block(stmts) ->
+ idt + "{" + nl +
+ (_PrintStmtList stmts (indent + 2) true) +
+ idt + "}" + nl
+ | Assign(lhs,rhs) -> sprintf "%s%s := %s;%s" idt (PrintExpr 0 lhs) (PrintExpr 0 rhs) nl
+ | ExprStmt(expr) -> sprintf "%s%s;%s" idt (PrintExpr 0 expr) nl
+and _PrintStmtList stmts indent printNewLine =
+ let idt = Indent indent
+ let str = stmts |> PrintSep newline (fun s -> _PrintStmt s indent false)
+ if printNewLine then
+ str + newline
+ else
+ str
+
+let PrintStmt stmt indent printNewline =
+ let stmts = PullUpMethodCalls stmt
+ _PrintStmtList stmts indent printNewline
+
+let PrintStmtList stmts indent printNewLine =
+ stmts |> List.fold (fun acc s -> acc + (PrintStmt s indent printNewLine)) ""
\ No newline at end of file diff --git a/Source/Jennisys/EnvUtils.fs b/Source/Jennisys/EnvUtils.fs new file mode 100644 index 00000000..0b840311 --- /dev/null +++ b/Source/Jennisys/EnvUtils.fs @@ -0,0 +1,9 @@ +module EnvUtils
+
+open Ast
+
+let GetThisLoc env =
+ Map.findKey (fun k v ->
+ match v with
+ | ThisConst(_) -> true
+ | _ -> false) env
\ No newline at end of file diff --git a/Source/Jennisys/FixpointSolver.fs b/Source/Jennisys/FixpointSolver.fs new file mode 100644 index 00000000..1ca3b057 --- /dev/null +++ b/Source/Jennisys/FixpointSolver.fs @@ -0,0 +1,374 @@ +module FixpointSolver
+
+open Ast
+open AstUtils
+open Printer
+open Resolver
+open Utils
+
+/////////////
+
+type UnifDirection = LTR | RTL
+
+exception CannotUnify
+
+let rec SelectiveUnifyImplies okToUnifyFunc lhs rhs dir unifs =
+ ///
+ let __AddOrNone unifs name e =
+ if okToUnifyFunc name then
+ Some(unifs |> Utils.MapAddNew name e)
+ else
+ None
+
+ ///
+ let __UnifLists lstL lstR =
+ if List.length lstL = List.length lstR then
+ try
+ let unifs2 = List.fold2 (fun acc elL elR -> match SelectiveUnifyImplies okToUnifyFunc elL elR dir acc with
+ | Some(u) -> u
+ | None -> raise CannotUnify) unifs lstL lstR
+ Some(unifs2)
+ with
+ | CannotUnify -> None
+ else
+ None
+
+ ///
+ let __ApplyUnifs unifs exprList =
+ exprList |> List.fold (fun acc e ->
+ let e' = e |> Rewrite (fun e ->
+ match e with
+ | VarLiteral(id) when Map.containsKey id unifs -> Some(unifs |> Map.find id)
+ | _ -> None)
+ acc |> Set.add e'
+ ) Set.empty
+
+ if lhs = FalseLiteral || rhs = TrueLiteral then
+ Some(unifs)
+ else
+ try
+ let l,r = match dir with
+ | LTR -> lhs,rhs
+ | RTL -> rhs,lhs
+ match l, r with
+ | VarLiteral(vname), rhs -> __AddOrNone unifs vname rhs
+ | IntLiteral(nL), IntLiteral(nR) when nL = nR ->
+ Some(unifs)
+ | BoolLiteral(bL), BoolLiteral(bR) when bL = bR ->
+ Some(unifs)
+ | SetExpr(elistL), SetExpr(elistR) ->
+ let s1 = elistL |> __ApplyUnifs unifs
+ let s2 = elistR |> Set.ofList
+ if (s1 = s2) then
+ Some(unifs)
+ else
+ __UnifLists elistL elistR
+ | SequenceExpr(elistL), SequenceExpr(elistR) when List.length elistL = List.length elistR ->
+ __UnifLists elistL elistR
+ | _ when l = r ->
+ Some(unifs)
+ | _ ->
+ let __TryUnifyPair x1 a1 x2 a2 unifs =
+ let builder = new Utils.CascadingBuilder<_>(None)
+ builder {
+ let! unifsLhs = SelectiveUnifyImplies okToUnifyFunc x1 a1 dir unifs
+ let! unifsRhs = SelectiveUnifyImplies okToUnifyFunc x2 a2 dir unifsLhs
+ return Some(unifsRhs)
+ }
+
+ // target implies candidate!
+ let rec ___f2 consequence premise unifs =
+ match consequence, premise with
+ // same operators + commutative -> try both
+ | BinaryExpr(_, opT, lhsT, rhsT), BinaryExpr(_, opC, lhsC, rhsC) when opT = opC && IsCommutativeOp opT ->
+ match __TryUnifyPair lhsC lhsT rhsC rhsT unifs with
+ | Some(x) -> Some(x)
+ | None -> __TryUnifyPair lhsC rhsT rhsC lhsT unifs
+ // operators are the same
+ | BinaryExpr(_, opT, lhsT, rhsT), BinaryExpr(_, opC, lhsC, rhsC) when opC = opT ->
+ __TryUnifyPair lhsC lhsT rhsC rhsT unifs
+ // operators are exactly the invers of one another
+ | BinaryExpr(_, opT, lhsT, rhsT), BinaryExpr(_, opC, lhsC, rhsC) when AreInverseOps opC opT ->
+ __TryUnifyPair lhsC rhsT rhsC lhsT unifs
+ //
+ | BinaryExpr(_, opT, lhsT, rhsT), BinaryExpr(_, opC, lhsC, rhsC) when DoesImplyOp opC opT ->
+ __TryUnifyPair lhsC lhsT rhsC rhsT unifs
+ | UnaryExpr(opC, subC), UnaryExpr(opP, subP) when opC = opP ->
+ SelectiveUnifyImplies okToUnifyFunc subP subC dir unifs
+ | SelectExpr(lstC, idxC), SelectExpr(lstP, idxP) ->
+ __TryUnifyPair lstP lstC idxP idxC unifs
+ | SeqLength(lstC), SeqLength(lstP) ->
+ SelectiveUnifyImplies okToUnifyFunc lstP lstC dir unifs
+ | Dot(exprC, fldNameC), Dot(exprP, fldNameP) when fldNameC = fldNameP ->
+ SelectiveUnifyImplies okToUnifyFunc exprP exprC dir unifs
+ | _ -> None
+
+ let rec ___f1 targetLst candidateLst unifs =
+ match targetLst, candidateLst with
+ | targetExpr :: targetRest, candExpr :: candRest ->
+ // trying to find a unification for "targetExpr"
+ let uOpt = match ___f2 targetExpr candExpr unifs with
+ // found -> just return
+ | Some(unifs2) -> Some(unifs2)
+ // not found -> keep looking in the rest of the candidate expressions
+ | None -> ___f1 [targetExpr] candRest unifs
+ match uOpt with
+ // found -> try find for the rest of the target expressions
+ | Some(unifs2) -> ___f1 targetRest candidateLst unifs2
+ // not found -> fail
+ | None -> None
+ | targetExpr :: _, [] ->
+ // no more candidates for unification for this targetExpr -> fail
+ None
+ | [], _ ->
+ // we've found unifications for all target expressions -> return the current unifications map
+ Some(unifs)
+
+ let __HasSetExpr e = DescendExpr2 (fun ex acc -> if acc then true else match ex with SetExpr(_) -> true | _ -> false) e false
+ let __PreprocSplitSort e = e |> DesugarAndRemove |> DistributeNegation |> SplitIntoConjunts |> List.sortBy (fun e -> if __HasSetExpr e then 1 else 0)
+ let lhsConjs = lhs |> __PreprocSplitSort
+ let rhsConjs = rhs |> __PreprocSplitSort
+ ___f1 rhsConjs lhsConjs unifs
+ with
+ | CannotUnify
+ | KeyAlreadyExists -> None
+
+let UnifyImplies lhs rhs dir unifs = SelectiveUnifyImplies (fun e -> true) lhs rhs dir unifs
+
+////////////////////////////////////////////
+
+let rec ComputeClosure heapInst expandExprFunc premises =
+ let bogusExpr = VarLiteral("!@#$%^&*()")
+
+ let ApplyUnifs unifs expr =
+ Rewrite (function
+ | VarLiteral(id) when unifs |> Map.containsKey id ->
+ Some(unifs |> Map.find id)
+ | _ -> None
+ ) expr
+
+ let FindMatches expr except premises =
+ //Logger.TraceLine ("finding matches for: " + (PrintExpr 0 expr) + "; #premises = " + (Set.count premises |> sprintf "%i"))
+ let okToUnifyFunc = fun (varName: string) -> varName.StartsWith("$")
+ if expr = TrueLiteral then
+ []
+ else
+ let matches =
+ premises |> Set.toList
+ |> List.choose (function BinaryExpr(_,"=",lhs,rhs) ->
+ if lhs = expr && not (rhs = except) then
+ Some(rhs)
+ elif rhs = expr && not (lhs = except) then
+ Some(lhs)
+ else
+ match SelectiveUnifyImplies okToUnifyFunc lhs expr LTR Map.empty with
+ | Some(unifs) -> Some(ApplyUnifs unifs rhs)
+ | None ->
+ match SelectiveUnifyImplies okToUnifyFunc rhs expr LTR Map.empty with
+ | Some(unifs) -> Some(ApplyUnifs unifs lhs)
+ | None -> None
+ | _ -> None)
+ //Logger.TraceLine (sprintf "Number of matches for %s: %i" (PrintExpr 0 expr) (List.length matches))
+ matches
+
+ let MySetAdd expr set =
+ let x = Printer.PrintExpr 0 expr
+ if x.Contains("$") || not (expandExprFunc expr) then
+ set
+ else
+ match expr with
+ | BinaryExpr(p,op,lhs,rhs) when IsCommutativeOp op && Set.contains (BinaryExpr(p,op,rhs,lhs)) set -> set
+ | BinaryExpr(p,op,lhs,rhs) when IsCommutativeOp op && rhs = lhs -> set
+ | _ -> Set.add expr set
+
+ let SelectExprCombinerFunc lst idx =
+ // distribute the indexing operation if possible
+ let rec __fff lst idx =
+ //Logger.TraceLine ("SelectExpr fff for " + (PrintExpr 0 lst))
+ let selExpr = SelectExpr(lst, idx)
+ match lst with
+ | BinaryExpr(_,"+",lhs,rhs) ->
+ let idxVal = EvalFull heapInst idx |> Expr2Int
+ let lhsVal = EvalFull heapInst lhs |> Expr2List
+ let rhsVal = EvalFull heapInst rhs |> Expr2List
+ if idxVal < List.length lhsVal then
+ __fff lhs idx
+ else
+ __fff rhs (BinarySub idx (IntLiteral(List.length lhsVal)))
+ | SequenceExpr(elist) ->
+ let idxVal = EvalFull heapInst idx |> Expr2Int
+ [elist.[idxVal]]
+ | _ -> [selExpr]
+ __fff lst idx
+
+ let SeqLenCombinerFunc lst =
+ // distribute the SeqLength operation if possible
+ let rec __fff lst =
+ //Logger.TraceLine ("SeqLen fff for " + (PrintExpr 0 lst))
+ let lenExpr = SeqLength(lst)
+ match lst with
+ | BinaryExpr(_,"+",lhs,rhs) ->
+ BinaryAdd (__fff lhs) (__fff rhs) //TODO: this ought to be incorrect!
+ | SequenceExpr(elist) ->
+ IntLiteral(List.length elist)
+ | _ -> lenExpr
+ [__fff lst]
+
+ let BinaryInCombiner lhs rhs =
+ // distribute the "in" operation if possible
+ let rec __fff lhs rhs =
+ //Logger.TraceLine ("In fff for " + (PrintExpr 0 lhs) + " and " + (PrintExpr 0 rhs))
+ let binInExpr = BinaryIn lhs rhs
+// match rhs with
+// | BinaryExpr(_,"+",BinaryExpr(_,"+",SetExpr(_), Dot(_)), Dot(_)) -> Logger.Trace ""
+// | _ -> ()//TODO: remove
+
+ match rhs with
+ | BinaryExpr(_,"+",l,r) ->
+// let lhsVal = EvalFull heapInst lhs
+// let lVal = EvalFull heapInst l
+// let rVal = EvalFull heapInst r
+// match lVal,rVal with
+// | SequenceExpr(elist), _ | _, SequenceExpr(elist)
+// | SetExpr(elist), _ | _, SetExpr(elist) ->
+// if elist |> Utils.ListContains lhsVal then
+// __fff lhs l
+// else
+// __fff lhs r
+// | _ -> [binInExpr]
+///////////////////////////////
+// [BinaryOr (BinaryIn lhs l) (BinaryIn lhs r)]
+ let opt1 = BinaryIn lhs l
+ let opt2 = BinaryIn lhs r
+ match EvalFull heapInst opt1 with
+ | BoolLiteral(true) -> [opt1]
+ | _ -> match EvalFull heapInst opt2 with
+ | BoolLiteral(true) -> [opt2]
+ | _ -> Utils.ListCombine BinaryOr (__fff lhs l) (__fff lhs r)
+ //[BinaryOr (BinaryIn lhs l)(BinaryIn lhs r)]
+ | SequenceExpr(elist) ->
+ let len = elist |> List.length
+ if len = 0 then
+ [FalseLiteral]
+ elif len = 1 then
+ [BinaryEq lhs elist.[0]]
+ else
+ let lhsVal = EvalFull heapInst lhs
+ let lst0Val = EvalFull heapInst elist.[0]
+ if lhsVal = lst0Val then
+ [BinaryEq lhs elist.[0]]
+ else
+ __fff lhs (SequenceExpr(elist |> List.tail))
+ //[BinaryIn lhs (SequenceExpr(elist |> List.tail))]
+ | SetExpr(elist) ->
+ let evalElist = elist |> List.map (EvalFull heapInst)
+ let evalLhs = EvalFull heapInst lhs
+ try
+ let idx = evalElist |> List.findIndex (fun e -> e = evalLhs)
+ [BinaryEq lhs elist.[idx]]
+ with
+ | _ -> [binInExpr]
+ | _ -> [binInExpr]
+ __fff lhs rhs
+
+ let BinaryNotInCombiner lhs rhs =
+ // distribute the "!in" operation if possible
+ let rec __fff lhs rhs =
+ //Logger.TraceLine ("NotIn fff for " + (PrintExpr 0 lhs) + " and " + (PrintExpr 0 rhs))
+ let binNotInExpr = BinaryNotIn lhs rhs
+ match rhs with
+ | BinaryExpr(_,"+",l,r) ->
+// let lhsVal = EvalFull heapInst lhs
+// let lVal = EvalFull heapInst l
+// let rVal = EvalFull heapInst r
+// match lVal,rVal with
+// | SequenceExpr(elistL), SequenceExpr(elistR)
+// | SetExpr(elistL), SetExpr(elistR) ->
+// (__fff lhs l) @
+// (__fff lhs r)
+// | _ -> [binNotInExpr]
+ __fff lhs l @ __fff lhs r
+ | SequenceExpr(elist) ->
+ let len = elist |> List.length
+ if len = 0 then
+ [TrueLiteral]
+ elif len = 1 then
+ [BinaryNeq lhs elist.[0]]
+ else
+ let lhsVal = EvalFull heapInst lhs
+ let lst0Val = EvalFull heapInst elist.[0]
+ [BinaryNeq lhs elist.[0]] @
+ __fff lhs (SequenceExpr(elist |> List.tail))
+ //[BinaryNotIn lhs (SequenceExpr(elist |> List.tail))]
+ | _ -> [binNotInExpr]
+ __fff lhs rhs
+
+ let rec __CombineAllMatches expr premises =
+ //Logger.TraceLine ("Combining all matches for: " + (PrintExpr 0 expr))
+ let lst0 = FindMatches expr bogusExpr premises
+ let lstCombined =
+ match expr with
+ | BinaryExpr(p,op,lhs,rhs) ->
+ let lhsMatches = __CombineAllMatches lhs premises
+ let rhsMatches = __CombineAllMatches rhs premises
+ let lst1 = Utils.ListCombine (fun e1 e2 -> BinaryExpr(p,op,e1,e2)) lhsMatches rhsMatches
+ let lst2 =
+ if op = "in" then
+ Utils.ListCombineMult BinaryInCombiner lhsMatches rhsMatches
+ elif op = "!in" then
+ Utils.ListCombineMult BinaryNotInCombiner lhsMatches rhsMatches
+ else
+ []
+ lst1 @ lst2
+ | UnaryExpr(op,sub) ->
+ __CombineAllMatches sub premises |> List.map (fun e -> UnaryExpr(op,e))
+ | SelectExpr(lst,idx) ->
+ let lstMatches = __CombineAllMatches lst premises
+ let idxMatches = __CombineAllMatches idx premises
+ Utils.ListCombineMult SelectExprCombinerFunc lstMatches idxMatches
+ | SeqLength(lst) ->
+ __CombineAllMatches lst premises |> List.map SeqLenCombinerFunc |> List.concat
+ // TODO: other cases
+ | _ -> []
+ expr :: (lst0 @ lstCombined)
+
+ let rec __ExpandPremise expr premises =
+ let __AddToPremisses exprLst premises = exprLst |> List.fold (fun acc e -> MySetAdd e acc) premises
+ let allMatches = lazy(__CombineAllMatches expr premises)
+ match expr with
+ | BinaryExpr(p,op,lhs,rhs) when IsRelationalOp op ->
+ let x = allMatches.Force()
+ __AddToPremisses x premises
+ | SelectExpr(lst, idx) ->
+ let x = allMatches.Force()
+ __AddToPremisses x premises
+ | _ -> premises
+
+ let rec __Iter exprLst premises =
+ match exprLst with
+ | expr :: rest ->
+ let newPremises =
+ if expandExprFunc expr then
+ //Logger.TraceLine ("expanding " + (PrintExpr 0 expr))
+ __ExpandPremise expr premises
+ else
+ premises
+ __Iter rest newPremises
+ | [] -> premises
+
+ (* --- function body starts here --- *)
+ let iterOnceFunc p = __Iter (p |> Set.toList) p
+ // TODO: iterate only 3 times, instead of to full closure
+ let p1 = iterOnceFunc premises
+ let p2 = p1 |> iterOnceFunc
+ //let p3 = p2 |> iterOnceFunc
+ p2
+// let premises' = iterOnceFunc premises
+// if premises' = premises then
+// premises'
+// else
+// Logger.TraceLine "-------closure----------------"
+// //premises' |> Set.iter (fun e -> Logger.TraceLine (Printer.PrintExpr 0 e))
+// ComputeClosure heapInst expandExprFunc premises'
+
+
diff --git a/Source/Jennisys/Getters.fs b/Source/Jennisys/Getters.fs new file mode 100644 index 00000000..2e2732af --- /dev/null +++ b/Source/Jennisys/Getters.fs @@ -0,0 +1,284 @@ +module Getters
+
+open Ast
+
+let RenameToOld name =
+ "old_" + name
+
+let RenameFromOld (name: string) =
+ if name.StartsWith("old_") then
+ name.Substring(4)
+ else
+ name
+
+// --- search functions ---
+
+// ==================================
+/// Returns variable name
+// ==================================
+let GetVarName var =
+ match var with
+ | Var(name,_,_) -> name
+
+let GetExtVarName var =
+ match var with
+ | Var(id, _, false) -> id
+ | Var(id, _, true) -> RenameToOld id
+
+let IsOldVar var =
+ match var with
+ | Var(_,_,isOld) -> isOld
+
+// ==================================
+/// Returns variable type
+// ==================================
+let GetVarType var =
+ match var with
+ | Var(_,t,_) -> t
+
+// ===============================================
+/// Returns whether there exists a variable
+/// in a given VarDecl list with a given name (id)
+// ===============================================
+let IsInVarList varLst id =
+ varLst |> List.exists (fun var -> GetVarName var = id)
+
+
+// =========================================================
+/// Out of all "members" returns only those that are "Field"s
+// =========================================================
+let FilterFieldMembers members =
+ members |> List.choose (function Field(vd) -> Some(vd) | _ -> None)
+
+// =============================================================
+/// Out of all "members" returns only those that are constructors
+// =============================================================
+let FilterConstructorMembers members =
+ members |> List.choose (function Method(_,_,_,_, true) as m -> Some(m) | _ -> None)
+
+// =============================================================
+/// Out of all "members" returns only those that are
+/// constructors and have at least one input parameter
+// =============================================================
+let FilterConstructorMembersWithParams members =
+ members |> List.choose (function Method(_,Sig(ins,outs),_,_, true) as m when not (List.isEmpty ins) -> Some(m) | _ -> None)
+
+// ==========================================================
+/// Out of all "members" returns only those that are "Method"s
+// ==========================================================
+let FilterMethodMembers members =
+ members |> List.choose (function Method(_,_,_,_,_) as m -> Some(m) | _ -> None)
+
+// =======================================================================
+/// Returns all members of the program "prog" that pass the filter "filter"
+// =======================================================================
+let FilterMembers prog filter =
+ match prog with
+ | Program(components) ->
+ components |> List.fold (fun acc comp ->
+ match comp with
+ | Component(Interface(_,_,members),_,_) -> List.concat [acc ; members |> filter |> List.choose (fun m -> Some(comp, m))]
+ | _ -> acc) []
+
+let GetAbstractFields comp =
+ match comp with
+ | Component(Interface(_,_,members), _, _) -> FilterFieldMembers members
+ | _ -> failwithf "internal error: invalid component: %O" comp
+
+let GetConcreteFields comp =
+ match comp with
+ | Component(_, DataModel(_,_,cVars,_,_), _) -> cVars
+ | _ -> failwithf "internal error: invalid component: %O" comp
+
+// =================================
+/// Returns all fields of a component
+// =================================
+let GetAllFields comp =
+ List.concat [GetAbstractFields comp; GetConcreteFields comp]
+
+// ===========================================================
+/// Returns a map (Type |--> Set<Var>) where all
+/// the given fields are grouped by their type
+///
+/// ensures: forall v :: v in ret.values.elems ==> v in fields
+/// ensures: forall k :: k in ret.keys ==>
+/// forall v1, v2 :: v1, v2 in ret[k].elems ==>
+/// v1.type = v2.type
+// ===========================================================
+let rec GroupFieldsByType fields =
+ match fields with
+ | Var(name, ty, old) :: rest ->
+ let map = GroupFieldsByType rest
+ let fldSet = Map.tryFind ty map |> Utils.ExtractOptionOr Set.empty
+ map |> Map.add ty (fldSet |> Set.add (Var(name, ty, old)))
+ | [] -> Map.empty
+
+let IsConcreteField comp fldName = GetConcreteFields comp |> List.exists (fun var -> GetVarName var = fldName)
+let IsAbstractField comp fldName = GetAbstractFields comp |> List.exists (fun var -> GetVarName var = fldName)
+
+// =================================
+/// Returns class name of a component
+// =================================
+let GetClassName comp =
+ match comp with
+ | Component(Interface(name,_,_),_,_) -> name
+ | _ -> failwith ("unrecognized component: " + comp.ToString())
+
+let GetClassType comp =
+ match comp with
+ | Component(Interface(name,typeParams,_),_,_) -> NamedType(name, typeParams)
+ | _ -> failwith ("unrecognized component: " + comp.ToString())
+
+// ========================
+/// Returns name of a method
+// ========================
+let GetMethodName mthd =
+ match mthd with
+ | Method(name,_,_,_,_) -> name
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+// ===========================================================
+/// Returns full name of a method (= <class_name>.<method_name>
+// ===========================================================
+let GetMethodFullName comp mthd =
+ (GetClassName comp) + "." + (GetMethodName mthd)
+
+// =============================
+/// Returns signature of a method
+// =============================
+let GetMethodSig mthd =
+ match mthd with
+ | Method(_,sgn,_,_,_) -> sgn
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+// =========================================================
+/// Returns all arguments of a method (both input and output)
+// =========================================================
+let GetSigVars sign =
+ match sign with
+ | Sig(ins, outs) -> List.concat [ins; outs]
+
+let GetMethodInArgs mthd =
+ match mthd with
+ | Method(_,Sig(ins, _),_,_,_) -> ins
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+let GetMethodOutArgs mthd =
+ match mthd with
+ | Method(_,Sig(_, outs),_,_,_) -> outs
+ | _ -> failwith ("not a method: " + mthd.ToString())
+
+let GetMethodArgs mthd =
+ let ins = GetMethodInArgs mthd
+ let outs = GetMethodOutArgs mthd
+ List.concat [ins; outs]
+
+let IsConstructor mthd =
+ match mthd with
+ | Method(_,_,_,_,isConstr) -> isConstr
+ | _ -> failwithf "expected a method but got %O" mthd
+
+let rec GetTypeShortName ty =
+ match ty with
+ | IntType -> "int"
+ | BoolType -> "bool"
+ | SetType(_) -> "set"
+ | SeqType(_) -> "seq"
+ | NamedType(n,_) | InstantiatedType(n,_) -> n
+
+// ==================================
+/// Returns component name
+// ==================================
+let GetComponentName comp =
+ match comp with
+ | Component(Interface(name,_,_),_,_) -> name
+ | _ -> failwithf "invalid component %O" comp
+
+let GetComponentTypeParameters comp =
+ match comp with
+ | Component(Interface(_,tp,_),_,_) -> tp
+ | _ -> failwithf "invalid component %O" comp
+
+
+// ==================================
+/// Returns all members of a component
+// ==================================
+let GetMembers comp =
+ match comp with
+ | Component(Interface(_,_,members),_,_) -> members
+ | _ -> failwith ("unrecognized component: " + comp.ToString())
+
+// ====================================================
+/// Finds a component of a program that has a given name
+// ====================================================
+let FindComponent (prog: Program) clsName =
+ match prog with
+ | Program(comps) -> comps |> List.filter (function Component(Interface(name,_,_),_,_) when name = clsName -> true | _ -> false)
+ |> Utils.ListToOption
+
+let FindComponentForType prog ty =
+ FindComponent prog (GetTypeShortName ty)
+
+let FindComponentForTypeOpt prog tyOpt =
+ match tyOpt with
+ | Some(ty) -> FindComponentForType prog ty
+ | None -> None
+
+let CheckSameCompType comp ty =
+ GetComponentName comp = GetTypeShortName ty
+
+let GetComponentType comp =
+ NamedType(GetComponentName comp, GetComponentTypeParameters comp)
+
+// ===================================================
+/// Finds a method of a component that has a given name
+// ===================================================
+let FindMethod comp methodName =
+ let x = GetMembers comp
+ let y = x |> FilterMethodMembers
+ let z = y |> List.filter (function Method(name,_,_,_,_) when name = methodName -> true | _ -> false)
+ GetMembers comp |> FilterMethodMembers |> List.filter (function Method(name,_,_,_,_) when name = methodName -> true | _ -> false)
+ |> Utils.ListToOption
+
+// ==============================================
+/// Finds a field of a class that has a given name
+// ==============================================
+//let FindCompVar prog clsName fldName =
+// let copt = FindComponent prog clsName
+// match copt with
+// | Some(comp) ->
+// GetAllFields comp |> List.filter (function Var(name,_) when name = fldName -> true | _ -> false)
+// |> Utils.ListToOption
+// | None -> None
+
+let FindVar comp fldName =
+ GetAllFields comp |> List.filter (fun var -> GetVarName var = fldName)
+ |> Utils.ListToOption
+
+// ======================================
+/// Returns the frame of a given component
+// ======================================
+let GetFrame comp =
+ match comp with
+ | Component(_, DataModel(_,_,_,frame,_), _) -> frame
+ | _ -> failwithf "not a valid component %O" comp
+
+let GetFrameFields comp =
+ let frame = GetFrame comp
+ frame |> List.choose (function IdLiteral(name) -> Some(name) | _ -> None) // TODO: is it really enough to handle only IdLiteral's
+ |> List.choose (fun varName ->
+ let v = FindVar comp varName
+ Utils.ExtractOptionMsg ("field not found: " + varName) v |> ignore
+ v
+ )
+
+// ==============================================
+/// Checks whether two given methods are the same.
+///
+/// Methods are the same if their names are the
+/// same and their components have the same name.
+// ==============================================
+let CheckSameMethods (c1,m1) (c2,m2) =
+ GetComponentName c1 = GetComponentName c2 && GetMethodName m1 = GetMethodName m2
+
+////////////////////////
\ No newline at end of file diff --git a/Source/Jennisys/Jennisys.fs b/Source/Jennisys/Jennisys.fs new file mode 100644 index 00000000..b10c9cfc --- /dev/null +++ b/Source/Jennisys/Jennisys.fs @@ -0,0 +1,72 @@ +// This project type requires the F# PowerPack at http://fsharppowerpack.codeplex.com/releases +// Learn more about F# at http://fsharp.net +// Original project template by Jomo Fisher based on work of Brian McNamara, Don Syme and Matt Valerio +// This posting is provided "AS IS" with no warranties, and confers no rights. +module Main + +open System +open System.IO +open Microsoft.FSharp.Text.Lexing + +open Ast +open AstUtils +open Lexer +open Options +open Parser +open Printer +open TypeChecker +open Analyzer + +let readAndProcess (filename: string) = + printfn "// Jennisys, Copyright (c) 2011, Microsoft." + // lex + let f = if filename = null then Console.In else new StreamReader(filename) :> TextReader + let lexbuf = LexBuffer<char>.FromTextReader(f) + lexbuf.EndPos <- { pos_bol = 0; + pos_fname=if filename = null then "stdin" else filename; + pos_cnum=0; + pos_lnum=1 } + + let sprog = + try + // parse + Parser.start Lexer.tokenize lexbuf + with + | ex -> + let pos = lexbuf.EndPos + printfn " [PARSE ERROR]: %s(%d,%d): %s" pos.FileName pos.Line pos.Column ex.Message + Environment.Exit(1) + failwith "" + match TypeCheck sprog with + | None -> () // errors have already been reported + | Some(prog) -> + Analyze prog filename + + +try + let args = Environment.GetCommandLineArgs() + ParseCmdLineArgs (List.ofArray args |> List.tail) + if CONFIG.breakIntoDebugger then ignore (System.Diagnostics.Debugger.Launch()) else () + if CONFIG.help then + printfn "%s" PrintHelpMsg + else + if CONFIG.inputFilename = "" then + printfn "*** Error: No input file was specified." + else + readAndProcess CONFIG.inputFilename +with + | InvalidCmdLineOption(msg) + | InvalidCmdLineArg(msg) as ex -> + printfn " [ERROR] %s" msg; + printfn "%s" PrintHelpMsg + | EvalFailed(msg) as ex -> + printfn " [EVALUATION ERROR] %s" msg + printfn "%O" ex.StackTrace + +//let mc = MethodOutSelect (MethodCall(IdLiteral("left"),"SetNode","Find",[VarLiteral("n")]), "ret") +//let expr = BinaryOr (BinaryOr (BinaryEq (VarLiteral("a")) (VarLiteral("b"))) mc) (mc) +//printfn "%s" (PrintExpr 0 expr) +//printfn "" +// +//let stmt = ExprStmt(expr) +//printfn "%s" (DafnyPrinter.PrintStmt stmt 0 false)
\ No newline at end of file diff --git a/Source/Jennisys/Jennisys.fsproj b/Source/Jennisys/Jennisys.fsproj new file mode 100644 index 00000000..d3493749 --- /dev/null +++ b/Source/Jennisys/Jennisys.fsproj @@ -0,0 +1,118 @@ +<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
+ <ProductVersion>8.0.30703</ProductVersion>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>{f2ff4b3a-2fe8-474a-88df-6950f7d78908}</ProjectGuid>
+ <OutputType>Exe</OutputType>
+ <RootNamespace>Language</RootNamespace>
+ <AssemblyName>Jennisys</AssemblyName>
+ <TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
+ <TargetFrameworkProfile>Client</TargetFrameworkProfile>
+ <Name>Language</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>bin\Debug\Language.XML</DocumentationFile>
+ <StartArguments>examples/oopsla12/IntSet.jen /method:IntSet.Singleton</StartArguments>
+ <StartWorkingDirectory>C:\boogie\Jennisys\Jennisys\</StartWorkingDirectory>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>bin\Release\Language.XML</DocumentationFile>
+ </PropertyGroup>
+ <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" />
+ <Import Project="$(MSBuildExtensionsPath32)\..\FSharpPowerPack-2.0.0.0\bin\FSharp.PowerPack.targets" />
+ <PropertyGroup>
+ <FsLexOutputFolder>$(IntermediateOutputPath)</FsLexOutputFolder>
+ <FsYaccOutputFolder>$(IntermediateOutputPath)</FsYaccOutputFolder>
+ </PropertyGroup>
+ <ItemGroup>
+ <Compile Include="SymGen.fs" />
+ <Compile Include="Logger.fs" />
+ <Compile Include="Utils.fs" />
+ <Compile Include="Options.fs" />
+ <Compile Include="PipelineUtils.fs" />
+ <Compile Include="Ast.fs" />
+ <Compile Include="Getters.fs" />
+ <Compile Include="AstUtils.fs" />
+ <Compile Include="$(IntermediateOutputPath)\Parser.fs">
+ <Visible>false</Visible>
+ <Link>Parser.fs</Link>
+ </Compile>
+ <Compile Include="$(IntermediateOutputPath)\Lexer.fs">
+ <Visible>false</Visible>
+ <Link>Lexer.fs</Link>
+ </Compile>
+ <Compile Include="DafnyModelUtils.fs" />
+ <Compile Include="EnvUtils.fs" />
+ <FsYacc Include="Parser.fsy">
+ <OtherFlags>--module Parser</OtherFlags>
+ </FsYacc>
+ <FsLex Include="Lexer.fsl">
+ <OtherFlags>--unicode</OtherFlags>
+ </FsLex>
+ <Compile Include="PrintUtils.fs" />
+ <Compile Include="Printer.fs" />
+ <Compile Include="DafnyPrinter.fs" />
+ <Compile Include="TypeChecker.fs" />
+ <Compile Include="Resolver.fs" />
+ <Compile Include="FixpointSolver.fs" />
+ <Compile Include="MethodUnifier.fs" />
+ <Compile Include="Modularizer.fs" />
+ <Compile Include="CodeGen.fs" />
+ <Compile Include="Analyzer.fs" />
+ <Compile Include="Jennisys.fs" />
+ </ItemGroup>
+ <ItemGroup>
+ <Reference Include="Boogie">
+ <HintPath>..\..\Binaries\Boogie.exe</HintPath>
+ </Reference>
+ <Reference Include="FSharp.PowerPack">
+ <HintPath>C:\Program Files\FSharpPowerPack-1.9.9.9\bin\FSharp.PowerPack.dll</HintPath>
+ </Reference>
+ <Reference Include="mscorlib" />
+ <Reference Include="FSharp.Core" />
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Numerics" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="..\..\Source\Model\Model.csproj">
+ <Name>Model</Name>
+ <Project>{acef88d5-dadd-46da-bae1-2144d63f4c83}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ </ItemGroup>
+ <!--
+ <ItemGroup>
+ <ProjectReference Include="..\..\Source\Model\Model.csproj">
+ <Name>Model</Name>
+ <Project>{acef88d5-dadd-46da-bae1-2144d63f4c83}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ </ItemGroup>
+ -->
+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+ Other similar extension points exist, see Microsoft.Common.targets.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
\ No newline at end of file diff --git a/Source/Jennisys/Lexer.fsl b/Source/Jennisys/Lexer.fsl new file mode 100644 index 00000000..e1d4795b --- /dev/null +++ b/Source/Jennisys/Lexer.fsl @@ -0,0 +1,83 @@ +{
+module Lexer
+open System
+open Parser
+open Microsoft.FSharp.Text.Lexing
+
+let lexeme lexbuf =
+ LexBuffer<char>.LexemeString lexbuf
+}
+
+// These are some regular expression definitions
+let digit = ['0'-'9']
+let nondigit = [ 'a'-'z' 'A'-'Z' '_' ]
+let idchar = (nondigit | digit)
+let whitespace = [' ' '\t' ]
+let newline = ('\n' | '\r' '\n')
+
+rule tokenize = parse
+| whitespace { tokenize lexbuf }
+| newline { lexbuf.EndPos <- lexbuf.EndPos.NextLine; tokenize lexbuf }
+// TODO: | "//"[-newline]* { tokenize lexbuf }
+// keywords
+| "interface" { INTERFACE }
+| "datamodel" { DATAMODEL }
+| "code" { CODE }
+| "var" { VAR }
+| "constructor" { CONSTRUCTOR }
+| "method" { METHOD }
+| "frame" { FRAME }
+| "invariant" { INVARIANT }
+| "returns" { RETURNS }
+| "requires" { REQUIRES }
+| "ensures" { ENSURES }
+| "forall" { FORALL }
+// Types
+| "int" { INTTYPE }
+| "bool" { BOOLTYPE }
+| "seq" { SEQTYPE }
+| "set" { SETTYPE }
+// Operators
+| "..." { DOTDOTDOT }
+| ".." { DOTDOT }
+| "." { DOT }
+| "old" { OLD }
+| "+" { PLUS }
+| "-" { MINUS }
+| "*" { STAR }
+| "div" { DIV }
+| "mod" { MOD }
+| "&&" { AND }
+| "||" { OR }
+| "!" { NOT }
+| "==>" { IMPLIES }
+| "<==>" { IFF }
+| "<" { LESS }
+| "<=" { ATMOST }
+| "=" { EQ }
+| "!=" { NEQ }
+| ">=" { ATLEAST }
+| ">" { GREATER }
+| "in" { IN }
+| "!in" { NOTIN }
+// Misc
+| ":=" { GETS }
+| "(" { LPAREN }
+| ")" { RPAREN }
+| "[" { LBRACKET }
+| "]" { RBRACKET }
+| "{" { LCURLY }
+| "}" { RCURLY }
+| "|" { VERTBAR }
+| ":" { COLON }
+| "::" { COLONCOLON }
+| "," { COMMA }
+| "?" { QMARK }
+// Numberic constants
+| digit+ { INTEGER (System.Convert.ToInt32(lexeme lexbuf)) }
+// identifiers
+| idchar+ { ID (LexBuffer<char>.LexemeString lexbuf) }
+// EOF
+| eof { EOF }
+| _ { printfn "Unrecognized input character: %s" (lexeme lexbuf) ; EOF }
+
diff --git a/Source/Jennisys/Logger.fs b/Source/Jennisys/Logger.fs new file mode 100644 index 00000000..dbf762cd --- /dev/null +++ b/Source/Jennisys/Logger.fs @@ -0,0 +1,41 @@ +// #######################################################
+/// Simple logging facility
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// #######################################################
+
+module Logger
+
+let newline = System.Environment.NewLine
+
+let _ALL = 100
+let _TRACE = 90
+let _DEBUG = 70
+let _INFO = 50
+let _WARN = 40
+let _ERROR = 20
+let _NONE = 0
+
+let logLevel = _ALL
+
+let Log level msg =
+ if logLevel >= level then
+ printf "%s" msg
+
+let LogLine level msg =
+ Log level (msg + newline)
+
+let Trace msg = Log _TRACE msg
+let TraceLine msg = LogLine _TRACE msg
+
+let Debug msg = Log _DEBUG msg
+let DebugLine msg = LogLine _DEBUG msg
+
+let Info msg = Log _INFO msg
+let InfoLine msg = LogLine _INFO msg
+
+let Warn msg = Log _WARN msg
+let WarnLine msg = LogLine _WARN msg
+
+let Error msg = Log _ERROR msg
+let ErrorLine msg = LogLine _ERROR msg
\ No newline at end of file diff --git a/Source/Jennisys/MethodUnifier.fs b/Source/Jennisys/MethodUnifier.fs new file mode 100644 index 00000000..d2b1db68 --- /dev/null +++ b/Source/Jennisys/MethodUnifier.fs @@ -0,0 +1,107 @@ +module MethodUnifier
+
+open Ast
+open Getters
+open AstUtils
+open FixpointSolver
+open PrintUtils
+open Resolver
+open Utils
+
+let TryUnify targetMthd candMethod =
+ let targetPre,targetPost = GetMethodPrePost targetMthd
+ let targetPre = BinaryAnd targetPre (GetMethodGhostPrecondition targetMthd)
+ let candPre,candPost = GetMethodPrePost candMethod
+ let candPre = BinaryAnd candPre (GetMethodGhostPrecondition candMethod)
+ let builder = new CascadingBuilder<_>(None)
+ builder {
+ let! unifs1 = UnifyImplies targetPre candPre RTL Map.empty
+ let! unifs2 = UnifyImplies candPost targetPost LTR unifs1
+ return Some(unifs2)
+ }
+
+let rec TryFindAMatch targetMthd candidateMethods =
+ let targetMthdName = GetMethodName targetMthd
+ match candidateMethods with
+ | candMthd :: rest ->
+ if GetMethodName candMthd = targetMthdName then
+ // skip if it is the same method
+ TryFindAMatch targetMthd rest
+ else
+ match TryUnify targetMthd candMthd with
+ | Some(unifs) -> Some(candMthd,unifs)
+ | None -> TryFindAMatch targetMthd rest
+ | [] -> None
+
+let TryFindExistingOpt comp targetMthd =
+ TryFindAMatch targetMthd (GetMembers comp |> FilterMethodMembers)
+
+let TryFindExisting comp targetMthd =
+ match TryFindAMatch targetMthd (GetMembers comp |> FilterMethodMembers) with
+ | Some(m,unifs) -> m,unifs
+ | None -> targetMthd, Map.empty
+
+let ApplyMethodUnifs receiver (c,m) unifs =
+ let __Apply args = args |> List.map (fun var ->
+ let name = GetExtVarName var
+ match Map.tryFind name unifs with
+ | Some(e) -> e
+ | None -> VarLiteral(name))
+ let ins = GetMethodInArgs m |> __Apply
+ let outs = GetMethodOutArgs m |> __Apply
+
+ let retVars, asgs = outs |> List.fold (fun (acc1,acc2) e ->
+ let vname = SymGen.NewSymFake e
+ let v = Var(vname, None, false)
+ let acc1' = acc1 @ [v]
+ let acc2' = acc2 @ [ArbitraryStatement(Assign(VarLiteral(vname), e))]
+ acc1', acc2'
+ ) ([],[])
+ let mcallExpr = MethodCall(receiver, GetComponentName c, GetMethodName m, ins)
+ match retVars, outs with
+ | [], [] -> [ArbitraryStatement(ExprStmt(mcallExpr))]
+ | [_], [VarLiteral(vn2)] -> [ArbitraryStatement(Assign(VarDeclExpr([Var(vn2, None, false)], false), mcallExpr))]
+ | _ ->
+ let mcall = ArbitraryStatement(Assign(VarDeclExpr(retVars, true), mcallExpr))
+ mcall :: asgs
+
+// ====================================================
+///
+// ====================================================
+let TryFindExistingAndConvertToSolution indent comp m cond callGraph =
+ let __Calls caller callee =
+ let keyOpt = callGraph |> Map.tryFindKey (fun (cc,mm) mset -> CheckSameMethods (comp,caller) (cc,mm))
+ match keyOpt with
+ | Some(k) -> callGraph |> Map.find k |> Set.contains ((GetComponentName comp),(GetMethodName callee))
+ | None -> false
+ (* --- function body starts here --- *)
+ if not Options.CONFIG.genMod then
+ None
+ else
+ let idt = Indent indent
+ let candidateMethods = GetMembers comp |> List.filter (fun cm ->
+ match cm with
+ | Method(mname,_,_,_,_) when not (__Calls cm m) -> true
+ | _ -> false)
+ match TryFindAMatch m candidateMethods with
+ | Some(m',unifs) ->
+ Logger.InfoLine (idt + " - substitution method found:")
+ Logger.InfoLine (Printer.PrintMethodSignFull (indent+6) comp m')
+ Logger.DebugLine (idt + " Unifications: ")
+ let idtt = idt + " "
+ unifs |> Map.fold (fun acc k v -> acc + (sprintf "%s%s -> %s%s" idtt k (Printer.PrintExpr 0 v) newline)) "" |> Logger.Debug
+ let obj = { name = "this"; objType = GetClassType comp }
+ let modObjs = if IsModifiableObj obj (comp,m) then Set.singleton obj else Set.empty
+ let body = ApplyMethodUnifs ThisLiteral (comp,m') unifs
+ let hInst = { objs = Utils.MapSingleton obj.name obj;
+ modifiableObjs = modObjs;
+ assignments = body;
+ concreteValues = body;
+ methodArgs = Map.empty;
+ methodRetVals = Map.empty;
+ concreteMethodRetVals = Map.empty;
+ globals = Map.empty }
+ Some(Map.empty |> Map.add (comp,m) [cond, hInst]
+ |> Map.add (comp,m') [])
+ | None -> None
+
diff --git a/Source/Jennisys/Modularizer.fs b/Source/Jennisys/Modularizer.fs new file mode 100644 index 00000000..f5d7e7b7 --- /dev/null +++ b/Source/Jennisys/Modularizer.fs @@ -0,0 +1,206 @@ +module Modularizer
+
+open Ast
+open Getters
+open AstUtils
+open MethodUnifier
+open PrintUtils
+open Resolver
+open Utils
+
+// =======================================================================
+/// Merges two solution maps so that if there are multiple entries for a
+/// single (comp,method) pair it concatenates them (corresponds to multiple
+/// branches).
+// =======================================================================
+let MergeSolutions sol1 sol2 =
+ let rec __Merge sol1map sol2lst res =
+ match sol2lst with
+ | ((c2,m2), lst2) :: rest ->
+ match sol1map |> Map.tryFindKey (fun (c1,m1) lst1 -> CheckSameMethods (c1,m1) (c2,m2)) with
+ | Some(c1,m1) ->
+ let lst1 = sol1map |> Map.find(c1,m1)
+ let newRes = res |> Map.add (c1,m1) (lst1@lst2)
+ __Merge sol1map rest newRes
+ | None ->
+ let newRes = res |> Map.add (c2,m2) lst2
+ __Merge sol1map rest newRes
+ | [] -> res
+ (* --- function body starts here --- *)
+ __Merge sol1 (sol2 |> Map.toList) sol1
+
+// ===========================================
+///
+// ===========================================
+let rec MakeModular indent prog comp meth cond hInst callGraph =
+ let directChildren = lazy (GetDirectModifiableChildren hInst)
+
+ let __IsAbstractField ty var =
+ let builder = CascadingBuilder<_>(false)
+ let varName = GetVarName var
+ builder {
+ let! comp = FindComponent prog (GetTypeShortName ty)
+ let! fld = GetAbstractFields comp |> List.fold (fun acc v -> if GetVarName v = varName then Some(varName) else acc) None
+ return true
+ }
+
+ let __FindObj objName =
+ try
+ //hInst.assignments |> List.find (fun ((obj,_),_) -> obj.name = objName) |> fst |> fst
+ hInst.assignments |> List.choose (function FieldAssignment((obj,_),_) ->
+ if (obj.name = objName) then Some(obj) else None
+ | _ -> None)
+ |> List.head
+ with
+ | ex -> failwithf "obj %s not found for method %s" objName (GetMethodFullName comp meth)
+
+ let __GetObjLitType objLitName =
+ (__FindObj objLitName).objType
+
+ // ===============================================================================
+ /// Goes through the assignments of the heapInstance and returns only those
+ /// assignments that correspond to abstract fields of the given "objLitName" object
+ // ===============================================================================
+ let __GetAbsFldAssignments objLitName =
+ hInst.assignments |> List.choose (function
+ FieldAssignment ((obj,var),e) ->
+ if obj.name = objLitName && __IsAbstractField obj.objType var then
+ Some(var,e)
+ else
+ None
+ | _ -> None)
+
+ // ===============================================================================
+ /// The given assignment is:
+ /// x := e
+ ///
+ /// If e is an object (e.g. gensym32) with e.g. two abstract fields "a" and "b",
+ /// with values 3 and 8 respectively, then the "x := e" spec is fixed as following:
+ /// x.a := 3 && x.b := 8
+ ///
+ /// List values are handled similarly, e.g.:
+ /// x := [gensym32]
+ /// is translated into
+ /// |x| = 1 && x[0].a = 3 && x[0].b = 8
+ // ===============================================================================
+ let rec __ExamineAndFix x e =
+ match e with
+ | ObjLiteral(id) when not (Utils.ListContains e (directChildren.Force())) -> //TODO: is it really only non-direct children?
+ let absFlds = __GetAbsFldAssignments id
+ absFlds |> List.fold (fun acc (var,vval) -> BinaryAnd acc (BinaryEq (Dot(x, GetVarName var)) vval)) TrueLiteral
+ | SequenceExpr(elist) ->
+ let rec __fff lst acc cnt =
+ match lst with
+ | fsExpr :: rest ->
+ let acc = BinaryAnd acc (__ExamineAndFix (SelectExpr(x, IntLiteral(cnt))) fsExpr)
+ __fff rest acc (cnt+1)
+ | [] ->
+ let lenExpr = BinaryEq (SeqLength(x)) (IntLiteral(cnt))
+ BinaryAnd lenExpr acc
+ __fff elist TrueLiteral 0
+ | _ -> BinaryEq x e
+
+ // ================================================================================
+ /// The spec for an object consists of assignments to its abstract fields with one
+ /// caveat: if some assignments include non-direct children objects of "this", then
+ /// those objects cannot be used directly in the spec; instead, their properties must
+ /// be expanded and embeded (that's what the "ExamineAndFix" function does)
+ // ================================================================================
+ let __GetSpecFor objLitName =
+ let absFieldAssignments = __GetAbsFldAssignments objLitName
+ let absFldAssgnExpr = absFieldAssignments |> List.fold (fun acc (var,e) -> BinaryAnd acc (__ExamineAndFix (IdLiteral(GetVarName var)) e)) TrueLiteral
+ let retValExpr = hInst.methodRetVals |> Map.fold (fun acc varName varValueExpr -> BinaryAnd acc (BinaryEq (VarLiteral(varName)) varValueExpr)) TrueLiteral
+ BinaryAnd absFldAssgnExpr retValExpr
+
+ // ================================================================================================
+ /// Simply traverses a given expression and returns all arguments of the "meth" method that are used
+ // ================================================================================================
+ let __GetArgsUsed expr =
+ let args = GetMethodArgs meth
+ let argSet = DescendExpr2 (fun e acc ->
+ match e with
+ | VarLiteral(vname) ->
+ match args |> List.tryFind (fun var -> GetVarName var = vname) with
+ | Some(var) -> acc |> Set.add var
+ | None -> acc
+ | _ -> acc
+ ) expr Set.empty
+ argSet |> Set.toList
+
+ let rec __GetDelegateMethods objs acc =
+ match objs with
+ | ObjLiteral(name) as obj :: rest ->
+ let mName = sprintf "_synth_%s_%s" (GetMethodFullName comp meth |> String.map (fun c -> if c = '.' then '_' else c)) name
+ let pre,_ = GetMethodPrePost meth //TrueLiteral
+ let post = __GetSpecFor name
+ let ins = __GetArgsUsed (BinaryAnd pre post)
+ let sgn = Sig(ins, [])
+ let m = Method(mName, sgn, pre, post, true)
+ let c = FindComponent prog (name |> __GetObjLitType |> GetTypeShortName) |> Utils.ExtractOption
+ let m',unifs = TryFindExisting c m
+ let args = ApplyMethodUnifs obj (c,m') unifs
+ __GetDelegateMethods rest (acc |> Map.add obj (c,m',args))
+ | _ :: rest -> failwith "internal error: expected to see only ObjLiterals"
+ | [] -> acc
+
+ // =======================================================================
+ /// Tries to make a given solution for a given method into more modular,
+ /// by delegating some statements (initialization of inner objects) to
+ /// method calls.
+ // =======================================================================
+ let __GetModularBranch =
+ let delegateMethods = __GetDelegateMethods (directChildren.Force()) Map.empty
+ let initChildrenExprList = delegateMethods |> Map.toList
+ |> List.map (fun (_, (_,_,asgs)) -> asgs)
+ |> List.concat
+ let newAssgns = hInst.assignments |> List.filter (function FieldAssignment((obj,_),_) -> obj.name = "this" | _ -> false)
+ let newMethodsLst = delegateMethods |> Map.fold (fun acc receiver (c,newMthd,_) ->
+ (c,newMthd) :: acc
+ ) []
+ newMethodsLst, { hInst with assignments = initChildrenExprList @ newAssgns }
+
+ (* --- function body starts here --- *)
+ let idt = Indent indent
+ if Options.CONFIG.genMod then
+ Logger.InfoLine (idt + " - delegating to method calls ...")
+ // first try to find a match for the entire method (based on the given solution)
+ let postSpec = __GetSpecFor "this"
+ let meth' = match meth with
+ | Method (mname, msig, mpre, _, isConstr) -> Method(mname, msig, mpre, postSpec, isConstr)
+ | _ -> failwithf "internal error: expected a Method but got %O" meth
+ match TryFindExistingAndConvertToSolution indent comp meth' cond callGraph with
+ | Some(sol) -> sol |> FixSolution comp meth
+ | None ->
+ // if not found, try to split into parts
+ let newMthdLst, newHeapInst = __GetModularBranch
+ let msol = Utils.MapSingleton (comp,meth) [cond, newHeapInst]
+ newMthdLst |> List.fold (fun acc (c,m) ->
+ acc |> MergeSolutions (Utils.MapSingleton (c,m) [])
+ ) msol
+ else
+ Utils.MapSingleton (comp,meth) [cond, hInst]
+
+//let GetModularSol prog sol =
+// let comp = fst (fst sol)
+// let meth = snd (fst sol)
+// let rec __xxx prog lst =
+// match lst with
+// | (cond, hInst) :: rest ->
+// let newProg, newComp, newMthdLst, newhInst = GetModularBranch prog comp meth hInst
+// let newProg, newRest = __xxx newProg rest
+// newProg, ((cond, newhInst) :: newRest)
+// | [] -> prog, []
+// let newProg, newSolutions = __xxx prog (snd sol)
+// let newComp = FindComponent newProg (GetComponentName comp) |> Utils.ExtractOption
+// newProg, ((newComp, meth), newSolutions)
+//
+//let Modularize prog solutions =
+// let rec __Modularize prog sols acc =
+// match sols with
+// | sol :: rest ->
+// let (newProg, newSol) = GetModularSol prog sol
+// let newAcc = acc |> Map.add (fst newSol) (snd newSol)
+// __Modularize newProg rest newAcc
+// | [] -> (prog, acc)
+// (* --- function body starts here --- *)
+// __Modularize prog (Map.toList solutions) Map.empty
diff --git a/Source/Jennisys/Options.fs b/Source/Jennisys/Options.fs new file mode 100644 index 00000000..fe640f48 --- /dev/null +++ b/Source/Jennisys/Options.fs @@ -0,0 +1,162 @@ +// ####################################################################
+/// This module is intended to store and handle configuration options
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+module Options
+
+open Utils
+
+type Config = {
+ help : bool;
+ inputFilename : string;
+ methodToSynth : string;
+ constructorsOnly : bool;
+ inferConditionals : bool;
+ verifyPartialSolutions : bool;
+ verifySolutions : bool;
+ checkUnifications : bool;
+ genRepr : bool;
+ genMod : bool;
+ timeout : int;
+ numLoopUnrolls : int;
+ recursiveValid : bool;
+ breakIntoDebugger : bool;
+ minimizeGuards : bool;
+}
+
+type CfgOption<'a> = {
+ optionName: string;
+ optionType: string;
+ optionSetter: 'a -> Config -> Config;
+ descr: string;
+}
+
+exception InvalidCmdLineArg of string
+exception InvalidCmdLineOption of string
+
+let CheckNonEmpty value optName =
+ if value = "" then raise (InvalidCmdLineArg("A value for option " + optName + " must not be empty")) else value
+
+let CheckInt value optName =
+ try
+ System.Int32.Parse value
+ with
+ | ex -> raise (InvalidCmdLineArg("A value for option " + optName + " must be a boolean"))
+
+let CheckBool value optName =
+ if value = "" then
+ true
+ else
+ try
+ System.Boolean.Parse value
+ with
+ | ex -> raise (InvalidCmdLineArg("A value for option " + optName + " must be an integer"))
+
+let cfgOptions = [
+ { optionName = "help"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with help = CheckBool v "help"}); descr = "prints out the available switches"; }
+ { optionName = "method"; optionType = "string"; optionSetter = (fun v (cfg: Config) -> {cfg with methodToSynth = CheckNonEmpty v "method"}); descr = "select methods to synthesize; method names are in the form <ClassName>.<MethodName>; multiple methods can be given as a list of comma separated values"; }
+ { optionName = "constrOnly"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with constructorsOnly = CheckBool v "constrOnly"}); descr = "synthesize constructors only"; }
+ { optionName = "inferConds"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with inferConditionals = CheckBool v "inferConds"}); descr = "try to infer conditions"; }
+ { optionName = "noInferConds"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with inferConditionals = not (CheckBool v "inferConds")}); descr = "don't try to infer conditions"; }
+ { optionName = "verifyParSol"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with verifyPartialSolutions = CheckBool v "verifyParSol"}); descr = "verify partial solutions"; }
+ { optionName = "noVerifyParSol"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with verifyPartialSolutions = not (CheckBool v "verifyParSol")}); descr = "don't verify partial solutions"; }
+ { optionName = "verifySol"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with verifySolutions = CheckBool v "verifySol"}); descr = "verify final solution"; }
+ { optionName = "noVerifySol"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with verifySolutions = not (CheckBool v "verifySol")}); descr = "don't verify final solution"; }
+ { optionName = "checkUnifs"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with checkUnifications = CheckBool v "checkUnifs"}); descr = "verify unifications"; }
+ { optionName = "noCheckUnifs"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with checkUnifications = not (CheckBool v "noCheckUnifs")}); descr = "don't verify unifications"; }
+ { optionName = "genRepr"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with genRepr = CheckBool v "genRepr"}); descr = "generate Repr field"; }
+ { optionName = "noGenRepr"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with genRepr = not (CheckBool v "noGenRepr")}); descr = "don't generate Repr field"; }
+ { optionName = "genMod"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with genMod = CheckBool v "genMod"}); descr = "generate modular code (delegate to methods)"; }
+ { optionName = "noGenMod"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with genMod = not (CheckBool v "noGenMod")}); descr = "dont generate modular code (delegate to methods)"; }
+ { optionName = "timeout"; optionType = "int"; optionSetter = (fun v (cfg: Config) -> {cfg with timeout = CheckInt v "timeout"}); descr = "timeout"; }
+ { optionName = "unrolls"; optionType = "int"; optionSetter = (fun v (cfg: Config) -> {cfg with numLoopUnrolls = CheckInt v "unrolls"}); descr = "number of unrolls of the Valid() function"; }
+ { optionName = "recValid"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with recursiveValid = CheckBool v "recValid"}); descr = "generate recursive Valid() function"; }
+ { optionName = "noRecValid"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with recursiveValid = not (CheckBool v "noRecValid")}); descr = "unroll Valid() function"; }
+ { optionName = "break"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with breakIntoDebugger = CheckBool v "break"}); descr = "launches debugger upon start-up"; }
+ { optionName = "minGuards"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with minimizeGuards = CheckBool v "minGuards"}); descr = "tries to remove unnecessary clauses from the inferred guards"; }
+ { optionName = "noMinGuards"; optionType = "bool"; optionSetter = (fun v (cfg: Config) -> {cfg with minimizeGuards = not (CheckBool v "noMinGuards")}); descr = "don't minimize guards"; }
+]
+
+let cfgOptMap = cfgOptions |> List.fold (fun acc o -> acc |> Map.add o.optionName o) Map.empty
+
+let newline = System.Environment.NewLine
+
+let PrintHelpMsg =
+ let maxw = cfgOptions |> List.fold (fun acc o -> if String.length o.optionName > acc then String.length o.optionName else acc) 0
+ let maxwStr = sprintf "%d" (maxw + 2)
+ let strf = new Printf.StringFormat<_>(" %-" + maxwStr + "s: %-6s | %s")
+ let rec __PrintHelp optLst =
+ match optLst with
+ | fs :: [] -> (sprintf strf fs.optionName fs.optionType fs.descr)
+ | fs :: rest -> (sprintf strf fs.optionName fs.optionType fs.descr) + newline + (__PrintHelp rest)
+ | [] -> ""
+ (* --- function body starts here --- *)
+ newline +
+ "Jennisys usage: Jennisys [ option ... ] filename" + newline +
+ " where <option> is one of " + newline + newline +
+ " ----- General options -----------------------------------------------------" + newline +
+ " (available switches are: /, -, --)" + newline + newline +
+ (__PrintHelp cfgOptions)
+
+let defaultConfig: Config = {
+ help = false;
+ inputFilename = "";
+ inferConditionals = true;
+ methodToSynth = "*";
+ constructorsOnly = false;
+ verifyPartialSolutions = true;
+ verifySolutions = true;
+ checkUnifications = false;
+ genRepr = true;
+ genMod = false;
+ timeout = 0;
+ numLoopUnrolls = 2;
+ recursiveValid = true;
+ breakIntoDebugger = false;
+ minimizeGuards = true;
+}
+
+/// Should not be mutated outside the ParseCmdLineArgs method, which is
+/// typically called only once at the beginning of the program execution
+let mutable CONFIG = defaultConfig
+
+let ParseCmdLineArgs args =
+ let __StripSwitches str =
+ match str with
+ | Prefix "--" x
+ | Prefix "-" x
+ | Prefix "/" x -> x
+ | _ -> str
+
+ let __Split (str: string) =
+ let stripped = __StripSwitches str
+ if stripped = str then
+ ("",str)
+ else
+ let splits = stripped.Split([| ':' |])
+ if splits.Length > 2 then raise (InvalidCmdLineOption("more than 2 colons in " + str))
+ if splits.Length = 2 then
+ let opt = splits.[0]
+ let value = splits.[1]
+ (opt,value)
+ else
+ let x = __StripSwitches splits.[0]
+ (x, "")
+
+ let rec __Parse args cfg =
+ match args with
+ | fs :: rest ->
+ let opt,value = __Split fs
+ if opt = "" then
+ __Parse rest { cfg with inputFilename = CheckNonEmpty value opt }
+ else
+ match Map.tryFind opt cfgOptMap with
+ | Some(opt) -> __Parse rest (opt.optionSetter value cfg)
+ | None -> raise (InvalidCmdLineOption("Unknown option: " + opt))
+ | [] -> cfg
+
+ (* --- function body starts here --- *)
+ CONFIG <- __Parse args defaultConfig
+
diff --git a/Source/Jennisys/Parser.fsy b/Source/Jennisys/Parser.fsy new file mode 100644 index 00000000..de8e1fb8 --- /dev/null +++ b/Source/Jennisys/Parser.fsy @@ -0,0 +1,214 @@ +%{
+
+open Ast
+open Getters
+open AstUtils
+
+let rec MyFold ee acc =
+ match ee with
+ | [] -> acc
+ | x::rest -> BinaryAnd x (MyFold rest acc)
+
+%}
+
+// The start token becomes a parser function in the compiled code:
+%start start
+
+// These are the terminal tokens of the grammar along with the types of
+// the data carried by each token:
+%token <string> ID
+%token <int> INTEGER
+%token DOT
+%token NOT
+%token STAR DIV MOD
+%token PLUS MINUS
+%token OLD
+%token DOTDOT DOTDOTDOT
+%token EQ NEQ LESS ATMOST ATLEAST GREATER IN NOTIN
+%token AND OR
+%token IMPLIES
+%token IFF
+%token LPAREN RPAREN LBRACKET RBRACKET LCURLY RCURLY VERTBAR
+%token GETS COLON COLONCOLON COMMA QMARK
+%token INTERFACE DATAMODEL CODE
+%token VAR CONSTRUCTOR METHOD FRAME INVARIANT RETURNS REQUIRES ENSURES FORALL
+%token INTTYPE BOOLTYPE SEQTYPE SETTYPE
+%token EOF
+
+// This is the type of the data produced by a successful reduction of the 'start'
+// symbol:
+%type < Ast.SyntacticProgram > start
+
+%%
+
+// These are the rules of the grammar along with the F# code of the
+// actions executed as rules are reduced. In this case the actions
+// produce data using F# data construction terms.
+start: TopLevelDecls EOF { SProgram($1) }
+
+TopLevelDecls:
+ | { [] }
+ | TopLevelDecl TopLevelDecls { $1 :: $2 }
+
+TopLevelDecl:
+ | INTERFACE ID TypeParams LCURLY Members RCURLY { Interface($2, $3, $5) }
+ | DATAMODEL ID TypeParams LCURLY FrameMembers RCURLY { match $5 with (vv,fr,inv) -> DataModel($2, $3, vv, fr, inv) }
+ | CODE ID TypeParams LCURLY RCURLY { Code($2, $3) }
+
+TypeParams:
+ | { [] }
+ | LBRACKET IdList RBRACKET { $2 }
+
+IdList:
+ | ID { [$1] }
+ | ID IdList { $1 :: $2 }
+
+Members:
+ | { [] }
+ | Member Members { $1 :: $2 }
+
+Signature:
+ | LPAREN VarDeclList RPAREN { Sig($2, []) }
+ | LPAREN VarDeclList RPAREN RETURNS LPAREN VarDeclList RPAREN { Sig($2, $6) }
+
+Pre:
+ | { TrueLiteral }
+ | REQUIRES Expr Pre { BinaryAnd $2 $3 }
+
+Post:
+ | { TrueLiteral }
+ | ENSURES Expr Post { BinaryAnd $2 $3 }
+ | ID GETS Expr Post { BinaryAnd (BinaryExpr(40,"=",IdLiteral($1),$3)) $4 }
+
+StmtList:
+ | { [] }
+ | Stmt StmtList { $1 :: $2 }
+
+Stmt:
+ | BlockStmt { $1 }
+ | Expr GETS Expr { Assign($1, $3) }
+
+BlockStmt:
+ | LCURLY StmtList RCURLY { Block $2 }
+
+Member:
+ | VAR VarDecl { Field($2) }
+ | CONSTRUCTOR ID Signature Pre Post { Method($2, $3, RewriteVars (GetSigVars $3) $4, RewriteVars (GetSigVars $3) $5, true) }
+ | METHOD ID Signature Pre Post { Method($2, $3, RewriteVars (GetSigVars $3) $4, RewriteVars (GetSigVars $3) $5, false) }
+ | INVARIANT ExprList { Invariant($2) }
+
+FrameMembers:
+ | { [], [], TrueLiteral }
+ | VAR VarDecl FrameMembers { match $3 with (vv,fr,inv) -> $2 :: vv, fr, inv }
+ | FRAME FrameMembers { $2 }
+ | FRAME FramePartitionList FrameMembers { match $3 with (vv,fr,inv) -> vv, List.append $2 fr, inv }
+ | INVARIANT ExprList FrameMembers { match $3 with (vv,fr,inv) -> vv, fr, MyFold $2 inv }
+
+FramePartitionList:
+ | FramePartition { $1 }
+ | FramePartition FramePartitionList { List.append $1 $2 }
+
+VarDeclList:
+ | { [] }
+ | VarDecl { [$1] }
+ | VarDecl COMMA VarDeclList { $1 :: $3 }
+
+VarDecl:
+ | ID { Var($1,None, false) }
+ | ID COLON Type { Var($1,Some($3), false) }
+
+Type:
+ | INTTYPE { IntType }
+ | BOOLTYPE { BoolType }
+ | ID { NamedType($1, []) }
+ | SEQTYPE LBRACKET Type RBRACKET { SeqType($3) }
+ | SETTYPE LBRACKET Type RBRACKET { SetType($3) }
+ | ID LBRACKET Type RBRACKET { InstantiatedType($1, [$3]) }
+
+ExprList:
+ | { [] }
+ | Expr { [$1] }
+ | Expr ExprList { $1 :: $2 }
+
+Expr:
+ | Expr10 { $1 }
+
+Expr10:
+ | Expr20 { $1 }
+ | Expr10 IFF Expr20 { BinaryExpr(10,"<==>",$1,$3) }
+
+Expr20:
+ | Expr25 { $1 }
+ | Expr25 IMPLIES Expr20 { BinaryExpr(20,"==>",$1,$3) }
+
+Expr25:
+ | Expr30 { $1 }
+ | Expr30 QMARK Expr25 COLON Expr25 { IteExpr($1,$3,$5) }
+Expr30:
+ | Expr40 { $1 }
+ | Expr40 AND Expr30and { BinaryAnd $1 $3 }
+ | Expr40 OR Expr30or { BinaryOr $1 $3 }
+Expr30and:
+ | Expr40 { $1 }
+ | Expr40 AND Expr30and { BinaryAnd $1 $3 }
+Expr30or:
+ | Expr40 { $1 }
+ | Expr40 AND Expr30or { BinaryOr $1 $3 }
+
+Expr40:
+ | Expr50 { $1 }
+ | Expr50 EQ Expr50 { BinaryExpr(40,"=",$1,$3) }
+ | Expr50 NEQ Expr50 { BinaryExpr(40,"!=",$1,$3) }
+ | Expr50 LESS Expr50 { BinaryExpr(40,"<",$1,$3) }
+ | Expr50 ATMOST Expr50 { BinaryExpr(40,"<=",$1,$3) }
+ | Expr50 ATLEAST Expr50 { BinaryExpr(40,">=",$1,$3) }
+ | Expr50 GREATER Expr50 { BinaryExpr(40,">",$1,$3) }
+ | Expr50 IN Expr50 { BinaryExpr(40,"in",$1,$3) }
+ | Expr50 NOTIN Expr50 { BinaryExpr(40,"!in",$1,$3) }
+
+Expr50:
+ | Expr55 { $1 }
+ | Expr55 DOTDOTDOT Expr55 { BinaryExpr(50,"...",$1,$3) }
+
+Expr55:
+ | Expr60 { $1 }
+ | Expr55 PLUS Expr60 { BinaryExpr(55,"+",$1,$3) }
+ | Expr55 MINUS Expr60 { BinaryExpr(55,"-",$1,$3) }
+
+Expr60:
+ | Expr90 { $1 }
+ | Expr60 STAR Expr90 { BinaryExpr(60,"*",$1,$3) }
+ | Expr60 DIV Expr90 { BinaryExpr(60,"div",$1,$3) }
+ | Expr60 MOD Expr90 { BinaryExpr(60,"mod",$1,$3) }
+
+Expr90:
+ | Expr100 { $1 }
+ | OLD LPAREN Expr90 RPAREN { OldExpr($3) }
+ | NOT Expr90 { UnaryExpr("!", $2) }
+ | MINUS Expr90 { UnaryExpr("-", $2) }
+ | Expr90 DOTDOT { LCIntervalExpr($1) }
+
+Expr100:
+ | INTEGER { IntLiteral($1) }
+ | ID { if $1 = "this" then
+ ObjLiteral("this")
+ elif $1 = "null" then
+ ObjLiteral("null")
+ else
+ IdLiteral($1) }
+ | Expr100 DOT ID { Dot($1, $3) }
+ | Expr100 LBRACKET StarExpr RBRACKET { SelectExpr($1, $3) }
+ | Expr100 LBRACKET Expr GETS Expr RBRACKET { UpdateExpr($1, $3, $5) }
+ | LPAREN Expr RPAREN { $2 }
+ | LBRACKET ExprList RBRACKET { SequenceExpr($2) }
+ | LCURLY ExprList RCURLY { SetExpr($2) }
+ | VERTBAR Expr VERTBAR { SeqLength($2) }
+ | FORALL VarDeclList COLONCOLON Expr { ForallExpr($2, RewriteVars $2 $4) }
+
+StarExpr:
+ | STAR { Star }
+ | Expr { $1 }
+
+FramePartition:
+ | Expr100 { [$1] }
+ | Expr100 STAR FramePartition { $1 :: $3 }
diff --git a/Source/Jennisys/PipelineUtils.fs b/Source/Jennisys/PipelineUtils.fs new file mode 100644 index 00000000..a87d442f --- /dev/null +++ b/Source/Jennisys/PipelineUtils.fs @@ -0,0 +1,63 @@ +// ####################################################################
+/// Utility functions for executing shell commands and
+/// running Dafny in particular
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+module PipelineUtils
+
+open Logger
+
+let dafnyScratchSuffix = "scratch"
+let dafnyVerifySuffix = "verify"
+let dafnyUnifSuffix = "unif"
+let dafnySynthFileNameTemplate = @"c:\tmp\jennisys-synth_###.dfy"
+let dafnyModularSynthFileNameTemplate = @"c:\tmp\jennisys-synth_###_mod.dfy"
+
+let mutable lastDafnyExitCode = 0 //TODO: how to avoid this muttable state?
+
+let CreateEmptyModelFile modelFile =
+ use mfile = System.IO.File.CreateText(modelFile)
+ fprintf mfile ""
+
+// =======================================================
+/// Runs Dafny on the given "inputFile" and prints
+/// the resulting model to the given "modelFile"
+// =======================================================
+let RunDafny inputFile modelFile =
+ //TraceLine "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Running Dafny @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
+ CreateEmptyModelFile modelFile
+ async {
+ use proc = new System.Diagnostics.Process()
+ proc.StartInfo.FileName <- @"c:\tmp\StartDafny-jen.bat"
+ proc.StartInfo.Arguments <- (sprintf "/mv:%s /timeLimit:%d %s" modelFile Options.CONFIG.timeout inputFile)
+ proc.StartInfo.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden
+ assert proc.Start()
+ proc.WaitForExit()
+ lastDafnyExitCode <- proc.ExitCode
+ } |> Async.RunSynchronously
+
+// =======================================================
+/// Runs Dafny on the given "dafnyCode" and returns models
+// =======================================================
+let RunDafnyProgram dafnyProgram suffix =
+ let inFileName = @"c:\tmp\jennisys-" + suffix + ".dfy"
+ let modelFileName = @"c:\tmp\jennisys-" + suffix + ".bvd"
+ use file = System.IO.File.CreateText(inFileName)
+ file.AutoFlush <- true
+ fprintfn file "%s" dafnyProgram
+ file.Close()
+ // run Dafny
+ RunDafny inFileName modelFileName
+ // read models from the model file
+ use modelFile = System.IO.File.OpenText(modelFileName)
+ Microsoft.Boogie.Model.ParseModels modelFile
+
+// =======================================================
+/// Checks whether the given dafny program verifies
+// =======================================================
+let CheckDafnyProgram dafnyProgram suffix =
+ let models = RunDafnyProgram dafnyProgram suffix
+ // if there are no models, verification was successful
+ lastDafnyExitCode = 0 && models.Count = 0
diff --git a/Source/Jennisys/PrintUtils.fs b/Source/Jennisys/PrintUtils.fs new file mode 100644 index 00000000..138b5e77 --- /dev/null +++ b/Source/Jennisys/PrintUtils.fs @@ -0,0 +1,12 @@ +module PrintUtils
+
+let newline = System.Environment.NewLine // "\r\n"
+
+let rec Indent i =
+ if i = 0 then "" else " " + (Indent (i-1))
+
+let rec PrintSep sep f list =
+ match list with
+ | [] -> ""
+ | [a] -> f a
+ | a :: more -> (f a) + sep + (PrintSep sep f more)
\ No newline at end of file diff --git a/Source/Jennisys/Printer.fs b/Source/Jennisys/Printer.fs new file mode 100644 index 00000000..32ae21ac --- /dev/null +++ b/Source/Jennisys/Printer.fs @@ -0,0 +1,156 @@ +module Printer
+
+open Ast
+open Getters
+open AstUtils
+open PrintUtils
+
+let rec PrintType ty =
+ match ty with
+ | IntType -> "int"
+ | BoolType -> "bool"
+ | NamedType(id, args) -> if List.isEmpty args then id else (PrintSep ", " (fun s -> s) args)
+ | SeqType(t) -> sprintf "seq[%s]" (PrintType t)
+ | SetType(t) -> sprintf "set[%s]" (PrintType t)
+ | InstantiatedType(id,args) -> sprintf "%s[%s]" id (PrintSep ", " (fun a -> PrintType a) args)
+
+let PrintVarDecl vd =
+ let name = GetExtVarName vd
+ match GetVarType vd with
+ | None -> name
+ | Some(ty) -> sprintf "%s: %s" name (PrintType ty)
+
+let rec PrintExpr ctx expr =
+ match expr with
+ | IntLiteral(d) -> sprintf "%d" d
+ | BoolLiteral(b) -> sprintf "%b" b
+ | BoxLiteral(id) -> sprintf "box_%s" id
+ | ObjLiteral(id)
+ | VarLiteral(id)
+ | IdLiteral(id) -> id
+ | VarDeclExpr(vlist, declare) ->
+ let decl = if declare then "var " else ""
+ let vars = PrintSep ", " PrintVarDecl vlist
+ sprintf "%s%s" decl vars
+ | Star -> "*"
+ | Dot(e,id) -> sprintf "%s.%s" (PrintExpr 100 e) id
+ | LCIntervalExpr(e) -> sprintf "%s.." (PrintExpr 90 e)
+ | OldExpr(e) -> sprintf "old(%s)" (PrintExpr 90 e)
+ | UnaryExpr(op,UnaryExpr(op2, e2)) -> sprintf "%s(%s)" op (PrintExpr 90 (UnaryExpr(op2, e2)))
+ | UnaryExpr(op,e) -> sprintf "%s%s" op (PrintExpr 90 e)
+ | BinaryExpr(strength,op,e0,e1) ->
+ let needParens = strength <= ctx
+ let openParen = if needParens then "(" else ""
+ let closeParen = if needParens then ")" else ""
+ sprintf "%s%s %s %s%s" openParen (PrintExpr strength e0) op (PrintExpr strength e1) closeParen
+ | IteExpr(c,e1,e2) -> sprintf "%s ? %s : %s" (PrintExpr 25 c) (PrintExpr 25 e1) (PrintExpr 25 e2)
+ | SelectExpr(e,i) -> sprintf "%s[%s]" (PrintExpr 100 e) (PrintExpr 0 i)
+ | UpdateExpr(e,i,v) -> sprintf "%s[%s := %s]" (PrintExpr 100 e) (PrintExpr 0 i) (PrintExpr 0 v)
+ | SequenceExpr(ee) -> sprintf "[%s]" (ee |> PrintSep " " (PrintExpr 0))
+ | SeqLength(e) -> sprintf "|%s|" (PrintExpr 0 e)
+ | SetExpr(ee) -> sprintf "{%s}" (ee |> PrintSep " " (PrintExpr 0))
+ | AssertExpr(e) -> sprintf "assert %s" (PrintExpr 0 e)
+ | AssumeExpr(e) -> sprintf "assume %s" (PrintExpr 0 e)
+ | ForallExpr(vv,e) ->
+ let needParens = ctx <> 0
+ let openParen = if needParens then "(" else ""
+ let closeParen = if needParens then ")" else ""
+ sprintf "%sforall %s :: %s%s" openParen (vv |> PrintSep ", " PrintVarDecl) (PrintExpr 0 e) closeParen
+ | MethodCall(rcv,_,name,aparams) ->
+ sprintf "%s.%s(%s)" (PrintExpr 0 rcv) name (aparams |> PrintSep ", " (PrintExpr 0))
+ | MethodOutSelect(mth,name) ->
+ sprintf "%s[\"%s\"]" (PrintExpr 0 mth) name
+
+let rec PrintConst cst =
+ match cst with
+ | IntConst(v) -> sprintf "%d" v
+ | BoolConst(b) -> sprintf "%b" b
+ | BoxConst(id) -> sprintf "box_%s" id
+ | VarConst(v) -> sprintf "%s" v
+ | SetConst(cset) -> sprintf "{%s}" (PrintSep " " (fun c -> PrintConst c) (Set.toList cset))
+ | SeqConst(cseq) -> sprintf "[%s]" (PrintSep " " (fun c -> PrintConst c) cseq)
+ | NullConst -> "null"
+ | NoneConst -> "<none>"
+ | ThisConst(_,_) -> "this"
+ | NewObj(name,_) -> PrintGenSym name
+ | Unresolved(name) -> sprintf "Unresolved(%s)" name
+
+let PrintSig signature =
+ match signature with
+ | Sig(ins, outs) ->
+ let returnClause =
+ if outs <> [] then sprintf " returns (%s)" (outs |> PrintSep ", " PrintVarDecl)
+ else ""
+ sprintf "(%s)%s" (ins |> PrintSep ", " PrintVarDecl) returnClause
+
+let rec PrintStmt stmt indent printNewline =
+ let idt = (Indent indent)
+ let nl = if printNewline then newline else ""
+ match stmt with
+ | Block(stmts) ->
+ idt + "{" + nl +
+ (PrintStmtList stmts (indent + 2) true) +
+ idt + "}" + nl
+ | Assign(lhs,rhs) -> sprintf "%s%s := %s%s" idt (PrintExpr 0 lhs) (PrintExpr 0 rhs) nl
+ | ExprStmt(expr) -> sprintf "%s%s%s" idt (PrintExpr 0 expr) nl
+and PrintStmtList stmts indent printNewline =
+ stmts |> List.fold (fun acc s -> acc + (PrintStmt s indent printNewline)) ""
+
+let PrintRoutine signature pre body =
+ let preStr = pre |> ForeachConjunct (fun e -> sprintf " requires %s%s" (PrintExpr 0 e) newline)
+ sprintf "%s%s%s%s" (PrintSig signature) newline preStr (PrintExpr 0 body)
+
+let PrintMember m =
+ match m with
+ | Field(vd) -> sprintf " var %s%s" (PrintVarDecl vd) newline
+ | Method(id,signature,pre,body,true) -> sprintf " constructor %s%s" id (PrintRoutine signature pre body)
+ | Method(id,signature,pre,body,false) -> sprintf " method %s%s" id (PrintRoutine signature pre body)
+ | Invariant(_) -> "" // invariants are handled separately
+
+let PrintTopLevelDeclHeader kind id typeParams =
+ let typeParamStr =
+ match typeParams with
+ | [] -> ""
+ | _ -> sprintf "[%s]" (typeParams |> PrintSep ", " (fun tp -> tp))
+ sprintf "%s %s%s {%s" kind id typeParamStr newline
+
+let PrintDecl d =
+ match d with
+ | Interface(id,typeParams,members) ->
+ sprintf "%s%s}%s" (PrintTopLevelDeclHeader "interface" id typeParams)
+ (List.fold (fun acc m -> acc + (PrintMember m)) "" members)
+ newline
+ | DataModel(id,typeParams,vars,frame,inv) ->
+ (PrintTopLevelDeclHeader "model" id typeParams) +
+ (vars |> List.fold (fun acc vd -> acc + " var " + (PrintVarDecl vd) + newline) "") +
+ " frame" + newline +
+ (frame |> List.fold (fun acc fr -> acc + " " + (PrintExpr 0 fr) + newline) "") +
+ " invariant" + newline +
+ (inv |> ForeachConjunct (fun e -> " " + (PrintExpr 0 e) + newline)) +
+ "}" + newline
+ | Code(id,typeParams) ->
+ (PrintTopLevelDeclHeader "code" id typeParams) + "}" + newline
+
+let PrintMethodSignFull indent comp m =
+ let idt = Indent indent
+ let __PrintPrePost pfix expr = SplitIntoConjunts expr |> PrintSep newline (fun e -> pfix + (PrintExpr 0 e) + ";")
+ let compName = GetComponentName comp
+ match m with
+ | Method(methodName, sgn, pre, post, isConstr) ->
+ let mc = if isConstr then "constructor" else "method"
+ let preStr = (__PrintPrePost (idt + " requires ") pre)
+ let postStr = (__PrintPrePost (idt + " ensures ") post)
+ idt + mc + " " + compName + "." + methodName + (PrintSig sgn) + newline +
+ preStr + (if preStr = "" then "" else newline) +
+ postStr
+ | _ -> failwithf "not a method: %O" m
+
+let Print prog =
+ match prog with
+ | SProgram(decls) -> List.fold (fun acc d -> acc + (PrintDecl d)) "" decls
+
+let PrintObjRefName o =
+ match o with
+ | ThisConst(_,_) -> "this";
+ | NewObj(name, _) -> PrintGenSym name
+ | _ -> failwith ("unresolved object ref: " + o.ToString())
\ No newline at end of file diff --git a/Source/Jennisys/README.txt b/Source/Jennisys/README.txt new file mode 100644 index 00000000..30f91b2e --- /dev/null +++ b/Source/Jennisys/README.txt @@ -0,0 +1,28 @@ +1. Installation instructions +---------------------------- + + - download the entire boogie source distribution and place it in c:\boogie + - create c:\tmp folder + - copy the Jennisys\scripts\StartDafny-jen.bat script into c:\tmp + +2. Running the examples +---------------------------- + + $ cd Jennisys + $ bin/Debug/Jennisys.exe examples/<name>.jen + + The most current and complete set of examples is in the + "examples/oopsla12" folder. No additional Jennisys switches need be + passed for either of them. + + Synthesized programs will be generated in "c:\tmp", and their file + names will follow the following pattern: + + "jennisys-synth_<example-name>.dfy" + + To verify the correctness of the synthesized programs, run + + $ Dafny /compile:0 jennisys-synth_<example-name>.dfy + + Expected outputs (i.e., synthesized Dafny programs) for the examples + in "examples/oopsla12" can be found in the same folder. diff --git a/Source/Jennisys/Resolver.fs b/Source/Jennisys/Resolver.fs new file mode 100644 index 00000000..bc330520 --- /dev/null +++ b/Source/Jennisys/Resolver.fs @@ -0,0 +1,380 @@ +// ####################################################################
+/// Utilities for resolving the "Unresolved" constants with respect to
+/// a given context (heap/env/ctx)
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+module Resolver
+
+open Ast
+open Getters
+open AstUtils
+open Printer
+open EnvUtils
+open DafnyModelUtils
+
+type Obj = { name: string; objType: Type }
+
+type AssignmentType =
+ | FieldAssignment of (Obj * VarDecl) * Expr // the first string is the symbolic name of an object literal
+ | ArbitraryStatement of Stmt
+
+type HeapInstance = {
+ objs : Map<string, Obj>;
+ modifiableObjs : Set<Obj>;
+ assignments : AssignmentType list;
+ concreteValues : AssignmentType list;
+ methodArgs : Map<string, Const>;
+ methodRetVals : Map<string, Expr>;
+ concreteMethodRetVals : Map<string, Expr>;
+ globals : Map<string, Expr>;
+}
+
+let NoObj = { name = ""; objType = NamedType("", []) }
+let ThisObj comp = {name = "this"; objType = GetComponentType comp}
+
+let ExtractAllExpressions asg =
+ match asg with
+ | FieldAssignment(_,e) -> [e]
+ | ArbitraryStatement(s) -> ExtractTopLevelExpressions s
+
+// use the orginal method, not the one with an extra precondition
+let FixSolution origComp origMeth sol =
+ sol |> Map.fold (fun acc (cc,mm) v ->
+ if CheckSameMethods (cc,mm) (origComp,origMeth) then
+ acc |> Map.add (origComp,origMeth) v
+ else
+ acc |> Map.add (cc,mm) v) Map.empty
+
+let ConvertToStatements heapInst onModifiableObjsOnly =
+ let stmtLst1 = heapInst.assignments |> List.choose (fun asgn ->
+ match asgn with
+ | FieldAssignment((o,f),e) when (not onModifiableObjsOnly || Set.contains o heapInst.modifiableObjs) ->
+ if IsOldVar f then
+ None
+ else
+ let fldName = GetVarName f
+ if fldName = "" then
+ Some(ExprStmt(e))
+ else
+ Some(Assign(Dot(ObjLiteral(o.name), fldName), e))
+ | ArbitraryStatement(stmt) -> Some(stmt)
+ | _ -> None)
+ let stmtLst2 = heapInst.methodRetVals |> Map.toList
+ |> List.map (fun (retVarName, retVarVal) -> Assign(VarLiteral(retVarName), retVarVal))
+ stmtLst1 @ stmtLst2
+
+// resolving values
+exception ConstResolveFailed of string
+
+// ================================================================
+/// Resolves a given Const (cst) with respect to a given env/ctx.
+///
+/// If unable to resolve, it just delegates the task to the
+/// failResolver function
+// ================================================================
+let rec ResolveCont hModel failResolver cst =
+ match cst with
+ | Unresolved(_) as u ->
+ // see if it is in the env map first
+ let envVal = Map.tryFind cst hModel.env
+ match envVal with
+ | Some(c) -> ResolveCont hModel failResolver c
+ | None ->
+ // not found in the env map --> check the equality sets
+ let eq = hModel.ctx |> Set.filter (fun eqSet -> Set.contains u eqSet)
+ |> Utils.SetToOption
+ match eq with
+ | Some(eqSet) ->
+ let cOpt = eqSet |> Set.filter (function Unresolved(_) -> false | _ -> true)
+ |> Utils.SetToOption
+ match cOpt with
+ | Some(c) -> c
+ | _ -> failResolver cst hModel
+ | None ->
+ failResolver cst hModel
+// // finally, see if it's an *input* (have no way of telling input from output params here) method argument
+// let m = hModel.env |> Map.filter (fun k v -> v = u && match k with VarConst(name) -> true | _ -> false) |> Map.toList
+// match m with
+// | (vc,_) :: [] -> vc
+// | _ -> failResolver cst hModel
+ | SeqConst(cseq) ->
+ let resolvedLst = cseq |> List.rev |> List.fold (fun acc c -> ResolveCont hModel failResolver c :: acc) []
+ SeqConst(resolvedLst)
+ | SetConst(cset) ->
+ let resolvedSet = cset |> Set.fold (fun acc c -> acc |> Set.add (ResolveCont hModel failResolver c)) Set.empty
+ SetConst(resolvedSet)
+ | _ -> cst
+
+// =====================================================================
+/// Tries to resolve a given Const (cst) with respect to a given env/ctx.
+///
+/// If unable to resolve, just returns the original Unresolved const.
+// =====================================================================
+let TryResolve hModel cst =
+ ResolveCont hModel (fun c _ -> c) cst
+
+// ==============================================================
+/// Resolves a given Const (cst) with respect to a given env/ctx.
+///
+/// If unable to resolve, raises a ConstResolveFailed exception
+// ==============================================================
+let Resolve hModel cst =
+ ResolveCont hModel (fun c _ ->
+ match c with
+ | Unresolved(id) -> BoxConst(id)
+ | _ -> failwithf "internal error: expected Unresolved but got %O" c
+ ) cst //fun c _ -> raise (ConstResolveFailed("failed to resolve " + c.ToString()))
+
+// ==================================================================
+/// Evaluates a given expression with respect to a given heap instance
+// ==================================================================
+
+let rec _EvalResolver heapInst useConcrete resolveExprFunc expr fldNameOpt =
+ let rec __FurtherResolve expr =
+ match expr with
+ | SetExpr(elist) -> SetExpr(elist |> List.map __FurtherResolve)
+ | SequenceExpr(elist) -> SequenceExpr(elist |> List.map __FurtherResolve)
+ | VarLiteral(_) ->
+ try
+ _EvalResolver heapInst useConcrete resolveExprFunc expr None
+ with
+ | _ -> expr
+ | IdLiteral(id) when not (id = "this" || id = "null") ->
+ try
+ _EvalResolver heapInst useConcrete resolveExprFunc expr None
+ with
+ | _ -> expr
+ | _ -> expr
+
+ (* --- function body starts here --- *)
+ let ex = match fldNameOpt with
+ | None -> expr
+ | Some(n) -> Dot(expr, n)
+ if not (resolveExprFunc ex) then
+ ex
+ else
+ match fldNameOpt with
+ | None ->
+ match expr with
+ | ObjLiteral("this") | ObjLiteral("null") -> expr
+ | IdLiteral("this") | IdLiteral("null") -> failwith "should never happen anymore" //TODO
+ | VarLiteral(id) ->
+ match heapInst.methodArgs |> Map.tryFind id with
+ | Some(argValue) -> argValue |> Const2Expr
+ | None ->
+ let retVals = if useConcrete then heapInst.concreteMethodRetVals else heapInst.methodRetVals
+ match retVals |> Map.tryFind id with
+ | Some(e) -> e |> __FurtherResolve
+ | None -> raise (EvalFailed("cannot find value for method parameter " + id))
+ | IdLiteral(id) ->
+ let globalVal = heapInst.globals |> Map.tryFind id
+ match globalVal with
+ | Some(e) -> e
+ | None -> _EvalResolver heapInst useConcrete resolveExprFunc ThisLiteral (Some(id))
+ | _ -> raise (EvalFailed(sprintf "I'm not supposed to resolve %O" expr))
+ | Some(fldName) ->
+ match expr with
+ | ObjLiteral(objName) ->
+ let asgs = if useConcrete then heapInst.concreteValues else heapInst.assignments
+ let h2 = asgs |> List.filter (function FieldAssignment((o, var), v) -> o.name = objName && GetExtVarName var = fldName | _ -> false)
+ match h2 with
+ | FieldAssignment((_,_),x) :: [] -> __FurtherResolve x
+ | _ :: _ -> raise (EvalFailed(sprintf "can't evaluate expression deterministically: %s.%s resolves to multiple locations" objName fldName))
+ | [] -> raise (EvalFailed(sprintf "can't find value for %s.%s" objName fldName)) // TODO: what if that value doesn't matter for the solution, and that's why it's not present in the model???
+ | _ -> Dot(expr, fldName)
+
+let _Eval heapInst resolveExprFunc returnFunc expr =
+ (* --- function body starts here --- *)
+ //EvalSym (__EvalResolver resolveExprFunc) expr
+ EvalSymRet (_EvalResolver heapInst false resolveExprFunc) returnFunc expr
+
+/// Resolves nothing
+let EvalNone heapInst expr =
+ EvalSym (_EvalResolver heapInst false (fun e -> false)) expr
+
+let fullResolver heapInst = _EvalResolver heapInst true (fun e -> true)
+
+/// Resolves everything
+let EvalFull heapInst expr =
+ EvalSym (fullResolver heapInst) expr
+ //_Eval heapInst (fun _ -> true) (fun e -> e) expr
+
+let Eval heapInst resolveExprFunc expr =
+ let returnFunc = fun expr -> match expr with IdLiteral(id) -> Dot(ThisLiteral, id) | _ -> expr
+ EvalSymRet (fullResolver heapInst) (_EvalResolver heapInst false resolveExprFunc) returnFunc expr
+
+let EvalAndCheckTrue heapInst resolveExprFunc expr =
+ let returnFunc = fun expr ->
+ let expr =
+ match expr with
+ //| IteExpr(c,t,e) ->
+ // let cond = c |> EvalFull heapInst |> Expr2Bool
+ // if cond then t else e
+ //| ForallExpr(vars, sub) -> expr
+ // TODO: this is just to ensure that all field accesses to this object are prefixed with "this."
+ // this is not the best place to do it, though
+ | IdLiteral(id) -> Dot(ThisLiteral, id)
+ | _ -> expr
+
+ // TODO: infer type of expr and then re-execute only if its type is Bool
+ let e1 = EvalFull heapInst expr //EvalSym (_EvalResolver heapInst true (fun _ -> true)) expr
+ match e1 with
+ | BoolLiteral(b) ->
+ if b then
+ expr
+ else
+ FalseLiteral
+ //UnaryNot expr
+ | _ -> expr
+ EvalSymRet (fullResolver heapInst) (_EvalResolver heapInst false resolveExprFunc) returnFunc expr
+ //_Eval heapInst resolveExprFunc returnFunc expr
+
+// =====================================================================
+/// Takes an unresolved model of the heap (HeapModel), resolves all
+/// references in the model and returns an instance of the heap
+/// (HeapInstance), where all fields for all objects have explicit
+/// assignments.
+// =====================================================================
+let ResolveModel hModel (comp,meth) =
+ let outArgs = GetMethodOutArgs meth
+ let hmap = hModel.heap |> Map.fold (fun acc (o,f) l ->
+ let objName, objTypeOpt = match Resolve hModel o with
+ | ThisConst(_,t) -> "this", t;
+ | NewObj(name, t) -> PrintGenSym name, t
+ | _ -> failwith ("unresolved object ref: " + o.ToString())
+ let objType = objTypeOpt |> Utils.ExtractOptionMsg "unknown object type"
+ let obj = {name = objName; objType = objType}
+ let value = TryResolve hModel l |> Const2Expr
+ Utils.ListMapAdd (obj, f) value acc
+ ) []
+ |> List.map (fun el -> FieldAssignment(el))
+ let objs, modObjs = hmap |> List.fold (fun (acc1,acc2) asgn ->
+ match asgn with
+ | FieldAssignment((obj,_),_) ->
+ let acc1' = acc1 |> Map.add obj.name obj
+ let acc2' =
+ if IsModifiableObj obj (comp,meth) then
+ acc2 |> Set.add obj
+ else
+ acc2
+ acc1',acc2'
+ | _ -> acc1,acc2
+ ) (Map.empty, Set.empty)
+ let argmap, retvals = hModel.env |> Map.fold (fun (acc1,acc2) k v ->
+ match k with
+ | VarConst(name) ->
+ let resolvedValExpr = Resolve hModel v
+ if outArgs |> List.exists (fun var -> GetVarName var = name) then
+ acc1, acc2 |> Map.add name (resolvedValExpr |> Const2Expr)
+ else
+ acc1 |> Map.add name resolvedValExpr, acc2
+ | _ -> acc1, acc2
+ ) (Map.empty, Map.empty)
+ { objs = objs;
+ modifiableObjs = modObjs;
+ assignments = hmap;
+ concreteValues = hmap;
+ methodArgs = argmap;
+ methodRetVals = retvals;
+ concreteMethodRetVals = retvals;
+ globals = Map.empty }
+
+let rec GetCallGraph solutions graph =
+ let rec __SearchExprsForMethodCalls elist acc =
+ match elist with
+ | e :: rest ->
+ match e with
+ // no need to descend for, just check if the top-level one is MEthodCall
+ | MethodCall(_,cname,mname,_) -> __SearchExprsForMethodCalls rest (acc |> Set.add (cname,mname))
+ | _ -> __SearchExprsForMethodCalls rest acc
+ | [] -> acc
+ match solutions with
+ | ((comp,m), sol) :: rest ->
+ let callees = sol |> List.fold (fun acc (cond, hInst) ->
+ hInst.assignments |> List.fold (fun acc asgn ->
+ match asgn with
+ | FieldAssignment(_,e) ->
+ __SearchExprsForMethodCalls [e] acc
+ | ArbitraryStatement(stmt) ->
+ let exprs = ExtractTopLevelExpressions stmt
+ __SearchExprsForMethodCalls exprs acc
+ ) acc
+ ) Set.empty
+ let graph' = graph |> Map.add (comp,m) callees
+ GetCallGraph rest graph'
+ | [] -> graph
+
+//////////////////////////////
+
+//TODO: below here should really go to a different module
+
+let __Is1stLevelExpr methodsOk heapInst expr =
+ DescendExpr2 (fun expr acc ->
+ if not acc then
+ false
+ else
+ match expr with
+ | Dot(discr, fldName) ->
+ try
+ let obj = EvalFull heapInst discr
+ match obj with
+ | ObjLiteral(id) -> id = "this"
+ | _ -> failwithf "Didn't expect the discriminator of a Dot to not be ObjLiteral"
+ with
+ | _ -> false
+ | MethodCall(_) -> methodsOk
+ | _ -> true
+ ) expr true
+
+let Is1stLevelExpr = __Is1stLevelExpr true
+
+let IsSolution1stLevelOnly heapInst =
+ let rec __IsSol1stLevel stmts =
+ match stmts with
+ | stmt :: rest ->
+ match stmt with
+ | Assign(_, e)
+ | ExprStmt(e) ->
+ let ok = Is1stLevelExpr heapInst e
+ ok && __IsSol1stLevel rest
+ | Block(stmts) -> __IsSol1stLevel (stmts @ rest)
+ | [] -> true
+ (* --- function body starts here --- *)
+ __IsSol1stLevel (ConvertToStatements heapInst true)
+
+let IsRecursiveSol (c,m) sol =
+ let compName = GetComponentName c
+ let methName = GetMethodName m
+ let allAssignments = sol |> List.map (fun (_,hInst) -> hInst.assignments) |> List.concat
+ let allExprs = (allAssignments |> List.map ExtractAllExpressions |> List.concat) @
+ (sol |> List.map (fun (_,hInst) -> hInst.methodRetVals |> Map.toList |> List.map snd) |> List.concat)
+ let singleExpr = allExprs |> List.fold BinaryAnd TrueLiteral
+ DescendExpr2 (fun expr acc ->
+ if acc then
+ true
+ else
+ match expr with
+ | MethodCall(_, cn, mn, elst) when cn = compName && mn = methName ->
+ true
+ | _ -> false
+ ) singleExpr false
+
+/// Returns a list of direct modifiable children objects with respect to "this" object
+///
+/// All returned expressions are of type ObjLiteral
+///
+/// ensures: forall e :: e in ret ==> e is ObjInstance
+let GetDirectModifiableChildren hInst =
+ let rec __AddDirectChildren e acc =
+ match e with
+ | ObjLiteral(_) when not (e = ThisLiteral || e = NullLiteral) -> acc |> Set.add e
+ | SequenceExpr(elist)
+ | SetExpr(elist) -> elist |> List.fold (fun acc2 e2 -> __AddDirectChildren e2 acc2) acc
+ | _ -> acc
+
+ (* --- function body starts here --- *)
+ let thisRhsExprs = hInst.assignments |> List.choose (function FieldAssignment((obj,_),e) when obj.name = "this" && Set.contains obj hInst.modifiableObjs -> Some(e) | _ -> None)
+ thisRhsExprs |> List.fold (fun acc e -> __AddDirectChildren e acc) Set.empty
+ |> Set.toList
diff --git a/Source/Jennisys/SymGen.fs b/Source/Jennisys/SymGen.fs new file mode 100644 index 00000000..b736ef31 --- /dev/null +++ b/Source/Jennisys/SymGen.fs @@ -0,0 +1,9 @@ +module SymGen
+
+let incr =
+ let counter = ref 0
+ fun () ->
+ counter := !counter + 1
+ !counter
+
+let NewSymFake expr = sprintf "x_%d" (incr())
\ No newline at end of file diff --git a/Source/Jennisys/TypeChecker.fs b/Source/Jennisys/TypeChecker.fs new file mode 100644 index 00000000..cef88072 --- /dev/null +++ b/Source/Jennisys/TypeChecker.fs @@ -0,0 +1,67 @@ +module TypeChecker
+
+open Ast
+open Getters
+open AstUtils
+open Printer
+open System.Collections.Generic
+
+let GetClass name decls =
+ match decls |> List.tryFind (function Interface(n,_,_) when n = name -> true | _ -> false) with
+ | Some(cl) -> cl
+ | None -> Interface(name,[],[])
+
+let GetModel name decls =
+ match decls |> List.tryFind (function DataModel(n,_,_,_,_) when n = name -> true | _ -> false) with
+ | Some(m) -> m
+ | None -> DataModel(name,[],[],[],BoolLiteral(true))
+
+let GetCode name decls =
+ match decls |> List.tryFind (function Code(n,_) when n = name -> true | _ -> false) with
+ | Some(c) -> c
+ | None -> Code(name,[])
+
+let IsUserType prog tpo =
+ match tpo with
+ | Some(tp) ->
+ let tpname = match tp with
+ | NamedType(tname,_) -> tname
+ | InstantiatedType(tname, _) -> tname
+ | _ -> ""
+ match prog with
+ | Program(components) -> components |> List.filter (function Component(Interface(name,_,_),_,_) when name = tpname -> true
+ | _ -> false) |> List.isEmpty |> not
+ | None -> false
+
+let TypeCheck prog =
+ match prog with
+ | SProgram(decls) ->
+ let componentNames = decls |> List.choose (function Interface(name,_,_) -> Some(name) | _ -> None)
+ let clist = componentNames |> List.map (fun name -> Component(GetClass name decls, GetModel name decls, GetCode name decls))
+ Some(Program(clist))
+
+let MethodArgChecker prog meth varName =
+ let ins = GetMethodInArgs meth
+ let outs = GetMethodOutArgs meth
+ ins @ outs |> List.choose (fun var -> if GetVarName var = varName then GetVarType var |> FindComponentForTypeOpt prog else None) |> Utils.ListToOption
+
+// TODO: implement this
+let rec InferType prog thisComp checkLocalFunc expr =
+ let __FindVar comp fldName =
+ let var = FindVar comp fldName |> Utils.ExtractOption
+ let c = FindComponentForType prog (Utils.ExtractOption (GetVarType var)) |> Utils.ExtractOption
+ Some(c)
+
+ try
+ match expr with
+ | ObjLiteral("this") -> Some(thisComp)
+ | ObjLiteral("null") -> None
+ | IdLiteral(id) -> __FindVar thisComp id
+ | VarLiteral(id) -> checkLocalFunc id
+ | Dot(discr, fldName) ->
+ match InferType prog thisComp checkLocalFunc discr with
+ | Some(comp) -> __FindVar comp fldName
+ | None -> None
+ | _ -> None
+ with
+ | ex -> None
\ No newline at end of file diff --git a/Source/Jennisys/Utils.fs b/Source/Jennisys/Utils.fs new file mode 100644 index 00000000..56b6b779 --- /dev/null +++ b/Source/Jennisys/Utils.fs @@ -0,0 +1,368 @@ +// ####################################################################
+/// Various utility functions
+///
+/// author: Aleksandar Milicevic (t-alekm@microsoft.com)
+// ####################################################################
+
+module Utils
+
+// -------------------------------------------
+// ----------- collection util funcs ---------
+// -------------------------------------------
+
+// =====================================
+/// ensures: ret = b ? Some(b) : None
+// =====================================
+let BoolToOption b =
+ if b then
+ Some(b)
+ else
+ None
+
+// =====================================
+/// ensures: ret = (opt == Some(_))
+// =====================================
+let OptionToBool opt =
+ match opt with
+ | Some(_) -> true
+ | None -> false
+
+// =====================================
+/// ensures: ret = (opt == Some(_))
+// =====================================
+let IsSomeOption opt =
+ match opt with
+ | Some(_) -> true
+ | None -> false
+
+// =====================================
+/// ensures: ret = (opt == None)
+// =====================================
+let IsNoneOption opt = IsSomeOption opt |> not
+
+// =====================================
+/// requres: x = Some(a) or failswith msg
+/// ensures: ret = a
+// =====================================
+let ExtractOptionMsg msg x =
+ match x with
+ | Some(a) -> a
+ | None -> failwith msg
+
+// ====================
+/// requres: x = Some(a)
+/// ensures: ret = a
+// ====================
+let ExtractOption x =
+ ExtractOptionMsg "can't extract anything from a None" x
+
+// ====================================
+/// ensures: res = Some(a) ==> ret = a
+/// ensures: res = None ==> ret = defVal
+// ====================================
+let ExtractOptionOr defVal opt =
+ match opt with
+ | Some(a) -> a
+ | None -> defVal
+
+// ==========================================================
+/// requres: List.length lst <= 1, otherwise fails with errMsg
+/// ensures: if |lst| = 0 then
+/// ret = None
+/// else
+/// ret = Some(lst[0])
+// ==========================================================
+let ListToOptionMsg lst errMsg =
+ if List.length lst > 1 then
+ failwith errMsg
+ if List.isEmpty lst then
+ None
+ else
+ Some(lst.[0])
+
+let ListToOption lst = ListToOptionMsg lst "given list contains more than one element"
+
+let ListDeduplicate lst =
+ let rec __Dedup lst (visitedSet: System.Collections.Generic.HashSet<_>) acc =
+ match lst with
+ | fs :: rest ->
+ let newAcc =
+ if visitedSet.Add(fs) then
+ acc @ [fs]
+ else
+ acc
+ __Dedup rest visitedSet newAcc
+ | _ -> acc
+ __Dedup lst (new System.Collections.Generic.HashSet<_>()) []
+
+let rec ListCombine combinerFunc lst1 lst2 =
+ match lst1 with
+ | e1 :: rest ->
+ let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ [combinerFunc e1 e2]) []
+ List.concat [resLst1; ListCombine combinerFunc rest lst2]
+ | [] -> []
+
+let rec ListCombineMult combinerFunc lst1 lst2 =
+ match lst1 with
+ | e1 :: rest ->
+ let resLst1 = lst2 |> List.fold (fun acc e2 -> acc @ combinerFunc e1 e2) []
+ List.concat [resLst1; ListCombineMult combinerFunc rest lst2]
+ | [] -> []
+
+// =============================================================
+/// ensures: forall i :: 0 <= i < |lst| ==> ret[i] = Some(lst[i])
+// =============================================================
+let rec ConvertToOptionList lst =
+ match lst with
+ | fs :: rest -> Some(fs) :: ConvertToOptionList rest
+ | [] -> []
+
+// =========================================================
+/// requres: Seq.length seq <= 1, otherwise fails with errMsg
+/// ensures: if |seq| = 0 then
+/// ret = None
+/// else
+/// ret = Some(seq[0])
+// =========================================================
+let SeqToOptionMsg seq errMsg =
+ if Seq.length seq > 1 then
+ failwith errMsg
+ if Seq.isEmpty seq then
+ None
+ else
+ Some(Seq.nth 0 seq)
+
+let SeqToOption seq = SeqToOptionMsg seq "given seq contains more than one element"
+
+// =========================================================
+/// requires: Set.count set <= 1, otherwise fails with errMsg
+/// ensures: if |set| = 0 then
+/// ret = None
+/// else
+/// ret = Some(set[0])
+// =========================================================
+let SetToOptionMsg set errMsg =
+ if Set.count set > 1 then
+ failwith errMsg
+ if (Set.isEmpty set) then
+ None
+ else
+ Some(set |> Set.toList |> List.head)
+
+let SetToOption set = SetToOptionMsg set "give set contains more than one value"
+
+// ============================================================
+/// requires: n >= 0
+/// ensures: |ret| = n && forall i :: 0 <= i < n ==> ret[i] = e
+// ============================================================
+let rec GenList n e =
+ if n < 0 then
+ failwith "n must be positive"
+ if n = 0 then
+ []
+ else
+ e :: (GenList (n-1) e)
+
+// =======================================
+/// ensures: forall i :: 0 <= i < |lst| ==>
+/// if lst[i] = oldElem then
+/// ret[i] = newElem
+/// else
+/// ret[i] = lst[i]
+// =======================================
+let ListReplace oldElem newElem lst =
+ lst |> List.map (fun e -> if e = oldElem then newElem else e)
+
+// =================================================
+/// if (exists (k,v) :: (k,v) in lst && k = key) then
+/// ret = Some(v)
+/// else
+/// ret = None
+// =================================================
+let ListMapTryFind key lst =
+ let filtered = lst |> List.filter (fun (k,v) -> k = key)
+ match filtered with
+ | fs :: rest -> Some(snd fs)
+ | [] -> None
+
+// ==================================================
+/// Replaces the first occurence of the given key in
+/// the given list with the given value, or appends
+/// (key,value) if key does not exist in the list
+// ==================================================
+let rec ListMapAdd key value lst =
+ match lst with
+ | (k,v) :: rest -> if k = key then (k, value) :: rest else (k,v) :: (ListMapAdd key value rest)
+ | [] -> [(key,value)]
+
+// ==========================
+/// ensures: ret = elem in lst
+// ==========================
+let ListContains elem lst =
+ lst |> List.exists (fun e -> e = elem)
+
+// ====================================================
+/// Removes all elements in lst that are equal to "elem"
+// ====================================================
+let ListRemove elem lst =
+ lst |> List.choose (fun e -> if e = elem then None else Some(e))
+
+let rec ListRemoveIdx idx lst =
+ if idx = 0 then
+ List.tail lst
+ else
+ List.head lst :: ListRemoveIdx (idx - 1) (List.tail lst)
+
+// ===============================================================
+/// ensures: |ret| = max(|lst| - cnt, 0)
+/// ensures: forall i :: cnt <= i < |lst| ==> ret[i] = lst[i-cnt]
+// ===============================================================
+let rec ListSkip cnt lst =
+ if cnt = 0 then
+ lst
+ else
+ match lst with
+ | fs :: rest -> ListSkip (cnt-1) rest
+ | [] -> []
+
+// ===============================================================
+/// ensures: forall i :: 0 <= i < max(|srcList|, |dstList|) ==>
+/// if i = idx then
+/// ret[i] = v
+/// elif i < |srcList| then
+/// ret[i] = srcList[i]
+/// else
+/// ret[i] = dstList[i]
+// ===============================================================
+let rec ListBuild srcList idx v dstList =
+ match srcList, dstList with
+ | fs1 :: rest1, fs2 :: rest2 -> if idx = 0 then
+ v :: List.concat [rest1 ; ListSkip (List.length rest1) rest2]
+ else
+ fs1 :: ListBuild rest1 (idx-1) v rest2
+ | [], fs2 :: rest2 -> if idx = 0 then
+ v :: rest2
+ else
+ fs2 :: ListBuild [] (idx-1) v rest2
+ | _, [] -> failwith "index out of range"
+
+// =======================================
+/// ensures: forall i :: 0 <= i < |lst| ==>
+/// if i = idx then
+/// ret[i] = v
+/// else
+/// ret[i] = lst[i]
+// =======================================
+let rec ListSet idx v lst =
+ match lst with
+ | fs :: rest -> if idx = 0 then
+ v :: rest
+ else
+ fs :: ListSet (idx-1) v rest
+ | [] -> failwith "index out of range"
+
+exception KeyAlreadyExists
+
+// =======================================
+/// requires (key |--> value) !in map
+///
+/// ensures ret = map ++ (key |--> value)
+// =======================================
+let MapAddNew key value map =
+ match Map.tryFind key map with
+ | Some(existingValue) ->
+ if existingValue = value then
+ map
+ else
+ raise KeyAlreadyExists
+ | None ->
+ map |> Map.add key value
+
+// =======================================
+/// ensures: forall k,v ::
+/// if k,v in map2 then
+// k,v in ret
+/// elif k,v in map1 then
+/// k,v in ret
+/// else
+/// k,v !in ret
+// =======================================
+let rec MapAddAll map1 map2 =
+ map2 |> Map.fold (fun acc k v -> acc |> Map.add k v) map1
+
+// =======================================
+/// ensures: |ret| = 1
+/// ensures: (key -> value) in ret
+// =======================================
+let MapSingleton key value =
+ Map.empty |> Map.add key value
+
+let MapKeys map =
+ map |> Map.toList |> List.map (fun (k,v) -> k)
+
+let MapReplaceKey oldKey newKey newVal map =
+ map |> Map.toList |> List.fold (fun acc (k,v) -> if k = oldKey then acc |> Map.add newKey newVal else acc |> Map.add k v) Map.empty
+
+// -------------------------------------------
+// ------------ algorithms -------------------
+// -------------------------------------------
+
+// =======================================================================
+/// Topologically sorts a given list
+///
+/// ensures: |ret| = |lst|
+/// ensures: forall e in lst :: e in ret
+/// ensures: forall i,j :: 0 <= i < j < ==> not (followsFunc ret[j] ret[i])
+// =======================================================================
+let rec TopSort followsFunc lst =
+ match lst with
+ | [] -> []
+ | fs :: [] -> [fs]
+ | fs :: rest ->
+ let min = rest |> List.fold (fun acc elem -> if followsFunc acc elem then elem else acc) fs
+ min :: TopSort followsFunc (ListRemove min lst)
+
+// -------------------------------------------
+// ------ string active patterns -------------
+// -------------------------------------------
+
+let (|Prefix|_|) (p:string) (s:string) =
+ if s.StartsWith(p) then
+ Some(s.Substring(p.Length))
+ else
+ None
+
+// -------------------------------------------
+// --------------- workflow ------------------
+// -------------------------------------------
+
+let IfDo1 cond func1 a =
+ if cond then
+ func1 a
+ else
+ a
+
+let IfDo2 cond func2 (a1,a2) =
+ if cond then
+ func2 a1 a2
+ else
+ a1,a2
+
+let Ite cond f1 f2 =
+ if cond then
+ f1
+ else
+ f2
+
+type CascadingBuilder<'a>(failVal: 'a) =
+ member this.Bind(v, f) =
+ match v with
+ | Some(x) -> f x
+ | None -> failVal
+ member this.Return(v) = v
+
+// -------------------------------------------
+// --------------- random --------------------
+// -------------------------------------------
+
+let Iden x = x
\ No newline at end of file diff --git a/Source/Jennisys/examples/BHeap.jen b/Source/Jennisys/examples/BHeap.jen new file mode 100644 index 00000000..55258bde --- /dev/null +++ b/Source/Jennisys/examples/BHeap.jen @@ -0,0 +1,33 @@ +interface BHeap { + var elems: set[int] + + constructor Singleton(x: int) + ensures elems = {x} + + constructor Dupleton(a: int, b: int) + requires a != b + ensures elems = {a b} + + constructor Tripleton(x: int, y: int, z: int) + requires x != y && y != z && z != x + ensures elems = {x y z} + + method Find(n: int) returns (ret: bool) + ensures ret = (n in elems) +} + +datamodel BHeap { + var data: int + var left: BHeap + var right: BHeap + + frame + left * right + + invariant + elems = {data} + (left != null ? left.elems : {}) + (right != null ? right.elems : {}) + left != null ==> forall e :: e in left.elems ==> e < data + right != null ==> forall e :: e in right.elems ==> e < data + left = null ==> right = null + (left != null && right = null) ==> left.elems = {left.data} +} diff --git a/Source/Jennisys/examples/DList.jen b/Source/Jennisys/examples/DList.jen new file mode 100644 index 00000000..43337ca8 --- /dev/null +++ b/Source/Jennisys/examples/DList.jen @@ -0,0 +1,39 @@ +interface DNode[T] {
+ var list: seq[T]
+
+ invariant
+ |list| > 0
+
+ constructor Init(t: T)
+ ensures list = [t]
+
+ constructor Double(p: T, q: T)
+ ensures list = [p q]
+
+ method List() returns (ret: seq[T])
+ ensures ret = list
+
+ method Size() returns (ret: int)
+ ensures ret = |list|
+
+ method Get(idx: int) returns (ret: T)
+ requires idx >= 0 && idx < |list|
+ ensures ret = list[idx]
+
+ method Find(n: T) returns (ret: bool)
+ ensures ret = (n in list)
+}
+
+datamodel DNode[T] {
+ var data: T
+ var next: DNode[T]
+ var prev: DNode[T]
+
+ frame
+ next
+
+ invariant
+ next = null ==> list = [data]
+ next != null ==> (list = [data] + next.list && next.prev = this)
+ prev != null ==> prev.next = this
+}
diff --git a/Source/Jennisys/examples/List.jen b/Source/Jennisys/examples/List.jen new file mode 100644 index 00000000..85a3b692 --- /dev/null +++ b/Source/Jennisys/examples/List.jen @@ -0,0 +1,77 @@ +interface List[T] { + var list: seq[T] + + constructor Empty() + ensures list = [] + + constructor Singleton(t: T) + ensures list = [t] + + constructor Double(p: T, q: T) + ensures list = [p q] +} + +datamodel List[T] { + var root: Node[T] + + frame + root + + invariant + root = null ==> |list| = 0 + root != null ==> list = root.list +} + +interface Node[T] { + var list: seq[T] + + invariant + |list| > 0 + + constructor Init(t: T) + ensures list = [t] + + constructor Double(p: T, q: T) + ensures list = [p q] + + method List() returns (ret: seq[T]) + ensures ret = list + + method Tail() returns (tail: Node[T]) + ensures |list| = 1 ==> tail = null + ensures |list| > 1 ==> tail != null && tail.list = list[1..] + + method Size() returns (ret: int) + ensures ret = |list| + + method SkipFew(num: int) returns (ret: Node[T]) + requires num >= 0 + ensures num >= |list| ==> ret = null + ensures num < |list| ==> ret != null && ret.list = list[num..] + + method Get(idx: int) returns (ret: T) + requires idx >= 0 && idx < |list| + ensures ret = list[idx] + + method Index(n: T) returns (ret: int) + ensures n !in list ==> ret = -1 + ensures n in list ==> ret >= 0 && ret < |list| && list[ret] = n + + method Find(n: T) returns (ret: bool) + ensures ret = (n in list) + + method Insert(n: T) + ensures list = old(list) + [n] +} + +datamodel Node[T] { + var data: T + var next: Node[T] + + frame + next + + invariant + next = null ==> list = [data] + next != null ==> list = [data] + next.list +} diff --git a/Source/Jennisys/examples/List2.jen b/Source/Jennisys/examples/List2.jen new file mode 100644 index 00000000..3bd527fb --- /dev/null +++ b/Source/Jennisys/examples/List2.jen @@ -0,0 +1,68 @@ +interface IntList { + var list: seq[int] + + constructor Empty() + ensures list = [] + + constructor SingletonTwo() + ensures list = [2] + + constructor OneTwo() + ensures list = [1 2] + + constructor Singleton(p: int) + ensures list = [p] + + constructor TwoConsecutive(p: int) + ensures list = [p] + [p+1] + + constructor Double(p: int, q: int) + ensures list = [p] + [q] + + constructor Sum(p: int, q: int) + ensures list = [p + q] +} + +datamodel IntList { + var root: IntNode + + frame + root + + invariant + root = null <==> |list| = 0 + root != null ==> list = root.list +} + +interface IntNode { + var list: seq[int] + + invariant + |list| > 0 + + constructor SingletonZero() + ensures list = [0] + + constructor Init(x: int) + ensures list = [x] + + constructor Double(x: int, y: int) + ensures list = [x y] + + method Max() returns (ret: int) + ensures ret in list + ensures forall t :: t in list ==> ret >= t + +} + +datamodel IntNode { + var data: int + var next: IntNode + + frame + next + + invariant + next = null ==> list = [data] + next != null ==> list = [data] + next.list +} diff --git a/Source/Jennisys/examples/List3.jen b/Source/Jennisys/examples/List3.jen new file mode 100644 index 00000000..9130f82a --- /dev/null +++ b/Source/Jennisys/examples/List3.jen @@ -0,0 +1,71 @@ +interface IntList { + var list: seq[int] + + constructor Empty() + ensures list = [] + + constructor SingletonTwo() + ensures list = [2] + + constructor OneTwo() + ensures list = [1 2] + + constructor Singleton(p: int) + ensures list = [p] + + constructor TwoConsecutive(p: int) + ensures list = [p] + [p+1] + + constructor Double(p: int, q: int) + ensures list = [p] + [q] + + constructor Sum(p: int, q: int) + ensures list = [p + q] +} + +datamodel IntList { + var root: IntNode + + frame + root + + invariant + root = null ==> |list| = 0 + root != null ==> (|list| = |root.succ| + 1 && + list[0] = root.data && + (forall i :: i in 1 ... |root.succ| ==> (root.succ[i-1] != null && list[i] = root.succ[i-1].data))) +} + +interface IntNode { + var succ: seq[IntNode] + var data: int + + constructor Zero() + ensures data = 0 + ensures succ = [] + + constructor OneTwo() + ensures data = 1 + ensures |succ| = 1 && succ[0] != null && succ[0].data = 2 + + constructor Init(p: int) + ensures data = p + + constructor InitInc(p: int) + ensures data = p + 1 + + + invariant + !(null in succ) +} + +datamodel IntNode { + var next: IntNode + + frame + next + + invariant + next = null ==> |succ| = 0 + next != null ==> (succ = [next] + next.succ) +} diff --git a/Source/Jennisys/examples/Number.jen b/Source/Jennisys/examples/Number.jen new file mode 100644 index 00000000..e31613bd --- /dev/null +++ b/Source/Jennisys/examples/Number.jen @@ -0,0 +1,44 @@ +interface Number { + var num: int + + constructor Init(p: int) + ensures num = p + + constructor Double(p: int) + ensures num = 2*p + + constructor Sum(a: int, b: int) + ensures num = a + b + + constructor Min2(a: int, b: int) + ensures a < b ==> num = a + ensures a >= b ==> num = b + + constructor Min22(a: int, b: int) + ensures num in {a b} + ensures num <= a && num <= b + + constructor Min3(a: int, b: int, c: int) + ensures num in {a b c} + ensures num <= a && num <= b && num <= c + + constructor Min32(a: int, b: int, c: int) + ensures num in {a b c} + ensures forall x :: x in {a b c} ==> num <= x + + constructor MinSum(a: int, b: int, c: int) + ensures num in {a+b a+c b+c} + ensures num <= a+b && num <= b+c && num <= a+c + + constructor Min4(a: int, b: int, c: int, d: int) + ensures num in {a b c d} + ensures forall x :: x in {a b c d} ==> num <= x + + constructor Abs(a: int) + ensures num in {a (-a)} && num >= 0 + +} + +datamodel Number { + +}
\ No newline at end of file diff --git a/Source/Jennisys/examples/NumberMethods.jen b/Source/Jennisys/examples/NumberMethods.jen new file mode 100644 index 00000000..f9b17f74 --- /dev/null +++ b/Source/Jennisys/examples/NumberMethods.jen @@ -0,0 +1,40 @@ +interface NumberMethods { + + method Double(p: int) returns (ret: int) + ensures ret = 2*p + + method Sum(a: int, b: int) returns (ret: int) + ensures ret = a + b + + method Min2(a: int, b: int) returns (ret: int) + ensures a < b ==> ret = a + ensures a >= b ==> ret = b + + method Min22(a: int, b: int) returns (ret: int) + ensures ret in {a b} + ensures ret <= a && ret <= b + + method Min3(a: int, b: int, c: int) returns (ret: int) + ensures ret in {a b c} + ensures ret <= a && ret <= b && ret <= c + + method Min32(a: int, b: int, c: int) returns (ret: int) + ensures ret in {a b c} + ensures forall x :: x in {a b c} ==> ret <= x + + method MinSum(a: int, b: int, c: int) returns (ret: int) + ensures ret in {a+b a+c b+c} + ensures ret <= a+b && ret <= b+c && ret <= a+c + + method Min4(a: int, b: int, c: int, d: int) returns (ret: int) + ensures ret in {a b c d} + ensures forall x :: x in {a b c d} ==> ret <= x + + method Abs(a: int) returns (ret: int) + ensures ret in {a (-a)} && ret >= 0 + +} + +datamodel NumberMethods { + +}
\ No newline at end of file diff --git a/Source/Jennisys/examples/Set.jen b/Source/Jennisys/examples/Set.jen new file mode 100644 index 00000000..01532f96 --- /dev/null +++ b/Source/Jennisys/examples/Set.jen @@ -0,0 +1,72 @@ +interface Set { + var elems: set[int] + + constructor Empty() + ensures elems = {} + + constructor SingletonZero() + ensures elems = {0} + + constructor Singleton(t: int) + ensures elems = {t} + + constructor Sum(p: int, q: int) + ensures elems = {p + q} + + constructor Double(p: int, q: int) + requires p != q + ensures elems = {p q} + +} + +datamodel Set { + var root: SetNode + + frame + root + + invariant + root = null ==> elems = {} + root != null ==> elems = root.elems +} + +interface SetNode { + var elems: set[int] + + constructor Init(x: int) + ensures elems = {x} + + constructor Double(a: int, b: int) + requires a != b + ensures elems = {a b} + + constructor DoubleBase(x: int, y: int) + requires x > y + ensures elems = {x y} + + constructor Triple(x: int, y: int, z: int) + requires x != y && y != z && z != x + ensures elems = {x y z} + + constructor TripleBase(x: int, y: int, z: int) + requires x < y && y < z + ensures elems = {x y z} + + method Find(n: int) returns (ret: bool) + ensures ret = (n in elems) + +} + +datamodel SetNode { + var data: int + var left: SetNode + var right: SetNode + + frame + left * right + + invariant + elems = {data} + (left != null ? left.elems : {}) + (right != null ? right.elems : {}) + left != null ==> forall e :: e in left.elems ==> e < data + right != null ==> forall e :: e in right.elems ==> e > data +} diff --git a/Source/Jennisys/examples/Set2.jen b/Source/Jennisys/examples/Set2.jen new file mode 100644 index 00000000..cfbcbce7 --- /dev/null +++ b/Source/Jennisys/examples/Set2.jen @@ -0,0 +1,60 @@ +class Set { var elems: seq[int] + + constructor Empty() + ensures elems = [] + + constructor Singleton(t: int) + ensures elems = [t] + + constructor Sum(p: int, q: int) + ensures elems = [p + q] + +} + +model Set { + var root: SetNode + + frame + root + + invariant + root = null ==> elems = [] + root != null ==> elems = root.elems +} + +class SetNode { + var elems: seq[int] + + constructor Init(x: int) + ensures elems = [x] + + constructor Double(a: int, b: int) + requires a != b + ensures |elems| = 2 && a in elems && b in elems + + constructor DoubleBase(x: int, y: int) + requires x < y + ensures elems = [x y] + + constructor Triple(x: int, y: int, z: int) + requires x != y && y != z && z != x + ensures |elems| = 3 && x in elems && y in elems && z in elems + + constructor TripleBase(x: int, y: int, z: int) + requires x < y && y < z + ensures elems = [x y z] +} + +model SetNode { + var data: int + var left: SetNode + var right: SetNode + + frame + left * right + + invariant + elems = (left != null ? left.elems : []) + [data] + (right != null ? right.elems : []) + left != null ==> forall e :: e in left.elems ==> e < data + right != null ==> forall e :: e in right.elems ==> e > data +} diff --git a/Source/Jennisys/examples/Simple.jen b/Source/Jennisys/examples/Simple.jen new file mode 100644 index 00000000..2f5e7feb --- /dev/null +++ b/Source/Jennisys/examples/Simple.jen @@ -0,0 +1,31 @@ +interface Simple {
+ var a: int
+
+ method Inc(p: int)
+ a := old(a) + p
+
+ method Init(n: int)
+ a := n
+
+ method Max(x: int, y: int)
+ ensures x < y ==> a = y
+ ensures x >= y ==> a = x
+
+
+ method Max2(x: int, y: int)
+ ensures a = x || a = y
+ ensures forall t :: t in {x y} ==> a >= t
+
+ method Max3__mod__(x: int, y: int)
+ ensures a in {x y}
+ ensures forall t :: t in {x y} ==> a >= t
+
+ method MaxAll__mod__(x: seq[int])
+ ensures a in x
+ ensures forall t :: t in x ==> a >= t
+}
+
+datamodel Simple {
+ var c: int
+ invariant a = c
+}
\ No newline at end of file diff --git a/Source/Jennisys/examples/jennisys-synth_List.dfy b/Source/Jennisys/examples/jennisys-synth_List.dfy new file mode 100644 index 00000000..0611c78b --- /dev/null +++ b/Source/Jennisys/examples/jennisys-synth_List.dfy @@ -0,0 +1,147 @@ +class List<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var root: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Singleton(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ {
+ var gensym65 := new Node<T>;
+ gensym65.data := t;
+ gensym65.list := [t];
+ gensym65.next := null;
+ this.list := [t];
+ this.root := gensym65;
+ // repr stuff
+ gensym65.Repr := {gensym65};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ {
+ var gensym66 := new Node<T>;
+ var gensym67 := new Node<T>;
+ gensym66.data := p;
+ gensym66.list := [p, q];
+ gensym66.next := gensym67;
+ gensym67.data := q;
+ gensym67.list := [q];
+ gensym67.next := null;
+ this.list := [p, q];
+ this.root := gensym66;
+ // repr stuff
+ gensym67.Repr := {gensym67};
+ gensym66.Repr := {gensym66} + gensym66.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class Node<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null <==> list == [data] && list[0] == data) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self() && (next.next != null ==> next.next.Valid_self()))
+ }
+
+ method Init(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ {
+ var gensym71 := new Node<T>;
+ gensym71.data := q;
+ gensym71.list := [q];
+ gensym71.next := null;
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym71;
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ this.Repr := {this} + this.next.Repr;
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/jennisys-synth_List2.dfy b/Source/Jennisys/examples/jennisys-synth_List2.dfy new file mode 100644 index 00000000..13e521a8 --- /dev/null +++ b/Source/Jennisys/examples/jennisys-synth_List2.dfy @@ -0,0 +1,207 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null <==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ {
+ var gensym65 := new IntNode;
+ gensym65.data := 2;
+ gensym65.list := [2];
+ gensym65.next := null;
+ this.list := [2];
+ this.root := gensym65;
+ // repr stuff
+ gensym65.Repr := {gensym65};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1] + [2];
+ {
+ var gensym62 := new IntNode;
+ var gensym69 := new IntNode;
+ gensym62.data := 1;
+ gensym62.list := [1, 2];
+ gensym62.next := gensym69;
+ gensym69.data := 2;
+ gensym69.list := [2];
+ gensym69.next := null;
+ this.list := [1, 2];
+ this.root := gensym62;
+ // repr stuff
+ gensym69.Repr := {gensym69};
+ gensym62.Repr := {gensym62} + gensym62.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ {
+ var gensym66 := new IntNode;
+ gensym66.data := p;
+ gensym66.list := [p];
+ gensym66.next := null;
+ this.list := [p];
+ this.root := gensym66;
+ // repr stuff
+ gensym66.Repr := {gensym66};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ {
+ var gensym63 := new IntNode;
+ var gensym71 := new IntNode;
+ gensym63.data := p;
+ gensym63.list := [p] + [p + 1];
+ gensym63.next := gensym71;
+ gensym71.data := p + 1;
+ gensym71.list := [p + 1];
+ gensym71.next := null;
+ this.list := [p] + [p + 1];
+ this.root := gensym63;
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ gensym63.Repr := {gensym63} + gensym63.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ {
+ var gensym64 := new IntNode;
+ var gensym71 := new IntNode;
+ gensym64.data := p;
+ gensym64.list := [p] + [q];
+ gensym64.next := gensym71;
+ gensym71.data := q;
+ gensym71.list := [q];
+ gensym71.next := null;
+ this.list := [p] + [q];
+ this.root := gensym64;
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ gensym64.Repr := {gensym64} + gensym64.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ {
+ var gensym67 := new IntNode;
+ gensym67.data := p + q;
+ gensym67.list := [p + q];
+ gensym67.next := null;
+ this.list := [p + q];
+ this.root := gensym67;
+ // repr stuff
+ gensym67.Repr := {gensym67};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var data: int;
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> list == [data] && list[0] == data) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self() && (next.next != null ==> next.next.Valid_self()))
+ }
+
+ method SingletonZero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [0];
+ {
+ this.data := 0;
+ this.list := [0];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/jennisys-synth_List3.dfy b/Source/Jennisys/examples/jennisys-synth_List3.dfy new file mode 100644 index 00000000..e202412f --- /dev/null +++ b/Source/Jennisys/examples/jennisys-synth_List3.dfy @@ -0,0 +1,255 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> |list| == |root.succ| + 1 && (list[0] == root.data && (forall i: int :: 0 < i && i <= |root.succ| ==> root.succ[i - 1] != null && list[i] == root.succ[i - 1].data)))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ {
+ var gensym65 := new IntNode;
+ gensym65.data := 2;
+ gensym65.next := null;
+ gensym65.succ := [];
+ this.list := [2];
+ this.root := gensym65;
+ // repr stuff
+ gensym65.Repr := {gensym65};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1] + [2];
+ {
+ var gensym63 := new IntNode;
+ var gensym75 := new IntNode;
+ gensym63.data := 1;
+ gensym63.next := gensym75;
+ gensym63.succ := [gensym75];
+ gensym75.data := 2;
+ gensym75.next := null;
+ gensym75.succ := [];
+ this.list := [1, 2];
+ this.root := gensym63;
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym63.Repr := {gensym63} + gensym63.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ {
+ var gensym66 := new IntNode;
+ gensym66.data := p;
+ gensym66.next := null;
+ gensym66.succ := [];
+ this.list := [p];
+ this.root := gensym66;
+ // repr stuff
+ gensym66.Repr := {gensym66};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ {
+ var gensym64 := new IntNode;
+ var gensym75 := new IntNode;
+ gensym64.data := p;
+ gensym64.next := gensym75;
+ gensym64.succ := [gensym75];
+ gensym75.data := p + 1;
+ gensym75.next := null;
+ gensym75.succ := [];
+ this.list := [p] + [p + 1];
+ this.root := gensym64;
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym64.Repr := {gensym64} + gensym64.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ {
+ var gensym65 := new IntNode;
+ var gensym77 := new IntNode;
+ gensym65.data := p;
+ gensym65.next := gensym77;
+ gensym65.succ := [gensym77];
+ gensym77.data := q;
+ gensym77.next := null;
+ gensym77.succ := [];
+ this.list := [p] + [q];
+ this.root := gensym65;
+ // repr stuff
+ gensym77.Repr := {gensym77};
+ gensym65.Repr := {gensym65} + gensym65.next.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ {
+ var gensym67 := new IntNode;
+ gensym67.data := p + q;
+ gensym67.next := null;
+ gensym67.succ := [];
+ this.list := [p + q];
+ this.root := gensym67;
+ // repr stuff
+ gensym67.Repr := {gensym67};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var succ: seq<IntNode>;
+ ghost var data: int;
+
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> |succ| == 0) &&
+ (next != null ==> succ == [next] + next.succ) &&
+ (!(null in succ))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self() && (next.next != null ==> next.next.Valid_self()))
+ }
+
+ method Zero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 0;
+ ensures succ == [];
+ {
+ this.data := 0;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 1;
+ ensures |succ| == 1;
+ ensures succ[0] != null;
+ ensures succ[0].data == 2;
+ {
+ var gensym71 := new IntNode;
+ gensym71.data := 2;
+ gensym71.next := null;
+ gensym71.succ := [];
+ this.data := 1;
+ this.next := gensym71;
+ this.succ := [gensym71];
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ this.Repr := {this} + this.next.Repr;
+ }
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ {
+ this.data := p;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method InitInc(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p + 1;
+ {
+ this.data := p + 1;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/jennisys-synth_Number.dfy b/Source/Jennisys/examples/jennisys-synth_Number.dfy new file mode 100644 index 00000000..5ede7f5c --- /dev/null +++ b/Source/Jennisys/examples/jennisys-synth_Number.dfy @@ -0,0 +1,202 @@ +class Number {
+ ghost var Repr: set<object>;
+ ghost var num: int;
+
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ true
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ true
+ }
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == p;
+ {
+ this.num := p;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Double(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == 2 * p;
+ {
+ this.num := 2 * p;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Sum(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == a + b;
+ {
+ this.num := a + b;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Min2(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures a < b ==> num == a;
+ ensures a >= b ==> num == b;
+ {
+ if (a >= b ==> a == b) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+ method Min22(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b};
+ ensures num <= a;
+ ensures num <= b;
+ {
+ if (a <= b) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+ method Min3(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ {
+ if (a <= b && a <= c) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (c <= a && c <= b) {
+ this.num := c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+ method MinSum(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a + b, a + c, b + c};
+ ensures num <= a + b;
+ ensures num <= b + c;
+ ensures num <= a + c;
+ {
+ if (a + b <= b + c && a + b <= a + c) {
+ this.num := a + b;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (a + c <= a + b && a + c <= b + c) {
+ this.num := a + c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b + c;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+ method Min4(a: int, b: int, c: int, d: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c, d};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ ensures num <= d;
+ {
+ if (a <= b && (a <= c && a <= d)) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (d <= a && (d <= b && d <= c)) {
+ this.num := d;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (c <= a && (c <= b && c <= d)) {
+ this.num := c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+ }
+
+ method Abs(a: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures a < 0 ==> num == -a;
+ ensures a >= 0 ==> num == a;
+ {
+ if (!(a >= 0)) {
+ this.num := -a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/jennisys-synth_Set.dfy b/Source/Jennisys/examples/jennisys-synth_Set.dfy new file mode 100644 index 00000000..efc9aa07 --- /dev/null +++ b/Source/Jennisys/examples/jennisys-synth_Set.dfy @@ -0,0 +1,344 @@ +class Set {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var root: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> elems == {}) &&
+ (root != null ==> elems == root.elems)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {};
+ {
+ this.elems := {};
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Singleton(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ var gensym66 := new SetNode;
+ gensym66.data := t;
+ gensym66.elems := {t};
+ gensym66.left := null;
+ gensym66.right := null;
+ this.elems := {t};
+ this.root := gensym66;
+ // repr stuff
+ gensym66.Repr := {gensym66};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p + q};
+ {
+ var gensym68 := new SetNode;
+ gensym68.data := p + q;
+ gensym68.elems := {p + q};
+ gensym68.left := null;
+ gensym68.right := null;
+ this.elems := {p + q};
+ this.root := gensym68;
+ // repr stuff
+ gensym68.Repr := {gensym68};
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+ requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ if (q < p) {
+ var gensym71 := new SetNode;
+ var gensym75 := new SetNode;
+ gensym71.data := p;
+ gensym71.elems := {p, q};
+ gensym71.left := gensym75;
+ gensym71.right := null;
+ gensym75.data := q;
+ gensym75.elems := {q};
+ gensym75.left := null;
+ gensym75.right := null;
+ this.elems := {p, q};
+ this.root := gensym71;
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym71.Repr := {gensym71} + gensym71.left.Repr;
+ this.Repr := {this} + this.root.Repr;
+ } else {
+ var gensym71 := new SetNode;
+ var gensym75 := new SetNode;
+ gensym71.data := q;
+ gensym71.elems := {p, q};
+ gensym71.left := gensym75;
+ gensym71.right := null;
+ gensym75.data := p;
+ gensym75.elems := {p};
+ gensym75.left := null;
+ gensym75.right := null;
+ this.elems := {p, q};
+ this.root := gensym71;
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym71.Repr := {gensym71} + gensym71.left.Repr;
+ this.Repr := {this} + this.root.Repr;
+ }
+ }
+
+}
+
+class SetNode {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: SetNode;
+ var right: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> e > data))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid_self() && (left.left != null ==> left.left.Valid_self())) &&
+ (right != null ==> right.Valid_self() && (right.right != null ==> right.right.Valid_self()))
+ }
+
+ method Init(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ this.data := t;
+ this.elems := {t};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+ requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ if (q > p) {
+ var gensym79 := new SetNode;
+ gensym79.data := q;
+ gensym79.elems := {q};
+ gensym79.left := null;
+ gensym79.right := null;
+ this.data := p;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym79;
+ // repr stuff
+ gensym79.Repr := {gensym79};
+ this.Repr := {this} + this.right.Repr;
+ } else {
+ var gensym79 := new SetNode;
+ gensym79.data := p;
+ gensym79.elems := {p};
+ gensym79.left := null;
+ gensym79.right := null;
+ this.data := q;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym79;
+ // repr stuff
+ gensym79.Repr := {gensym79};
+ this.Repr := {this} + this.right.Repr;
+ }
+ }
+
+ method Triple(p: int, q: int, r: int)
+ modifies this;
+ requires p != q;
+ requires q != r;
+ requires r != p;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q, r};
+ {
+ if (p < q && r > q) {
+ var gensym83 := new SetNode;
+ var gensym84 := new SetNode;
+ gensym83.data := r;
+ gensym83.elems := {r};
+ gensym83.left := null;
+ gensym83.right := null;
+ gensym84.data := p;
+ gensym84.elems := {p};
+ gensym84.left := null;
+ gensym84.right := null;
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym84;
+ this.right := gensym83;
+ // repr stuff
+ gensym83.Repr := {gensym83};
+ gensym84.Repr := {gensym84};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (p < r && q > r) {
+ var gensym85 := new SetNode;
+ var gensym86 := new SetNode;
+ gensym85.data := q;
+ gensym85.elems := {q};
+ gensym85.left := null;
+ gensym85.right := null;
+ gensym86.data := p;
+ gensym86.elems := {p};
+ gensym86.left := null;
+ gensym86.right := null;
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym86;
+ this.right := gensym85;
+ // repr stuff
+ gensym85.Repr := {gensym85};
+ gensym86.Repr := {gensym86};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (r < p && q > p) {
+ var gensym84 := new SetNode;
+ var gensym85 := new SetNode;
+ gensym84.data := q;
+ gensym84.elems := {q};
+ gensym84.left := null;
+ gensym84.right := null;
+ gensym85.data := r;
+ gensym85.elems := {r};
+ gensym85.left := null;
+ gensym85.right := null;
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym85;
+ this.right := gensym84;
+ // repr stuff
+ gensym84.Repr := {gensym84};
+ gensym85.Repr := {gensym85};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (q < p && r > p) {
+ var gensym82 := new SetNode;
+ var gensym83 := new SetNode;
+ gensym82.data := r;
+ gensym82.elems := {r};
+ gensym82.left := null;
+ gensym82.right := null;
+ gensym83.data := q;
+ gensym83.elems := {q};
+ gensym83.left := null;
+ gensym83.right := null;
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym83;
+ this.right := gensym82;
+ // repr stuff
+ gensym82.Repr := {gensym82};
+ gensym83.Repr := {gensym83};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (q < r && p > r) {
+ var gensym85 := new SetNode;
+ var gensym86 := new SetNode;
+ gensym85.data := p;
+ gensym85.elems := {p};
+ gensym85.left := null;
+ gensym85.right := null;
+ gensym86.data := q;
+ gensym86.elems := {q};
+ gensym86.left := null;
+ gensym86.right := null;
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym86;
+ this.right := gensym85;
+ // repr stuff
+ gensym85.Repr := {gensym85};
+ gensym86.Repr := {gensym86};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ var gensym82 := new SetNode;
+ var gensym83 := new SetNode;
+ gensym82.data := p;
+ gensym82.elems := {p};
+ gensym82.left := null;
+ gensym82.right := null;
+ gensym83.data := r;
+ gensym83.elems := {r};
+ gensym83.left := null;
+ gensym83.right := null;
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym83;
+ this.right := gensym82;
+ // repr stuff
+ gensym82.Repr := {gensym82};
+ gensym83.Repr := {gensym83};
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ }
+ }
+ }
+ }
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod/jennisys-synth_List.dfy b/Source/Jennisys/examples/mod/jennisys-synth_List.dfy new file mode 100644 index 00000000..474eb9f1 --- /dev/null +++ b/Source/Jennisys/examples/mod/jennisys-synth_List.dfy @@ -0,0 +1,202 @@ +class List<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var root: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ {
+ var gensym68 := new Node<T>;
+ gensym68._synth_List_Double_gensym68(p, q);
+ this.list := [p, q];
+ this.root := gensym68;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Singleton(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ {
+ var gensym69 := new Node<T>;
+ gensym69._synth_List_Singleton_gensym69(t);
+ this.list := [t];
+ this.root := gensym69;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class Node<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null <==> list == [data] && list[0] == data) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Init(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_List_Double_gensym68(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 2;
+ ensures list[0] == p;
+ ensures list[1] == q;
+ {
+ var gensym75 := new Node<T>;
+ gensym75._synth_Node__synth_List_Double_gensym68_gensym75(q);
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym75;
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_List_Singleton_gensym69(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == t;
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ {
+ var gensym73 := new Node<T>;
+ gensym73._synth_Node_Double_gensym73(q);
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym73;
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_Node_Double_gensym73(q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == q;
+ {
+ this.data := q;
+ this.list := [q];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_Node__synth_List_Double_gensym68_gensym75(q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == q;
+ {
+ this.data := q;
+ this.list := [q];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod/jennisys-synth_List2.dfy b/Source/Jennisys/examples/mod/jennisys-synth_List2.dfy new file mode 100644 index 00000000..46213b46 --- /dev/null +++ b/Source/Jennisys/examples/mod/jennisys-synth_List2.dfy @@ -0,0 +1,323 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null <==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ {
+ var gensym67 := new IntNode;
+ gensym67._synth_IntList_Double_gensym67(p, q);
+ this.list := [p] + [q];
+ this.root := gensym67;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1, 2];
+ {
+ var gensym65 := new IntNode;
+ gensym65._synth_IntList_OneTwo_gensym65();
+ this.list := [1, 2];
+ this.root := gensym65;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ {
+ var gensym70 := new IntNode;
+ gensym70._synth_IntList_Singleton_gensym70(p);
+ this.list := [p];
+ this.root := gensym70;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ {
+ var gensym69 := new IntNode;
+ gensym69._synth_IntList_SingletonTwo_gensym69();
+ this.list := [2];
+ this.root := gensym69;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ {
+ var gensym71 := new IntNode;
+ gensym71._synth_IntList_Sum_gensym71(p, q);
+ this.list := [p + q];
+ this.root := gensym71;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ {
+ var gensym66 := new IntNode;
+ gensym66._synth_IntList_TwoConsecutive_gensym66(p);
+ this.list := [p] + [p + 1];
+ this.root := gensym66;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var data: int;
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> list == [data] && list[0] == data) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method SingletonZero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [0];
+ {
+ this.data := 0;
+ this.list := [0];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Double_gensym67(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ {
+ var gensym78 := new IntNode;
+ gensym78._synth_IntNode__synth_IntList_Double_gensym67_gensym78(q);
+ this.data := p;
+ this.list := [p] + [q];
+ this.next := gensym78;
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntList_OneTwo_gensym65()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 2;
+ ensures list[0] == 1;
+ ensures list[1] == 2;
+ {
+ var gensym75 := new IntNode;
+ gensym75._synth_IntNode__synth_IntList_OneTwo_gensym65_gensym75();
+ this.data := 1;
+ this.list := [1, 2];
+ this.next := gensym75;
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntList_SingletonTwo_gensym69()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == 2;
+ {
+ this.data := 2;
+ this.list := [2];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Singleton_gensym70(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == p;
+ {
+ this.data := p;
+ this.list := [p];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Sum_gensym71(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == p + q;
+ {
+ this.data := p + q;
+ this.list := [p + q];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_TwoConsecutive_gensym66(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ {
+ var gensym78 := new IntNode;
+ gensym78._synth_IntNode__synth_IntList_TwoConsecutive_gensym66_gensym78(p);
+ this.data := p;
+ this.list := [p] + [p + 1];
+ this.next := gensym78;
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntNode__synth_IntList_Double_gensym67_gensym78(q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == q;
+ {
+ this.data := q;
+ this.list := [q];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_OneTwo_gensym65_gensym75()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == 2;
+ {
+ this.data := 2;
+ this.list := [2];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_TwoConsecutive_gensym66_gensym78(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures |list| == 1;
+ ensures list[0] == p + 1;
+ {
+ this.data := p + 1;
+ this.list := [p + 1];
+ this.next := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod/jennisys-synth_List3.dfy b/Source/Jennisys/examples/mod/jennisys-synth_List3.dfy new file mode 100644 index 00000000..e079b608 --- /dev/null +++ b/Source/Jennisys/examples/mod/jennisys-synth_List3.dfy @@ -0,0 +1,393 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> |list| == |root.succ| + 1 && (list[0] == root.data && (forall i :: 1 <= i && i <= |root.succ| ==> root.succ[i - 1] != null && list[i] == root.succ[i - 1].data)))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ {
+ var gensym68 := new IntNode;
+ gensym68._synth_IntList_Double_gensym68(p, q);
+ this.list := [p] + [q];
+ this.root := gensym68;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ {
+ this.list := [];
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1, 2];
+ {
+ var gensym65 := new IntNode;
+ gensym65._synth_IntList_OneTwo_gensym65();
+ this.list := [1, 2];
+ this.root := gensym65;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ {
+ var gensym70 := new IntNode;
+ gensym70._synth_IntList_Singleton_gensym70(p);
+ this.list := [p];
+ this.root := gensym70;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ {
+ var gensym69 := new IntNode;
+ gensym69._synth_IntList_SingletonTwo_gensym69();
+ this.list := [2];
+ this.root := gensym69;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ {
+ var gensym71 := new IntNode;
+ gensym71._synth_IntList_Sum_gensym71(p, q);
+ this.list := [p + q];
+ this.root := gensym71;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ {
+ var gensym67 := new IntNode;
+ gensym67._synth_IntList_TwoConsecutive_gensym67(p);
+ this.list := [p] + [p + 1];
+ this.root := gensym67;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var succ: seq<IntNode>;
+ ghost var data: int;
+
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> |succ| == 0) &&
+ (next != null ==> succ == [next] + next.succ) &&
+ (!(null in succ))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ {
+ this.data := p;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method InitInc(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p + 1;
+ {
+ this.data := p + 1;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Zero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 0;
+ ensures succ == [];
+ {
+ this.data := 0;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Double_gensym68(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ ensures |succ| == 1;
+ ensures succ[0].data == q;
+ ensures succ[0].succ == [];
+ {
+ var gensym80 := new IntNode;
+ gensym80._synth_IntNode__synth_IntList_Double_gensym68_gensym80(q);
+ this.data := p;
+ this.next := gensym80;
+ this.succ := [gensym80];
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntList_OneTwo_gensym65()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 1;
+ ensures |succ| == 1;
+ ensures succ[0].data == 2;
+ ensures succ[0].succ == [];
+ {
+ var gensym78 := new IntNode;
+ gensym78._synth_IntNode__synth_IntList_OneTwo_gensym65_gensym78();
+ this.data := 1;
+ this.next := gensym78;
+ this.succ := [gensym78];
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntList_SingletonTwo_gensym69()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 2;
+ ensures |succ| == 0;
+ {
+ this.data := 2;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Singleton_gensym70(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ ensures |succ| == 0;
+ {
+ this.data := p;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Sum_gensym71(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p + q;
+ ensures |succ| == 0;
+ {
+ this.data := p + q;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_TwoConsecutive_gensym67(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ ensures |succ| == 1;
+ ensures succ[0].data == p + 1;
+ ensures succ[0].succ == [];
+ {
+ var gensym79 := new IntNode;
+ gensym79._synth_IntNode__synth_IntList_TwoConsecutive_gensym67_gensym79(p);
+ this.data := p;
+ this.next := gensym79;
+ this.succ := [gensym79];
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 1;
+ ensures |succ| == 1;
+ ensures succ[0] != null;
+ ensures succ[0].data == 2;
+ {
+ var gensym73 := new IntNode;
+ gensym73._synth_IntNode_OneTwo_gensym73();
+ this.data := 1;
+ this.next := gensym73;
+ this.succ := [gensym73];
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ }
+
+
+ method _synth_IntNode_OneTwo_gensym73()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 2;
+ ensures |succ| == 0;
+ {
+ this.data := 2;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_Double_gensym68_gensym80(q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == q;
+ ensures |succ| == 0;
+ {
+ this.data := q;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_OneTwo_gensym65_gensym78()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 2;
+ ensures |succ| == 0;
+ {
+ this.data := 2;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_TwoConsecutive_gensym67_gensym79(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p + 1;
+ ensures |succ| == 0;
+ {
+ this.data := p + 1;
+ this.next := null;
+ this.succ := [];
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod/jennisys-synth_Number.dfy b/Source/Jennisys/examples/mod/jennisys-synth_Number.dfy new file mode 100644 index 00000000..3f1e6b4b --- /dev/null +++ b/Source/Jennisys/examples/mod/jennisys-synth_Number.dfy @@ -0,0 +1,233 @@ +class Number {
+ ghost var Repr: set<object>;
+ ghost var num: int;
+
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ true
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ true
+ }
+
+
+ method Double(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == 2 * p;
+ {
+ this.num := 2 * p;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == p;
+ {
+ this.num := p;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Sum(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == a + b;
+ {
+ this.num := a + b;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Abs(a: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, -a};
+ ensures num >= 0;
+ {
+ if (a >= 0) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := -a;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+
+ method Min4(a: int, b: int, c: int, d: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c, d};
+ ensures (forall x :: x in {a, b, c, d} ==> num <= x);
+ {
+ if (a <= b && (a <= c && a <= d)) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (d <= a && (d <= b && d <= c)) {
+ this.num := d;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (c <= a && (c <= b && c <= d)) {
+ this.num := c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+ }
+
+
+ method MinSum(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a + b, a + c, b + c};
+ ensures num <= a + b;
+ ensures num <= b + c;
+ ensures num <= a + c;
+ {
+ if (a + b <= b + c && a + b <= a + c) {
+ this.num := a + b;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (a + c <= a + b && a + c <= b + c) {
+ this.num := a + c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b + c;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+
+ method Min32(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c};
+ ensures (forall x :: x in {a, b, c} ==> num <= x);
+ {
+ if (a <= b && a <= c) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (c <= a && c <= b) {
+ this.num := c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+
+ method Min3(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ {
+ if (a <= b && a <= c) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ if (c <= a && c <= b) {
+ this.num := c;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+
+ method Min22(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b};
+ ensures num <= a;
+ ensures num <= b;
+ {
+ if (a <= b) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+
+ method Min2(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures a < b ==> num == a;
+ ensures a >= b ==> num == b;
+ {
+ if (a >= b ==> a == b) {
+ this.num := a;
+ // repr stuff
+ this.Repr := {this};
+ } else {
+ this.num := b;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod/jennisys-synth_Set.dfy b/Source/Jennisys/examples/mod/jennisys-synth_Set.dfy new file mode 100644 index 00000000..40404bfb --- /dev/null +++ b/Source/Jennisys/examples/mod/jennisys-synth_Set.dfy @@ -0,0 +1,388 @@ +class Set {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var root: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> elems == {}) &&
+ (root != null ==> elems == root.elems)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ var gensym67 := new SetNode;
+ gensym67._synth_Set_Double_gensym67(p, q);
+ this.elems := {p, q};
+ this.root := gensym67;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {};
+ {
+ this.elems := {};
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Singleton(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ var gensym67 := new SetNode;
+ gensym67._synth_Set_Singleton_gensym67(t);
+ this.elems := {t};
+ this.root := gensym67;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p + q};
+ {
+ var gensym69 := new SetNode;
+ gensym69._synth_Set_Sum_gensym69(p, q);
+ this.elems := {p + q};
+ this.root := gensym69;
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class SetNode {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: SetNode;
+ var right: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> e > data))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid_self()) &&
+ (right != null ==> right.Valid_self()) &&
+ (left != null && left.left != null ==> left.left.Valid_self()) &&
+ (left != null && left.right != null ==> left.right.Valid_self()) &&
+ (right != null && right.left != null ==> right.left.Valid_self()) &&
+ (right != null && right.right != null ==> right.right.Valid_self())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ if (q > p) {
+ var gensym77 := new SetNode;
+ gensym77._synth_SetNode_Double_gensym77(q);
+ this.data := p;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym77;
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ } else {
+ var gensym77 := new SetNode;
+ gensym77._synth_SetNode_Double_gensym77(p);
+ this.data := q;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym77;
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ }
+ }
+
+
+ method _synth_SetNode_Double_gensym77(q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {q};
+ {
+ this.data := q;
+ this.elems := {q};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_SetNode_Triple_gensym80(r: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {r};
+ {
+ this.data := r;
+ this.elems := {r};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Triple(p: int, q: int, r: int)
+ modifies this;
+ requires p != q;
+ requires q != r;
+ requires r != p;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q, r};
+ {
+ if (p < q && r > q) {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(r);
+ gensym81._synth_SetNode_Triple_gensym81(p);
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (r < p && q > p) {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(q);
+ gensym81._synth_SetNode_Triple_gensym81(r);
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (p < r && q > r) {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(q);
+ gensym81._synth_SetNode_Triple_gensym81(p);
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (r < q && p > q) {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(p);
+ gensym81._synth_SetNode_Triple_gensym81(r);
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (q < r && p > r) {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(p);
+ gensym81._synth_SetNode_Triple_gensym81(q);
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ var gensym80 := new SetNode;
+ var gensym81 := new SetNode;
+ gensym80._synth_SetNode_Triple_gensym80(r);
+ gensym81._synth_SetNode_Triple_gensym81(q);
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym81;
+ this.right := gensym80;
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ }
+ }
+ }
+ }
+ }
+ }
+
+
+ method _synth_SetNode_Triple_gensym81(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p};
+ {
+ this.data := p;
+ this.elems := {p};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Init(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ this.data := t;
+ this.elems := {t};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_SetNode__synth_Set_Double_gensym67_gensym77(q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {q};
+ {
+ this.data := q;
+ this.elems := {q};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_Set_Double_gensym67(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ if (q > p) {
+ var gensym77 := new SetNode;
+ gensym77._synth_SetNode__synth_Set_Double_gensym67_gensym77(q);
+ this.data := p;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym77;
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ } else {
+ if (p > q) {
+ var gensym77 := new SetNode;
+ gensym77._synth_SetNode__synth_Set_Double_gensym67_gensym77(p);
+ this.data := q;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym77;
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ } else {
+ this.data := q;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+ }
+ }
+
+
+ method _synth_Set_Singleton_gensym67(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ this.data := t;
+ this.elems := {t};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_Set_Sum_gensym69(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p + q};
+ {
+ this.data := p + q;
+ this.elems := {p + q};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_DList.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_DList.dfy new file mode 100644 index 00000000..3e1aa99f --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_DList.dfy @@ -0,0 +1,255 @@ +class DList<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var root: DNode<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym79 := new DNode<T>;
+ var gensym85 := new DNode<T>;
+ this.list := [p, q];
+ this.root := gensym79;
+ gensym79.data := p;
+ gensym79.list := [p, q];
+ gensym79.next := gensym85;
+ gensym79.prev := null;
+ gensym85.data := q;
+ gensym85.list := [q];
+ gensym85.next := null;
+ gensym85.prev := gensym79;
+
+ // repr stuff
+ gensym85.Repr := {gensym85};
+ gensym79.Repr := {gensym79} + {gensym85};
+ this.Repr := {this} + ({gensym79} + {gensym85});
+ // assert repr objects are valid (helps verification)
+ assert gensym79.Valid() && gensym85.Valid();
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ ensures |list| == 0;
+ {
+ this.list := [];
+ this.root := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Singleton(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ var gensym78 := new DNode<T>;
+ this.list := [t];
+ this.root := gensym78;
+ gensym78.data := t;
+ gensym78.list := [t];
+ gensym78.next := null;
+ gensym78.prev := null;
+
+ // repr stuff
+ gensym78.Repr := {gensym78};
+ this.Repr := {this} + {gensym78};
+ // assert repr objects are valid (helps verification)
+ assert gensym78.Valid();
+ }
+
+}
+
+class DNode<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: DNode<T>;
+ var prev: DNode<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> (list == [data] && list[0] == data) && |list| == 1) &&
+ (next != null ==> list == [data] + next.list && next.prev == this) &&
+ (prev != null ==> prev.next == this) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym95 := new DNode<T>;
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym95;
+ this.prev := null;
+ gensym95.data := q;
+ gensym95.list := [q];
+ gensym95.next := null;
+ gensym95.prev := this;
+
+ // repr stuff
+ this.Repr := {this} + {gensym95};
+ gensym95.Repr := {gensym95};
+ // assert repr objects are valid (helps verification)
+ assert gensym95.Valid();
+ }
+
+
+ method Find(n: T) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in list);
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := n == this.data;
+ } else {
+ var x_5 := this.next.Find(n);
+ ret := n == this.data || x_5;
+ }
+ }
+
+
+ method Get(idx: int) returns (ret: T)
+ requires Valid();
+ requires idx >= 0;
+ requires idx < |list|;
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list[idx];
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := this.data;
+ } else {
+ if (idx == 0) {
+ ret := this.data;
+ } else {
+ var x_6 := this.next.Get(idx - 1);
+ ret := x_6;
+ }
+ }
+ }
+
+
+ method Init(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+ this.prev := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method List() returns (ret: seq<T>)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := [this.data];
+ } else {
+ var x_7 := this.next.List();
+ ret := [this.data] + x_7;
+ }
+ }
+
+
+ method Size() returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == |list|;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := 1;
+ } else {
+ var x_8 := this.next.Size();
+ ret := 1 + x_8;
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_List.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_List.dfy new file mode 100644 index 00000000..9939dcc2 --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_List.dfy @@ -0,0 +1,249 @@ +class List<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var root: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym78 := new Node<T>;
+ gensym78.Double(p, q);
+ this.list := [p, q];
+ this.root := gensym78;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym78.Valid();
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ ensures |list| == 0;
+ {
+ this.list := [];
+ this.root := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Singleton(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ var gensym77 := new Node<T>;
+ gensym77.Init(t);
+ this.list := [t];
+ this.root := gensym77;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym77.Valid();
+ }
+
+}
+
+class Node<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: Node<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> (list == [data] && list[0] == data) && |list| == 1) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym87 := new Node<T>;
+ gensym87.Init(q);
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym87;
+
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym87.Valid();
+ }
+
+
+ method Find(n: T) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in list);
+ decreases Repr;
+ {
+ if (n != this.data && this.next == null) {
+ ret := n == this.data;
+ } else {
+ if (this.next != null) {
+ var x_6 := this.next.Find(n);
+ ret := n == this.data || x_6;
+ } else {
+ ret := true;
+ }
+ }
+ }
+
+
+ method Get(idx: int) returns (ret: T)
+ requires Valid();
+ requires idx >= 0;
+ requires idx < |list|;
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list[idx];
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := this.data;
+ } else {
+ if (idx == 0) {
+ ret := this.data;
+ } else {
+ var x_7 := this.next.Get(idx - 1);
+ ret := x_7;
+ }
+ }
+ }
+
+
+ method Init(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method List() returns (ret: seq<T>)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := [this.data];
+ } else {
+ var x_8 := this.next.List();
+ ret := [this.data] + x_8;
+ }
+ }
+
+
+ method Size() returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == |list|;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := 1;
+ } else {
+ var x_9 := this.next.Size();
+ ret := 1 + x_9;
+ }
+ }
+
+
+ method Tail() returns (tail: Node<T>)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures |list| == 1 ==> tail == null;
+ ensures |list| > 1 ==> tail != null && tail.list == list[1..];
+ ensures tail != null ==> tail.Valid();
+ {
+ tail := this.next;
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_List2.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_List2.dfy new file mode 100644 index 00000000..f994186b --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_List2.dfy @@ -0,0 +1,225 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null <==> |list| == 0) &&
+ (root != null ==> list == root.list)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym74 := new IntNode;
+ gensym74.Double(p, q);
+ this.list := [p] + [q];
+ this.root := gensym74;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym74.Valid();
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ ensures |list| == 0;
+ {
+ this.list := [];
+ this.root := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1, 2];
+ ensures list[0] == 1;
+ ensures list[1] == 2;
+ ensures |list| == 2;
+ {
+ this.Double(1, 2);
+ }
+
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ ensures list[0] == p;
+ ensures |list| == 1;
+ {
+ var gensym73 := new IntNode;
+ gensym73.Init(p);
+ this.list := [p];
+ this.root := gensym73;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym73.Valid();
+ }
+
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ ensures list[0] == 2;
+ ensures |list| == 1;
+ {
+ this.Singleton(2);
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ ensures list[0] == p + q;
+ ensures |list| == 1;
+ {
+ this.Singleton(p + q);
+ }
+
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ ensures list[0] == p;
+ ensures list[1] == p + 1;
+ ensures |list| == 2;
+ {
+ this.Double(p, p + 1);
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var data: int;
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> (list == [data] && list[0] == data) && |list| == 1) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Double(x: int, y: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [x, y];
+ ensures list[0] == x;
+ ensures list[1] == y;
+ ensures |list| == 2;
+ {
+ var gensym87 := new IntNode;
+ gensym87.Init(y);
+ this.data := x;
+ this.list := [x, y];
+ this.next := gensym87;
+
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym87.Valid();
+ }
+
+
+ method Init(x: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [x];
+ ensures list[0] == x;
+ ensures |list| == 1;
+ {
+ this.data := x;
+ this.list := [x];
+ this.next := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method SingletonZero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [0];
+ ensures list[0] == 0;
+ ensures |list| == 1;
+ {
+ this.Init(0);
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_List3.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_List3.dfy new file mode 100644 index 00000000..65e308bd --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_List3.dfy @@ -0,0 +1,309 @@ +class IntList {
+ ghost var Repr: set<object>;
+ ghost var list: seq<int>;
+
+ var root: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> |list| == 0) &&
+ (root != null ==> |list| == |root.succ| + 1 && (list[0] == root.data && (forall i :: 1 <= i && i <= |root.succ| ==> root.succ[i - 1] != null && list[i] == root.succ[i - 1].data)))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym79 := new IntNode;
+ gensym79._synth_IntList_Double_gensym79(p, q);
+ this.list := [p] + [q];
+ this.root := gensym79;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym79.Valid();
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [];
+ ensures |list| == 0;
+ {
+ this.list := [];
+ this.root := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [1, 2];
+ ensures list[0] == 1;
+ ensures list[1] == 2;
+ ensures |list| == 2;
+ {
+ this.Double(1, 2);
+ }
+
+
+ method Singleton(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p];
+ ensures list[0] == p;
+ ensures |list| == 1;
+ {
+ var gensym77 := new IntNode;
+ gensym77._synth_IntList_Singleton_gensym77(p);
+ this.list := [p];
+ this.root := gensym77;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym77.Valid();
+ }
+
+
+ method SingletonTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [2];
+ ensures list[0] == 2;
+ ensures |list| == 1;
+ {
+ this.Singleton(2);
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p + q];
+ ensures list[0] == p + q;
+ ensures |list| == 1;
+ {
+ this.Singleton(p + q);
+ }
+
+
+ method TwoConsecutive(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p] + [p + 1];
+ ensures list[0] == p;
+ ensures list[1] == p + 1;
+ ensures |list| == 2;
+ {
+ this.Double(p, p + 1);
+ }
+
+}
+
+class IntNode {
+ ghost var Repr: set<object>;
+ ghost var succ: seq<IntNode>;
+ ghost var data: int;
+
+ var next: IntNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> |succ| == 0) &&
+ (next != null ==> succ == [next] + next.succ) &&
+ (!(null in succ))
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ {
+ this.data := p;
+ this.next := null;
+ this.succ := [];
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method InitInc(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p + 1;
+ {
+ this.Init(p + 1);
+ }
+
+
+ method OneTwo()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 1;
+ ensures |succ| == 1;
+ ensures succ[0] != null;
+ ensures succ[0].data == 2;
+ {
+ var gensym83 := new IntNode;
+ gensym83._synth_IntNode_OneTwo_gensym83();
+ this.data := 1;
+ this.next := gensym83;
+ this.succ := [gensym83];
+
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym83.Valid();
+ }
+
+
+ method Zero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 0;
+ ensures succ == [];
+ ensures |succ| == 0;
+ {
+ this.data := 0;
+ this.next := null;
+ this.succ := [];
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntList_Double_gensym79(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ ensures |succ| == 1;
+ ensures succ[0].data == q;
+ ensures succ[0].succ == [];
+ ensures |succ[0].succ| == 0;
+ {
+ var gensym93 := new IntNode;
+ gensym93._synth_IntNode__synth_IntList_Double_gensym79_gensym93(q);
+ this.data := p;
+ this.next := gensym93;
+ this.succ := [gensym93];
+
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym93.Valid();
+ }
+
+
+ method _synth_IntList_Singleton_gensym77(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == p;
+ ensures |succ| == 0;
+ {
+ this.data := p;
+ this.next := null;
+ this.succ := [];
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode_OneTwo_gensym83()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == 2;
+ ensures |succ| == 0;
+ {
+ this.data := 2;
+ this.next := null;
+ this.succ := [];
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method _synth_IntNode__synth_IntList_Double_gensym79_gensym93(q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures data == q;
+ ensures |succ| == 0;
+ {
+ this.data := q;
+ this.next := null;
+ this.succ := [];
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_Number.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_Number.dfy new file mode 100644 index 00000000..9bb3c398 --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_Number.dfy @@ -0,0 +1,181 @@ +class Number {
+ ghost var Repr: set<object>;
+ ghost var num: int;
+
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ true
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ true
+ }
+
+
+ method Abs(a: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, -a};
+ ensures num >= 0;
+ {
+ if (a >= 0) {
+ this.Init(a);
+ } else {
+ this.Init(-a);
+ }
+ }
+
+
+ method Double(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == 2 * p;
+ {
+ this.Init(2 * p);
+ }
+
+
+ method Init(p: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == p;
+ {
+ this.num := p;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Min2(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures a < b ==> num == a;
+ ensures a >= b ==> num == b;
+ {
+ if (a < b) {
+ this.Init(a);
+ } else {
+ this.Init(b);
+ }
+ }
+
+
+ method Min22(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b};
+ ensures num <= a;
+ ensures num <= b;
+ {
+ if (a <= b) {
+ this.Init(a);
+ } else {
+ this.Init(b);
+ }
+ }
+
+
+ method Min3(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ {
+ this.Min32(a, b, c);
+ }
+
+
+ method Min32(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ {
+ if (a <= b && a <= c) {
+ this.Init(a);
+ } else {
+ if (c <= a && c <= b) {
+ this.Init(c);
+ } else {
+ this.Init(b);
+ }
+ }
+ }
+
+
+ method Min4(a: int, b: int, c: int, d: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a, b, c, d};
+ ensures num <= a;
+ ensures num <= b;
+ ensures num <= c;
+ ensures num <= d;
+ {
+ if ((a <= b && a <= c) && a <= d) {
+ this.Init(a);
+ } else {
+ if ((d <= a && d <= b) && d <= c) {
+ this.Init(d);
+ } else {
+ if ((c <= a && c <= b) && c <= d) {
+ this.Init(c);
+ } else {
+ this.Init(b);
+ }
+ }
+ }
+ }
+
+
+ method MinSum(a: int, b: int, c: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num in {a + b, a + c, b + c};
+ ensures num <= a + b;
+ ensures num <= b + c;
+ ensures num <= a + c;
+ {
+ this.Min3(a + b, b + c, a + c);
+ }
+
+
+ method Sum(a: int, b: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures num == a + b;
+ {
+ this.Init(a + b);
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_NumberMethods.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_NumberMethods.dfy new file mode 100644 index 00000000..b20e2741 --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_NumberMethods.dfy @@ -0,0 +1,167 @@ +class NumberMethods {
+ ghost var Repr: set<object>;
+
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ true
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ true
+ }
+
+
+ method Abs(a: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, -a};
+ ensures ret >= 0;
+ {
+ if (-a >= 0) {
+ ret := -a;
+ } else {
+ ret := a;
+ }
+ }
+
+
+ method Double(p: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == 2 * p;
+ {
+ ret := 2 * p;
+ }
+
+
+ method Min2(a: int, b: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures a < b ==> ret == a;
+ ensures a >= b ==> ret == b;
+ {
+ if (a < b) {
+ ret := a;
+ } else {
+ ret := b;
+ }
+ }
+
+
+ method Min22(a: int, b: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, b};
+ ensures ret <= a;
+ ensures ret <= b;
+ {
+ if (a <= b) {
+ ret := a;
+ } else {
+ ret := b;
+ }
+ }
+
+
+ method Min3(a: int, b: int, c: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, b, c};
+ ensures ret <= a;
+ ensures ret <= b;
+ ensures ret <= c;
+ {
+ ret := this.Min32(a, b, c);
+ }
+
+
+ method Min32(a: int, b: int, c: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, b, c};
+ ensures ret <= a;
+ ensures ret <= b;
+ ensures ret <= c;
+ {
+ if (a <= b && a <= c) {
+ ret := a;
+ } else {
+ if (c <= a && c <= b) {
+ ret := c;
+ } else {
+ ret := b;
+ }
+ }
+ }
+
+
+ method Min4(a: int, b: int, c: int, d: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, b, c, d};
+ ensures ret <= a;
+ ensures ret <= b;
+ ensures ret <= c;
+ ensures ret <= d;
+ {
+ if ((a <= b && a <= c) && a <= d) {
+ ret := a;
+ } else {
+ if ((d <= a && d <= b) && d <= c) {
+ ret := d;
+ } else {
+ if ((c <= a && c <= b) && c <= d) {
+ ret := c;
+ } else {
+ ret := b;
+ }
+ }
+ }
+ }
+
+
+ method MinSum(a: int, b: int, c: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a + b, a + c, b + c};
+ ensures ret <= a + b;
+ ensures ret <= b + c;
+ ensures ret <= a + c;
+ {
+ ret := this.Min3(a + b, b + c, a + c);
+ }
+
+
+ method Sum(a: int, b: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == a + b;
+ {
+ ret := a + b;
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/mod2/jennisys-synth_Set.dfy b/Source/Jennisys/examples/mod2/jennisys-synth_Set.dfy new file mode 100644 index 00000000..fea364d6 --- /dev/null +++ b/Source/Jennisys/examples/mod2/jennisys-synth_Set.dfy @@ -0,0 +1,304 @@ +class Set {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var root: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> elems == {}) &&
+ (root != null ==> elems == root.elems)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+
+ method Double(p: int, q: int)
+ modifies this;
+ requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ var gensym80 := new SetNode;
+ gensym80.Double(p, q);
+ this.elems := {q, p};
+ this.root := gensym80;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym80.Valid();
+ }
+
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {};
+ {
+ this.elems := {};
+ this.root := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Singleton(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ var gensym75 := new SetNode;
+ gensym75.Init(t);
+ this.elems := {t};
+ this.root := gensym75;
+
+ // repr stuff
+ this.Repr := {this} + this.root.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym75.Valid();
+ }
+
+
+ method SingletonZero()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {0};
+ {
+ this.Singleton(0);
+ }
+
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p + q};
+ {
+ this.Singleton(p + q);
+ }
+
+}
+
+class SetNode {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: SetNode;
+ var right: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> e > data))
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid()) &&
+ (right != null ==> right.Valid()) &&
+ (left != null ==> left.Valid_self()) &&
+ (right != null ==> right.Valid_self()) &&
+ (left != null && left.left != null ==> left.left.Valid_self()) &&
+ (left != null && left.right != null ==> left.right.Valid_self()) &&
+ (right != null && right.left != null ==> right.left.Valid_self()) &&
+ (right != null && right.right != null ==> right.right.Valid_self())
+ }
+
+
+ method Double(a: int, b: int)
+ modifies this;
+ requires a != b;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {a, b};
+ {
+ if (b > a) {
+ this.DoubleBase(b, a);
+ } else {
+ var gensym88 := new SetNode;
+ gensym88.Init(a);
+ this.data := b;
+ this.elems := {b, a};
+ this.left := null;
+ this.right := gensym88;
+
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym88.Valid();
+ }
+ }
+
+
+ method DoubleBase(x: int, y: int)
+ modifies this;
+ requires x > y;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x, y};
+ {
+ var gensym88 := new SetNode;
+ gensym88.Init(x);
+ this.data := y;
+ this.elems := {y, x};
+ this.left := null;
+ this.right := gensym88;
+
+ // repr stuff
+ this.Repr := {this} + this.right.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym88.Valid();
+ }
+
+
+ method Find(n: int) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in elems);
+ decreases Repr;
+ {
+ if (this.left != null && this.right != null) {
+ var x_9 := this.left.Find(n);
+ var x_10 := this.right.Find(n);
+ ret := (n == this.data || x_9) || x_10;
+ } else {
+ if (this.left != null && this.right == null) {
+ var x_11 := this.left.Find(n);
+ ret := n == this.data || x_11;
+ } else {
+ if (this.right != null && this.left == null) {
+ var x_12 := this.right.Find(n);
+ ret := n == this.data || x_12;
+ } else {
+ ret := n == this.data;
+ }
+ }
+ }
+ }
+
+
+ method Init(x: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x};
+ {
+ this.data := x;
+ this.elems := {x};
+ this.left := null;
+ this.right := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Triple(x: int, y: int, z: int)
+ modifies this;
+ requires x != y;
+ requires y != z;
+ requires z != x;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x, y, z};
+ {
+ if (z < x && y > x) {
+ this.TripleBase(z, x, y);
+ } else {
+ if (x < y && z > y) {
+ this.TripleBase(x, y, z);
+ } else {
+ if (x < z && y > z) {
+ this.TripleBase(x, z, y);
+ } else {
+ if (y < z && x > z) {
+ this.TripleBase(y, z, x);
+ } else {
+ if (z < y && x > y) {
+ this.TripleBase(z, y, x);
+ } else {
+ var gensym82 := new SetNode;
+ var gensym83 := new SetNode;
+ gensym82.Init(y);
+ gensym83.Init(z);
+ this.data := x;
+ this.elems := {y, x, z};
+ this.left := gensym82;
+ this.right := gensym83;
+
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym82.Valid() && gensym83.Valid();
+ }
+ }
+ }
+ }
+ }
+ }
+
+
+ method TripleBase(x: int, y: int, z: int)
+ modifies this;
+ requires x < y;
+ requires y < z;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x, y, z};
+ {
+ var gensym89 := new SetNode;
+ var gensym90 := new SetNode;
+ gensym89.Init(z);
+ gensym90.Init(x);
+ this.data := y;
+ this.elems := {x, y, z};
+ this.left := gensym90;
+ this.right := gensym89;
+
+ // repr stuff
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym89.Valid() && gensym90.Valid();
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/oopsla12/BHeap.jen b/Source/Jennisys/examples/oopsla12/BHeap.jen new file mode 100644 index 00000000..41ebec85 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/BHeap.jen @@ -0,0 +1,34 @@ +interface BHeap {
+ var elems: set[int]
+
+ constructor Singleton(x: int)
+ elems := {x}
+
+ constructor Dupleton(a: int, b: int)
+ requires a != b
+ elems := {a b}
+
+ constructor Tripleton(x: int, y: int, z: int)
+ requires x != y && y != z && z != x
+ elems := {x y z}
+
+ method Find(n: int) returns (ret: bool)
+ ret := n in elems
+}
+
+datamodel BHeap {
+ var data: int
+ var left: BHeap
+ var right: BHeap
+
+ frame
+ left * right
+
+ invariant
+ elems = {data} + (left != null ? left.elems : {})
+ + (right != null ? right.elems : {})
+ left != null ==> forall e :: e in left.elems ==> e < data
+ right != null ==> forall e :: e in right.elems ==> e < data
+ left = null ==> right = null
+ left != null && right = null ==> left.elems = {left.data}
+}
\ No newline at end of file diff --git a/Source/Jennisys/examples/oopsla12/BHeap_synth.dfy b/Source/Jennisys/examples/oopsla12/BHeap_synth.dfy new file mode 100644 index 00000000..addba4ae --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/BHeap_synth.dfy @@ -0,0 +1,220 @@ +class BHeap {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: BHeap;
+ var right: BHeap;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> e < data)) &&
+ (left == null ==> right == null) &&
+ (left != null && right == null ==> left.elems == {left.data})
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid()) &&
+ (right != null ==> right.Valid()) &&
+ (left != null ==> left.Valid_self()) &&
+ (right != null ==> right.Valid_self()) &&
+ (left != null && left.left != null ==> left.left.Valid_self()) &&
+ (left != null && left.right != null ==> left.right.Valid_self()) &&
+ (right != null && right.left != null ==> right.left.Valid_self()) &&
+ (right != null && right.right != null ==> right.right.Valid_self())
+ }
+
+
+ method Dupleton(a: int, b: int)
+ modifies this;
+ requires a != b;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {a, b};
+ {
+ if (b < a) {
+ var gensym71 := new BHeap;
+ var gensym73 := new BHeap;
+ this.data := a;
+ this.elems := {b, a};
+ this.left := gensym73;
+ this.right := gensym71;
+ gensym71.data := b;
+ gensym71.elems := {b};
+ gensym71.left := null;
+ gensym71.right := null;
+ gensym73.data := b;
+ gensym73.elems := {b};
+ gensym73.left := null;
+ gensym73.right := null;
+
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ gensym73.Repr := {gensym73};
+ this.Repr := ({this} + {gensym73}) + {gensym71};
+ // assert repr objects are valid (helps verification)
+ assert gensym71.Valid() && gensym73.Valid();
+ } else {
+ var gensym71 := new BHeap;
+ var gensym73 := new BHeap;
+ this.data := b;
+ this.elems := {a, b};
+ this.left := gensym73;
+ this.right := gensym71;
+ gensym71.data := a;
+ gensym71.elems := {a};
+ gensym71.left := null;
+ gensym71.right := null;
+ gensym73.data := a;
+ gensym73.elems := {a};
+ gensym73.left := null;
+ gensym73.right := null;
+
+ // repr stuff
+ gensym71.Repr := {gensym71};
+ gensym73.Repr := {gensym73};
+ this.Repr := ({this} + {gensym73}) + {gensym71};
+ // assert repr objects are valid (helps verification)
+ assert gensym71.Valid() && gensym73.Valid();
+ }
+ }
+
+
+ method Find(n: int) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in elems);
+ decreases Repr;
+ {
+ if (this.left == null) {
+ ret := n == this.data;
+ } else {
+ if (this.right != null) {
+ var x_10 := this.left.Find(n);
+ var x_11 := this.right.Find(n);
+ ret := (n == this.data || x_10) || x_11;
+ } else {
+ var x_12 := this.left.Find(n);
+ ret := n == this.data || x_12;
+ }
+ }
+ }
+
+
+ method Singleton(x: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x};
+ {
+ this.data := x;
+ this.elems := {x};
+ this.left := null;
+ this.right := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Tripleton(x: int, y: int, z: int)
+ modifies this;
+ requires x != y;
+ requires y != z;
+ requires z != x;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x, y, z};
+ {
+ if (z < y && x < y) {
+ var gensym75 := new BHeap;
+ var gensym77 := new BHeap;
+ this.data := y;
+ this.elems := {z, x, y};
+ this.left := gensym77;
+ this.right := gensym75;
+ gensym75.data := x;
+ gensym75.elems := {x};
+ gensym75.left := null;
+ gensym75.right := null;
+ gensym77.data := z;
+ gensym77.elems := {z};
+ gensym77.left := null;
+ gensym77.right := null;
+
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym77.Repr := {gensym77};
+ this.Repr := ({this} + {gensym77}) + {gensym75};
+ // assert repr objects are valid (helps verification)
+ assert gensym75.Valid() && gensym77.Valid();
+ } else {
+ if (x < z) {
+ var gensym75 := new BHeap;
+ var gensym77 := new BHeap;
+ this.data := z;
+ this.elems := {x, y, z};
+ this.left := gensym77;
+ this.right := gensym75;
+ gensym75.data := x;
+ gensym75.elems := {x};
+ gensym75.left := null;
+ gensym75.right := null;
+ gensym77.data := y;
+ gensym77.elems := {y};
+ gensym77.left := null;
+ gensym77.right := null;
+
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym77.Repr := {gensym77};
+ this.Repr := ({this} + {gensym77}) + {gensym75};
+ // assert repr objects are valid (helps verification)
+ assert gensym75.Valid() && gensym77.Valid();
+ } else {
+ var gensym75 := new BHeap;
+ var gensym77 := new BHeap;
+ this.data := x;
+ this.elems := {z, y, x};
+ this.left := gensym77;
+ this.right := gensym75;
+ gensym75.data := y;
+ gensym75.elems := {y};
+ gensym75.left := null;
+ gensym75.right := null;
+ gensym77.data := z;
+ gensym77.elems := {z};
+ gensym77.left := null;
+ gensym77.right := null;
+
+ // repr stuff
+ gensym75.Repr := {gensym75};
+ gensym77.Repr := {gensym77};
+ this.Repr := ({this} + {gensym77}) + {gensym75};
+ // assert repr objects are valid (helps verification)
+ assert gensym75.Valid() && gensym77.Valid();
+ }
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/oopsla12/DList.jen b/Source/Jennisys/examples/oopsla12/DList.jen new file mode 100644 index 00000000..7e087f95 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/DList.jen @@ -0,0 +1,40 @@ +interface DList[T] {
+ var list: seq[T]
+
+ invariant
+ |list| > 0
+
+ constructor Init(t: T)
+ list := [t]
+
+ constructor Double(p: T, q: T)
+ list := [p q]
+
+ method List() returns (ret: seq[T])
+ ret := list
+
+ method Size() returns (ret: int)
+ ret := |list|
+
+ method Get(idx: int) returns (ret: T)
+ requires 0 <= idx && idx < |list|
+ ret := list[idx]
+
+ method Find(n: T) returns (ret: bool)
+ ret := n in list
+}
+
+datamodel DList[T] {
+ var data: T
+ var next: DList[T]
+ var prev: DList[T]
+
+ frame
+ next
+
+ invariant
+ next = null ==> list = [data]
+ next != null ==> (list = [data] + next.list
+ && next.prev = this)
+ prev != null ==> prev.next = this
+}
\ No newline at end of file diff --git a/Source/Jennisys/examples/oopsla12/DList_synth.dfy b/Source/Jennisys/examples/oopsla12/DList_synth.dfy new file mode 100644 index 00000000..897a6de0 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/DList_synth.dfy @@ -0,0 +1,154 @@ +class DList<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: DList<T>;
+ var prev: DList<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> (list == [data] && list[0] == data) && |list| == 1) &&
+ (next != null ==> list == [data] + next.list && next.prev == this) &&
+ (prev != null ==> prev.next == this) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Double(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym71 := new DList<T>;
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym71;
+ this.prev := null;
+ gensym71.data := q;
+ gensym71.list := [q];
+ gensym71.next := null;
+ gensym71.prev := this;
+
+ // repr stuff
+ this.Repr := {this} + {gensym71};
+ gensym71.Repr := {gensym71};
+ // assert repr objects are valid (helps verification)
+ assert gensym71.Valid();
+ }
+
+
+ method Find(n: T) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in list);
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := n == this.data;
+ } else {
+ var x_5 := this.next.Find(n);
+ ret := n == this.data || x_5;
+ }
+ }
+
+
+ method Get(idx: int) returns (ret: T)
+ requires Valid();
+ requires 0 <= idx;
+ requires idx < |list|;
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list[idx];
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := this.data;
+ } else {
+ if (idx == 0) {
+ ret := this.data;
+ } else {
+ var x_6 := this.next.Get(idx - 1);
+ ret := x_6;
+ }
+ }
+ }
+
+
+ method Init(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+ this.prev := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method List() returns (ret: seq<T>)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := [this.data];
+ } else {
+ var x_7 := this.next.List();
+ ret := [this.data] + x_7;
+ }
+ }
+
+
+ method Size() returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == |list|;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := 1;
+ } else {
+ var x_8 := this.next.Size();
+ ret := 1 + x_8;
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/oopsla12/IntSet.jen b/Source/Jennisys/examples/oopsla12/IntSet.jen new file mode 100644 index 00000000..4800371e --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/IntSet.jen @@ -0,0 +1,30 @@ +interface IntSet {
+ var elems: set[int]
+
+ constructor Singleton(x: int)
+ elems := {x}
+
+ constructor Dupleton(x: int, y: int)
+ requires x != y
+ elems := {x y}
+
+ method Find(x: int) returns (ret: bool)
+ ret := x in elems
+}
+
+datamodel IntSet {
+ var data: int
+ var left: IntSet
+ var right: IntSet
+
+ frame left * right
+
+ invariant
+ elems = {data} +
+ (left != null ? left.elems : {}) +
+ (right != null ? right.elems : {})
+ left != null ==>
+ (forall e :: e in left.elems ==> e < data)
+ right != null ==>
+ (forall e :: e in right.elems ==> data < e)
+}
\ No newline at end of file diff --git a/Source/Jennisys/examples/oopsla12/IntSet_synth.dfy b/Source/Jennisys/examples/oopsla12/IntSet_synth.dfy new file mode 100644 index 00000000..55523e79 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/IntSet_synth.dfy @@ -0,0 +1,130 @@ +class IntSet {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: IntSet;
+ var right: IntSet;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> data < e))
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid()) &&
+ (right != null ==> right.Valid()) &&
+ (left != null ==> left.Valid_self()) &&
+ (right != null ==> right.Valid_self()) &&
+ (left != null && left.left != null ==> left.left.Valid_self()) &&
+ (left != null && left.right != null ==> left.right.Valid_self()) &&
+ (right != null && right.left != null ==> right.left.Valid_self()) &&
+ (right != null && right.right != null ==> right.right.Valid_self())
+ }
+
+
+ method Dupleton(x: int, y: int)
+ modifies this;
+ requires x != y;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x, y};
+ {
+ if (x < y) {
+ var gensym73 := new IntSet;
+ this.data := x;
+ this.elems := {x, y};
+ this.left := null;
+ this.right := gensym73;
+ gensym73.data := y;
+ gensym73.elems := {y};
+ gensym73.left := null;
+ gensym73.right := null;
+
+ // repr stuff
+ gensym73.Repr := {gensym73};
+ this.Repr := {this} + {gensym73};
+ // assert repr objects are valid (helps verification)
+ assert gensym73.Valid();
+ } else {
+ var gensym73 := new IntSet;
+ this.data := y;
+ this.elems := {y, x};
+ this.left := null;
+ this.right := gensym73;
+ gensym73.data := x;
+ gensym73.elems := {x};
+ gensym73.left := null;
+ gensym73.right := null;
+
+ // repr stuff
+ gensym73.Repr := {gensym73};
+ this.Repr := {this} + {gensym73};
+ // assert repr objects are valid (helps verification)
+ assert gensym73.Valid();
+ }
+ }
+
+
+ method Find(x: int) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (x in elems);
+ decreases Repr;
+ {
+ if (this.left != null && this.right != null) {
+ var x_13 := this.left.Find(x);
+ var x_14 := this.right.Find(x);
+ ret := (x == this.data || x_13) || x_14;
+ } else {
+ if (this.left != null) {
+ var x_15 := this.left.Find(x);
+ ret := x == this.data || x_15;
+ } else {
+ if (this.right != null) {
+ var x_16 := this.right.Find(x);
+ ret := x == this.data || x_16;
+ } else {
+ ret := x == this.data;
+ }
+ }
+ }
+ }
+
+
+ method Singleton(x: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {x};
+ {
+ this.data := x;
+ this.elems := {x};
+ this.left := null;
+ this.right := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/oopsla12/List.jen b/Source/Jennisys/examples/oopsla12/List.jen new file mode 100644 index 00000000..10a70050 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/List.jen @@ -0,0 +1,29 @@ +interface List[T] {
+ var list: seq[T]
+ invariant |list| > 0
+
+ constructor Singleton(t: T)
+ list := [t]
+ constructor Dupleton(p: T, q: T)
+ list := [p q]
+ method Elems() returns (ret: seq[T])
+ ret := list
+ method Get(idx: int) returns (ret: T)
+ requires 0 <= idx && idx < |list|
+ ret := list[idx]
+ method Find(n: T) returns (ret: bool)
+ ret := n in list
+ method Size() returns (ret: int)
+ ret := |list|
+}
+
+datamodel List[T] {
+ var data: T
+ var next: List[T]
+
+ frame next
+
+ invariant
+ next = null ==> list = [data]
+ next != null ==> list = [data] + next.list
+}
\ No newline at end of file diff --git a/Source/Jennisys/examples/oopsla12/List_synth.dfy b/Source/Jennisys/examples/oopsla12/List_synth.dfy new file mode 100644 index 00000000..5cbfa10e --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/List_synth.dfy @@ -0,0 +1,146 @@ +class List<T> {
+ ghost var Repr: set<object>;
+ ghost var list: seq<T>;
+
+ var data: T;
+ var next: List<T>;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (next != null ==> next in Repr && next.Repr <= Repr && this !in next.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (next == null ==> (list == [data] && list[0] == data) && |list| == 1) &&
+ (next != null ==> list == [data] + next.list) &&
+ (|list| > 0)
+ }
+
+ function Valid(): bool
+ reads *;
+ decreases Repr;
+ {
+ this.Valid_self() &&
+ (next != null ==> next.Valid()) &&
+ (next != null ==> next.Valid_self()) &&
+ (next != null && next.next != null ==> next.next.Valid_self())
+ }
+
+
+ method Dupleton(p: T, q: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [p, q];
+ ensures list[0] == p;
+ ensures list[1] == q;
+ ensures |list| == 2;
+ {
+ var gensym71 := new List<T>;
+ gensym71.Singleton(q);
+ this.data := p;
+ this.list := [p, q];
+ this.next := gensym71;
+
+ // repr stuff
+ this.Repr := {this} + this.next.Repr;
+ // assert repr objects are valid (helps verification)
+ assert gensym71.Valid();
+ }
+
+
+ method Elems() returns (ret: seq<T>)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := [this.data];
+ } else {
+ var x_5 := this.next.Elems();
+ ret := [this.data] + x_5;
+ }
+ }
+
+
+ method Find(n: T) returns (ret: bool)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == (n in list);
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := n == this.data;
+ } else {
+ var x_6 := this.next.Find(n);
+ ret := n == this.data || x_6;
+ }
+ }
+
+
+ method Get(idx: int) returns (ret: T)
+ requires Valid();
+ requires 0 <= idx;
+ requires idx < |list|;
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == list[idx];
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := this.data;
+ } else {
+ if (idx == 0) {
+ ret := this.data;
+ } else {
+ var x_7 := this.next.Get(idx - 1);
+ ret := x_7;
+ }
+ }
+ }
+
+
+ method Singleton(t: T)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures list == [t];
+ ensures list[0] == t;
+ ensures |list| == 1;
+ {
+ this.data := t;
+ this.list := [t];
+ this.next := null;
+
+ // repr stuff
+ this.Repr := {this};
+ }
+
+
+ method Size() returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret == |list|;
+ decreases Repr;
+ {
+ if (this.next == null) {
+ ret := 1;
+ } else {
+ var x_8 := this.next.Size();
+ ret := 1 + x_8;
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/oopsla12/Math.jen b/Source/Jennisys/examples/oopsla12/Math.jen new file mode 100644 index 00000000..0cc772b3 --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/Math.jen @@ -0,0 +1,20 @@ +interface Math {
+ method Min2(a: int, b: int) returns (ret: int)
+ ensures a < b ==> ret = a
+ ensures a >= b ==> ret = b
+
+ method Min3Sum(a: int, b: int, c: int)
+ returns (ret: int)
+ ensures ret in {a+b a+c b+c}
+ ensures forall x :: x in {a+b a+c b+c} ==> ret <= x
+
+ method Min4(a: int, b: int, c: int, d: int)
+ returns (ret: int)
+ ensures ret in {a b c d}
+ ensures forall x :: x in {a b c d} ==> ret <= x
+
+ method Abs(a: int) returns (ret: int)
+ ensures ret in {a (-a)} && ret >= 0
+}
+
+datamodel Math {}
\ No newline at end of file diff --git a/Source/Jennisys/examples/oopsla12/Math_synth.dfy b/Source/Jennisys/examples/oopsla12/Math_synth.dfy new file mode 100644 index 00000000..68893b3d --- /dev/null +++ b/Source/Jennisys/examples/oopsla12/Math_synth.dfy @@ -0,0 +1,105 @@ +class Math {
+ ghost var Repr: set<object>;
+
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ true
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ true
+ }
+
+
+ method Abs(a: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, -a};
+ ensures ret >= 0;
+ {
+ if (a >= 0) {
+ ret := a;
+ } else {
+ ret := -a;
+ }
+ }
+
+
+ method Min2(a: int, b: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures a < b ==> ret == a;
+ ensures a >= b ==> ret == b;
+ {
+ if (a < b) {
+ ret := a;
+ } else {
+ ret := b;
+ }
+ }
+
+
+ method Min3Sum(a: int, b: int, c: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a + b, a + c, b + c};
+ ensures ret <= a + b;
+ ensures ret <= a + c;
+ ensures ret <= b + c;
+ {
+ if (a + b <= a + c && a + b <= b + c) {
+ ret := a + b;
+ } else {
+ if (b + c <= a + c) {
+ ret := b + c;
+ } else {
+ ret := a + c;
+ }
+ }
+ }
+
+
+ method Min4(a: int, b: int, c: int, d: int) returns (ret: int)
+ requires Valid();
+ ensures fresh(Repr - old(Repr));
+ ensures Valid();
+ ensures ret in {a, b, c, d};
+ ensures ret <= a;
+ ensures ret <= b;
+ ensures ret <= c;
+ ensures ret <= d;
+ {
+ if ((a <= b && a <= c) && a <= d) {
+ ret := a;
+ } else {
+ if (d <= b && d <= c) {
+ ret := d;
+ } else {
+ if (c <= b) {
+ ret := c;
+ } else {
+ ret := b;
+ }
+ }
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/examples/set.dfy b/Source/Jennisys/examples/set.dfy new file mode 100644 index 00000000..627f1ecb --- /dev/null +++ b/Source/Jennisys/examples/set.dfy @@ -0,0 +1,246 @@ +class Set {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var root: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (root != null ==> root in Repr && root.Repr <= Repr && this !in root.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (root == null ==> elems == {}) &&
+ (root != null ==> elems == root.elems)
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (root != null ==> root.Valid())
+ }
+
+ method Empty()
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {};
+ {
+ this.elems := {};
+ this.root := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Singleton(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ var gensym66 := new SetNode;
+ gensym66.Init(t);
+ this.elems := {t};
+ this.root := gensym66;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Sum(p: int, q: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p + q};
+ {
+ var gensym68 := new SetNode;
+ gensym68.Init(p+q);
+ this.elems := {p + q};
+ this.root := gensym68;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+ requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ var gensym71 := new SetNode;
+ gensym71.Double(p, q);
+ this.elems := {p, q};
+ this.root := gensym71;
+ this.Repr := {this} + this.root.Repr;
+ }
+
+}
+
+class SetNode {
+ ghost var Repr: set<object>;
+ ghost var elems: set<int>;
+
+ var data: int;
+ var left: SetNode;
+ var right: SetNode;
+
+ function Valid_repr(): bool
+ reads *;
+ {
+ this in Repr &&
+ null !in Repr &&
+ (left != null ==> left in Repr && left.Repr <= Repr && this !in left.Repr) &&
+ (right != null ==> right in Repr && right.Repr <= Repr && this !in right.Repr)
+ }
+
+ function Valid_self(): bool
+ reads *;
+ {
+ Valid_repr() &&
+ (elems == ({data} + (if left != null then left.elems else {})) + (if right != null then right.elems else {})) &&
+ (left != null ==> (forall e :: e in left.elems ==> e < data)) &&
+ (right != null ==> (forall e :: e in right.elems ==> e > data))
+ }
+
+ function Valid(): bool
+ reads *;
+ {
+ this.Valid_self() &&
+ (left != null ==> left.Valid_self() && (left.left != null ==> left.left.Valid_self())) &&
+ (right != null ==> right.Valid_self() && (right.right != null ==> right.right.Valid_self()))
+ }
+
+ method Init(t: int)
+ modifies this;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {t};
+ {
+ this.data := t;
+ this.elems := {t};
+ this.left := null;
+ this.right := null;
+ // repr stuff
+ this.Repr := {this};
+ }
+
+ method Double(p: int, q: int)
+ modifies this;
+// requires p != q;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q};
+ {
+ if (q > p) {
+ var gensym79 := new SetNode;
+ gensym79.Init(q);
+ this.data := p;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym79;
+ this.Repr := {this} + this.right.Repr;
+ } else if (q < p) {
+ var gensym79 := new SetNode;
+ gensym79.Init(p);
+ this.data := q;
+ this.elems := {p, q};
+ this.left := null;
+ this.right := gensym79;
+ this.Repr := {this} + this.right.Repr;
+ } else {
+ this.data := p;
+ this.elems := {p};
+ this.left := null;
+ this.right := null;
+ this.Repr := {this};
+ }
+ }
+
+ method Triple(p: int, q: int, r: int)
+ modifies this;
+ requires p != q;
+ requires q != r;
+ requires r != p;
+ ensures fresh(Repr - {this});
+ ensures Valid();
+ ensures elems == {p, q, r};
+ {
+ if (p < q && r > q) {
+ var gensym83 := new SetNode;
+ var gensym84 := new SetNode;
+ gensym83.Init(r);
+ gensym84.Init(p);
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym84;
+ this.right := gensym83;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (p < r && q > r) {
+ var gensym85 := new SetNode;
+ var gensym86 := new SetNode;
+ gensym85.Init(q);
+ gensym86.Init(p);
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym86;
+ this.right := gensym85;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (r < p && q > p) {
+ var gensym84 := new SetNode;
+ var gensym85 := new SetNode;
+ gensym84.Init(q);
+ gensym85.Init(r);
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym85;
+ this.right := gensym84;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (q < p && r > p) {
+ var gensym82 := new SetNode;
+ var gensym83 := new SetNode;
+ gensym82.Init(r);
+ gensym83.Init(q);
+ this.data := p;
+ this.elems := {p, q, r};
+ this.left := gensym83;
+ this.right := gensym82;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ if (q < r && p > r) {
+ var gensym85 := new SetNode;
+ var gensym86 := new SetNode;
+ gensym85.Init(p);
+ gensym86.Init(q);
+ this.data := r;
+ this.elems := {p, q, r};
+ this.left := gensym86;
+ this.right := gensym85;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ } else {
+ var gensym82 := new SetNode;
+ var gensym83 := new SetNode;
+ gensym82.Init(p);
+ gensym83.Init(r);
+ this.data := q;
+ this.elems := {p, q, r};
+ this.left := gensym83;
+ this.right := gensym82;
+ this.Repr := ({this} + this.left.Repr) + this.right.Repr;
+ }
+ }
+ }
+ }
+ }
+ }
+
+}
+
+
diff --git a/Source/Jennisys/scripts/StartDafny-jen.bat b/Source/Jennisys/scripts/StartDafny-jen.bat new file mode 100644 index 00000000..6f44ec4c --- /dev/null +++ b/Source/Jennisys/scripts/StartDafny-jen.bat @@ -0,0 +1,2 @@ +@echo off
+"c:/boogie/Binaries/Dafny.exe" -nologo -compile:0 /print:xxx.bpl -timeLimit:60 %* > c:\tmp\jen-doo.out
|