packages feed

liquid-fixpoint (empty) → 0.1.0.0

raw patch · 170 files changed

+51601/−0 lines, 170 filesdep +ansi-terminaldep +arraydep +basebuild-type:Customsetup-changed

Dependencies added: ansi-terminal, array, base, bifunctors, bytestring, cmdargs, containers, deepseq, directory, filemanip, filepath, ghc, ghc-prim, hashable, liquid-fixpoint, mtl, parsec, pretty, process, syb, text, unordered-containers

Files

+ Fixpoint.hs view
@@ -0,0 +1,37 @@++import Language.Fixpoint.Interface     (solveFile)+import System.Environment              (getArgs)+-- import System.Console.GetOpt+import Language.Fixpoint.Config hiding (config)+import Data.Maybe                      (fromMaybe, listToMaybe)+import System.Console.CmdArgs                  +import System.Console.CmdArgs.Verbosity (whenLoud)++++main = do cfg <- getOpts +          whenLoud $ putStrLn $ "Options: " ++ show cfg+          solveFile cfg++config = Config { +    inFile   = def   &= typ "TARGET"       &= args    &= typFile +  , outFile  = "out" &= help "Output file"  +  , solver   = def   &= help "Name of SMT Solver" +  , genSorts = def   &= help "Generalize qualifier sorts"+}  &= verbosity+   &= program "fixpoint" +   &= help    "Predicate Abstraction Based Horn-Clause Solver" +   &= summary "fixpoint © Copyright 2009-13 Regents of the University of California." +   &= details [ "Predicate Abstraction Based Horn-Clause Solver"+              , ""+              , "To check a file foo.fq type:"+              , "  fixpoint foo.fq"+              ]++getOpts :: IO Config +getOpts = do md <- cmdArgs config +             putStrLn $ banner md+             return md++banner args =  "Liquid-Fixpoint © Copyright 2009-13 Regents of the University of California.\n" +            ++ "All Rights Reserved.\n"
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Ranjit Jhala++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ranjit Jhala nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,34 @@+import Control.Monad+import Data.Maybe+import Distribution.PackageDescription+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Setup+import System.Posix.Env+import System.Process+import System.Exit++main         = defaultMainWithHooks fixHooks +  where +    fixHooks = simpleUserHooks { postInst = buildAndCopyFixpoint } +   +buildAndCopyFixpoint _ _ pkg lbi +  = do putStrLn $ "Post Install: " ++ show binDir+       setEnv "Z3MEM" (show z3mem) True+       executeShellCommand "./configure"+       executeShellCommand "./build.sh"+       executeShellCommand "chmod a+x external/fixpoint/fixpoint.native "+       executeShellCommand $ "cp external/fixpoint/fixpoint.native " ++ binDir+       when z3mem $+         executeShellCommand $ "cp external/z3/lib/libz3.* "         ++ binDir+  where +    allDirs     = absoluteInstallDirs pkg lbi NoCopyDest+    binDir      = bindir allDirs ++ "/"+    flags       = configConfigurationsFlags $ configFlags lbi+    z3mem       = fromJust $ lookup (FlagName "z3mem") flags++executeShellCommand cmd   = putStrLn ("EXEC: " ++ cmd) >> system cmd >>= check+  where +    check (ExitSuccess)   = return ()+    check (ExitFailure n) = error $ "cmd: " ++ cmd ++ " failure code " ++ show n +
+ configure view
@@ -0,0 +1,45 @@+#!/bin/bash++ROOTHOME=`pwd`+GHCBIN=`which ghc`+GHCHOME=`dirname $GHCBIN`+OCAMLLIB=`ocamlc -v | tail -1 | cut -d : -f 2 | tr -d " "`++if [[ $Z3MEM = 'True' ]]+then+  Z3HOME=$ROOTHOME/external/z3+else+  Z3HOME=+fi++cat - > external/fixpoint/config.make <<EOF+OCAMLGRAPHHOME=$ROOTHOME/external/ocamlgraph+OCAMLLIB=$OCAMLLIB+Z3HOME=$Z3HOME+EOF++cat - > build.sh <<EOF+#!`which bash`++set -e++if [[ '$Z3MEM' = 'True' ]]+then+  if [[ \`uname -m\` = 'x86_64' ]]+  then+    echo Found 64-bit kernel. Moving z3 into place.+    cp external/z3/lib/libz3-so-64b external/z3/lib/libz3.so+    cp external/z3/lib/libz3-a-64b external/z3/lib/libz3.a+  else+    echo Assuming 32-bit kernel. Moving z3 into place.+    cp external/z3/lib/libz3-so-32b external/z3/lib/libz3.so+    cp external/z3/lib/libz3-a-32b external/z3/lib/libz3.a+  fi+  cd external/z3/ocaml; ./build-lib.sh; cd ../../../+fi++cd external/ocamlgraph/; ./configure; make; cd ../../+cd external/fixpoint; make; cd ../../+EOF++chmod a+x build.sh
+ external/fixpoint/Makefile view
@@ -0,0 +1,64 @@+include config.make++DIRS=-I misc+OFLAGS=$(DIRS) $(IFLAGS) $(LFLAGS) $(CFLAGS)++LIBS_=-libs unix,str,graph+IFLAGS_=-lflags -I,$(OCAMLGRAPHHOME)+LFLAGS_=-lflags -cclib,-L$(OCAMLLIB) \++CFLAGS_=-cflags -dtypes,-annot \+		-cflags -I,$(OCAMLGRAPHHOME) \+		-cflags -thread++SMTZ3=smtZ3.ml++ifdef Z3HOME+  LIBS=$(LIBS_),z3+  IFLAGS=$(IFLAGS_) \+		 -lflags -I,$(Z3HOME)/lib \+		 -lflags -I,$(Z3HOME)/ocaml+  LFLAGS=$(LFLAGS_) \+		 -lflags -cc,g++ \+		 -lflags -cclib,-lstdc++ \+		 -lflags -cclib,-lcamlidl \+		 -lflags -cclib,-L$(Z3HOME)/lib \+		 -lflags -cclib,-lz3 \+		 -lflags -cclib,-lz3stubs \+		 -lflags -cclib,-fopenmp\+		 -lflags -cclib,-lrt+  CFLAGS=$(CFLAGS_) \+		 -cflags -I,$(Z3HOME)/ocaml+  SMTZ3SRC=smtZ3.mem.ml+else+  LIBS=$(LIBS_)+  IFLAGS=$(IFLAGS_)+  LFLAGS=$(LFLAGS_)+  CFLAGS=$(CFLAGS_)+  SMTZ3SRC=smtZ3.nomem.ml+endif++all: smtz3+	ln -sf ../misc+	ocamlbuild -r $(LIBS) $(OFLAGS) -tags thread fixpoint.native+	ocamlbuild -r $(OFLAGS) fix.cmxa+	rm -f fixpoint.native+	cp _build/fixpoint.native .++smtz3: $(SMTZ3SRC)+	cp $(SMTZ3SRC) $(SMTZ3)++clean:+	rm -rf *.byte *.native _build _log++fixtop:+	ocamlbuild -r $(LIBS) $(OFLAGS) fixtop.native++horn:+	ocamlbuild -r $(LIBS) $(OFLAGS) hornToInterproc.native++MLITARGET=toSmtLib.ml+mli:+	ocamlc -I _build/ -I _build/misc/ -I $(Z3HOME)/lib -I $(Z3HOME)/ocaml -i $(MLITARGET)++
+ external/fixpoint/Simplification.ml view
@@ -0,0 +1,197 @@+module C = FixConstraint+module P = Ast.Predicate+module E = Ast.Expression+module Sy = Ast.Symbol+module Su = Ast.Subst++module Misc = FixMisc open Misc.Ops++let rec defs_of_pred (edefs, pdefs) ((p, _) as pred) = +  match p with+    | Ast.Atom ((Ast.Var v, _), Ast.Eq, e) when not(P.is_tauto pred) -> Sy.SMap.add v e edefs, pdefs+    | Ast.And [Ast.Imp ((Ast.Bexp (Ast.Var v1, _), _), p1), _; +	       Ast.Imp (p2, (Ast.Bexp (Ast.Var v2, _), _)), _] when v1 = v2 && p1 = p2 && not(P.is_tauto pred) -> +	edefs, Sy.SMap.add v1 p1 pdefs+    | Ast.And preds -> List.fold_left defs_of_pred (edefs, pdefs) preds+    | _ -> edefs, pdefs++let some_def_applied = ref false+let rec expr_apply_defs edefs pdefs ((e, _) as expr) = +  let current_some_def_applied = !some_def_applied in+    some_def_applied := false;+    let expr'' =+      match e with+	| Ast.Con _ -> expr+	| Ast.Var v -> +	    begin+	      try+		let expr' = Sy.SMap.find v edefs in+		  some_def_applied := true;+		  expr'+	      with Not_found -> expr+	    end+	| Ast.App (v, es) -> +	    let edefs' = Sy.SMap.remove v edefs in+	      Ast.eApp (v, List.map (expr_apply_defs edefs' pdefs) es)+	| Ast.Bin (e1, op, e2) -> +	    Ast.eBin (expr_apply_defs edefs pdefs e1, op, expr_apply_defs edefs pdefs e2)+	| Ast.Ite (p, e1, e2) -> +	    Ast.eIte (pred_apply_defs edefs pdefs p, +		      expr_apply_defs edefs pdefs e1,+		      expr_apply_defs edefs pdefs e2)+	| Ast.Fld (v, e) -> +	    let v' = +	      try+		match Sy.SMap.find v edefs with+		  | (Ast.Var v'', _) -> +		      some_def_applied := true;+		      v''+		  | _ -> v+	      with Not_found -> v+	    in+	      Ast.eFld (v', expr_apply_defs edefs pdefs e)+        | _ -> assertf "Simplification.expr_apply_defs TODO" +    in+      if !some_def_applied then+	let expr''' = expr_apply_defs edefs pdefs expr'' in+	  some_def_applied := current_some_def_applied;+	  expr'''+      else+	begin+	  some_def_applied := current_some_def_applied;+	  expr''+	end++and pred_apply_defs edefs pdefs ((p, _) as pred) =+  let current_some_def_applied = !some_def_applied in+    some_def_applied := false;+    let pred'' =+      match p with+	| Ast.And ps -> List.map (pred_apply_defs edefs pdefs) ps |> Ast.pAnd+	| Ast.Or ps -> List.map (pred_apply_defs edefs pdefs) ps |> Ast.pOr+	| Ast.Not p -> pred_apply_defs edefs pdefs p |> Ast.pNot+	| Ast.Imp (p, q) -> Ast.pImp (pred_apply_defs edefs pdefs p, pred_apply_defs edefs pdefs q)+	| Ast.Bexp (Ast.Var v, _) ->+	    begin+	      try+		let expr' = Sy.SMap.find v edefs in+		  some_def_applied := true;+		  Ast.pBexp expr'+	      with Not_found ->+		try+		  let pred' = Sy.SMap.find v pdefs in+		    some_def_applied := true;+		    pred'+		with Not_found ->+		  pred+	    end+	| Ast.Atom (e1, brel, e2) ->+	    Ast.pAtom (expr_apply_defs edefs pdefs e1, brel, expr_apply_defs edefs pdefs e2)+	| Ast.Forall (qs, p) ->+	    let vs = List.map fst qs in+	    let edefs' = List.fold_left (fun defs v -> Sy.SMap.remove v defs) edefs vs in+	    let pdefs' = List.fold_left (fun defs v -> Sy.SMap.remove v defs) pdefs vs in+	      Ast.pForall (qs, pred_apply_defs edefs' pdefs' p)+	| _ -> pred+    in+      if !some_def_applied then+	let pred''' = pred_apply_defs edefs pdefs pred'' in+	  some_def_applied := current_some_def_applied;+	  pred'''+      else +	begin+	  some_def_applied := current_some_def_applied;+	  pred''+	end++let subs_apply_defs edefs pdefs subs =+  List.map (fun (s, e) -> s, expr_apply_defs edefs pdefs e) subs++let kvar_apply_defs edefs pdefs (subs, sym) = +  subs_apply_defs edefs pdefs subs, sym++let simplify_subs subs =+  List.filter (fun (s, e) -> not(P.is_tauto (Ast.pAtom (Ast.eVar s, Ast.Eq, e)))) subs++let simplify_kvar (subs, sym) =+  simplify_subs subs, sym++let simplify_t t = +  let env_ps, pfree_env = (* separate concrete predicates from refinement templates *)+    Sy.SMap.fold +      (fun bv reft (ps, env) -> +	 let vv = C.vv_of_reft reft in+	 let bv_expr = Ast.eVar bv in+	 let sort = C.sort_of_reft reft in+	 let reft_ps, reft_ks = C.preds_kvars_of_reft reft in+	   (List.rev_append (List.map (fun p -> P.subst p vv bv_expr) reft_ps) ps,+	    if reft_ks = [] then env else Sy.SMap.add bv (vv, sort, reft_ks) env)+      ) (C.env_of_t t) ([], Sy.SMap.empty) in+  let lhs = C.lhs_of_t t in+  let lhs_vv = C.vv_of_reft lhs in+  let lhs_ps, lhs_ks = C.preds_kvars_of_reft lhs in+  let body_pred = Ast.pAnd (C.grd_of_t t :: List.rev_append lhs_ps env_ps) in+  let edefs, pdefs = defs_of_pred (Sy.SMap.empty, Sy.SMap.empty) body_pred in+    (*+    Printf.printf "\nbody_pred edefs map for %d\n" (C.id_of_t t);+    Sy.SMap.iter (fun v exp ->+		    Printf.printf "%s -> %s\n" (Sy.to_string v) (E.to_string exp)+		 ) edefs;+    Printf.printf "edef for lhs_vv %s = %s (simplified %s)\n" (Sy.to_string lhs_vv) +      (try Sy.SMap.find lhs_vv edefs |> E.to_string with Not_found -> "none")+      (try +	 Sy.SMap.find lhs_vv edefs +         |> expr_apply_defs edefs pdefs +	 |> E.to_string with Not_found -> "none");+    *)+  let kvar_to_simple_Kvar (subs, sym) = C.Kvar (subs |> Su.to_list |> subs_apply_defs edefs pdefs |> simplify_subs |> Su.of_list, sym) in+  let senv = +    Sy.SMap.mapi (fun bv (vv, sort, ks) -> +		    List.map kvar_to_simple_Kvar ks |>	C.make_reft vv sort) pfree_env in+(*     Printf.printf "body_pred: %s\n" (P.to_string body_pred); *)+  let sgrd' = pred_apply_defs edefs pdefs body_pred |> Ast.simplify_pred in+  let sgrd = +    try+      Ast.pAnd [sgrd'; Ast.pAtom (Ast.eVar lhs_vv, Ast.Eq, Sy.SMap.find lhs_vv edefs |> expr_apply_defs edefs pdefs)]+    with Not_found -> sgrd' in+(*    Printf.printf "simplified body_pred: %s\n" (P.to_string sgrd); *)+  let slhs = List.map kvar_to_simple_Kvar lhs_ks |> C.make_reft (C.vv_of_reft lhs) (C.sort_of_reft lhs) in+  let rhs = C.rhs_of_t t in+  let rhs_ps, rhs_ks = C.preds_kvars_of_reft rhs in+  let srhs_pred = pred_apply_defs edefs pdefs (Ast.pAnd rhs_ps) |> Ast.simplify_pred in+  let srhs_ks = List.map kvar_to_simple_Kvar rhs_ks in+  let srhs =  (if P.is_tauto srhs_pred then srhs_ks else (C.Conc srhs_pred) :: srhs_ks) |> +      C.make_reft (C.vv_of_reft rhs) (C.sort_of_reft rhs) in+    C.make_t senv sgrd slhs srhs (Some (C.id_of_t t)) (C.tag_of_t t)++let simplify_ts ts =+  (* drop t if its rhs is a k variable that is not read *)+  let ts_sofar = ref ts in+  let pruned = ref true in+    while !pruned && !ts_sofar <> [] do+      let pruned_ts, rest_ts = +	List.partition+	  (fun t ->+	     match C.rhs_of_t t |> C.preds_kvars_of_reft with+	       | [], [(_, sy)] ->+		   List.for_all +		     (fun t' -> +			List.for_all (fun (_, sy') -> sy <> sy') +			  (Sy.SMap.fold +			     (fun _ reft sofar -> List.rev_append (C.kvars_of_reft reft) sofar) +			     (C.env_of_t t') (C.lhs_of_t t' |> C.kvars_of_reft))+		     ) !ts_sofar+	       | _ -> false+	  ) !ts_sofar in+	ts_sofar := rest_ts;+	pruned := pruned_ts <> []+    done;+    !ts_sofar++let is_tauto_t t =+  match C.rhs_of_t t |> C.ras_of_reft with+    | [] -> true+    | [C.Conc p] -> P.is_tauto p +    | _ -> false++
+ external/fixpoint/Simplification.mli view
@@ -0,0 +1,5 @@++val simplify_t  : FixConstraint.t -> FixConstraint.t+val simplify_ts : FixConstraint.t list -> FixConstraint.t list+val is_tauto_t  : FixConstraint.t -> bool+
+ external/fixpoint/ast.ml view
@@ -0,0 +1,1652 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(**+ * This module implements a DAG representation for expressions and + * predicates: each sub-predicate or sub-expression is paired with+ * a unique int ID, which enables constant time hashing. + * However, one must take care when using DAGS:+ * (1) they can only be constructed using the appropriate functions+ * (2) when destructed via pattern-matching, one must discard the ID+ *)++(* random touch *)++module F  = Format+module Misc = FixMisc+open Misc.Ops+module SM = Misc.StringMap++let mydebug = false++module Cone = struct+  type 'a t = Empty | Cone of ('a * 'a t) list++  let rec map f = function +    | Empty    -> Empty+    | Cone xcs -> Cone (List.map (f <**> map f) xcs)+end ++module Sort =+  struct+    type loc = +      | Loc  of string +      | Lvar of int+      | LFun ++    type tycon = string++    type t =+      | Int+      | Bool+      | Obj+      | Var of int              (* type-var *)+      | Ptr of loc              (* c-pointer *)+      | Func of int * t list    (* type-var-arity, in-types @ [out-type]      *)+      | Num                     (* kind, for numeric tyvars -- ptr(loc(s)) -- *)+      | App of tycon * t list   (* type constructors *)++    type sub = { locs: (int * string) list; +                 vars: (int * t) list; }++   +    let tycon_string x = x+    (*+    let is_loc_string s = +      let re = Str.regexp "[a-zA-Z]+[0-9]+" in +      Str.string_match re s 0+    +    let loc_of_string = fun s -> let _ = asserts (is_loc_string s) in Loc s+    let loc_of_index  = fun i -> Lvar i+    *)++    let t_num       = Num +    let t_obj       = Obj+    let t_bool      = Bool+    let t_int       = Int+    let t_generic   = fun i -> let _ = asserts (0 <= i) "t_generic: %d" i in Var i+    let t_ptr       = fun l -> Ptr l+    let t_func      = fun i ts -> Func (i, ts)+    let tycon s     = s +    +    (* let tycon_re    = Str.regexp "[A-Z][0-9 a-z A-Z '.']"+     * function | s when Str.string_match tycon_re s 0 -> s  +                | s -> assertf "Error: Invalid tycon: %s" s +     *)++    let t_app c ts  = App (c, ts)++    let loc_to_string = function+      | Loc s  -> s+      | Lvar i -> string_of_int i+      | LFun   -> "<fun>"++    let rec to_string = function+      | Var i        -> Printf.sprintf "@(%d)" i+      | Int          -> "int"+      | Bool         -> "bool"+      | Obj          -> "obj"+      | Num          -> "num"+      | Ptr l        -> loc_to_string l +                        (* Printf.sprintf "ptr(%s)" (loc_to_string l) *)+      | Func (n, ts) -> ts |> List.map to_string +                           |> String.concat " ; " +                           |> Printf.sprintf "func(%d, [%s])" n +      | App (c, ts)  -> ts |> List.map to_string_arg +                           |> String.concat " " +                           |> Printf.sprintf "%s %s" c +    +    and to_string_arg t = match t with +      | App (_, _) -> Printf.sprintf "(%s)" (to_string t)+      | _          -> to_string t++    let to_string_short = function+      | Func _ -> "func"+   (* | Ptr _  -> "ptr" *)+      | t      -> to_string t      ++    let print fmt t = +      t |> to_string +        |> Format.fprintf fmt "%s"++    let sub_to_string {locs = ls; vars = vs} =+      let lts = fun (i, s) -> Printf.sprintf "(%d := %s)" i s in+      let vts = fun (i, t) -> Printf.sprintf "(%d := %s)" i (to_string t) in+      Printf.sprintf "locs := %s, vars := %s \n" +        (String.concat "" (List.map lts ls)) +        (String.concat "" (List.map vts vs)) ++    let rec map f = function +      | Func (n, ts) -> Func (n, List.map (map f) ts)+      | App  (c, ts) -> App  (c, List.map (map f) ts)+      | t            -> f t++    let rec fold f b = function+      | Func (n, ts) as t -> List.fold_left (fold f) (f b t) ts+      | t                 -> f b t++    let subs_tvar ts = +      map begin function +          | Var i -> Misc.do_catchf "ERROR: subs_tvar" (List.nth ts) i+          | t     -> t+      end++    let is_bool = function+      | Bool -> true+      | _    -> false++    let is_int = function+      | Int -> true+      | _   -> false++    let is_func = function+      | Func _ -> true+      | _   -> false++    let app_of_t = function+      | App (c, ts) -> Some (c, ts) +      | _           -> None+++    let func_of_t = function+      | Func (i, ts) -> let (xts, t) = ts |> Misc.list_snoc |> Misc.swap in +                        Some (i, xts, t)+      | _            -> None++    let ptr_of_t = function+      | Ptr l -> Some l+      | _     -> None++    (* Sleazy Hack for C pointers. Make this go away... *)++    let compat t1 t2 = match t1, t2 with+      | Int, (Ptr _) -> true+      | (Ptr _), Int -> true+      | _            -> t1 = t2++    (* {{{ +    let concretize ts = function +      | Func (n, ats) when n = List.length ts -> +          Func (n, List.map (subs_tvar ts) ats)+      | _ -> +          assertf "ERROR: bad application" ++    let is_monotype t = +      fold (fun b t -> b && (match t with Var _ -> false | _ -> true)) true t+    }}} *)+++    let lookup_var = fun s i -> try Some (List.assoc i s.vars) with Not_found -> None+    let lookup_loc = fun s j -> try Some (List.assoc j s.locs) with Not_found -> None+    +    let rec unifyt s = function +      | Num,_ | _, Num -> None+      | ct, (Var i) +      | (Var i), ct +        (* when ct != Bool *) -> +          begin match lookup_var s i with +          | Some ct' when ct = ct' -> Some s+          | Some _                 -> None+          | None                   -> Some {s with vars = (i,ct) :: s.vars}+          end++      | Ptr LFun, Ptr _ +      | Ptr _, Ptr LFun -> Some s+      | Ptr (Loc cl), Ptr (Lvar j)+      | Ptr (Lvar j), Ptr (Loc cl) ->+          begin match lookup_loc s j with +          | Some cl' when cl' = cl -> Some s+          | Some _                 -> None+          | None                   -> Some {s with locs = (j,cl) :: s.locs}+          end+      +      | App (c1, t1s), App (c2, t2s) +        when c1 = c2 && List.length t1s = List.length t2s ->+          Misc.maybe_fold unifyt s (List.combine t1s t2s)+      +      | (t1, t2) when t1 = t2 -> +          Some s+      | _        -> None+   +    let empty_sub = {vars = []; locs = []}+   +    let unifyWith s ats cts =+      let _ = asserts (List.length ats = List.length cts) "ERROR: unify sorts" in+      List.combine ats cts +      |> Misc.maybe_fold unifyt s +      (* >> (fun so -> Printf.printf "unify: [%s] ~ [%s] = %s \n" +                      (String.concat "; " (List.map to_string ats))+                      (String.concat "; " (List.map to_string cts))+                      (match so with None -> "NONE" | Some s -> sub_to_string s))+       *)++    let unify = unifyWith empty_sub++    let apply s = +      map begin fun t -> match t with+          | Var i        -> (match lookup_var s i with Some t' -> t' | _ -> t)+          | Ptr (Lvar j) -> (match lookup_loc s j with Some l -> Ptr (Loc l) | _ -> t)+          | _            -> t+      end++    let rec fold f acc t = match t with+      | Var _ | Int  | Bool | Obj | Num | Ptr _ +        -> f acc t +      | Func (_, ts) | App (_, ts) +        -> List.fold_left (fold f) (f acc t) ts +      +    let vars_of_t = fold begin fun acc -> function +      | Var i -> i :: acc +      | _     -> acc+    end []+    +    let locs_of_t = fold begin fun acc -> function +      | Ptr (Loc l) -> l :: acc +      | _           -> acc+    end []+    +    let subst_locs_vars lim = map begin function+      | Ptr (Loc l) when SM.mem l lim -> Var (SM.find l lim)+      | t                             -> t+    end++    (* API *)+    let generalize ts = +      let locs = ts |> Misc.flap locs_of_t |> Misc.sort_and_compact       in+      let idx  = ts |> Misc.flap vars_of_t |> Misc.list_max (-1) |> (+) 1 in +      let lim  = Misc.index_from idx locs |>: Misc.swap |> SM.of_list     in+      List.map (subst_locs_vars lim) ts++    (* API *)+    let sub_args s = List.sort compare s.vars++    (* API *)+    let check_arity n s = s.vars |>: fst |> Misc.sort_and_compact |> List.length |> (=) n+      (* if ... then s else assertf "Type Inst. With Wrong Arity!" *)++  end++module Symbol = +  struct +    type t = string+    +    let mk_wild =+      let t,_ = Misc.mk_int_factory () in+      t <+> string_of_int <+> (^) "~A"+    +    let is_wild_fresh s = s = "_"+    let is_wild_any   s = s.[0] = '~'+    let is_wild_pre   s = s.[0] = '@'+    let is_wild s       = is_wild_fresh s || is_wild_any s || is_wild_pre s++    let is_safe s = +      let re = Str.regexp "[A-Za-z '~' '_' '\'' '@' ][0-9 a-z A-Z '_' '@' '\'' '.' '#']*$" in+      Str.string_match re s 0+    +    let of_string, to_string = +      let of_t = Hashtbl.create 117 in+      let to_t = Hashtbl.create 117 in+      let bind = fun s sy -> Hashtbl.replace of_t s sy; Hashtbl.replace to_t sy s in+      let f,_  = Misc.mk_string_factory "FIXPOINTSYMBOL_" in+      ((fun s -> +        if is_wild_fresh s then mk_wild () else+        if is_safe s then s else+           try Hashtbl.find of_t s with Not_found ->+             let sy = f () in+             let _  = bind s sy in sy),+       (fun sy -> try Hashtbl.find to_t sy with Not_found -> sy))+                   +    let to_string = fun s -> s (* if is_safe s then s else "'" ^ s ^ "'" *)++    let suffix = fun s suff -> of_string ((to_string s) ^ suff)++    let print fmt s =+      to_string s |> Format.fprintf fmt "%s" ++    let vvprefix = "VV_"+    let vvsuffix = function+      | Sort.Ptr l -> Sort.loc_to_string l+      | t          -> Sort.to_string_short t++++    let is_value_variable = Misc.is_prefix vvprefix+    let value_variable t = vvprefix ^ (vvsuffix t)++    (* DEBUG *)+    let vvprefix = "VV"+    let is_value_variable = (=) vvprefix+    let value_variable _  = vvprefix++    module SMap = Misc.EMap (struct type t = string +                                    let compare i1 i2 = compare i1 i2 +                                    let print         = print         end)++    module SSet = Misc.ESet (struct type t = string+                                    let compare i1 i2 = compare i1 i2 end)++   (* let sm_length m = +      SMap.fold (fun _ _ i -> i+1) m 0++    let sm_filter f sm = +      SMap.fold begin fun x y sm -> +        if f x y then SMap.add x y sm else sm +    end sm SMap.empty ++    let sm_to_list sm =+      SMap.fold (fun x y acc -> (x,y)::acc) sm []+    +    let sm_of_list xs = +      List.fold_left (fun sm (k,v) -> SMap.add k v sm) SMap.empty xs +   *)++  end++module Constant =+  struct+    type t = Int of int++    let to_string = function+      | Int i -> string_of_int i++    let print fmt s =+      to_string s |> Format.fprintf fmt "%s"+  end+ ++type tag = int++type brel = Eq | Ne | Gt | Ge | Lt | Le ++type bop  = Plus | Minus | Times | Div | Mod  (* NOTE: For "Mod" 2nd expr should be a constant or a var *)++type expr = expr_int * tag +    +and expr_int =+  | Con  of Constant.t+  | Var  of Symbol.t+  | App  of Symbol.t * expr list+  | Bin  of expr * bop * expr  +  | Ite  of pred * expr * expr+  | Fld  of Symbol.t * expr             (* NOTE: Fld (s, e) == App ("field"^s,[e]) *) +  | Cst  of expr * Sort.t +  | Bot+  | MExp of expr list+  | MBin of expr * bop list * expr ++and pred = pred_int * tag++and pred_int =+  | True+  | False+  | And   of pred list+  | Or    of pred list+  | Not   of pred+  | Imp   of pred * pred+  | Iff   of pred * pred+  | Bexp  of expr+  | Atom  of expr * brel * expr +  | MAtom of expr * brel list * expr+  | Forall of ((Symbol.t * Sort.t) list) * pred++let list_hash b xs = +  List.fold_left (fun v (_,id) -> 2*v + id) b xs++module Hashcons (X : sig type t +                         val sub_equal : t -> t -> bool +                         val hash : t -> int end) = struct++  module HashStruct = struct+    type t = X.t * int+    let equal (x,_) (y,_) = X.sub_equal x y+    let hash (x,_) = X.hash x+  end++  module Hash = Weak.Make(HashStruct)+  +  let wrap = +    let tab = Hash.create 251 in+    let ctr = ref 0 in+    fun e -> +      let res = Hash.merge tab (e, !ctr) in+      let _   = if snd res = !ctr then incr ctr in+      res++  let unwrap (e,_) = e++end++module ExprHashconsStruct = struct+  type t = expr_int+  let sub_equal e1 e2 =+    match e1, e2 with+      | Con c1, Con c2 -> +          c1 = c2+      | MExp es1, MExp es2 -> +          es1 = es2+      | Var x1, Var x2 -> +          x1 = x2+      | App (s1, e1s), App (s2, e2s) ->+	  (s1 = s2) && +          (try List.for_all2 (==) e1s e2s with _ -> false)+      | Bin (e1, op1, e1'), Bin (e2, op2, e2') ->+          op1 = op2 && e1 == e2 && e1' == e2'+      | MBin (e1, ops1, e1'), MBin (e2, ops2, e2') ->+          ops1 = ops2 && e1 == e2 && e1' == e2'+      | Ite (ip1,te1,ee1), Ite (ip2,te2,ee2) ->+	      ip1 == ip2 && te1 == te2 && ee1 == ee2+      | Fld (s1, e1), Fld (s2, e2) ->+          s1 = s2 && e1 == e2+      | Cst (e1, s1), Cst (e2, s2) ->+          s1 = s2 && e1 == e2+      | _ -> +          false+  +  let hash = function+    | Con (Constant.Int x) -> +        x+    | MExp es ->+        list_hash 6 es +    | Var x -> +        Hashtbl.hash x+    | App (s, es) -> +        list_hash ((Hashtbl.hash s) + 1) es +    | Bin ((_,id1), op, (_,id2)) -> +        (Hashtbl.hash op) + 1 + (2 * id1) + id2 +    | MBin ((_,id1), op::_ , (_,id2)) -> +        (Hashtbl.hash op) + 1 + (2 * id1) + id2 +    | Ite ((_,id1), (_,id2), (_,id3)) -> +        32 + (4 * id1) + (2 * id2) + id3+    | Fld (s, (_,id)) ->+        (Hashtbl.hash s) + 12 + id+    | Cst ((_, id), t) ->+        id + Hashtbl.hash (Sort.to_string t)+    | Bot ->+        0+    | _ -> assertf "pattern error in A.pred hash"++end+  +module ExprHashcons = Hashcons(ExprHashconsStruct)++module PredHashconsStruct = struct+  +  type t = pred_int+  +  let sub_equal p1 p2 =+    match p1, p2 with+      | True, True | False, False -> +          true+      | And p1s, And p2s  | Or  p1s, Or p2s -> +          (try List.for_all2 (==) p1s p2s with _ -> false)+      | Not p1, Not p2 -> +          p1 == p2+      | Imp (p1, p1'), Imp (p2, p2') -> +          p1 == p2 && p1' == p2'+      | Iff (p1,p1'), Iff (p2,p2') ->+          p1 == p2 && p1' == p2'+      | Bexp e1, Bexp e2 -> +          e1 == e2+      | Atom (e1, r1, e1'), Atom (e2, r2, e2') ->+          r1 = r2 && e1 == e2 && e1' == e2'+      | MAtom (e1, r1, e1'), MAtom (e2, r2, e2') ->+          r1 = r2 && e1 == e2 && e1' == e2'+      | Forall(q1s,p1), Forall(q2s,p2) -> +          q1s = q2s && p1 == p2+      | _ -> +          false+ + let hash = function+   | True -> +       0+   | False -> +       1+   | And ps -> +       list_hash 2 ps+   | Or ps -> +       list_hash 3 ps+   | Not (_,id) -> +       8 + id +   | Imp ((_,id1), (_,id2)) ->+       20 + (2 * id1) + id2+   | Iff ((_,id1), (_,id2)) ->+       28 + (2 * id1) + id2+   | Bexp (_, id) ->+       32 + id+   | Atom ((_,id1), r, (_,id2)) ->+       36 + (Hashtbl.hash r) + (2 * id1) + id2+   | MAtom ((_,id1), r, (_,id2)) ->+       42 + (Hashtbl.hash r) + (2 * id1) + id2+   | Forall(qs,(_,id)) -> +       50 + (2 * (Hashtbl.hash qs)) + id+end+  +module PredHashcons = Hashcons(PredHashconsStruct)++let ewr = ExprHashcons.wrap+let euw = ExprHashcons.unwrap+let pwr = PredHashcons.wrap +let puw = PredHashcons.unwrap++(* Constructors: Expressions *)+let eCon  = fun c  -> ewr  (Con c)+let eMExp = fun es -> ewr  (MExp es)+let eInt  = fun i  -> eCon (Constant.Int i)+let zero  = eInt 0+let one   = eInt 1+let bot  = ewr Bot+let eMod = fun (e, m) -> ewr (Bin (e, Mod, eInt m))+let eModExp = fun (e, m) -> ewr (Bin (e, Mod, m))+let eVar = fun s -> ewr (Var s)+let eApp = fun (s, es) -> ewr (App (s, es))+let eBin = fun (e1, op, e2) -> ewr (Bin (e1, op, e2)) ++let eMBin = fun (e1, ops, e2) -> ewr (MBin (e1, ops, e2)) +let eIte = fun (ip,te,ee) -> ewr (Ite(ip,te,ee))+let eFld = fun (s,e) -> ewr (Fld (s,e))+let eCst = fun (e,t) -> ewr (Cst (e, t))++let eTim = function +  | (Con (Constant.Int n1), _), (Con (Constant.Int n2), _) -> +      ewr (Con (Constant.Int (n1 * n2)))+  | (Con (Constant.Int 1), _), e2 -> +      e2 +  | (Con (Constant.Int (-1)), _), e2 -> +      eBin (zero, Minus, e2) +  | (e1, e2) -> eBin (e1, Times, e2)+++let rec conjuncts = function+  | And ps, _ -> Misc.flap conjuncts ps+  | True, _   -> []+  | p         -> [p]+++(* Constructors: Predicates *)+let pTrue  = pwr True+let pFalse = pwr False+let pAtom  = fun (e1, r, e2) -> pwr (Atom (e1, r, e2))+let pMAtom = fun (e1, r, e2) -> pwr (MAtom (e1, r, e2))+let pOr    = fun ps -> pwr (Or ps)+let pNot   = fun p  -> pwr (Not p)+let pBexp  = fun e  -> pwr (Bexp e)+let pImp   = fun (p1,p2) -> pwr (Imp (p1,p2))+let pIff   = fun (p1,p2) -> pwr (Iff (p1,p2))+let pForall= fun (qs, p) -> pwr (Forall (qs, p))+let pEqual = fun (e1,e2) -> pAtom (e1, Eq, e2)+++let pAnd   = fun ps -> match Misc.flap conjuncts ps with +                       | []  -> pTrue +                       | [p] -> p+                       | ps  -> pwr (And (Misc.flap conjuncts ps))++++module ExprHash = Hashtbl.Make(struct+  type t = expr+  let equal (_,x) (_,y) = (x = y)+  let hash (_,x) = x+end)++module PredHash = Hashtbl.Make(struct+  type t = pred+  let equal (_,x) (_,y) = (x = y)+  let hash (_,x) = x+end)++let bop_to_string = function +  | Plus  -> "+"+  | Minus -> "-"+  | Times -> "*"+  | Div   -> "/"+  | Mod   -> "mod" ++let brel_to_string = function +  | Eq -> "="+  | Ne -> "!="+  | Gt -> ">"+  | Ge -> ">="+  | Lt -> "<"+  | Le -> "<="++let print_brel ppf r = +  F.fprintf ppf "%s" (brel_to_string r)++let print_binding ppf (s,t) = +  F.fprintf ppf "%a:%a" Symbol.print s Sort.print t++let bind_to_string  (s,t) = +  Printf.sprintf "%s:%s" (Symbol.to_string s) (Sort.to_string t)++let rec print_expr ppf e = match euw e with+  | Con c -> +      F.fprintf ppf "%a" Constant.print c +  | MExp es -> +      F.fprintf ppf "[%a]" (Misc.pprint_many false " ; " print_expr) es+  | Var s -> +      F.fprintf ppf "%a" Symbol.print s+  | App (s, es) -> +      F.fprintf ppf "%a([%a])" +        Symbol.print s+        (Misc.pprint_many false "; " print_expr) es+  | Bin (e1, op, e2) ->+      F.fprintf ppf "(%a %s %a)" +        print_expr e1 +        (bop_to_string op) +        print_expr e2+  | MBin (e1, ops, e2) ->+      F.fprintf ppf "(%a [%s] %a)" +        print_expr e1 +        (ops |>: bop_to_string |> String.concat " ; ")+        print_expr e2+ +  | Ite(ip,te,ee) -> +      F.fprintf ppf "(%a ? %a : %a)" +        print_pred ip +        print_expr te+        print_expr ee+  | Fld(s, e) -> +      F.fprintf ppf "%a.%s" print_expr e s +  | Cst(e,t) ->+      F.fprintf ppf "(%a : %a)" +        print_expr e +        Sort.print t+  | Bot ->+      F.fprintf ppf "_|_" ++and print_pred ppf p = match puw p with+  | True -> +      F.fprintf ppf "true"+  | False -> +      F.fprintf ppf "false"+  | Bexp (App (s, es), _) ->+      F.fprintf ppf "%a(%a)" Symbol.print s (Misc.pprint_many false ", " print_expr) es+  | Bexp e ->+      F.fprintf ppf "(Bexp %a)" print_expr e+  | Not p -> +      F.fprintf ppf "(~ (%a))" print_pred p+  | Imp (p1, p2) -> +      F.fprintf ppf "(%a => %a)" print_pred p1 print_pred p2 +  | Iff (p1, p2) ->+      F.fprintf ppf "(%a <=> %a)" print_pred p1 print_pred p2 +  | And ps -> begin match ps with [] -> F.fprintf ppf "true" | _ ->+      F.fprintf ppf "&& %a" (Misc.pprint_many_brackets true print_pred) ps+    end+  | Or ps -> begin match ps with [] -> F.fprintf ppf "false" | _ -> +      F.fprintf ppf "|| %a" (Misc.pprint_many_brackets true print_pred) ps+    end++  | Atom (e1, r, e2) ->+      (* F.fprintf ppf "@[(%a %s %a)@]" *)+      F.fprintf ppf "(%a %s %a)"+        print_expr e1 +        (brel_to_string r) +        print_expr e2+  | MAtom (e1, rs, e2) ->+      F.fprintf ppf "(%a [%a] %a)" +      (* F.fprintf ppf "@[(%a [%a] %a)@]"  *)+        print_expr e1 +        (Misc.pprint_many false " ; " print_brel) rs+        print_expr e2+  | Forall (qs, p) -> +      F.fprintf ppf "forall [%a] . %a" +        (Misc.pprint_many false "; " print_binding) qs+        print_pred p+  +let rec expr_to_string e = +  match euw e with+  | Con c -> +      Constant.to_string c+  | MExp es -> +      Printf.sprintf "[%s]" (es |>: expr_to_string |> String.concat " ; ")+  | Var s -> +      Symbol.to_string s+  | App (s, es) ->+      Printf.sprintf "%s([%s])" +        (Symbol.to_string s)+        (es |> List.map expr_to_string |> String.concat "; ")+  | Bin (e1, op, e2) ->+      Printf.sprintf "(%s %s %s)" +        (expr_to_string e1) (bop_to_string op) (expr_to_string e2)+  | MBin (e1, ops, e2) ->+      Printf.sprintf "(%s [%s] %s)" +        (expr_to_string e1) +        (ops |> List.map bop_to_string |> String.concat "; ")+        (expr_to_string e2)+  | Ite(ip,te,ee) -> +      Printf.sprintf "(%s ? %s : %s)" +        (pred_to_string ip) (expr_to_string te) (expr_to_string ee)+  | Fld(s,e) -> +      Printf.sprintf "%s.%s" (expr_to_string e) s +  | Cst(e,t) ->+      Printf.sprintf "(%s : %s)" (expr_to_string e) (Sort.to_string t)+  | Bot ->+      Printf.sprintf "_|_" +++and pred_to_string p = +  match puw p with+    | True -> +        "true"+    | False -> +        "false"+    | Bexp e ->+        Printf.sprintf "(Bexp %s)" (expr_to_string e)+    | Not p -> +        Printf.sprintf "(~ (%s))" (pred_to_string p) +    | Imp (p1, p2) -> +        Printf.sprintf "(%s => %s)" (pred_to_string p1) (pred_to_string p2)+    | Iff (p1, p2) ->+        Printf.sprintf "(%s <=> %s)" (pred_to_string p1) (pred_to_string p2)+    | And ps -> +        Printf.sprintf "&& [%s]" (List.map pred_to_string ps |> String.concat " ; ")+    | Or ps -> +        Printf.sprintf "|| [%s]" (List.map pred_to_string ps |> String.concat ";")+    | Atom (e1, r, e2) ->+        Printf.sprintf "(%s %s %s)" +        (expr_to_string e1) (brel_to_string r) (expr_to_string e2)+    | MAtom (e1, rs, e2) ->+        Printf.sprintf "(%s [%s] %s)" +        (expr_to_string e1)+        (List.map brel_to_string rs |> String.concat " ; ") +        (expr_to_string e2)+    | Forall (qs,p) -> +        Printf.sprintf "forall [%s] . %s" +        (List.map bind_to_string qs |> String.concat "; ") (pred_to_string p)++let rec pred_map hp he fp fe p =+  let rec pm p =+    try PredHash.find hp p with Not_found -> begin+      let p' = +        match puw p with+        | True | False as p1 -> +            p1+        | And ps -> +            And (List.map pm ps)  +        | Or ps -> +            Or (List.map pm ps)  +        | Not p -> +            Not (pm p) +        | Imp (p1, p2) -> +            Imp (pm p1, pm p2)+        | Iff (p1, p2) ->+            Iff (pm p1, pm p2)+        | Bexp e ->+            Bexp (expr_map hp he fp fe e) +        | Atom (e1, r, e2) ->+            Atom (expr_map hp he fp fe e1, r, expr_map hp he fp fe e2)+        | MAtom (e1, rs, e2) ->+            MAtom (expr_map hp he fp fe e1, rs, expr_map hp he fp fe e2)+        | Forall (qs, p) ->+            Forall (qs, pm p) in+      let rv = fp (pwr p') in+      let _  = PredHash.add hp p rv in +      rv+    end in pm p ++and expr_map hp he fp fe e =+  let rec em e =+    try ExprHash.find he e with Not_found -> begin+      let e' = +        match euw e with+        | Con _ | Var _ | Bot as e1 -> +            e1+        | MExp es ->+            MExp (List.map em es) +        | App (f, es) ->+            App (f, List.map em es)+        | Bin (e1, op, e2) ->+            Bin (em e1, op, em e2)+        | MBin (e1, ops, e2) ->+            MBin (em e1, ops, em e2)+        | Ite (ip, te, ee) ->+            Ite (pred_map hp he fp fe ip, em te, em ee) +        | Fld (s, e1) -> +            Fld (s, em e1) +        | Cst (e1, t) -> +            Cst (em e1, t) +      in+      let rv = fe (ewr e') in+      let _  = ExprHash.add he e rv in+      rv+    end in em e++let rec pred_iter fp fe pw =+  begin match puw pw with+    | True | False -> ()+    | Bexp e -> expr_iter fp fe e+    | Not p -> pred_iter fp fe p+    | Imp (p1, p2) -> pred_iter fp fe p1; pred_iter fp fe p2+    | Iff (p1, p2) -> pred_iter fp fe p1; pred_iter fp fe p2+    | And ps | Or ps -> List.iter (pred_iter fp fe) ps+    | Atom (e1, _, e2) -> expr_iter fp fe e1; expr_iter fp fe e2+    | MAtom (e1, _, e2) -> expr_iter fp fe e1; expr_iter fp fe e2+    | Forall (_, p) -> pred_iter fp fe p (* pmr: looks wrong, but so does pred_map *)+  end;+  fp pw++and expr_iter fp fe ew =+  begin match puw ew with+    | Con _ | Var _ | Bot -> +        ()+    | MExp es ->+        List.iter (expr_iter fp fe) es+    | App (_, es)  -> +        List.iter (expr_iter fp fe) es+    | Bin (e1, _, e2)  -> +        expr_iter fp fe e1; expr_iter fp fe e2+    | MBin (e1, _, e2)  -> +        expr_iter fp fe e1; expr_iter fp fe e2+    | Ite (ip, te, ee) -> +        pred_iter fp fe ip; expr_iter fp fe te; expr_iter fp fe ee+    | Fld (_, e1) | Cst (e1, _) -> +        expr_iter fp fe e1+  end;+  fe ew++let esub x e = function+  | (Var y), _ when x = y -> e+  | _ as e1 -> e1 ++let expr_subst hp he e x e' =+  expr_map hp he id (esub x e') e ++let pred_subst hp he p x e' =+  pred_map hp he id (esub x e') p ++module Expression = +  struct+      +    module Hash   = ExprHash +      +    let to_string = expr_to_string++    (* let print     = fun fmt e -> Format.pp_print_string fmt (to_string e)+     *)+    let print = print_expr+    +    let show      = print Format.std_formatter++    let map fp fe e =+      let hp = PredHash.create 251 in+      let he = ExprHash.create 251 in +      expr_map hp he fp fe e ++    let iter fp fe e =+      expr_iter fp fe e++    let subst e x e' =+      map id (esub x e') e++    let substs e xes =+      map id (fun e -> List.fold_left (esub |> Misc.uncurry |> Misc.flip) e xes) e++    let support e =+      let xs = ref Symbol.SSet.empty in+      iter un begin function +        | (Var x), _ +        | (App (x,_)),_ -> xs := Symbol.SSet.add x !xs+        | _               -> ()+      end e;+      Symbol.SSet.elements !xs |> List.sort compare++    let unwrap = euw++    let has_bot p =+      let r = ref false in+      iter un begin function +        | Bot, _ -> r := true+        | _      -> ()+      end p; +      !r++  end+    +module Predicate = struct+  module Hash = PredHash +	+  let to_string = pred_to_string+  let print     = print_pred+  let show      = print Format.std_formatter+			+  let map fp fe p =+	let hp = PredHash.create 251 in+	let he = ExprHash.create 251 in +    pred_map hp he fp fe p+	+  let iter fp fe p =+    pred_iter fp fe p++  let subst p x e' =+    map id (esub x e') p++  let substs p xes =+    map id (fun e -> List.fold_left (esub |> Misc.uncurry |> Misc.flip) e xes) p++  let support p =+    let xs = ref Symbol.SSet.empty in+    iter un begin function +      | (Var x), _ +      | (App (x,_)),_ -> xs := Symbol.SSet.add x !xs;+      | _               -> ()+    end p; +    Symbol.SSet.elements !xs |> List.sort compare++  (*+  let size p =+	let c = ref 0           in+    let f = fun _ -> incr c in+    let _ = iter f f p      in +    !c++  let size p =+	let c = ref 0                    in+    let _ = iter (fun _ -> incr c) p in +    !c+  *)+  +  let unwrap = puw++  let is_contra = +    let t = PredHash.create 17 in+    let _ = [pFalse; pNot pTrue; pAtom (zero, Eq, one); pAtom (one, Eq, zero)]+            |> List.iter (fun p-> PredHash.replace t p ()) in +    fun p -> PredHash.mem t p +   ++  let rec is_tauto  = function+    | Atom(e1, Eq, e2), _ -> snd e1 == snd e2+    | Imp (p1, p2), _     -> snd p1 == snd p2+    | And ps, _           -> List.for_all is_tauto ps+    | Or  ps, _           -> List.exists is_tauto ps+    | True, _             -> true+    | _                   -> false++  let has_bot p =+    let r = ref false in+    iter un begin function +      | Bot, _ -> r := true+      | _      -> ()+    end p; +    !r++  end++let print_stats _ = +  Printf.printf "Ast Stats. [none] \n"+++(********************************************************************************)+(************************** Rationalizing Division ******************************)+(********************************************************************************)++let expr_isdiv = function+  | Bin (_, Div, _), _ -> true+  | _                  -> false++let pull_divisor = function +  | Bin (_, Div, (Con (Constant.Int i),_)), _ -> i +  | _ -> 1++let calc_cm e1 e2 =+    pull_divisor e1 * pull_divisor e2 ++let rec apply_mult m = function +  | Bin (e, Div,  (Con (Constant.Int d),_)), _ ->+      let _   = assert ((m/d) * d = m) in+      eTim ((eCon (Constant.Int (m/d))), e)  +  | Bin (e1, op, e2), _ ->+      eBin (apply_mult m e1, op, apply_mult m e2)+  | Con (Constant.Int i), _ -> +      eCon (Constant.Int (i*m))+  | e -> +      eTim (eCon (Constant.Int m), e)++let rec pred_isdiv = function +  | True,_ | False,_ -> +      false+  | And ps,_ | Or ps,_ -> +      List.exists pred_isdiv ps+  | Not p, _ | Forall (_, p), _ -> +      pred_isdiv p+  | Imp (p1, p2), _ ->+      pred_isdiv p1 || pred_isdiv p2+  | Iff (p1, p2), _ ->+      pred_isdiv p1 || pred_isdiv p2+  | Bexp e, _ ->+      expr_isdiv e+  | Atom (e1, _, e2), _ -> +      expr_isdiv e1 || expr_isdiv e2+  | _ -> failwith "Unexpected: pred_isdiv"++let bound m e e1 e2 =+  pAnd [pAtom (apply_mult m e, Gt, apply_mult m e2);+        pAtom(apply_mult m e, Le, apply_mult m e1)] ++let rec fixdiv = function+  | p when not (pred_isdiv p) -> +      p+  | Atom ((Var _,_) as e, Eq, e1), _ | Atom ((Con _, _) as e, Eq, e1), _ ->+      bound (calc_cm e e1) e e1 (eBin (e1, Minus, one))+  | And ps, _ ->+      pAnd (List.map fixdiv ps) +  | Or ps, _ ->+      pOr (List.map fixdiv ps)+  | Imp (p1, p2), _ ->+      pImp (fixdiv p1, fixdiv p2)+  | Iff (p1, p2), _ ->+      pIff (fixdiv p1, fixdiv p2)+  | Not p, _ -> +      pNot (fixdiv p) +  | p -> p++(***************************************************************************)+(************* Type Checking Expressions and Predicates ********************)+(***************************************************************************)++let sortcheck_sym f s = f s+  (* try Some (f s)  with _ -> None *)++let sortcheck_loc f = function+  | Sort.Loc s  -> sortcheck_sym f (Symbol.of_string s)+  | Sort.Lvar _ -> None+  | Sort.LFun   -> None++let rec sortcheck_expr g f e = +  match euw e with+  | Bot   -> +      None+  | Con _ -> +      Some Sort.Int +  | Var s ->+      sortcheck_sym f s+  | Bin (e1, op, e2) -> +      sortcheck_op g f (e1, op, e2)+  | Ite (p, e1, e2) -> +      if sortcheck_pred g f p then +        match Misc.map_pair (sortcheck_expr g f) (e1, e2) with+        | (Some t1, Some t2) when t1 = t2 -> Some t1 +        | _ -> None+      else None+  +  | Cst (e1, t) ->+      begin match euw e1 with+        | App (uf, es) -> sortcheck_app g f (Some t) uf es+        | _            ->+            match sortcheck_expr g f e1 with+              | Some t1 when Sort.compat t t1 -> Some t+              | _                             -> None +      end++  | App (uf, es) ->+      sortcheck_app g f None uf es+    +  | _ -> assertf "Ast.sortcheck_expr: unhandled expr = %s" (Expression.to_string e)++(* TODO: OMG! 5 levels of matching!!!!! *)+and sortcheck_app_sub g f so_expected uf es =+  let yikes uf = F.printf "sortcheck_app_sub: unknown sym = %s \n" (Symbol.to_string uf) in+  sortcheck_sym f uf+  |> function None -> (yikes uf; None) | Some t -> +       Sort.func_of_t t +       |> function None -> None | Some (tyArity, i_ts, o_t) -> +              let _  = asserts (List.length es = List.length i_ts) +                         "ERROR: uf arg-arity error: uf=%s" uf in+              let e_ts = es |> List.map (sortcheck_expr g f) |> Misc.map_partial id in+                if List.length e_ts <> List.length i_ts then +                  None +                else+                  match Sort.unify e_ts i_ts with+                    | None   -> None+                    | Some s ->+                        let t = Sort.apply s o_t in+                          match so_expected with+                            | None    -> Some (s, t)+                            | Some t' ->+                                match Sort.unifyWith s [t] [t'] with+                                  | None    -> None+                                  | Some s' -> Some (s', Sort.apply s' t)++and sortcheck_app g f so_expected uf es = +  sortcheck_app_sub g f so_expected uf es +  |> Misc.maybe_map snd +  (* >> begin function +       | Some t -> Format.printf "sortcheck_app: e = %s , t = %s \n"+                     (expr_to_string (eApp (uf, es))) (Sort.to_string t)+       | None   -> Format.printf "sortcheck_app: e = %s FAILS\n"+                     (expr_to_string (eApp (uf, es)))+     end+  *)++++and sortcheck_op g f (e1, op, e2) = +  match Misc.map_pair (sortcheck_expr g f) (e1, e2) with+  | (Some Sort.Int, Some Sort.Int) +  -> Some Sort.Int+  +  (* only allow when language is Haskell *)+  | (Some (Sort.Ptr l), Some (Sort.Ptr l')) +  when (l = l' && sortcheck_loc f l = Some Sort.Num)+ -> Some (Sort.Ptr l)+ +  (* only allow when language is C *)+  | (Some (Sort.Ptr s), Some Sort.Int) +  | (Some Sort.Int, Some (Sort.Ptr s)) +  -> Some (Sort.Ptr s)++  (* only allow when language is C *)+  | (Some (Sort.Ptr s), Some (Sort.Ptr s')) +  when op = Minus && s = s'+  -> Some Sort.Int++  | _ -> None+++and sortcheck_rel g f (e1, r, e2) =+  let t1o, t2o = (e1,e2) |> Misc.map_pair (sortcheck_expr g f) in+  match r, t1o, t2o with+  | _, Some (Sort.Ptr _) , Some (Sort.Ptr Sort.LFun)+  | _, Some (Sort.Ptr Sort.LFun), Some (Sort.Ptr _)+    -> true+  | _ , Some Sort.Int,     Some (Sort.Ptr l)+  | _ , Some (Sort.Ptr l), Some Sort.Int+    -> (sortcheck_loc f l = Some Sort.Num)+  | _ , Some (Sort.Ptr l1), Some (Sort.Ptr l2) when (sortcheck_loc f l1 = Some Sort.Num) && (sortcheck_loc f l2 = Some Sort.Num)+    -> true+  | Eq, Some t1, Some t2+  | Ne, Some t1, Some t2+    -> t1 = t2+  | _ , Some (Sort.App (tc,_)), _+    when (g tc) (* tc is an interpreted tycon *)+    -> false+  | _ , Some t1, Some t2+    -> t1 = t2 && t1 != Sort.Bool+  | _ -> false++and sortcheck_pred g f p =+  match puw p with+    | True  +    | False -> +        true +    | Bexp e ->+        sortcheck_expr g f e = Some Sort.Bool +    | Not p -> +        sortcheck_pred g f p+    | Imp (p1, p2) | Iff (p1, p2) -> +        List.for_all (sortcheck_pred g f) [p1; p2]+    | And ps  +    | Or ps ->+        List.for_all (sortcheck_pred g f) ps+    +    | Atom ((Con (Constant.Int(0)),_), _, e) +    | Atom (e, _, (Con (Constant.Int(0)),_)) +      when not (!Constants.strictsortcheck)+      -> not (None = sortcheck_expr g f e)+    +    | Atom ((Var x, _) , Eq, (App (uf, es), _))+    | Atom ((App (uf, es), _), Eq, (Var x, _))+      -> begin match sortcheck_sym f x with +         | None    -> false +         | Some tx -> not (None = sortcheck_app g f (Some tx) uf es)+         end++    | Atom (e1, r, e2) ->+        sortcheck_rel g f (e1, r, e2)+    | Forall (qs,p) ->+        (* let f' = fun x -> try List.assoc x qs with _ -> f x in *)+        let f' = fun x -> match Misc.list_assoc_maybe x qs with None -> f x | y -> y+        in sortcheck_pred g f' p+    | _ -> failwith "Unexpected: sortcheck_pred"++(* and sortcheck_pred f p =+  sortcheck_pred' f p+  >> (fun b -> if not b then F.eprintf "WARNING: Malformed Lhs Pred (%a)\n" Predicate.print p) + *)++let uf_arity f uf =  +  match sortcheck_sym f uf with None -> None | Some t -> +    match Sort.func_of_t t with None -> None | Some (i,_,_) -> +      Some i+ +(* API *)+let sortcheck_app g f t uf es = +  match uf_arity f uf, sortcheck_app_sub g f t uf es with +    | (Some n , Some (s, t)) -> +        if Sort.check_arity n s then Some (s, t) else+           assertf "Ast.sortcheck_app: type args not fully instantiated %s" +             (expr_to_string (eApp (uf, es)))+    | _ -> None++(*+let sortcheck_pred f p = +  sortcheck_pred f p+  >> (fun b -> ignore <| F.printf "sortcheck_pred: p = %a, res = %b\n"+  Predicate.print p b)+*)++(***************************************************************************)+(************* Simplifying Expressions and Predicates **********************)+(***************************************************************************)++let pred_of_bool = function true -> pTrue | false -> pFalse++let rec remove_bot pol ((p, _) as pred) =+  match p with+  | Not p  -> +      pNot (remove_bot (not pol) p)+  | Imp (p, q) ->+      pImp (remove_bot (not pol) p, remove_bot pol q)+  | Forall (qs, p) ->+      pForall (qs, remove_bot pol p)+  | And ps ->+      ps |> List.map (remove_bot pol) |> pAnd+  | Or ps -> +      ps |> List.map (remove_bot pol) |> pOr+  | Bexp e when Expression.has_bot e ->+      pred_of_bool pol+  | Atom (e1, _, e2) when Expression.has_bot e1 || Expression.has_bot e2 -> +      pred_of_bool pol+  | _ -> +      pred++let remove_bot p = +  if Predicate.has_bot p +  then remove_bot true p +  else p++let symm_brel = function+  | Eq -> Eq +  | Ne -> Ne +  | Gt -> Lt+  | Ge -> Le+  | Lt -> Gt+  | Le -> Ge+++let neg_brel = function +  | Eq -> Ne+  | Ne -> Eq+  | Gt -> Le+  | Ge -> Lt+  | Lt -> Ge+  | Le -> Gt++let rec push_neg ?(neg=false) ((p, _) as pred) =+  match p with+    | True   -> +        if neg then pFalse else pred+    | False  -> +        if neg then pTrue else pred+    | Bexp _ -> +        if neg then pNot pred else pred+    | Not p  -> +        push_neg ~neg:(not neg) p+    | Imp (p, q) -> +	if neg then pAnd [push_neg p; push_neg ~neg:true q]+	else pImp (push_neg p, push_neg q)+    | Iff (p, q) ->+        if neg then pIff (p, push_neg ~neg:true q)+        else pIff (push_neg p, push_neg q)+    | Forall (qs, p) -> +	let pred' = pForall (qs, push_neg ~neg:false p) in+	if neg then pNot pred' else pred'+    | And ps -> +        List.map (push_neg ~neg:neg) ps +        |> if neg then pOr else pAnd+    | Or ps -> +        List.map (push_neg ~neg:neg) ps +        |> if neg then pAnd else pOr+    | Atom (e1, brel, e2) -> +        if neg then pAtom (e1, neg_brel brel, e2) else pred+    | _ -> failwith "Unexpected: push_neg"++(* Andrey: TODO flatten nested conjunctions/disjunctions *)+let rec simplify_pred ((p, _) as pred) =+  match p with+    | Not p -> pNot (simplify_pred p)+    | Imp (p, q) -> pImp (simplify_pred p, simplify_pred q) +    | Forall (qs, p) -> pForall (qs, simplify_pred p)+    | And ps -> ps |> List.map simplify_pred +                   |> List.filter (not <.> Predicate.is_tauto) +                   |> (function | []  -> pTrue+                                | [p] -> p+                                | _ when List.exists Predicate.is_contra ps -> pFalse+                                | _   -> pAnd ps)+    | Or ps -> ps |> List.map simplify_pred +                  |> List.filter (not <.> Predicate.is_contra)+                  |> (function []  -> pFalse+                             | [p] -> p+                             | ps when List.exists Predicate.is_tauto ps -> pTrue+                             | ps  -> pOr ps)+    | _ -> pred++(**************************************************************************)+(*************************** Substitutions ********************************)+(**************************************************************************)++module Subst = struct++  type t = expr Symbol.SMap.t+ +  let valid xes = +    xes |> List.split +        |> Misc.app_snd (Misc.flap Expression.support)+        |> Misc.uncurry Misc.disjoint+            +    +  let extend s (x, e) =+    let s = Symbol.SMap.map (esub x e) s in+      if Symbol.SMap.mem x s then+        s+      else+        match e with+        | Var x', _ when x = x' -> s+        | _                     -> Symbol.SMap.add x e s++  let empty     = Symbol.SMap.empty+  let is_empty  = Symbol.SMap.is_empty+  let to_list   = Symbol.SMap.to_list   +  let apply     = Misc.flip Symbol.SMap.maybe_find+  let of_list   = fun xes -> List.fold_left extend empty xes+  let simultaneous_of_list = Symbol.SMap.of_list+  let compose s t = +    let s' = Symbol.SMap.fold (fun x e s -> Symbol.SMap.map (esub x e) s) t s+    in Symbol.SMap.fold (fun x e s -> if Symbol.SMap.mem x s+                                         then s else Symbol.SMap.add x e s)+                        t s'+  let print_sub = fun ppf (x,e) -> F.fprintf ppf "[%a:=%a]" Symbol.print x Expression.print e+  let print     = fun ppf -> to_list <+> F.fprintf ppf "%a" (Misc.pprint_many false "" print_sub)+      +(* fun s1 s2 -> Symbol.SMap.fold (fun x e s -> extend s (x, e)) s2 s1 *)+(*   let apply     = Misc.flip Symbol.SMap.maybe_find *)++end+++(**************************************************************************)+(******************* Horn Clauses: Parsing ARMC files *********************)+(**************************************************************************)++module Horn = struct+  +  type pr = string * string list+  type gd = C of pred | K of pr+  type t  = pr * gd list ++  let print_pr ppf (x, xs) = +    Format.fprintf ppf "%s(%s)" x (String.concat "," xs) +    +  let print_gd ppf = function +    | C p -> Predicate.print ppf p+    | K x -> print_pr ppf x ++  let print ppf (hd, gds) = +    Format.fprintf ppf "%a :- %a." +      print_pr hd +      (Misc.pprint_many false "," print_gd) gds++  let support_pr = snd +  let support_gd = function K pr -> support_pr pr | C p  -> p |> Predicate.support |> List.map Symbol.to_string +  let support    = fun (hd, gds) -> (support_pr hd) ++ (Misc.flap support_gd gds)+end++(* API *)+let simplify_pred = remove_bot <+> simplify_pred+++let esub_su su e = match e with +  | ((Var y), _) -> Misc.maybe_default (Subst.apply su y) e+  | _            -> e++(* ORIG +   let substs_pred   = fun p su -> su |> Subst.to_list |> Predicate.substs p |> simplify_pred+*)++let substs_pred p su = Predicate.map  id (esub_su su) p+let substs_expr e su = Expression.map id (esub_su su) e++(****************************************************************************)+(******************** Unification of Predicates *****************************)+(****************************************************************************)+++exception DoesNotUnify ++let rec pUnify (p1, p2) = +  let res = +    match p1, p2 with+  | (Atom (e1, r1, e1'), _), (Atom (e2, r2, e2'), _) when r1 = r2 ->+      let s1       = eUnify (e1, e2) in+      let e1', e2' = Misc.map_pair ((Misc.flip Expression.substs) s1) (e1', e2') in+      let s2       = eUnify (e1', e2') in+      s1 ++ s2+  | (Bexp e1, _), (Bexp e2, _) ->+      eUnify (e1, e2)+  | (Not p1, _), (Not p2, _) ->+      pUnify (p1, p2)+  | (Imp (p1, p1'), _), (Imp (p2, p2'), _) ->+      psUnify ([p1; p1'], [p2; p2'])+  +  | (And p1s, _), (And p2s, _) +  | (Or p1s, _), (Or p2s, _) +    when List.length p1s = List.length p2s ->+      psUnify (p1s, p2s)+  | _, _ -> raise DoesNotUnify+  in+  let _ = if mydebug then +          (Format.printf "pUnify: p1 is %a, p2 is %a, subst = %a \n" +          Predicate.print p1 Predicate.print p2 Subst.print (Subst.of_list res)) in+  res++and psUnify (p1s, p2s) =+  let _ = asserts (List.length p1s = List.length p2s) "psUnify" in+  List.fold_left2 begin fun s p1 p2 ->+    (p1, p2) +    |> Misc.map_pair (fun p -> Predicate.substs p s)+    |> pUnify+    |> (fun s' -> s' ++ s)+  end [] p1s p2s++and eUnify = function+  | (Con c1, _), (Con c2, _) when c1 = c2 ->+      []+  | (Var x1, _), (Var x2, _) when x1 = x2 ->+      []+  | (Bin (e1, op1, e1'),_), (Bin (e2, op2, e2'), _) when op1 = op2 ->+      esUnify ([e1; e1'], [e2; e2'])+  | (Ite (p1, e1, e1'),_), (Ite (p2, e2, e2'), _) ->+      let s = pUnify (p1, p2) in+      let [e1; e1'; e2; e2'] = List.map ((Misc.flip Expression.substs) s) [e1; e1'; e2; e2'] in+      esUnify ([e1; e1'], [e2; e2'])+  | (Cst (e1, t1),_), (Cst (e2, t2),_) when t1 = t2 ->+      eUnify (e1, e2)+  | (App (uf1, e1s), _), (App (uf2, e2s),_) when uf1 = uf2 ->+      esUnify (e1s, e2s)+  | e, (Var x, _) | (Var x, _), e when Symbol.is_wild x ->+      [(x, e)]+  | _, _ -> raise DoesNotUnify ++and esUnify (e1s, e2s) =+  let _ = asserts (List.length e1s = List.length e2s) "esUnify" in+  List.fold_left2 begin fun s e1 e2 ->+    (e1, e2) +    |> Misc.map_pair (fun e -> Expression.substs e s)+    |> eUnify+    |> (fun s' -> s' ++ s)+  end [] e1s e2s++(* API *)+let unify_pred p1 p2 = try pUnify (p1, p2) |> Subst.of_list |> some with DoesNotUnify -> None +let into_of_expr = function Con (Constant.Int i), _  -> Some i | _ -> None++let symm_pred = function +  | Atom (e1, r, e2), _ -> pAtom (e2, symm_brel r, e1)+  | p                   -> p++(* {{{+let rec expr_subst hp he e x e' =+  let rec esub e =+    try ExprHash.find he e with Not_found -> begin+      let rv = +        match euw e with+        | Var y when x = y ->+            e' +        | Con _ | Var _ -> +            e+        | App (s, es) ->+            App (s, List.map esub es) |> ewr+        | Bin (e1, op, e2) ->+            Bin (esub e1, op, esub e2) |> ewr+        | Ite (ip, te, ee) ->+            Ite (pred_subst hp he ip x e', esub te, esub ee) |> ewr+        | Fld (s, e1) ->+            Fld (s, esub e1) |> ewr in+      let _  = ExprHash.add he e rv in+      rv +    end in esub e++and pred_subst hp he e x e' =+  let rec s e =+    try PredHash.find h e with+	Not_found -> (let foo = s1 e in PredHash.add h e foo; foo)+  and s1 e =+    match puw e with+	True -> e+      | False -> e+      | And plist -> pwr (And(List.map s plist))+      | Or plist -> pwr (Or(List.map s plist))+      | Not p -> pwr (Not(s p))+      | Implies (p1, p2) -> pwr (Implies (s p1, s p2))+      | Equality (x,y) -> pwr (Equality(expr_subst h he x v vv,expr_subst h he y v vv))+      | Atom (_) -> e+      | Leq(x,y) -> pwr (Leq(expr_subst h he x v vv, expr_subst h he y v vv))+  in s e+}}} *)  +(** {{{+      let rec support pred =+        let h = Hash.create 251 in+        let eh = Expression.Hash.create 251 in+        let sh = Hashtbl.create 251 in+        let res = ref [] in+        let add s = if not(Hashtbl.mem sh s) then Hashtbl.add sh s (); res := s :: !res in++        let se exp =+          let rec s exp =+            try Expression.Hash.find eh exp with+                Not_found -> Expression.Hash.add eh exp (); s1 exp+          and s1 exp =+            match euw exp with+                Constant(_) -> ()+              | Application (func, args) -> +                  add func; List.iter s args+              | Variable(sym) -> add sym+              | Sum(args) -> List.iter s args+              | Coeff(c,t) -> s t+              | Ite _ -> failwith "ite not supported"+          in s exp in+          +        let rec s exp =+          try Hash.find h exp with+              Not_found -> Hash.add h exp (); s1 exp+        and s1 pred =+          match puw pred with+              True -> ()+            | False -> ()+            | And plist -> List.iter s plist+            | Or plist -> List.iter s plist+            | Not p -> s p+            | Implies (p1, p2) -> s p1; s p2+            | Equality (x,y) -> se x; se y+            | Leq (x,y) -> se x; se y+            | Atom (s) -> ()+        in s pred; List.rev !res+        +      let h = PredHash.create 251 in+        let rec ip p =+          let _ = f p in+          if not (PredHash.mem h p) then begin+            let _ = PredHash.add h p () in+            match puw p with+            | And ps | Or ps -> +                List.iter ip plist+            | Not p  | Forall (_,p) -> +                ip p +            | Imp (p1, p2) -> +                ip p1; ip p2+            | _ -> ()+          end in+        ip p +   }}} *)+(* {{{+  +      (* Translate predicate to a satisfiability-equivalent predicate without Ite *)+      +      let temp_ctr = ref 0+      let new_temp () =+	let n = "$$$" ^ (string_of_int !temp_ctr) in+	  (temp_ctr := !temp_ctr + 1; n)+	  +      let elim_ite sp =+	let cnsts = ref [] in+	let he = Expression.Hash.create 251 in+	let hp = Hash.create 251 in+	let rec te e =+	  try Expression.Hash.find he e+	  with Not_found -> (let foo = te1 e in Expression.Hash.add he e foo; foo)+	and te1 e =+	  match euw e with+	      Constant(c) -> e+	    | Application (func, args) -> +		ewr (Application (func, List.map te args))+	    | Variable(v) -> ewr (Variable(v))+	    | Sum(args) -> ewr (Sum(List.map te args))+	    | Coeff(c,t) -> ewr (Coeff(c,te t))+	    | Ite(si,st,se) ->+		let temp = ewr (Variable(new_temp())) in+		let i = tp si in+		let tv = te st and ev = te se in+		  begin+		    cnsts := pwr (Or [pwr (Not i); pwr (Equality(temp,(tv)))]) :: (!cnsts);+		    cnsts := pwr (Or [i; pwr (Equality(temp,(ev)))]) :: (!cnsts);+		    temp+		  end+	and tp p = +	  try Hash.find hp p+	  with Not_found -> (let foo = tp1 p in Hash.add hp p foo; foo)+	and tp1 p =+	  match puw p with+	      True -> p+	    | False -> p+	    | And plist -> pwr (And (List.map tp plist))+	    | Or plist -> pwr (Or (List.map tp plist))+	    | Not p -> pwr (Not (tp p))+	    | Implies (p1, p2) -> pwr (Implies((tp p1),(tp p2)))+	    | Equality (x,y) -> pwr(Equality((te x),(te y)))+	    | Leq (x,y) -> pwr(Leq((te x),(te y)))+	    | Atom (s) -> p+	in+	let foo = tp sp in+	  pwr (And(foo :: !cnsts))+    }}} *)
+ external/fixpoint/ast.mli view
@@ -0,0 +1,250 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(**+ * This module implements a DAG representation for expressions and + * predicates: each sub-predicate or sub-expression is paired with+ * a unique int ID, which enables constant time hashing. + * However, one must take care when using DAGS:+ * (1) they can only be constructed using the appropriate functions+ * (2) when destructed via pattern-matching, one must discard the ID+ *)++(*******************************************************)+(********************** Base Logic  ********************)+(*******************************************************)++module Cone : sig +  type 'a t = Empty | Cone of ('a * 'a t) list+  val map : ('a -> 'b) -> 'a t -> 'b t+end++module Sort :+  sig+    type loc = +      | Loc  of string +      | Lvar of int+      | LFun++    type tycon+    type t    +    type sub+   +    val tycon       : string -> tycon+    val tycon_string: tycon -> string++    val to_string   : t -> string+    val print       : Format.formatter -> t -> unit+   +    val t_num       : t+    val t_obj       : t+    val t_bool      : t+    val t_int       : t+    val t_generic   : int -> t+    val t_ptr       : loc -> t+    val t_func      : int -> t list -> t+    val t_app       : tycon -> t list -> t+    (* val t_fptr      : t *)+   +    val is_bool     : t -> bool+    val is_int      : t -> bool+    val is_func     : t -> bool+    val app_of_t    : t -> (tycon * t list) option +    val func_of_t   : t -> (int * t list * t) option+    val ptr_of_t    : t -> loc option+ +    val compat      : t -> t -> bool+    val empty_sub   : sub+    val unifyWith   : sub -> t list -> t list -> sub option +    val unify       : t list -> t list -> sub option+    val apply       : sub -> t -> t+    val generalize  : t list -> t list+    val sub_args    : sub -> (int * t) list+    (* val check_arity : int -> sub -> bool *)+  end++module Symbol : +  sig +    type t +    module SMap         : FixMisc.EMapType with type key = t+    module SSet         : FixMisc.ESetType with type elt = t+    val mk_wild         : unit -> t  +    val of_string       : string -> t+    val to_string       : t -> string +    val is_wild_any     : t -> bool+    val is_wild_fresh   : t -> bool+    val is_wild         : t -> bool+    val print           : Format.formatter -> t -> unit+    val value_variable  : Sort.t -> t+    val is_value_variable : t -> bool+    val suffix          : t -> string -> t+  end++module Constant :+  sig+    type t = Int of int+    val to_string : t -> string+    val print : Format.formatter -> t -> unit+  end++type tag  (* externally opaque *)++type brel = Eq | Ne | Gt | Ge | Lt | Le ++type bop  = Plus | Minus | Times | Div | Mod    (* NOTE: For "Mod" 2nd expr should be a constant or a var *)++type expr = expr_int * tag ++and expr_int =+  | Con  of Constant.t+  | Var  of Symbol.t+  | App  of Symbol.t * expr list+  | Bin  of expr * bop * expr  +  | Ite  of pred * expr * expr+  | Fld  of Symbol.t * expr             (* NOTE: Fld (s, e) == App ("field"^s,[e]) *) +  | Cst  of expr * Sort.t +  | Bot+  | MExp of expr list+  | MBin of expr * bop list * expr +  +and pred = pred_int * tag++and pred_int =+  | True+  | False+  | And  of pred list+  | Or   of pred list+  | Not  of pred+  | Imp  of pred * pred+  | Iff  of pred * pred+  | Bexp of expr+  | Atom of expr * brel * expr +  | MAtom of expr * brel list * expr+  | Forall of ((Symbol.t * Sort.t) list) * pred++(* Constructors : expressions *)+val eTim : expr * expr -> expr+val eInt : int -> expr+val eCon : Constant.t -> expr+val eMExp : expr list -> expr+val eMod : expr * int -> expr+val eModExp : expr * expr -> expr+val eVar : Symbol.t -> expr+val eApp : Symbol.t * expr list -> expr+val eBin : expr * bop * expr -> expr +val eMBin : expr * bop list * expr -> expr +val eIte : pred * expr * expr -> expr+val eFld : Symbol.t * expr -> expr+val eCst : expr * Sort.t -> expr+(* Constructors : predicates *)+val pTrue  : pred+val pFalse : pred+val pAtom  : expr * brel * expr -> pred+val pMAtom : expr * brel list * expr -> pred+val pAnd   : pred list -> pred+val pOr    : pred list -> pred+val pNot   : pred -> pred+val pImp   : (pred * pred) -> pred+val pIff   : (pred * pred) -> pred+val pBexp  : expr -> pred+val pForall: ((Symbol.t * Sort. t) list) * pred -> pred+val pEqual : expr * expr -> pred++val neg_brel : brel -> brel++module Expression : +sig+  module Hash : Hashtbl.S with type key = expr +  +  val print     : Format.formatter -> expr -> unit+  val show      : expr -> unit+  val to_string : expr -> string+  +  val unwrap    : expr -> expr_int+  val support   : expr -> Symbol.t list+  val subst     : expr -> Symbol.t -> expr -> expr +  val map       : (pred -> pred) -> (expr -> expr) -> expr -> expr +  val iter      : (pred -> unit) -> (expr -> unit) -> expr -> unit +end+ ++module Predicate :+sig+  module Hash : Hashtbl.S with type key = pred + +  val print     : Format.formatter -> pred -> unit+  val show      : pred -> unit+  val to_string : pred -> string++  val unwrap    : pred -> pred_int+  val support   : pred -> Symbol.t list+  val subst     : pred -> Symbol.t -> expr -> pred+  val map       : (pred -> pred) -> (expr -> expr) -> pred -> pred +  val iter      : (pred -> unit) -> (expr -> unit) -> pred -> unit +  val is_contra : pred -> bool+  val is_tauto  : pred -> bool+end++module Subst : +  sig+    type t+    val empty                : t+    val is_empty             : t -> bool+    val extend               : t -> (Symbol.t * expr) -> t+    val compose               : t -> t -> t+    val of_list              : (Symbol.t * expr) list -> t+    val simultaneous_of_list : (Symbol.t * expr) list -> t+    val to_list              : t -> (Symbol.t * expr) list+    val print                : Format.formatter -> t -> unit+    val apply                : t -> Symbol.t -> expr option+  end+++module Horn :+  sig+    type pr = string * string list+    type gd = C of pred | K of pr+    type t  = pr * gd list +    val print: Format.formatter -> t -> unit+    val support: t -> string list+  end++val print_stats    : unit -> unit+val fixdiv         : pred -> pred+val zero           : expr+val one            : expr+val bot            : expr++val symm_pred      : pred -> pred+val unify_pred     : pred -> pred -> Subst.t option+val substs_expr    : expr -> Subst.t -> expr+val substs_pred    : pred -> Subst.t -> pred +val simplify_pred  : pred -> pred+val conjuncts      : pred -> pred list++val sortcheck_expr : (Sort.tycon -> bool) -> (Symbol.t -> Sort.t option) -> expr -> Sort.t option+val sortcheck_pred : (Sort.tycon -> bool)  -> (Symbol.t -> Sort.t option) -> pred -> bool+val sortcheck_app  : (Sort.tycon -> bool)  -> (Symbol.t -> Sort.t option) -> Sort.t option -> Symbol.t -> expr list -> (Sort.sub * Sort.t) option++val into_of_expr   : expr -> int option+
+ external/fixpoint/cindex.ml view
@@ -0,0 +1,411 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(***************************************************************)+(**** This module implements constraint indexing ***************)+(***************************************************************)+module H  = Hashtbl+module F  = Format+module BS = BNstats+module Co = Constants+module C  = FixConstraint+module Misc = FixMisc +module IM = Misc.IntMap+module IS = Misc.IntSet+module SM = Ast.Symbol.SMap +module SS = Ast.Symbol.SSet+module P  = Ast.Predicate++open Misc.Ops++let mydebug = false ++(* TODO: Describe the SCC ordering scheme! *)++(***********************************************************************)+(***************** Index Data Structures and Accessors *****************)+(***********************************************************************)++type rank = {+    id    : C.id+  ; scc   : int    (* SCC number with ALL dependencies    *)+  ; iscc  : int    (* SCC number without CUT dependencies *)+  ; simpl : bool   (* Is the RHS simple ?                 *)+  ; cut   : bool   (* Is the RHS a CUT-VAR                *)+  ; tag   : C.tag;+}++let string_of_tag t = +  Printf.sprintf "[%s]" (Misc.map_to_string string_of_int t)++let pprint_rank ppf r = +  Format.fprintf ppf "id=%d, scc=%d, iscc=%d, cut=%b, tag=%a" +    r.id r.scc r.iscc r.cut C.print_tag r.tag++module WH = +  Heaps.Functional (struct +    type t = int * rank +    let compare (ts,r) (ts',r') = +      if r.scc <> r'.scc then compare r.scc r'.scc else+        if ts <> ts' then - (compare ts ts') else +          if r.iscc <> r'.iscc then compare r.iscc r'.iscc else+            if !Constants.ptag && r.tag <> r'.tag then compare r.tag r'.tag else+              compare r.simpl r'.simpl+  end)++type wkl = WH.t++type t = +  { cnst  : FixConstraint.t IM.t     (* id   -> refinement_constraint *) +  ; rnkm  : rank IM.t                (* id   -> dependency rank *)+  ; depm  : C.id list IM.t           (* id   -> successor ids *)+  ; pend  : (C.id, unit) H.t         (* id   -> is in wkl ? *)+  ; rts   : IS.t                     (* {rank} members are "root" sccs *)+  ; ds    : C.dep list               (* add/del dep list *)+  ; rdeps : (int * int) list         (* real dependencies *)  +  ; kuts  : Ast.Symbol.t list        (* CUT KVars *)+  }++let get_ref_rank me c =+  Misc.do_catch "ERROR: Cindex.get_ref_rank" (IM.find (C.id_of_t c)) me.rnkm++let get_ref_constraint me i = +  Misc.do_catch "ERROR: Cindex.get_ref_constraint" (IM.find i) me.cnst++(***********************************************************************)+(******************** Building Real Dependencies ***********************)+(***********************************************************************)++let refa_ko = function C.Kvar (_,k) -> Some k | _ -> None++let reft_ks = function (_,_,ras) -> Misc.map_partial refa_ko ras++let lhs_ks c = +  c |> C.lhs_of_t+    |> reft_ks +    |> SM.fold (fun _ (r:C.reft) l -> (reft_ks r) ++ l) (C.env_of_t c)++let rhs_ks c =+  c |> C.rhs_of_t |> reft_ks ++let make_kread_map cm = +  cm |> IM.to_list +     |> Misc.flap (fun (id, c) -> lhs_ks c |>: (fun k -> (k, id)))+     |> SM.of_alist +(*     >> SM.iter (fun k ids -> Co.bprintf mydebug "ReadIn %a := %a\n" Ast.Symbol.print k Misc.pprint_pretty_ints ids) + *)++let make_deps cm = +  let km = make_kread_map cm in+  cm |> IM.to_list+     |> Misc.flap (fun (id, c) -> rhs_ks c |> Misc.flap (fun k -> SM.finds k km |>: (fun id' -> (id, id'))))+     |> Misc.pad_fst IM.of_alist +(*      >> (fst <+> IM.iter (fun i js -> Co.bprintf mydebug "DepsOf (id = %d) = @[%a@]\n" i Misc.pprint_pretty_ints js)) +*)++(* IM.fold begin fun id c acc ->+    List.fold_left begin fun (dm, deps) k -> +      let rd_ids = SM.finds k km in+      let deps'  = List.map (fun rd_id -> (id, rd_id)) rd_ids in+      (IM.adds id rd_ids dm, (deps' ++ deps)) +    end acc (rhs_ks c) +   end cm (IM.empty, [])+ *)++(***********************************************************************)+(************* Adjusting Dependencies with Provided Tag-Deps ***********)+(***********************************************************************)++let delete_deps cm dds = +  let delf = C.matches_deps dds in+  let tagf = fun x -> IM.find x cm |> C.tag_of_t in+  List.filter (not <.> delf <.> Misc.map_pair tagf)+  +let add_deps cm ads ijs = +  let tt = H.create 37 in+  let _  = IM.iter (fun id c -> H.add tt (C.tag_of_t c) id) cm in+  ads |> Misc.map C.tags_of_dep+      |> Misc.map (Misc.map_pair (H.find_all tt))+      |> Misc.flap (Misc.uncurry Misc.cross_product)+      |> (++) ijs++let adjust_deps cm ds = +  let ads, dds = List.partition C.pol_of_dep ds in+  !Constants.adjdeps <?> (add_deps cm ads <.> delete_deps cm dds)++(***********************************************************************)+(**************************** Dependency SCCs **************************)+(***********************************************************************)++let string_of_ints is = is |> List.map string_of_int |> String.concat ", "++let print_rank_groups f rs = +  rs |>  Misc.kgroupby f +     |>  List.sort compare +     |>  List.iter begin fun (g, rs) ->+            Format.printf "Group=%s size=%d ids=%s\n" +              g (List.length rs) (string_of_ints (List.map (fun r -> r.id) rs)) +          end++let string_of_cid cm id = +  try +    IM.find id cm +    |> C.tag_of_t+    |> Misc.fsprintf C.print_tag+    |> Printf.sprintf "%d: %s" id +  with _ -> assertf "string_of_cid: impossible" ++let make_rankm cm ranks iranks = +  let rm  = IM.of_list ranks  in+  let irm = IM.of_list iranks in+  IM.domain cm +    |>: begin fun id ->+          let c         = IM.find id cm  in+          let r         = IM.find id rm  in+          let (ir, cut) = IM.find id irm in+          id, { id    = id; scc   = r; iscc  = ir; cut   = cut; tag   = C.tag_of_t c +              ; simpl = (not !Co.psimple) || (C.is_simple c)                         }+        end+    |> IM.of_list+    (* >> (IM.range <+> print_rank_groups (fun r -> Printf.sprintf "(%d/%d)" r.scc r.iscc ))   *)++(* returns a predicate which is true of ids whose RHS kvar is a kut-var *)+let is_cut_cst cm kuts = +  let id_cstr     = fun i -> IM.find i cm    in+  let is_cut_kvar = let ks = SS.of_list kuts in +                    fun k -> SS.mem k ks  +  in List.exists is_cut_kvar <.> List.map snd <.> C.kvars_of_reft <.> C.rhs_of_t <.> id_cstr ++let inner_ranks cm deps irs = function +  | [] ->   (* if no kuts specified, use dummys *)+      irs  |>: (fun (i, r) -> (i, (r, false)))  +  | kuts -> (* else, redo the SCC computation without cut-dependencies *)+      let is_eq_rank = let rm = IM.of_list irs in  fun i j -> (IM.find i rm = IM.find j rm)  in+      let is_cut_id  = is_cut_cst cm kuts                                                    in+      let is_cut_dep = fun (i, j) -> is_cut_id i && is_eq_rank i j                           in+      deps |> List.filter (not <.> is_cut_dep)+           |> Fcommon.scc_rank "inner" (string_of_cid cm) (IM.domain cm)  +           |>: (fun (i, ir) -> (i, (ir, is_cut_id i)))++let make_ranks cm deps kuts =+  let ranks  = Fcommon.scc_rank "constraint" (string_of_cid cm) (IM.domain cm) deps in+  let iranks = inner_ranks cm deps ranks kuts                                       in+  make_rankm cm ranks iranks++let make_roots rankm ijs =+  let sccs = rankm |> IM.to_list |> Misc.map (fun (_,r) -> r.scc) in +  let sccm = List.fold_left (fun is scc -> IS.add scc is) IS.empty sccs in+  List.fold_left begin fun sccm (i,j) ->+    let ir = (IM.find i rankm).scc in+    let jr = (IM.find j rankm).scc in+    if ir <> jr then IS.remove jr sccm else sccm+  end sccm ijs+++(* A constraint c is non-live if its rhs is a k variable that is not+ * (transitively) read. + * roots := { c | (rhs_of_t c) has a concrete predicate }+ * lives := Pre*(roots) where Pre* is refl-trans-clos of the depends-on relation *)++let make_lives cm real_deps =+  let dm = real_deps |>: Misc.swap |> IM.of_alist in+  let js = cm |> IM.filter (fun _ -> C.is_conc_rhs) |> IM.domain |> IS.of_list  in+  (js, IS.empty)+  |> Misc.fixpoint begin fun (js, vm) ->+       let vm = IS.fold (fun j vm -> IS.add j vm) js vm in+       let js = IS.fold begin fun j js ->+                  IM.finds j dm +                  |> List.filter (fun j -> not (IS.mem j vm)) +                  |> IS.of_list+                  |> IS.union js+                end js IS.empty+       in ((js, vm), not (IS.is_empty js))+     end+  |> (fst <+> snd) +  >> (IS.cardinal <+> Co.bprintf mydebug "#Live Constraints: %d \n") ++let create_raw kuts ds cm dm real_deps =+  let deps = adjust_deps cm ds real_deps in+  let rnkm = make_ranks cm deps kuts     in+  { cnst = cm; ds  = ds; kuts = kuts; rdeps = real_deps; rnkm  = rnkm+  ; depm = dm; rts = make_roots rnkm deps ;  pend = H.create 17}+++(***********************************************************************)+(**************************** API **************************************)+(***********************************************************************)++(* API *) +let print ppf me =+  List.iter (Format.fprintf ppf "@[%a@] \n" C.print_dep) me.ds; +  IM.iter (fun _ c -> Format.fprintf ppf "@[%a@] \n" (C.print_t None) c) me.cnst+ +let save fname me = +  Misc.with_out_file fname begin fun oc -> +    let ppf = F.formatter_of_out_channel oc in +    F.fprintf ppf "//Sliced Constraints@.";+    F.fprintf ppf "@[%a@] \n" print me+  end++(* The "adjusted" dependencies are used to create the SCC ranks ONLY.+ * For soundness, the "real" dependencies must be used to push + * "successors" into the worklist. *)++(* API *)+let create kuts ds cs =+  let cm            = cs |>: (Misc.pad_fst C.id_of_t) |> IM.of_list in +  let dm, real_deps = make_deps cm in+  create_raw kuts ds cm dm real_deps ++(* API *)+let slice me = +  let lives = make_lives me.cnst me.rdeps in+  let cm    = me.cnst  +              |> IM.filter (fun i _ -> IS.mem i lives) in+  let dm    = me.depm  +              |> IM.filter (fun i _ -> IS.mem i lives) +              |> IM.map (List.filter (fun j -> IS.mem j lives)) in+  let rdeps = me.rdeps +              |> Misc.filter (fun (i,j) -> IS.mem i lives && IS.mem j lives) in  +  create_raw me.kuts me.ds cm dm rdeps+  >> save !Co.save_file++(* API *) +let slice_wf me ws = +  let ks = me.cnst +           |> IM.range +           |> Misc.flap C.kvars_of_t +           |> Misc.map snd +           |> SS.of_list +  in Misc.filter (C.reft_of_wf <+> C.kvars_of_reft <+> List.exists (fun (_,k) -> SS.mem k ks)) ws+  +  +let pp_cstr_id ppf c   = F.fprintf ppf "%d" (C.id_of_t c)+let pp_cstr_ids ppf cs = F.fprintf ppf "@[%a@.@]" (Misc.pprint_many false "," pp_cstr_id) cs++(* API *) +let deps me c =+  (try IM.find (C.id_of_t c) me.depm with Not_found -> [])+  |> List.map (get_ref_constraint me)+  (* >> (List.map C.id_of_t <+> Co.logPrintf "Deps %d = [%a]\n" (C.id_of_t c) Misc.pprint_pretty_ints) *)++(* API *)+let to_list me = IM.range me.cnst++(* +(* API *)+let to_live_list me =+  me.cnst |> IM.to_list +          |> Misc.map_partial (fun (i,c) -> if IS.mem i me.livs then Some c else None)++*)++let sort_iter_ref_constraints me f = +  me.rnkm |> IM.to_list+          |> List.sort (fun (_,r) (_,r') -> compare r.tag r'.tag) +          |> List.iter (fun (id,_) -> f (IM.find id me.cnst)) ++(* API *)+let wpush =+  let timestamp = ref 0 in+  fun me w cs ->+    incr timestamp;+    List.fold_left begin fun w c -> +      let id = C.id_of_t c in+      if Hashtbl.mem me.pend id then w else begin +        Co.cprintf Co.ol_solve "Pushing %d at %d \n" id !timestamp; +        Hashtbl.replace me.pend id (); +        WH.add (!timestamp, get_ref_rank me c) w+      end+    end w cs++let wstring w = +  WH.fold (fun (_,r) acc -> r.id :: acc) w [] +  |> List.sort compare+  |> Misc.map_to_string string_of_int++(* API *)+let wpop me w =+  try +    let _, r = WH.maximum w in+    let _    = Hashtbl.remove me.pend r.id in+    let c    = get_ref_constraint me r.id in+    let _    = Co.cprintf Co.ol_solve "popping (%a) " pprint_rank r in+    let _    = Co.cprintf Co.ol_solve "from wkl = %s \n" (wstring w) in +    (Some c, WH.remove w)+  with Heaps.EmptyHeap -> (None, w) ++let roots me =+  IM.fold begin fun id r sccm ->+   (*  if not (IM.mem r.scc me.rts) then sccm else *)+      let rs = try IM.find r.scc sccm with Not_found -> [] in+      IM.add r.scc (r::rs) sccm+  end me.rnkm IM.empty+  |> IM.map (List.hd <.> List.sort compare)+  |> IM.to_list+  |> Misc.map (fun (_,r) -> get_ref_constraint me r.id) ++(* API *)+let winit me = +  roots me |> wpush me WH.empty  ++++(***************************************************************)+(*********** A Operations for Constraint Cones *****************)+(***************************************************************)++let rec cone_height = function+  | Ast.Cone.Empty    -> +      0+  | Ast.Cone.Cone xcs -> +      xcs |> List.map (snd <+> cone_height <+> (+) 1) |> Misc.list_max 0++let rec cone_size = function+  | Ast.Cone.Empty    ->+      0+  | Ast.Cone.Cone xcs -> +      let ns = List.map (snd <+> cone_size) xcs in+      List.fold_left (+) (List.length ns) ns++let cone (cm, dm) =+  let rec go seen cid = +    if IS.mem cid seen then Ast.Cone.Empty else+      let seen' = IS.add cid seen in+      match IM.finds cid dm with+      | []    -> Ast.Cone.Empty+      | cids' -> Ast.Cone.Cone (List.map (Misc.pad_snd (go seen')) cids')+  in begin fun id -> +           (Ast.Cone.Cone [(id, go IS.empty id)])+        |> (Ast.Cone.map (fun i -> C.tag_of_t <| IM.safeFind i cm "Cindex.cone")) +        >> (fun c -> Format.printf "CONE: %d size=%d height=%d" id (cone_size c) (cone_height c))+     end++let data_sliced_deps cs = +  let cs = FixSimplify.WeakFixpoint.simplify_ts cs          in+  let cm = cs |>: Misc.pad_fst C.id_of_t |>  IM.of_list     in+  let dm = make_deps cm |> snd |>: Misc.swap |> IM.of_alist in+  (cm, dm)+  +(* API *)+let data_cones cs = cs |> data_sliced_deps |> cone
+ external/fixpoint/cindex.mli view
@@ -0,0 +1,54 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(***************************************************************)+(**** This module implements constraint indexing ***************)+(***************************************************************)++type t+type wkl++(** indexing and dependencies *)+val to_list      : t -> FixConstraint.t list ++(* val to_live_list : t -> FixConstraint.t list *)+val create       : Ast.Symbol.t list -> FixConstraint.dep list -> FixConstraint.t list -> t +val deps         : t -> FixConstraint.t -> FixConstraint.t list+val slice        : t -> t +val slice_wf     : t -> FixConstraint.wf list -> FixConstraint.wf list++(** worklist manipulation *)+val wpush        : t -> wkl -> FixConstraint.t list -> wkl +val wpop         : t -> wkl -> FixConstraint.t option * wkl+val winit        : t -> wkl++(** printing *)+val print        : Format.formatter -> t -> unit +++(***************************************************************)+(*********** Some Operations for Constraint Cones **************)+(***************************************************************)++val data_cones: FixConstraint.t list -> FixConstraint.id -> FixConstraint.tag Ast.Cone.t+
+ external/fixpoint/counterexample.ml view
@@ -0,0 +1,323 @@+(*+ * Copyright © 2009-12 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(***************************************************************)+(* Counterexample Generation (cf. Lahiri-Vanegue, VMCAI 2011) **) +(***************************************************************)++module F  = Format+module BS = BNstats+module C  = FixConstraint++module Misc = FixMisc +module IM = Misc.IntMap+module IS = Misc.IntSet++module A  = Ast+module Sy = A.Symbol+module SM = Sy.SMap +module SS = Sy.SSet+module P  = A.Predicate+module Su = A.Subst+module Q  = Qualifier++open Misc.Ops++let mydebug   = false++(***************************************************************************)+(************** Type Aliases ***********************************************)+(***************************************************************************)++type step  = int+type kvar  = Sy.t+type fact  = Abs of kvar * Qualifier.t | Conc of C.id+type cause = step * C.id * ((Sy.t * fact) list)++(* [k |-> [(i0, [q_i0_1...]),...]] + * where q_i0_1... are killed at timestep i0 for kvar k sorted by step *)+type lifespan = (step * Q.t list) list SM.t ++(* [id |-> i0,...] + * where the constraint id is selected at steps i0... by solver *)+type ctrace  = step list IM.t ++(* [((x1,k1,q1), c1);...;((xn,kn,qn),cn)] + * where each k_i+1, q_i+1, c_i+1 is the "cause" for why k_i, q_i is killed *)+(* type cex     = (Sy.t * fact * C.id) list *)+type cex     = Cause of Sy.t * fact * C.id * cex list++(****************************************************************************)+(******************** Printing Counterexamples ******************************)+(****************************************************************************)++let print_fact ppf = function+  | Abs (k, q) -> F.fprintf ppf "(%a/%a)" Sy.print k Q.print_args q+  | Conc i     -> F.fprintf ppf "(id %d)" i++let print_step ppf (x, f, cid) =+  F.fprintf ppf "%a: %a @@ %d" Sy.print x print_fact f cid++(*+let print_cex = Misc.pprint_many_box true "" "---> " "" print_step+*)++let rec print_cex spaces ppf (Cause (x, f, cid, cs)) =+  F.fprintf ppf "%s `-> %a\n%a" +    (String.concat "" (Misc.clone " " spaces))+    print_step (x, f, cid) +    (Misc.pprint_many false "\n\n" (print_cex (spaces + 4))) cs++let print_cex = print_cex 0++let print_fact_causes n ppf (f, xfs) =+  F.fprintf ppf "fact %a killed at %d by: %a \n"+    print_fact f+    n+    (Misc.pprint_many_brackets false  (Misc.pprint_tuple Sy.print print_fact)) xfs++(****************************************************************************)+(******************** Instance Type *****************************************)+(****************************************************************************)++let compare_fact f1 f2 =+  compare (Misc.fsprintf print_fact f1) (Misc.fsprintf print_fact f2)++module FactMap = Misc.EMap (struct +  type t = fact+  let compare = compare_fact+  let print   = print_fact+end)++type t = { tpc      : ProverArch.prover +         ; n        : int                   (* number of solver iters *)+         ; s        : FixConstraint.soln+         ; cm       : FixConstraint.t IM.t+         ; ctrace   : ctrace +         ; lifespan : lifespan              (* builds soln at n                *)+         ; fsm      : step FactMap.t        (* fact |-> step at which killed   *)+         ; scm      : int IM.t              (* step |-> constr at step         *)+         }++let scm_of_ctrace ctrace = +  ctrace +  |> IM.to_list +  |> Misc.flap (fun (cid, is) -> List.map (fun i -> (i, cid)) is)+  |> Misc.fsort fst+  |> IM.of_list++let fsm_of_lifespan lifetime =+  SM.fold begin fun k sqs fsm ->+    List.fold_left begin fun fsm (step, qs) -> +      List.fold_left begin fun fsm q -> +        FactMap.add (Abs (k, q)) step fsm+      end fsm qs+    end fsm sqs+  end lifetime FactMap.empty ++(************************************************************************)+(*********** Helpers to Reconstitute Solutions and Candidates ***********)+(************************************************************************)++let constrOfId me cid = +   IM.safeFind cid me.cm "Cex.constrOfId"++let solutionAt me n k =+  SM.safeFind k me.lifespan "solutionAt: bad kvar"+  |> List.filter (fun (m,_) -> n <= m) +  |> Misc.flap snd+  |> Misc.map Q.pred_of_t+  |> (++) (me.s k)++let isUnsatAt me c n = +  let s     = solutionAt me n                                 in+  let rhsp  = A.pAnd <| C.preds_of_reft s (C.rhs_of_t c)      in+  let query = A.pAnd <| (A.pNot rhsp) :: (C.preds_of_lhs s c) in+  not <| me.tpc#is_contra (C.senv_of_t c) query++let prevStep_conc me c : int =+  let _  = asserts (C.is_conc_rhs c) in+  let no = Misc.find_first_true (isUnsatAt me c) 0 me.n in+  Misc.maybe_apply (+) no (-1)++let prevStep_abs me cid n : int = +  let rec go n = function+    | m1 :: _ when m1 = n     -> (-1)+    | m1 :: (m2 :: _ as rest) -> if n = m2 then m1 else go n rest+    | _                       -> assertf "prevStep with bad ctrace"+  in go n (IM.safeFind cid me.ctrace "prevStep: bad cid") ++let prevStep me c n = +  if C.is_conc_rhs c then +    prevStep_conc me c+  else+    prevStep_abs me (C.id_of_t c) n++let killstep_of_fact me f = +  FactMap.safeFind f me.fsm "Cex.killstep_of_fact"++let delta me c n k : fact list = +  let _n = prevStep me c n in+  SM.safeFind k me.lifespan "delta: bad kvar" +  |> List.filter (fun (m,_) -> _n <= m && m < n) +  |> Misc.flap snd+  |> Misc.map (fun q -> Abs (k, q))++(************************************************************************)+(************************************************************************)+(************************************************************************)++let killerCands me c n : (int * (((Sy.t * fact) * A.pred)) list) list =+  foreach (C.kbindings_of_lhs c) begin fun (x, (vv, t, ras)) ->+    foreach ras begin function C.Kvar (su, k) ->+      foreach (delta me c n k) begin function (Abs (_, q) as f) ->+        let su' = Su.extend su (vv, A.eVar x)       in+        let p'  = A.substs_pred (Q.pred_of_t q) su' in +        (x, f), p'+      end+    end |> Misc.flatten+  end |> Misc.flatten+  |> Misc.kgroupby (fst <+> snd <+> killstep_of_fact me)++(************************************************************************)+(******************** Lazy Explanations *********************************)+(************************************************************************)++let killedPred me c f =  +  match f, C.rhs_of_t c with+  | Abs (k, q), (_,_, [C.Kvar (su, k')])+    when k = k'+    -> A.substs_pred (Q.pred_of_t q) su+  | Conc cid, (_,_,[C.Conc p])+    when C.id_of_t c = cid+    -> p +  | _ -> failwith "Counterexample.killed"++let getKillStep me c bgp iks =+  let iks = Misc.fsort fst iks in+  let ps  = iks |>: (snd <+> List.map snd <+> A.pAnd) in+  match me.tpc#unsat_suffix (C.senv_of_t c) bgp ps with+  | Some j when 0 <= j && j < List.length iks +       -> List.nth iks j +  | io -> let _ = F.printf +                  "getKillStep failure: (cid = %d) (|iks| = %d) (io = %a)\n bgp = %a\nps  = %a\n"+                    (C.id_of_t c) +                    (List.length iks) +                    (Misc.pprint_maybe Misc.pprint_int) io+                    P.print bgp+                    (Misc.pprint_many_brackets true P.print) ps +          in assertf "getKillStep"++let killinfo me = function+  | Conc cid -> me.n, cid+  | f        -> let n = killstep_of_fact me f in+                (n, IM.safeFind n me.scm "Cex.killinfo")++(* {{{ ORIGINAL: simply use unsat core.++let is_bot_killer = function+  | (f, p) when P.is_contra p -> Some f+  | _                         -> None+++let getKillers_cands me c bgp cands =+  match cands, Misc.exists_maybe is_bot_killer cands with +  | [], _ ->+      None+  | _, Some g -> +      Some g +  | _, _  -> +      TP.unsat_core me.tpc (C.senv_of_t c) bgp cands +      |> Misc.do_catch "ERROR: empty unsat core" List.hd+      |> some++let getKillers_fact (me: t) (f: fact) = +  let n, cid     = killinfo me f                            in+  let c          = IM.safeFind cid me.cm "Cex.getKillers 3" in+  match killerCands me c n with []  -> (cid, None) | iks -> +    let bgps       = C.preds_of_lhs (solutionAt me n) c+                     |> (++) [A.pNot (killedPred me c f)]   in+    let (j, cands) = getKillStep me c (A.pAnd bgps) iks     in+    let bgps'      = iks +                   |> List.filter (fun (i,_) -> j < i)+                   |> Misc.flap   (snd <+> List.map snd)    in +    (cid, getKillers_cands me c (A.pAnd (bgps ++ bgps')) cands)++let maxCubeSize = 1++let underApproxCubes me  (p:pred) (q:pred) (rs: ('a * pred) list) : 'a option =+  Misc.exists_maybe begin fun (f, fp) ->+    if SAT (p /\ fp) && UNSAT (p /\ fp /\ q) +    then Some f+    else None+  end rs++}}} *)++let getKillers_cands me c p q rs =+  let env    = C.senv_of_t c in+  let contra = fun p -> me.tpc#is_contra env p in+  Misc.map_partial begin fun (f, fp) ->+    if contra (A.pAnd [p; fp; q]) && not (contra (A.pAnd [p; fp]))+    then Some f+    else None+  end rs++let getKillers_fact (me: t) (f: fact) = +  let n, cid     = killinfo me f                            in+  let c          = IM.safeFind cid me.cm "Cex.getKillers 3" in+  match killerCands me c n with []  -> (cid, []) | iks -> +    let bgps       = C.preds_of_lhs (solutionAt me n) c     in+    let killedp    = A.pNot (killedPred me c f)             in +    let (j, cands) = getKillStep me c (A.pAnd bgps) iks     in+    let bgps'      = iks +                   |> List.filter (fun (i,_) -> j < i)+                   |> Misc.flap   (snd <+> List.map snd)    in +    (cid, getKillers_cands me c (A.pAnd (bgps ++ bgps')) killedp cands)++let rec explain me f =+  let cid, xfs = getKillers_fact me f in+  List.map (fun (x',f') -> Cause (x', f', cid, explain me f')) xfs++(********************************************************************)+(*********************** API ****************************************)+(********************************************************************)++(* API *)+let create tpc s cs ctrace lifespan =+  let scm    = scm_of_ctrace ctrace in+  { tpc      = tpc +  ; s        = s +  ; cm       = cs |>: Misc.pad_fst C.id_of_t |> IM.of_list +  ; n        = 1 + Misc.list_max 0 (IM.domain scm)+  ; ctrace   = IM.map Misc.sort_and_compact ctrace +  ; lifespan = lifespan+  ; fsm      = fsm_of_lifespan lifespan+  ; scm      = scm+  }  ++(* API *)+let explain me c = +  let cid0 = C.id_of_t c in+  let f0   = Conc cid0   in+  Cause (Sy.of_string "ERROR", f0, cid0, explain me f0)
+ external/fixpoint/counterexample.mli view
@@ -0,0 +1,51 @@+(*+ * Copyright © 2009-12 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(***************************************************************)+(* Counterexample Generation (cf. Lahiri-Vanegue, VMCAI 2011) **) +(***************************************************************)++type t ++type kvar     = Ast.Symbol.t+type fact     = Abs of kvar * Qualifier.t | Conc of FixConstraint.id+type step     = int ++(* [k |-> [(i0, [q_i0_1...]),...]] + * where q_i0_1... are killed at timestep i0 for kvar k sorted by step *)+type lifespan = (step * Qualifier.t list) list Ast.Symbol.SMap.t ++(* [cid |-> i0,...] cid is selected at steps i0... by solver *)+type ctrace  = step list FixMisc.IntMap.t ++type cex     ++val create  :  ProverArch.prover        (* tp context        *)+            -> FixConstraint.soln       (* assumes           *) +            -> FixConstraint.t list     (* all constraints   *)+            -> ctrace                   +            -> lifespan +            -> t++val explain : t -> FixConstraint.t -> cex+val print_cex : Format.formatter -> cex -> unit
+ external/fixpoint/fix.ml view
@@ -0,0 +1,36 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++module Ast        = Ast+module Symbol     = Ast.Symbol+module Constant   = Ast.Constant++module Sort       = Ast.Sort+module Predicate  = Ast.Sort+module Expression = Ast.Expression++module FixConstraint = FixConstraint+module Solve      = Solve+++
+ external/fixpoint/fixConfig.ml view
@@ -0,0 +1,162 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++module Sy  = Ast.Symbol+module SM  = Sy.SMap+module Q   = Qualifier+module C   = FixConstraint+module So  = Ast.Sort+module Co  = Constants++module Misc = FixMisc open Misc.Ops++exception UnmappedKvar of Ast.Symbol.t++let mydebug  = false ++type qbind   = Q.t list++type solbind = Ast.Symbol.t * ((Ast.Symbol.t * (Ast.expr list)) list)++type deft = Srt of Ast.Sort.t +          | Axm of Ast.pred +          | Cst of FixConstraint.t+          | Wfc of FixConstraint.wf+          | Con of Ast.Symbol.t * Ast.Sort.t+          | Sol of solbind+          (* | Sol of Ast.Symbol.t * (Ast.pred * (Ast.Symbol.t * Ast.Subst.t)) list *)+          | Qul of Q.t+          | Dep of FixConstraint.dep+          | Kut of Ast.Symbol.t+          | IBind of int * Ast.Symbol.t * FixConstraint.reft  ++type 'bind cfg = { +   a      : int                               (* Tag arity                            *)+ ; ts     : Ast.Sort.t list                   (* New sorts, now = []                  *)+ ; ps     : Ast.pred list                     (* New axioms, now = []                 *)+ ; cs     : FixConstraint.t list              (* Implication Constraints              *)+ ; ws     : FixConstraint.wf list             (* Well-formedness Constraints          *)+ ; ds     : FixConstraint.dep list            (* Constraint Dependencies              *)+ ; qs     : Q.t list                          (* Qualifiers                           *)+ ; kuts   : Ast.Symbol.t list                 (* "Cut"-Kvars, which break cycles      *)+ ; bm     : 'bind SM.t                        (* Initial Sol Bindings                 *)+ ; uops   : Ast.Sort.t Ast.Symbol.SMap.t      (* Globals: measures + distinct consts) *)+ ; cons   : Ast.Symbol.t list                 (* Distinct Constants, defined in uops  *)+ ; assm   : FixConstraint.soln                (* Seed Solution -- must be a fixpoint over constraints *)+}++let get_arity = function+  | []   -> Constants.bprintflush mydebug "WARNING: NO CONSTRAINTS!"; 0+  | c::_ -> c |> FixConstraint.tag_of_t |> fst |> List.length++let sift_quals qs = +  qs >> (fun _ -> Co.bprintflush mydebug "BEGIN: Q.normalize\n")+     |> Q.normalize +     (* >> (Format.printf "Normalized Quals: \n%a" (Misc.pprint_many true "\n" Q.print)) *)+     >> (fun _ -> Co.bprintflush mydebug "DONE: Q.normalize\n")+     |> Misc.map (Misc.pad_fst Q.name_of_t)+     |> SM.of_list++let extend f cfg = function+  | Srt t         -> {cfg with ts   = t     :: cfg.ts   }+  | Axm p         -> {cfg with ps   = p     :: cfg.ps   }+  | Cst c         -> {cfg with cs   = c     :: cfg.cs   }+  | Wfc w         -> {cfg with ws   = w     :: cfg.ws   }+  | Dep d         -> {cfg with ds   = d     :: cfg.ds   }+  | Kut k         -> {cfg with kuts = k     :: cfg.kuts }+  | Qul q         -> {cfg with qs   = q     :: cfg.qs   }+  | Sol (k, fess) -> {cfg with bm   = SM.add k (List.map f fess) cfg.bm  }+  | Con (s,t)     -> {cfg with cons = if So.is_func t then cfg.cons else s :: cfg.cons+                             ; uops = SM.add s t cfg.uops} +  | IBind _       -> cfg +++let empty = +  { a      = 0 +  ; ts     = []+  ; ps     = []+  ; cs     = []+  ; ws     = []+  ; ds     = []+  ; qs     = []+  ; kuts   = []+  ; bm     = SM.empty+  ; cons   = []+  ; uops   = SM.empty +  ; assm   = FixConstraint.empty_solution +  }++let fes2q qm (f, es) =+  let q   = SM.safeFind f qm "name2qual" in+  q |> Q.all_params_of_t+    |> List.map fst +    |> Misc.flip (Misc.combine "FixConfig.fes2q") es+    |> Q.inst q ++let normalize_defts ds =+  let qs, ds' = Misc.either_partition begin function +                  | Qul q -> Left q+                  | d     -> Right d+                end ds                            in+  let qm      = sift_quals qs                     in+  let ds''    = qm |>  SM.range +                   |>: (fun q -> Qul q)+                   |>  (++) ds'                   in+  (qm, ds'')++(* API *)+let create ds =+  let qm, ds' = normalize_defts ds in+  ds' |> List.fold_left (extend (fes2q qm)) empty+      |> (fun cfg -> {cfg with a  = get_arity cfg.cs})+      |> (fun cfg -> {cfg with ws = C.add_wf_ids cfg.ws})++(* API *)+let create_raw ts env ps a ds cs ws qs kuts assm = +  { empty with +    a     = a+  ; ts    = ts+  ; uops  = env+  ; ps    = ps+  ; ds    = ds+  ; cs    = cs+  ; ws    = C.add_wf_ids ws+  ; kuts  = kuts+  ; qs    = Q.normalize qs +  ; assm  = assm+  }++module type SIMPLIFIER = sig+  val simplify_ts: FixConstraint.t list -> FixConstraint.t list+end+++(* type t = Ast.Qualifier.def list list cfg *)++let print ppf me =+  (* Print cs *)+  Format.fprintf ppf "@[%a@] \n" (Misc.pprint_many true "\n" (C.print_t None)) me.cs;+  (* Print ws *)+  Format.fprintf ppf "@[%a@] \n" (Misc.pprint_many true "\n" (C.print_wf None)) me.ws;+  (* Print qs *)+  Format.fprintf ppf "@[%a@] \n" (Misc.pprint_many true "\n" Q.print) (Q.normalize me.qs)+
+ external/fixpoint/fixConfig.mli view
@@ -0,0 +1,53 @@+(* This module deals with top-level parsing of fq files and such *)++(*+exception UnmappedKvar of Ast.Symbol.t+*)+type solbind = Ast.Symbol.t * ((Ast.Symbol.t * (Ast.expr list)) list)+type deft = Srt of Ast.Sort.t +          | Axm of Ast.pred +          | Cst of FixConstraint.t+          | Wfc of FixConstraint.wf+          | Con of Ast.Symbol.t * Ast.Sort.t+          | Sol of solbind+          | Qul of Qualifier.t+          | Dep of FixConstraint.dep+          | Kut of Ast.Symbol.t+          | IBind of int * Ast.Symbol.t * FixConstraint.reft  ++type 'bind cfg = { +   a     : int                               (* Tag arity                            *)+ ; ts    : Ast.Sort.t list                   (* New sorts, now = []                  *)+ ; ps    : Ast.pred list                     (* New axioms, now = []                 *)+ ; cs    : FixConstraint.t list              (* Implication Constraints              *)+ ; ws    : FixConstraint.wf list             (* Well-formedness Constraints          *)+ ; ds    : FixConstraint.dep list            (* Constraint Dependencies              *)+ ; qs    : Qualifier.t list                  (* Qualifiers                           *)+ ; kuts  : Ast.Symbol.t list                 (* "Cut"-Kvars, which break cycles      *)+ ; bm    : 'bind Ast.Symbol.SMap.t           (* Initial Sol Bindings                 *)+ ; uops  : Ast.Sort.t Ast.Symbol.SMap.t      (* Globals: measures + distinct consts) *)+ ; cons  : Ast.Symbol.t list                 (* Distinct Constants, defined in uops  *)+ ; assm  : FixConstraint.soln                (* Seed Solution -- must be a fixpoint over constraints *)+}+++++module type SIMPLIFIER = sig+  val simplify_ts: FixConstraint.t list -> FixConstraint.t list+end++val empty     : 'a cfg +val create    : deft list -> (Qualifier.t list) cfg+val print     : Format.formatter -> 'a cfg -> unit+val create_raw:  Ast.Sort.t list +              -> Ast.Sort.t Ast.Symbol.SMap.t +              -> Ast.pred list +              -> int +              -> FixConstraint.dep list +              -> FixConstraint.t list +              -> FixConstraint.wf list +              -> Qualifier.t list+              -> Ast.Symbol.t list+              -> FixConstraint.soln +              -> 'a cfg
+ external/fixpoint/fixConstraint.ml view
@@ -0,0 +1,541 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONSy.+ *+ *)++(* This module implements basic datatypes and operations on constraints *)+module F  = Format+module H  = Hashtbl+module A  = Ast+module E  = A.Expression+module P  = A.Predicate+module Sy = A.Symbol+module So = A.Sort+module SM = Sy.SMap+module BS = BNstats+module Su = Ast.Subst+module Co  = Constants+module Misc = FixMisc +module MSM  = Misc.StringMap++open Misc.Ops++type tag  = int list * string+type id   = int+type dep  = Adp of tag * tag | Ddp of tag * tag | Ddp_s of tag | Ddp_t of tag++type refa = Conc of A.pred | Kvar of Su.t * Sy.t+type reft = Sy.t * A.Sort.t * refa list                (* { VV: t | [ra] } *)+type envt = reft SM.t+type wf   = envt * reft * (id option) * (Qualifier.t -> bool)+type t    = { full    : envt; +              nontriv : envt;+              guard   : A.pred;+              iguard  : A.pred;+              lhs     : reft;+              rhs     : reft;+              ido     : id option;+              tag     : tag; }++type soln = Ast.Symbol.t -> Ast.pred list++exception BadConstraint of (id * tag * string)+++(*+type soln    = Ast.pred list Ast.Symbol.SMap.t+type soln = { read  : Ast.Symbol.t -> Ast.pred list+            ; kvars : Ast.Symbol.SSet.t }+*)++let mydebug = false ++(*************************************************************)+(************************** Misc.  ***************************)+(*************************************************************)++let is_simple_refatom = function +  | Kvar (s, _) -> Ast.Subst.is_empty s +  | _           -> false++let is_tauto_refatom  = function +  | Conc p -> P.is_tauto p +  |  _ -> false+  ++(* API *)+let fresh_kvar = +  let tick, _  = Misc.mk_int_factory () in+  tick <+> string_of_int <+> (^) "k_" <+> Sy.of_string++(* API *)+let kvars_of_reft (_, _, rs) =+  Misc.map_partial begin function +    | Kvar (subs, k) -> Some (subs,k) +    | _              -> None +  end rs++let meet x (v1, t1, ra1s) (v2, t2, ra2s) = +  asserts (v1=v2 && t1=t2) "ERROR: FixConstraint.meet x=%s (v1=%s, t1=%s) (v2=%s, t2=%s)" +  (Sy.to_string x) (Sy.to_string v1) (A.Sort.to_string t1) (Sy.to_string v2) (A.Sort.to_string t2) ;+  (v1, t1, Misc.sort_and_compact (ra1s ++ ra2s))++let env_of_bindings_ meetb xrs =+  List.fold_left begin fun env (x, r) -> +    let r = if meetb && SM.mem x env then meet x r (SM.find x env) else r in+    SM.add x r env+  end SM.empty xrs++(* API *)+let env_of_bindings         = env_of_bindings_ true+let env_of_ordered_bindings = env_of_bindings_ false ++(* +let env_of_bindings xrs =+  List.fold_left begin fun env (x, r) -> +    let r = if SM.mem x env then meet x r (SM.find x env) else r in+    SM.add x r env+  end SM.empty xrs+*)++let bindings_of_env = SM.to_list++(* let bindings_of_env env = +  SM.fold (fun x y bs -> (x,y)::bs) env []+*)++let split_ras ras = +  let cras, kras = List.partition (function (Conc _) -> true | _ -> false) ras in+  cras |> Misc.map_partial (function Conc p -> Some p | _ -> None) +       |> (function [] -> (None, kras) | ps -> (Some (A.pAnd ps), kras))+++let kbindings_of_lhs {nontriv = ne; lhs = (v, t, ras)} =  +  let xkss     = SM.to_list ne in+  let _, kras  = split_ras ras in+  (v, (v,t,kras)) :: xkss++let map_env    = SM.mapi+let lookup_env = Misc.flip SM.maybe_find +(* let lookup_env env x = try Some (SM.find x env) with Not_found -> None *)++++(* API *)+let is_simple {lhs = (_,_,ra1s); rhs = (_,_,ra2s)} = +  List.for_all is_simple_refatom ra1s +  && List.for_all is_simple_refatom ra2s +  && !Co.simple++let is_conc_refa = function Conc p -> not (P.is_tauto p) | _ -> false++(* API *)+let is_conc_rhs {rhs = (_,_,ras)} =+  List.exists is_conc_refa ras+  >> (fun rv -> if rv then (asserts (List.for_all is_conc_refa ras) "is_conc_rhs"))+++(* API *)+let kvars_of_t {nontriv = env; lhs = lhs; rhs = rhs} =+  [lhs; rhs] +  |> SM.fold (fun _ r acc -> r :: acc) env+  |> Misc.flap kvars_of_reft +++++(*************************************************************)+(*********************** Logic Embedding *********************)+(*************************************************************)++let canon_ras ras = +  match split_ras ras with+  | None, kras   -> kras+  | Some p, kras -> Conc p :: kras++(* +let non_trivial env = +  SM.fold begin fun x r sm -> match thd3 r with +        | [] -> sm +        | _::_ -> SM.add x r sm+  end env SM.empty+*)++let non_trivial env = +  SM.fold begin fun x (v,t,ras) ((ne, ps) as acc) -> match ras with+    | [] -> acc +    | _  -> let po, kras = split_ras ras in +            let ne' = match kras with [] -> ne | _      -> SM.add x (v,t,kras) ne in+            let ps' = match po with None -> ps | Some p -> (P.subst p v (A.eVar x)) :: ps  in+            ne', ps'+  end env (SM.empty, []) ++(* API *)+let is_conc_refa = function+  | Conc _ -> true+  | _      -> false++let soln_read s k = s k (* SM.find k s *)++(* API *)+let preds_of_refa s = function+  | Conc p      -> [p]+  | Kvar (su,k) -> soln_read s k |> List.map (Misc.flip A.substs_pred su)++(* API *)+let preds_of_reft f (_,_,ras) = +  Misc.flap (preds_of_refa f) ras++(* API *)+let meet_solution s1 s2 = fun k -> s1 k ++ s2 k (* SM.extendWith (fun _ -> (++)) *)+let empty_solution      = fun _ -> []++let apply_solution_refa f ra = +  Conc (A.pAnd (preds_of_refa f ra))++(* API *)+let apply_solution f (v, t, ras) = +  (v, t, List.map (apply_solution_refa f) ras)++let preds_of_envt f env =+  SM.fold+    (fun x ((vv, t, ras) as r) ps -> +      let vps = preds_of_reft f r in+      let xps = List.map (fun p -> P.subst p vv (A.eVar x)) vps in+      xps ++ ps)+    env [] ++(* API *)+let wellformed_pred env = +  A.sortcheck_pred Theories.is_interp (Misc.maybe_map snd3 <.> Misc.flip SM.maybe_find env)++(* API *)+let preds_of_lhs_nofilter f c = +  let envps = preds_of_envt f c.nontriv in+  let r1ps  = preds_of_reft f c.lhs in+  (c.iguard :: envps) ++ r1ps+++(* let preds_of_lhs f c =+  let env   = SM.add (fst3 c.lhs) c.lhs c.full in+  let wfp p = wellformed_pred env p +              >> (fun b -> if not b then F.eprintf "WARNING: Malformed Lhs Pred (%a)\n" P.print p) in+  let ps    = preds_of_lhs_nofilter f c        in+  let ps'   = List.filter wfp ps               in+  if !Co.strictsortcheck && List.length ps != List.length ps' +  then raise (BadConstraint (Misc.maybe c.ido, c.tag, "Malformed Lhs Pred"))+  else ps+*)++let report_wellformed env c p wf = +  if not wf then+    let msg = F.sprintf "WARNING: Malformed Lhs Pred (%s)\n" (P.to_string p)                  in +    let _   = F.eprintf "%s" msg                                                              in +    let _   = SM.iter (fun s (_,t,_) -> F.eprintf "@[%a :: %a@]@." Sy.print s So.print t) env in+    let _   = F.eprintf "@[%a@]@.@." P.print p                                                in+    if !Co.strictsortcheck then raise (BadConstraint (Misc.maybe c.ido, c.tag, msg))++(* API *)+let preds_of_lhs f c = +  let env = SM.add (fst3 c.lhs) c.lhs c.full in+  preds_of_lhs_nofilter f c +  |> List.filter (fun p -> wellformed_pred env p >> report_wellformed env c p)++(* API *)+let vars_of_t f ({rhs = r2} as c) =+  (preds_of_reft f r2) ++ (preds_of_lhs f c)+  |> Misc.flap P.support++(**************************************************************)+(********************** Pretty Printing ***********************)+(**************************************************************)++let print_refineatom ppf = function+  | Conc p       -> F.fprintf ppf "%a" P.print p+  | Kvar (su, k) -> F.fprintf ppf "%a%a" Sy.print k Su.print su++(*+(* API *)+let print_ras so ppf = function +  | []  -> F.fprintf ppf "true"+  | ras -> begin match so with +            | None   ->+               F.fprintf ppf "%a" (Misc.pprint_many_box false "" "; " "" print_refineatom) ras +             | Some s -> let ps = Misc.flap (preds_of_refa s) ras in+                         (match ps with +                         | [] -> F.fprintf ppf "[]" +                         | _  -> F.fprintf ppf "%a" P.print (A.pAnd ps))+           end+*)++(* API *)+let print_ras so ppf ras = match so with+  | None  -> +      Misc.pprint_many_box false "[" "; " "]" print_refineatom ppf ras+  | Some s -> +      begin match Misc.flap (preds_of_refa s) ras with +            | [] -> F.fprintf ppf "[]"+            | ps -> F.fprintf ppf "[%a]" P.print (A.pAnd ps)+      end+++(* API *)+let print_reft_pred so ppf (v,t,ras) =+  F.fprintf ppf "@[{%a:%a | %a}@]"+    Sy.print v +    Ast.Sort.print t+    (print_ras so) ras++(*+let print_reft_pred so ppf = function+  | (v,_,[])  -> F.fprintf ppf "@[{%a | true }@]" Sy.print v+  | (v,_,ras) -> F.fprintf ppf "@[{%a | @[%a@]}@]" Sy.print v (print_ras so) ras+*)++(* API *)+let print_reft so ppf (v, t, ras) =+  F.fprintf ppf "@[{%a : %a | %a}@]" +    Sy.print v +    Ast.Sort.print t+    (print_ras so) ras++(* API *)+let print_binding so ppf (x, r) = +  F.fprintf ppf "@[%a:%a@]" Sy.print x (print_reft so) r ++(* API *)+let print_env so ppf env = +  bindings_of_env env +  |> F.fprintf ppf "@[%a@]" (Misc.pprint_many_brackets true (print_binding so))+++let pprint_id ppf = function+  | Some id     -> F.fprintf ppf "id %d" id+  | None        -> F.fprintf ppf ""+++let string_of_intlist = (String.concat ";") <.> (List.map string_of_int)++(* API *)+let print_tag ppf = function+  | [],_ -> F.fprintf ppf ""+  | is,s -> F.fprintf ppf "tag [%s] //%s" (string_of_intlist is) s ++(* API *)+let print_dep ppf = function+  | Adp ((t,_), (t',_)) +    -> F.fprintf ppf "add_dep: [%s] => [%s]" (string_of_intlist t) (string_of_intlist t')+  | Ddp ((t,_), (t',_)) +    -> F.fprintf ppf "del_dep: [%s] => [%s]" (string_of_intlist t) (string_of_intlist t')+  | Ddp_s (t,_)    +    -> F.fprintf ppf "del_dep: [%s] => *" (string_of_intlist t) +  | Ddp_t (t',_)    +    -> F.fprintf ppf "del_dep: * => [%s]" (string_of_intlist t')++(* API *)+let print_wf so ppf (env, r, io, _) =+  F.fprintf ppf "wf: env @[%a@] @\n reft %a @\n %a @\n"+    (print_env so) env+    (print_reft so) r+    pprint_id io++let print_t so ppf c =+  let env, g = if !Co.print_nontriv then c.nontriv, c.iguard else c.full, c.guard in +  F.fprintf ppf +  "constraint:@. env  @[%a@] @\n grd @[%a@] @\n lhs @[%a@] @\n rhs @[%a@] @\n %a %a @\n"+    (print_env so) env +    P.print g+    (print_reft so) c.lhs +    (print_reft so) c.rhs+    pprint_id c.ido+    print_tag c.tag ++(* API *)+let to_string         = Misc.fsprintf (print_t None)+let refa_to_string    = Misc.fsprintf print_refineatom +let reft_to_string    = Misc.fsprintf (print_reft None)+let binding_to_string = Misc.fsprintf (print_binding None) +++ +(***************************************************************)+(*********************** Getter/Setter *************************)+(***************************************************************)++let theta_ra (su': Su.t) = function+  | Conc p       -> Conc (A.substs_pred p su')+  | Kvar (su, k) -> Kvar (Su.compose su su', k) +++(* API *)+let make_reft     = fun v so ras -> (v, so, List.map (theta_ra Su.empty) (canon_ras ras))++let vv_of_reft    = fst3+let sort_of_reft  = snd3+let ras_of_reft   = thd3+let shape_of_reft = fun (v, so, _) -> (v, so, [])+let theta         = fun subs (v, so, ras) -> (v, so, Misc.map (theta_ra subs) ras)+++(* API *)+let env_of_t    = fun t -> t.full +let grd_of_t    = fun t -> t.guard +let lhs_of_t    = fun t -> t.lhs +let rhs_of_t    = fun t -> t.rhs+let tag_of_t    = fun t -> t.tag+let ido_of_t    = fun t -> t.ido+let id_of_t     = fun t -> match t.ido with Some i -> i | _ -> assertf "C.id_of_t"+let is_tauto    = rhs_of_t <+> ras_of_reft <+> List.for_all is_tauto_refatom+let make_t      = fun env p r1 r2 io is ->+                    let p        = A.simplify_pred p in+                    let ne, ps   = non_trivial env   in+                    { full    = env +                    ; nontriv = ne+                    ; guard   = p+                    ; iguard  = A.pAnd (p::ps) +                    ; lhs     = r1 +                    ; rhs     = r2+                    ; ido     = io+                    ; tag     = is }++let vv_of_t     = fun t -> fst3 t.lhs+let sort_of_t   = fun t -> snd3 t.lhs+let senv_of_t   = fun t -> SM.map snd3 t.full+                        |> SM.add (vv_of_t t) (sort_of_t t) ++(*+let make_t      = fun env p ((v,t,ras1) as r1) r2 io is ->+                    let p        = A.simplify_pred p in+                    let po, kras = split_ras ras1    in+                    let ne, ps   = non_trivial env   in+                    let gps      = match po with Some p' -> p' :: p :: ps | _ -> p :: ps in+                    { full    = env +                    ; nontriv = ne+                    ; guard   = p+                    ; iguard  = A.pAnd gps +                    ; lhs     = (v, t, kras) +                    ; rhs     = r2+                    ; ido     = io+                    ; tag     = is }+*)++let reft_of_sort so = make_reft (Sy.value_variable so) so []++let add_consts_env consts env =+  consts+  |> List.map (Misc.app_snd reft_of_sort)+  |> List.fold_left (fun env (x,r) -> SM.add x r env) env++(* API *)+let add_consts_wf consts (env,x,y,z) = (add_consts_env consts env, x, y, z)++(* API *)+let add_consts_t consts t = {t with full = add_consts_env consts t.full}++(* API *)+let make_wf          = fun env r io -> (env, r, io, fun _ -> true)+let make_filtered_wf = fun env r io fltr -> (env, r, io, fltr)+let env_of_wf        = fst4+let reft_of_wf       = snd4+let id_of_wf         = function (_,_,Some i,_) -> i | _ -> assertf "C.id_of_wf"+let filter_of_wf     = fth4+  +let intersect_maps m1 m2 = SM.filter begin fun k elt ->+  SM.mem k m2 && SM.find k m2 = elt+end m1+  +let intersect_wfs (e1, r1, id1, qf1) (e2, r2, id2, qf2) =+  let _ = assert (r1 = r2) in+  let env = intersect_maps e1 e2 in+  (env, r1, id1, fun x -> (qf1 x && qf2 x))+    +let reduce_wfs wfs = +  wfs +  |> Misc.groupby reft_of_wf +  |>: (fun wfs -> List.fold_left intersect_wfs (List.hd wfs) (List.tl wfs))+++(* API *)+let matches_deps ds = +  let tt   = H.create 37 in+  let s_tt = H.create 37 in+  let t_tt = H.create 37 in+  List.iter begin function  +    | Adp (t, t') +    | Ddp (t, t') -> H.add tt (t,t') ()+    | Ddp_s t     -> H.add s_tt t  ()+    | Ddp_t t'    -> H.add t_tt t' ()+  end ds;+  (fun (t, t') -> H.mem tt (t, t') || H.mem s_tt t || H.mem t_tt t')++(* API *)+let pol_of_dep = function Adp (_,_) -> true | _ -> false++(* API *)+let tags_of_dep = function +  | Adp (t, t') | Ddp (t, t') -> t,t' +  | _ -> assertf "tags_of_dep"++(* API *)+let make_dep b xo yo =+  match (b, xo, yo) with+  | true , Some t, Some t' -> Adp (t, t')+  | false, Some t, Some t' -> Ddp (t, t')+  | false, Some t, None    -> Ddp_s t+  | false, None  , Some t' -> Ddp_t t'+  | _                      -> assertf "FixConstraint.make_dep: match failure"++(* API *)+let preds_kvars_of_reft reft =+  List.fold_left begin fun (ps, ks) -> function +    | Conc p -> p :: ps, ks+    | Kvar (xes, kvar) -> ps, (xes, kvar) :: ks +  end ([], []) (ras_of_reft reft)+++(***************************************************************)+(************* Add Distinct Ids to Constraints *****************)+(***************************************************************)++let max_id n cs =+  cs |> Misc.map_partial ido_of_t +     >> (fun ids -> asserts (Misc.distinct ids) "Duplicate Ids")+     |> List.fold_left max n++let max_wf_id n ws =+  ws |> Misc.map_partial (fun (_,_,ido,_) -> ido) +     >> (fun ids -> asserts (Misc.distinct ids) "Duplicate WF Ids")+     |> List.fold_left max n++(* API *)+let add_wf_ids ws = +  Misc.mapfold begin fun j wf -> match wf with+    | (x,y,None,z) -> j+1, (x, y, Some j, z) +    | _            -> j, wf+  end ((max_wf_id 0 ws) + 1) ws+  |> snd+    +(* API *)+let add_ids n cs =+  Misc.mapfold begin fun j c -> match c with+    | {ido = None} -> j+1, {c with ido = Some j}+    | c            -> j, c+  end ((max_id n cs) + 1) cs
+ external/fixpoint/fixConstraint.mli view
@@ -0,0 +1,140 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++(* This module implements basic datatypes and operations on constraints *)+++type t                  (* NEVER EVER expose! *) +type wf                 (* NEVER EVER expose! *)+type dep                (* NEVER EVER expose! dependencies between constraints *)++type tag  = int list * string (* for ordering: must have same dim, lexico-ordered *)+type id   = int         (* for identifying: must be unique *) ++exception BadConstraint of (id * tag * string)++type soln = Ast.Symbol.t -> Ast.pred list+type refa = Conc of Ast.pred | Kvar of Ast.Subst.t * Ast.Symbol.t+type reft = Ast.Symbol.t * Ast.Sort.t * refa list   (* { VV: t | [ra] } *)+type envt = reft Ast.Symbol.SMap.t++val fresh_kvar       : unit -> Ast.Symbol.t+val kvars_of_reft    : reft -> (Ast.Subst.t * Ast.Symbol.t) list+val kvars_of_t       : t -> (Ast.Subst.t * Ast.Symbol.t) list++val is_conc_refa     : refa -> bool+val is_conc_rhs      : t -> bool++val empty_solution   : soln+val meet_solution    : soln -> soln -> soln+val apply_solution   : soln -> reft -> reft++val wellformed_pred  : envt -> Ast.pred -> bool+val preds_of_refa    : soln -> refa -> Ast.pred list+val preds_of_reft    : soln -> reft -> Ast.pred list+val preds_of_lhs     : soln -> t -> Ast.pred list+val preds_of_lhs_nofilter : soln -> t -> Ast.pred list++val vars_of_t        : soln -> t -> Ast.Symbol.t list+val is_tauto         : t -> bool++val preds_kvars_of_reft     : reft -> (Ast.pred list * (Ast.Subst.t * Ast.Symbol.t) list)+val env_of_bindings         : (Ast.Symbol.t * reft) list -> envt+val env_of_ordered_bindings : (Ast.Symbol.t * reft) list -> envt++(* TODO: Deprecate *)+val bindings_of_env  : envt -> (Ast.Symbol.t * reft) list++val kbindings_of_lhs : t -> (Ast.Symbol.t * reft) list++val is_simple        : t -> bool+val map_env          : (Ast.Symbol.t -> reft -> reft) -> envt -> envt +val lookup_env       : envt -> Ast.Symbol.t -> reft option++(* to print a constraint "c" do:+   Format.printf "%a" (print_t None) c++   to print an env "env" do:+   Format.printf "%a" (print_env None) c++   to print a wf constraint wf do:+   Format.printf "%a" (print_wf None) wf++   to convert a constraint c to a string do:+   to_string c++   to print a list of constraints cs do: +   Format.printf "%a" (FixMisc.pprint_many true "\n" (C.print_t None)) cs+   *)++val print_env        : soln option -> Format.formatter -> envt -> unit+val print_wf         : soln option -> Format.formatter -> wf -> unit+val print_t          : soln option -> Format.formatter -> t -> unit+val print_ras        : soln option -> Format.formatter -> refa list -> unit+val print_reft       : soln option -> Format.formatter -> reft -> unit+val print_reft_pred  : soln option -> Format.formatter -> reft -> unit+val print_binding    : soln option -> Format.formatter -> (Ast.Symbol.t * reft) -> unit+val print_tag        : Format.formatter -> tag -> unit+val print_dep        : Format.formatter -> dep -> unit++val to_string        : t -> string +val refa_to_string   : refa -> string+val reft_to_string   : reft -> string+val binding_to_string: (Ast.Symbol.t * reft) -> string++val make_reft        : Ast.Symbol.t -> Ast.Sort.t -> refa list -> reft+val vv_of_reft       : reft -> Ast.Symbol.t+val sort_of_reft     : reft -> Ast.Sort.t+val ras_of_reft      : reft -> refa list+val shape_of_reft    : reft -> reft+val theta            : Ast.Subst.t -> reft -> reft++val add_consts_wf    : (Ast.Symbol.t * Ast.Sort.t) list -> wf -> wf+val add_consts_t     : (Ast.Symbol.t * Ast.Sort.t) list -> t -> t+val make_t           : envt -> Ast.pred -> reft -> reft -> id option -> tag -> t++val sort_of_t        : t -> Ast.Sort.t+val vv_of_t          : t -> Ast.Symbol.t+val senv_of_t        : t -> Ast.Sort.t Ast.Symbol.SMap.t+val env_of_t         : t -> envt+val grd_of_t         : t -> Ast.pred+val lhs_of_t         : t -> reft+val rhs_of_t         : t -> reft+val id_of_t          : t -> id+val ido_of_t         : t -> id option+val tag_of_t         : t -> tag+val add_ids          : id -> t list -> id * t list+val add_wf_ids       : wf list -> wf list+val make_wf          : envt -> reft -> id option -> wf+val make_filtered_wf : envt -> reft -> id option -> (Qualifier.t -> bool) -> wf+val env_of_wf        : wf -> envt+val reft_of_wf       : wf -> reft+val id_of_wf         : wf -> id +val filter_of_wf     : wf -> (Qualifier.t -> bool)+  +val reduce_wfs       : wf list -> wf list++val make_dep         : bool -> tag option -> tag option -> dep+val matches_deps     : dep list -> tag * tag -> bool+val tags_of_dep      : dep -> tag * tag+val pol_of_dep       : dep -> bool
+ external/fixpoint/fixLex.mll view
@@ -0,0 +1,151 @@+(*+ * Copyright © 1990-2002 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * d + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++{+  module Misc = FixMisc+  +  open Misc.Ops+  module E = Errorline+  open E+  open FixParse ++  let lexerror msg lexbuf = +    E.error (Lexing.lexeme_start lexbuf) msg+ +  (* +  let int_of_lexbuf lb = +    let str = Lexing.lexeme lb in+    let len = String.length str in+    let zero = Char.code '0' in+    let rec accum a d =+      let acc c = a + (d * ((Char.code c) - zero)) in+      function 0 -> let c = str.[0] in+			  	    if c='-' then - a else (acc c)+		     | i -> accum (acc str.[i]) (d * 10) (i - 1)+    in accum 0 1 (len-1) +   *)++  let safe_int_of_string s = +    try int_of_string s with ex -> +      let _ = Printf.printf "safe_int_of_string crashes on: %s (error = %s)" s (Printexc.to_string ex) in+      raise ex+}++let digit    = ['0'-'9' '-']+let letdig   = ['0'-'9' 'a'-'z' 'A'-'Z' '_' '@' ''' '.' '#']+let alphlet  = ['A'-'Z' 'a'-'z' '~' '_' ''' '@' ]+let capital  = ['A'-'Z']+let small    = ['a'-'z' '$' '_']+let ws       = [' ' '\009' '\012']+let pathname = ['a'-'z' 'A'-'Z' '0'-'9' '.' '/' '\\' '-']++rule token = parse+    ['\r''\t'' ']       { token lexbuf}+  | '\n'		        { begin+			                E.startNewline (Lexing.lexeme_end lexbuf);+			                token lexbuf +			              end }+  | "//"[^'\n']*'\n'+                        { begin+                          E.startNewline (Lexing.lexeme_end lexbuf);+			              token lexbuf+                          end +                        }+  | '['                 { LB }+  | ']'                 { RB }+  | '('			        { LPAREN }+  | ')'			        { RPAREN }+  | '{'			        { LC }+  | '}'			        { RC }+  | '~'                 { NOT }+  | ';'                 { SEMI }+  | ','                 { COMMA }+  | ':'                 { COLON }+  | '|'                 { MID }+  | '+'                 { PLUS }+  | '-'                 { MINUS }+  | '*'                 { TIMES }+  | '/'                 { DIV }+  | '?'                 { QM }+  | '.'                 { DOT }+  | "not"               { NOTWORD }+  | "tag"               { TAG }+  | "id"                { ID }+  | "Bexp"              { BEXP }+  | "false"             { FALSE }+  | "true"              { TRUE }+  | ":="                { ASGN }+  | "&&"                { AND }+  | "||"                { OR  }+  | "<=>"               { IFF }+  | "iff"               { IFFWORD }+  | "=>"                { IMPL }+  | "!="		        { NE }+  | "="		            { EQ }+  | "<="		        { LE }+  | "<"		            { LT }+  | ">="		        { GE }+  | ">"		            { GT }+  | "mod"               { MOD }+  | "obj"               { OBJ }+  | "num"               { NUM }+  | "int"               { INT }+  | "ptr"               { PTR }+  | "<fun>"             { LFUN }+  (* | "fptr"           { FPTR } *)+  | "bool"              { BOOL }+  | "uit"               { UNINT }+  | "func"              { FUNC }+  | "sort"              { SRT }+  | "axiom"             { AXM }+  | "constant"          { CON }+  | "constraint"        { CST }+  | "wf"                { WF }+  | "solution"          { SOL }+  | "qualif"            { QUL }+  | "cut"               { KUT }+  | "bind"              { BIND }+  | "add_dep"           { ADP }+  | "del_dep"           { DDP }+  | "env"               { ENV }+  | "grd"               { GRD }+  | "lhs"               { LHS }+  | "rhs"               { RHS }+  | "reft"              { REF }+  | "@"                 { TVAR } +  | (digit)+	        { Num (safe_int_of_string (Lexing.lexeme lexbuf)) }+  | (alphlet)letdig*	{ Id    (Lexing.lexeme lexbuf) }+  | '''[^''']*'''       { let str = Lexing.lexeme lexbuf in+			              let len = String.length str in+			              Id (String.sub str 1 (len-2)) +                        }+  +  | eof			{ EOF }+  | _			{ +                          begin+                            lexerror ("Illegal Character '" ^ +                                      (Lexing.lexeme lexbuf) ^ "'") lexbuf;+			    token lexbuf+			  end }+
+ external/fixpoint/fixParse.mly view
@@ -0,0 +1,420 @@++%{+module A  = Ast+module So = A.Sort+module Sy = A.Symbol+module E  = A.Expression+module P  = A.Predicate+module H  = A.Horn+module Su = A.Subst+module C  = FixConstraint+module Co = Constants+open FixMisc.Ops++(* + *+  %token <string> Tycon+  | (capital)letdig*    { Tycon (Lexing.lexeme lexbuf) }          +  | Tycon                               { So.t_app (So.tycon $1) [] }+  | Tycon tyconargsne                   { So.t_app (So.tycon $1) $2 }+   *)+  (*  | Id                                  { So.t_ptr (So.Loc $1) }++(*+pExprs:+    LPAREN RPAREN                       { []   }+  | LPAREN expr RPAREN                  { [$2] }+  | LPAREN exprsCommaNe RPAREN          { $2   }+  ;++exprsCommaNe:+    expr                                { [$1] }+  | expr COMMA exprsCommaNe             { $1 :: $3 }+  ; +  *)++*)+let parse_error msg =+  Errorline.error (symbol_start ()) msg++let create_qual name vv = Qualifier.create (Sy.of_string name) (Sy.of_string vv) ++let set_ibind, get_ibind =+  let bindt = Hashtbl.create 37 in+  ( (fun (i, x, t) -> Hashtbl.replace bindt i (x, t))+  , (fun i         -> try Hashtbl.find bindt i with Not_found -> assertf "Unknown binding: %d\n" i) +  )++let env_of_ibindings is = +  is |> FixMisc.sort_and_compact +     |> FixMisc.map get_ibind+     |> C.env_of_ordered_bindings++%}++%token <string> Id+%token <int> Num+%token TVAR +%token TAG ID +%token BEXP+%token TRUE FALSE+%token LPAREN  RPAREN LB RB LC RC+%token EQ NE GT GE LT LE+%token AND OR NOT NOTWORD IMPL IFF IFFWORD FORALL SEMI COMMA COLON MID+%token EOF+%token MOD +%token PLUS+%token MINUS+%token TIMES +%token DIV +%token QM DOT ASGN+%token OBJ INT NUM PTR LFUN BOOL UNINT FUNC+%token SRT AXM CON CST WF SOL QUL KUT BIND ADP DDP+%token ENV GRD LHS RHS REF++%right IFF IFFWORD+%right IMPL+%left PLUS+%left MINUS+%left DIV+%left TIMES+%left DOT+%right NOT++%start defs +%start sols+%start reft ++%type <FixConfig.deft list>     defs+%type <FixConfig.deft>          def+%type <FixConfig.solbind list>  sols+%type <So.t list>               sorts, sortsne +%type <So.t>                    sort+%type <(Sy.t * So.t) list>      binds, bindsne +%type <A.pred list>             preds, predsne+%type <A.pred>                  pred+%type <A.expr list>             exprs, exprsne+%type <A.expr>                  expr+%type <C.t>                     cstr+%type <C.envt>                  env+%type <FixConstraint.reft>      reft+%type <C.refa list>             refas, refasne+%type <C.refa>                  refa+%type <Su.t>                    subs++%%+defs:+                                        { [] } +  | def defs                            { $1 :: $2 }+  ;++++qual:+    Id LPAREN Id COLON sort RPAREN COLON pred            { create_qual $1 $3 $5 [] $8 }+  | Id LPAREN Id RPAREN COLON pred                       { create_qual $1 $3 So.t_int [] $6 }+  | Id LPAREN Id COLON sort qbindsne RPAREN COLON pred   { create_qual $1 $3 $5 $6 $9 }+  ;++qbindsne:+    COMMA bind                          { [$2] }+  | COMMA bind qbindsne                 { $2 :: $3 }+  ;++def:+    SRT COLON sort                      { FixConfig.Srt $3 }+  | AXM COLON pred                      { FixConfig.Axm $3 }+  | CST COLON cstr                      { FixConfig.Cst $3 }+  | CON Id COLON sort                   { FixConfig.Con (Sy.of_string $2, $4) }+  | WF  COLON wf                        { FixConfig.Wfc $3 }+  | sol                                 { FixConfig.Sol $1 } +  | QUL qual                            { FixConfig.Qul $2 }+  | KUT Id                              { FixConfig.Kut (Sy.of_string $2) }+  | dep                                 { FixConfig.Dep $1 }+  | BIND Num Id COLON reft              { let (i, x, r) = ($2, Sy.of_string $3, $5) +                                                          >> set_ibind +                                          in FixConfig.IBind (i,x,r)              } +  ;+++sorts:+    LB RB                               { [] }+  | LB sortsne RB                       { $2 }+  ;++sortsne:+    sort                                { [$1] }+  | sort SEMI sortsne                   { $1 :: $3 }+  ;++tyconargsne: +  | bsort                               { [$1] }+  | bsort tyconargsne                   { $1 :: $2 }+  ;++sort:+  | bsort                               { $1 }+  | Id tyconargsne                      { So.t_app (So.tycon $1) $2 }+  | LB sort RB                          { So.t_app (So.tycon "List") [$2] }+ +  ;++bsort:+  | INT                                 { So.t_int }+  | BOOL                                { So.t_bool }+  | PTR                                 { So.t_ptr (So.Lvar 0) }+  | PTR LPAREN LFUN RPAREN              { So.t_ptr (So.LFun) }+  | PTR LPAREN Num RPAREN               { So.t_ptr (So.Lvar $3) }+  | PTR LPAREN Id RPAREN                { So.t_ptr (So.Loc $3) }+  | OBJ                                 { So.t_obj } +  | NUM                                 { So.t_num } +  | TVAR LPAREN Num RPAREN              { So.t_generic $3 }+  | FUNC LPAREN sorts RPAREN            { So.t_func 0 $3  }+  | FUNC LPAREN Num COMMA sorts RPAREN  { So.t_func $3 $5 }+  | Id                                  { let s = $1 in +                                          if !Co.gen_qual_sorts || FixMisc.stringIsLower s then +                                            So.t_ptr (So.Loc s)       (* tyvar *) +                                          else +                                            So.t_app (So.tycon s) []  (* tycon *) +                                        }+  | LPAREN sort RPAREN                  { $2 }+  ; +++binds:+    LB RB                               { [] }+  | LB bindsne RB                       { $2 }+  ;++bindsne:+    bind                                { [$1] }+  | bind SEMI bindsne                   { $1::$3 }+  ;+++bind:+  Id COLON sort                         { ((Sy.of_string $1), $3) }+  ;++rels:+    LB RB                               { [] }+  | LB relsne RB                        { $2 }+  ;++relsne: +    rel                                 { [$1]}+  | rel SEMI relsne                     { $1 :: $3}+  ;++rel:+   EQ                                   { A.Eq }+ | NE                                   { A.Ne }    + | GT                                   { A.Gt }+ | GE                                   { A.Ge }+ | LT                                   { A.Lt }+ | LE                                   { A.Le }+ ;+++preds:+    LB RB                               { [] }+  | LB predsne RB                       { $2 }+  ;++predsne:+    pred                                { [$1] }+  | pred SEMI predsne                   { $1 :: $3 }+;++pred:+    TRUE				                { A.pTrue }+  | FALSE				                { A.pFalse }+  | BEXP expr                           { A.pBexp $2 }+  | QM expr                             { A.pBexp $2 }+  | Id LPAREN argsne RPAREN             { A.pBexp (A.eApp ((Sy.of_string $1), $3)) }+  | AND preds   			            { A.pAnd ($2) }+  | OR  preds 	        		        { A.pOr  ($2) }+  | NOT pred				            { A.pNot ($2) }+  | NOTWORD pred				        { A.pNot ($2) }+  | LPAREN pred AND pred RPAREN         { A.pAnd [$2; $4] }+  | LPAREN pred OR  pred RPAREN         { A.pOr  [$2; $4] }+  | expr rel expr                       { A.pAtom  ($1, $2, $3) }+  | expr rels expr                      { A.pMAtom ($1, $2, $3) }+  | FORALL binds DOT pred               { A.pForall ($2, $4) }+  | pred IMPL pred                      { A.pImp ($1, $3) }+  | pred IFF pred                       { A.pIff ($1, $3) }+  | pred IFFWORD pred                   { A.pIff ($1, $3) }+  | LPAREN pred RPAREN			        { $2 }+  ;++argsne:+    expr                                { [$1] } +  | expr COMMA argsne                   { $1::$3 }+  ;++++exprs:+    LB RB                               { [] }+  | LB exprsne RB                       { $2 }+  ;++exprsne:+    expr                                { [$1] }+  | expr SEMI exprsne                   { $1 :: $3 }+  ;++expr:+    Id                                    { A.eVar (Sy.of_string $1) }+  | con                                   { A.eCon $1  }+  | exprs                                 { A.eMExp $1 } +  | LPAREN expr MOD Num RPAREN            { A.eMod ($2, $4) }+  | expr PLUS expr                        { A.eBin ($1, A.Plus, $3) }+  | expr MINUS expr                       { A.eBin ($1, A.Minus, $3) }+  | expr TIMES expr                       { A.eBin ($1, A.Times, $3) }+  | expr DIV expr                         { A.eBin ($1, A.Div, $3) }+  | expr ops expr                         { A.eMBin ($1, $2, $3) }+  | Id LPAREN exprs RPAREN                { A.eApp ((Sy.of_string $1), $3) }+  | Id Id                                 { A.eApp ((Sy.of_string $1), [A.eVar (Sy.of_string $2)]) }+  | LPAREN pred QM expr COLON expr RPAREN { A.eIte ($2,$4,$6) }+  | expr DOT Id                           { A.eFld ((Sy.of_string $3), $1) }+  | LPAREN expr COLON sort RPAREN         { A.eCst ($2, $4) }+  | LPAREN expr RPAREN                    { $2 }+  ;++op:+  | PLUS                                  { A.Plus  }+  | MINUS                                 { A.Minus }+  | TIMES                                 { A.Times }+  | DIV                                   { A.Div   }+  ; ++ops:+    LB RB                                 { [] }+  | LB opsne RB                           { $2 }+  ; ++opsne:+    op                                    { [$1] }+  | op SEMI opsne                         { $1 :: $3 }+  ;++++con:+  | Num                                   { (A.Constant.Int $1) }+  | MINUS Num                             { (A.Constant.Int (-1 * $2)) }+  ;++cons:+    LB RB                                 { [] }+  | LB consne RB                          { $2 }+  ;++consne:+    con                                   { [$1] }+  | con SEMI consne                       { $1 :: $3 }+  ;++wf:+    ENV env REF reft                              { C.make_wf $2 $4 None }+  | ENV env REF reft ID Num                       { C.make_wf $2 $4 (Some $6) }+  ;++tagsne:+  Num                                             { [$1] }+  | Num SEMI tagsne                               { $1 :: $3 }+  ;++tag: +  | LB tagsne RB                                  { ($2, "") }+  ;++dep:+  | ADP COLON tag IMPL tag                     {C.make_dep true (Some $3) (Some $5) }+  | DDP COLON tag IMPL tag                     {C.make_dep false (Some $3) (Some $5) }+  | DDP COLON TIMES IMPL tag                   {C.make_dep false None (Some $5) }+  | DDP COLON tag IMPL TIMES                   {C.make_dep false (Some $3) None }+  ;++info:+  ID Num                                        { ((Some $2), ([],"")) }+  | TAG tag                                     { (None     , $2)} +  | ID Num TAG tag                              { ((Some $2), $4) }+  ;++cstr:+  | ENV env GRD pred LHS reft RHS reft          { C.make_t $2 $4 $6 $8 None ([],"") }+  | ENV env GRD pred LHS reft RHS reft info     { C.make_t $2 $4 $6 $8 (fst $9) (snd $9)}+  ;++env:+    LB RB                               { C.env_of_bindings [] }+  | LB envne RB                         { C.env_of_bindings $2 }+  | LB ienvne RB                        { env_of_ibindings $2  }+  ;++ienvne:+    Num                                 { [$1] }+  | Num SEMI ienvne                     { $1 :: $3 }+  ;++envne:+    rbind                               { [$1] }+  | rbind SEMI envne                    { $1 :: $3 }+  ;+++rbind: +  Id COLON reft                         { (Sy.of_string $1, $3) }+  ;++ibind:+  Num Id COLON reft                     { ($1, Sy.of_string $2, $4) }    +  ;++reft: +  LC Id COLON sort MID refas RC         { ((Sy.of_string $2), $4, $6) }+  ;++refas:+    LB RB                               { [] }+  | LB refasne RB                       { $2 }+  ;++refasne:+    refa                                { [$1] }+  | refa SEMI refasne                   { $1 :: $3 }+  ;+  +refa:+    Id subs                             { C.Kvar ($2, (Sy.of_string $1)) }+  | pred                                { C.Conc $1 }+  ;++subs:+                                        { Su.empty }+  | LB Id ASGN expr RB subs             { Su.extend $6 ((Sy.of_string $2), $4) } +  ;++npred: +  LPAREN pred COMMA Id LPAREN argsne RPAREN RPAREN      { ((* $2, *) (Sy.of_string $4, $6)) }+  ;++npreds:+    LB RB                                { [] }+  | LB npredsne RB                       { $2 }+  ;++npredsne:+    npred                                { [$1] }+  | npred SEMI npredsne                  { $1 :: $3 }+;++sol:+    SOL COLON Id ASGN npreds            { ((Sy.of_string $3), $5) }++sols:+             { [] }+  | sol sols { $1 :: $2 }+
+ external/fixpoint/fixSimplify.ml view
@@ -0,0 +1,455 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++module BS = BNstats+module Co = Constants+module C  = FixConstraint+module P  = Ast.Predicate+module E  = Ast.Expression+module Sy = Ast.Symbol+module Kg = Kvgraph+module Su = Ast.Subst+module SM = Ast.Symbol.SMap+module SS = Ast.Symbol.SSet++module Misc = FixMisc +module IM = Misc.IntMap+open Misc.Ops+open Ast++let mydebug = false+++(****************************************************************************)+(*********************************** Misc. **********************************)+(****************************************************************************)++let add_cm     = List.fold_left (fun cm c -> IM.add (C.id_of_t c) c cm) +let find_cm    = fun cm id -> IM.find id cm+let refas_of_k = fun k -> [C.Kvar (Su.empty, k)] ++(****************************************************************************)+(************** Generic Simplification/Transformation API *******************)+(****************************************************************************)++module type SIMPLIFIER = sig+  val simplify_ts: FixConstraint.t list -> FixConstraint.t list+end++(****************************************************************************)+(******************* Syntactic Simplification *******************************)+(****************************************************************************)++module Syntactic : SIMPLIFIER = struct++let defs_of_pred = +  let rec dofp (em, pm) p = match p with+    | Atom ((Var v, _), Eq, e), _ +      when not (P.is_tauto p) -> +        Sy.SMap.add v e em, pm+    | And [Imp ((Bexp (Var v1, _), _), p1), _; +           Imp (p2, (Bexp (Var v2, _), _)), _], _ +      when v1 = v2 && p1 = p2 && not(P.is_tauto p) -> +        em, Sy.SMap.add v1 p1 pm+    | And ps, _ -> +        List.fold_left dofp (em, pm) ps+    | _ -> em, pm+  in dofp (Sy.SMap.empty, Sy.SMap.empty)++let rec expr_apply_defs em pm expr = +  let ef = expr_apply_defs em pm in+  let pf = pred_apply_defs em pm in+  match expr with +  | Var v, _ when Sy.SMap.mem v em ->+      Sy.SMap.find v em, true+  | Var _, _ | Con _, _ | Bot, _ ->+      expr, false+  | App (v, es), _ -> +      let _  = asserts (not (Sy.SMap.mem v em)) "binding for UF" in+      es |> List.map ef +         |> List.split +         |> (fun (es', bs') -> (eApp (v, es'), List.fold_left (||) false bs'))+  | Bin (e1, op, e2), _ -> +      let e1', b1' = ef e1 in+      let e2', b2' = ef e2 in+      eBin (e1', op, e2'), (b1' || b2')+  | Ite (p, e1, e2), _ -> +      let p', b'   = pf p in+      let e1', b1' = ef e1 in+      let e2', b2' = ef e2 in+      eIte (p', e1', e2'), (b' || b1' || b2')+  | Fld (v, e), _ -> +      let e', b'   = ef e in+      eFld (v, e'), b'+  | Cst (e, t), _ ->+      let e', b'   = ef e in+      eCst (e', t), b'+  | _ -> failwith "Pattern: expr_apply_defs"++and pred_apply_defs em pm pred =+  let ef = expr_apply_defs em pm in+  let pf = pred_apply_defs em pm in+  match pred with +  | And ps, _ -> +      ps |> List.map pf+         |> List.split+         |> (fun (ps', bs') -> pAnd ps', List.exists id bs') +  | Or ps, _ -> +      ps |> List.map pf+         |> List.split+         |> (fun (ps', bs') -> pOr ps', List.exists id bs') +  | Not p, _ ->+       p |> pf +         |> Misc.app_fst pNot+  | Imp (p1, p2), _ -> +      let p1', b1' = pf p1 in+      let p2', b2' = pf p2 in+      pImp (p1', p2'), b1' || b2'+  | Bexp (Var v, _), _ when Sy.SMap.mem v pm ->+      Sy.SMap.find v pm, true+  | Bexp e, _ ->+      e |> ef |> Misc.app_fst pBexp+  | Atom (e1, brel, e2), _ ->+      let e1', b1' = ef e1 in+      let e2', b2' = ef e2 in+      pAtom (e1', brel, e2'), b1' || b2'+  | Forall (qs, p), _ -> +      assertf "Forall in Simplify!"+  | _ ->+      pred, false++(* Why does this fixpointing terminate?+ * close em, pm under substitution so that+   for all x in dom(em), support(em(x)) \cap dom(em) = empty *)++(* Assume: em is well-formed, + * i.e. exists an ordering on vars of dom(em)+ * x1 < x2 < ... < xn s.t. if xj \in em(xi) then xj < xi *)++let expr_apply_defs em fm e = +  e |> Misc.fixpoint (expr_apply_defs em fm) +    |> fst++let pred_apply_defs em fm p = +  p |> Misc.fixpoint (pred_apply_defs em fm) +    |> fst+    |> simplify_pred++let subs_apply_defs em pm xes = List.map (Misc.app_snd (expr_apply_defs em pm)) xes+++let print_em_pm t (em, pm) =+  let id   = t |> C.id_of_t in+  let vv   = t |> C.lhs_of_t |> C.vv_of_reft in+  let vve  = try Sy.SMap.find vv em with Not_found -> bot in+  let vve' = expr_apply_defs em pm vve in+  Co.bprintf mydebug "\nbodyp em map for %d\n" id ;+  Sy.SMap.iter (fun x e -> Co.bprintf mydebug "%a -> %a\n" Sy.print x  E.print e) em;+  Co.bprintf mydebug "\nbodyp pm map for %d\n" id ;+  Sy.SMap.iter (fun x p -> Co.bprintf mydebug "%a -> %a\n" Sy.print x  P.print p) pm;+  Co.bprintf mydebug "edef for vv %a = %a (simplified %a)\n" Sy.print vv E.print vve E.print vve'++let preds_kvars_of_env env =+  Sy.SMap.fold begin fun x r (ps, env) -> +    let vv       = C.vv_of_reft r in+    let xe       = Ast.eVar x in+    let t        = C.sort_of_reft r in+    let rps, rks = C.preds_kvars_of_reft r in+    let ps'      = List.map (fun p -> P.subst p vv xe) rps ++ ps in+    let env'     = (* match rks with [] -> env | _ -> *) Sy.SMap.add x (vv, t, rks) env in+    ps', env'+  end env ([], Sy.SMap.empty)++let simplify_kvar em pm (su, sym) =+  su |> Su.to_list +     |> subs_apply_defs em pm+     |> Su.of_list+     |> (fun su -> C.Kvar (su, sym))++let simplify_env em pm ks_env = +  Sy.SMap.map begin fun (vv, t, ks) -> +    ks |> List.map (simplify_kvar em pm) |> C.make_reft vv t+  end ks_env++let simplify_grd em pm vv t p =+  let _  = Co.bprintf mydebug "simplify_grd [1]: %a \n" P.print p in+  let p  = pred_apply_defs em pm p in+  let _  = Co.bprintf mydebug "simplify_grd [2]: %a \n" P.print p in+  begin try +    Sy.SMap.find vv em +    |> expr_apply_defs em pm+    |> (fun vve -> pAnd [p; pAtom (eVar vv, Eq, vve)])+  with Not_found -> p end+  >> Co.bprintf mydebug "simplify_grd [3]: %a \n" P.print++let simplify_refa em pm = function +  | C.Conc p          -> C.Conc (pred_apply_defs em pm p) +  | C.Kvar (xes, sym) -> simplify_kvar em pm (xes, sym)++(* API *)+let simplify_t c = +  let id             = c |> C.id_of_t in+  let _              = Co.bprintf mydebug "============== Simplifying %d ============== \n"id in+  let env_ps, ks_env = c |> C.env_of_t |> preds_kvars_of_env in+  let l_ps, l_ks     = c |> C.lhs_of_t |> C.preds_kvars_of_reft in+  let vv, t          = c |> C.lhs_of_t |> Misc.tmap2 (C.vv_of_reft, C.sort_of_reft) in+  let bodyp          = Ast.pAnd ([C.grd_of_t c] ++ l_ps ++ env_ps) +                       >> Co.bprintf mydebug "body_pred: %a \n" P.print in+  let em, pm         = defs_of_pred bodyp                          +                       >> print_em_pm c in++  let senv           = simplify_env em pm ks_env in+  let sgrd           = simplify_grd em pm vv t bodyp in+  let slhs           = l_ks |> List.map (simplify_kvar em pm) |> C.make_reft vv t in+  let srhs           = c |> C.rhs_of_t |> C.ras_of_reft |> List.map (simplify_refa em pm) |> C.make_reft vv t in+  +  C.make_t senv sgrd slhs srhs (C.ido_of_t c) (C.tag_of_t c)++(* API *)+let simplify_ts cs = +  cs |> List.map simplify_t+    (* |> List.filter (not <.> C.is_tauto) *) +end++(****************************************************************************)+(*** Cone-of-Influence: Remove Constraints that don't reach constant-pred ***)+(****************************************************************************)++module Cone : SIMPLIFIER = struct+  let simplify_ts cs =+    let cm = add_cm IM.empty cs in +    cs |> Kg.add Kg.empty +       >> Kg.print_stats+       |> Kg.cone_ids +       |> List.map (find_cm cm)+end++(**************************************************************************)+(*** Direct-Dependencies: Remove non-data-dependent binders****************)+(*************************************************************************)++module WeakFixpoint : SIMPLIFIER = struct+ +  let weaken_env c e = +    C.make_t e +      (C.grd_of_t c) (C.lhs_of_t c) (C.rhs_of_t c) +      (C.ido_of_t c) (C.tag_of_t c)++  let support_of_refa = function +    | C.Conc p -> P.support p+    | _        -> []++  let support_of_reft = +    Misc.flap support_of_refa <.> thd3++  let rec data_cone env m n xs = match xs with +    | _::_ -> let m' = List.fold_left (fun m' x -> Sy.SMap.add x n m') m xs in+              xs |> Misc.map_partial (C.lookup_env env) +                 |> Misc.flap support_of_reft+                 |> Misc.filter (fun x -> not (Sy.SMap.mem x m))+                 |> data_cone env m' (n+1)+    | []   -> m+  +  let data_cone c = +    (P.support (C.grd_of_t c)) +    |> (++) (support_of_reft (C.lhs_of_t c))+    |> data_cone (C.env_of_t c) Sy.SMap.empty 0++  let project_cone m x ((v,t,ras) as r) =+    if Sy.SMap.mem x m then r else (v, t, List.filter C.is_conc_refa ras)++  let simplify_t c =+    c |> data_cone |> project_cone |> C.map_env +      |> (fun f -> f (C.env_of_t c))+      |> weaken_env c+      +  let simplify_ts = Misc.map simplify_t+end++(****************************************************************************)+(***** Merge Write and Read of Kvar: A |- k and B, k |- C  iff A,B |- C  ****)+(****************************************************************************)++module EliminateK : SIMPLIFIER = struct+  +  type t = { g  : Kg.t;+             cm : FixConstraint.t IM.t;+             id : int; }++  let print_k ppf k = +    Format.fprintf ppf "%s" (C.refa_to_string k)++  let empty  = +    { g  = Kg.empty; +      cm = IM.empty; +      id = 0; }+ +  let add me cs = +    let n, cs = C.add_ids me.id cs in +    { g  = Kg.add me.g cs; +      cm = add_cm me.cm cs; +      id = n+1 }+ +  let remove me (k, cs) =+    { g  = Kg.remove me.g [k]; +      cm = List.map C.id_of_t cs |> List.fold_left (Misc.flip IM.remove) me.cm;+      id = me.id; }+ +  let of_ts     = add empty +  let to_ts     = fun me -> me.cm |> IM.to_list |> List.map snd+  let cs_of_k   = fun f me k ->  f me.g [k] |> List.map (find_cm me.cm)++  (* Assume that k is written in (1) and read once in (2)+     +     (1) env1, g1, k_v:l1                       |- k[xi := ai]+     (2) env2, g2, y:k[xi := bi]                |- r2+     +     Now, (1) equiv (1') and (2) equiv (2')+     +     (1') env1, g1, #i:{v=ai}, k_v:l1                           |- k[xi := #i]+     (2') env2, g2, #i:{v=bi}, y:k2[xi := #i]                   |- r2+     +     Next, we can merge (1') and (2')+     +     (1'+2') env1 ++ env2, g1 && g2, #i:{v=ai}, #i:{v=bi}, y:l1 |- r2+     +     Which simplifies to:+     +     (1'+2') env1 ++ env2, g1 && g2 && {ai = bi}, y:l1          |- r2+  *)++  let meet_env env1 env2 xrs =+    [env1; env2]+    |> Misc.flap C.bindings_of_env +    |> (++) xrs +    |> C.env_of_bindings++  let meet_sub su1 su2 =+    [su1; su2]+    |> Misc.flap Su.to_list+    |> Misc.groupby fst +    |> List.map (function [(x,e)] -> pEqual (eVar x, e)| [(_,e1);(_,e2)] -> pEqual (e1,e2))+    |> pAnd++  let merge_one me k (wc, rc) =+    let env1, env2       = Misc.map_pair C.env_of_t (wc, rc) in +    let g1, g2           = Misc.map_pair C.grd_of_t (wc, rc) in+    let l1               = C.lhs_of_t wc in+    let [C.Kvar(su1, k)] = C.rhs_of_t wc |> thd3 in+    let su2, yr', l'     = match Kg.k_reads me.g (C.id_of_t rc) (C.Kvar (Su.empty, k)) with +                           | [Kg.Bnd (y, su2)] -> su2, [(y,l1)], (C.lhs_of_t rc)+                           | [Kg.Lhs su2]      -> su2, [], l1 +                           | _ -> assertf "EliminateK.merge_one (k=%s, id=%d)" (Sy.to_string k) (C.id_of_t rc) in+    let env'             = meet_env env1 env2 yr'          in+    let g'               = pAnd [g1; g2; meet_sub su1 su2] in+    let r'               = C.rhs_of_t rc                   in+    C.make_t env' g' l' r' None (C.tag_of_t rc)+    +  let eliminate me (k, wcs, rcs)  =+    me >> (fun _ -> Format.printf "EliminateK.eliminate %s \n" (C.refa_to_string k))  +       |> Misc.flip add    (Misc.cross_product wcs rcs |> List.map (merge_one me k)) +       |> Misc.flip remove (k, wcs ++ rcs)++  let select_ks me = +    me.g +    |> Kg.filter_kvars (Kg.is_single_wr me.g) +    |> List.filter (Kg.is_single_rd me.g)+    |> List.map (fun k -> (k, cs_of_k Kg.writes me k, cs_of_k Kg.reads me k))+    |> List.filter (fun (_,wcs, rcs) -> Misc.disjoint wcs rcs)+    >> (List.map fst3 <+> Format.printf "EliminateK.select_ks [OUT]: %a \n" +                          (Misc.pprint_many false "," print_k))++  let simplify_ts cs =+    let me = of_ts cs in+    me |> select_ks+       |> List.fold_left eliminate me +       |> to_ts +end+++(****************************************************************************)+(***** Copy Propagation *****************************************************)+(****************************************************************************)++module CopyProp : SIMPLIFIER = struct++  let subst_theta = +    List.map <.> Misc.app_snd <.> (fun (x, e) e' -> E.subst e' x e) +  +  let subst_bind su x y ((v, t, ras) as r) =  +    if x = y then (v, t, []) else C.theta su r++  let subst_cstr (x, e) c =+    let su    = Su.of_list [(x, e)]                         in+    let env'  = C.env_of_t c |> C.map_env (subst_bind su x) in+    let grd'  = C.grd_of_t c |> (fun p -> P.subst p x e)    in+    let lhs'  = C.lhs_of_t c |> C.theta su                  in+    let rhs'  = C.rhs_of_t c |> C.theta su                  in+    C.make_t env' grd' lhs' rhs' (C.ido_of_t c) (C.tag_of_t c)+  +  let rec eliminate c = function +      | (x, e) :: theta' when List.mem x (E.support e)+        -> eliminate c theta'+      | xe :: theta' (* x not in e *)+        -> eliminate (subst_cstr xe c) (subst_theta xe theta') +      | []  -> c+ +  let rigid_vars c =+    c |> C.kvars_of_t +      |> List.map fst +      |> Misc.flap Su.to_list +      |> List.map fst +      |> SS.of_list ++  let equalities_of_binding = function +    | (x, (v, _, [C.Conc ( Atom ((Var v', _), Eq, e), _  )])) +      when v = v' -> Some (x, e)+    | (x, (v, _, [C.Conc (  Atom (e, Eq, (Var v', _)), _ )])) +      when v = v' -> Some (x, e)+    | _ -> None++  let equalities_of_t c =+    c |> C.env_of_t +      |> (fun _ -> failwith "CopyProp.equalities_of_t") (* C.bindings_of_env  *)+      |> Misc.map_partial equalities_of_binding++  let simplify_t c = +    let ys = rigid_vars c in+    c |> equalities_of_t +      |> List.filter (fun (x,_) -> not (SS.mem x ys))+      |> eliminate c++  let simplify_ts = Misc.map simplify_t+end++(* API *)+let simplify_ts cs =+  cs +  |> Misc.filter (not <.> C.is_tauto)+  |> ((not !Co.lfp)  <?> BS.time "simplify 0" WeakFixpoint.simplify_ts)+  |> BS.time "add ids  1" (C.add_ids 0) +  |> snd+  (* |> (!Co.copyprop   <?> BS.time "simplify CP" CopyProp.simplify_ts)  *)+  |> (!Co.simplify_t <?> BS.time "simplify 1" Syntactic.simplify_ts) (* termination bug, tickled by C benchmarks *)+  |> (!Co.simplify_t <?> BS.time "simplify 2" Cone.simplify_ts)+  |> (!Co.simplify_t <?> BS.time "simplify 3" EliminateK.simplify_ts)
+ external/fixpoint/fixSimplify.mli view
@@ -0,0 +1,28 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)+++module WeakFixpoint : FixConfig.SIMPLIFIER +include FixConfig.SIMPLIFIER++(* val simplify_ts : FixConstraint.t list -> FixConstraint.t list *)
+ external/fixpoint/fixpoint.ml view
@@ -0,0 +1,148 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)+++(** read a set of constraints, solve, and dump out the solution *)++module CX  = Counterexample+module BS  = BNstats+module SM  = Ast.Symbol.SMap+module Co  = Constants +module C   = FixConstraint+module F   = Format+module T   = Toplevel+module PA  = PredAbs+module SPA = Solve.Make (PA)+module Cg  = FixConfig++module Misc = FixMisc open Misc.Ops++let mydebug = false++(*****************************************************************)+(********************* Hooking into Solver ***********************)+(*****************************************************************)++let print_raw_cs ppf = function+  | [] -> F.fprintf ppf "SAT \n \n \n"+  | cs -> F.fprintf ppf "UNSAT [%s] \n \n \n" (Misc.map_to_string (C.id_of_t <+> string_of_int) cs)++let save_raw fname cs s = +  Misc.with_out_formatter fname begin fun ppf ->+    F.fprintf ppf "%a \n" print_raw_cs cs; +    F.fprintf ppf "%a \n" PA.print s;+    F.fprintf ppf "@.";+    F.print_flush ()+  end++let save_crash fname (id, tag, msg) =+  Misc.with_out_formatter fname begin fun ppf ->+    F.fprintf ppf "CRASH %d (%s)\n" id msg;+    F.fprintf ppf "//%a\n" C.print_tag tag;+    F.fprintf ppf "@.";+    F.print_flush ()+  end++let solve ac  = +  let _         = Co.bprintflush mydebug "Fixpoint: Creating  CI\n" in+  let ctx, s    = BS.time "create" SPA.create ac None in+  let _         = Co.bprintflush mydebug "Fixpoint: Solving \n" in+  let s, cs',_  = BS.time "solve" (SPA.solve ctx) s in+  +  let _         = Co.bprintflush mydebug "Fixpoint: Saving Result \n" in+  let _         = BS.time "save" (save_raw !Co.out_file cs') s in+  let _         = Co.bprintflush mydebug "Fixpoint: Saving Result DONE \n" in+  cs'++let dump_solve ac = +  try +    let cs' = solve { ac with Cg.bm = SM.map PA.mkbind ac.Cg.bm } in+    let _   = if Co.ck_olev 1 then BNstats.print stdout "Fixpoint Solver Time \n" in+    match cs' with +    | [] -> (F.printf "\nSAT\n" ; exit 0)+    | _  -> (F.printf "\nUNSAT\n" ; exit 1)+  with (C.BadConstraint (id, tag, msg)) -> begin+    Format.printf "Fixpoint: Bad Constraint! id = %d (%s) tag = %a \n" +    id msg C.print_tag tag;+    save_crash !Co.out_file (id, tag, msg); +  end++(*****************************************************************)+(********************* Generate Imp Program **********************)+(*****************************************************************)++let dump_imp a = +  (List.map (fun c -> Cg.Cst c) a.Cg.cs ++ List.map (fun c -> Cg.Wfc c) a.Cg.ws)+  |> ToImp.render F.std_formatter+  |> fun _ -> exit 1 ++(*****************************************************************)+(***************** Generate Simplified Constraints ***************)+(*****************************************************************)++let hook_simplify_ts = function+  | "andrey" -> List.map Simplification.simplify_t+                <+> List.filter (not <.> Simplification.is_tauto_t)+                <+> Simplification.simplify_ts+  | "jhala"  -> FixSimplify.simplify_ts+  (* put other transforms here *)+  | _        -> id++let simplify_ts cs = hook_simplify_ts !Co.dump_simp cs++let dump_simp ac = +  let ac = {ac with Cg.cs = simplify_ts ac.Cg.cs; Cg.bm = SM.empty} in+  Misc.with_out_formatter !Co.save_file (fun ppf -> Cg.print ppf ac)++(*+let dump_simp ac = +  (* let ac    = {ac with Cg.cs = simplify_ts ac.Cg.cs; Cg.bm = SM.empty; Cg.qs = []} in *)+  let ac    = {ac with Cg.cs = simplify_ts ac.Cg.cs; Cg.bm = SM.empty} in+  Misc.with_out_formatter !Co.save_file (fun ppf -> Cg.print ppf ac)++  let ctx,_ = BS.time "create" SPA.create ac None in+  let s0    = PA.empty (* PA.create ac None *) in +  let _     = BS.time "save" (SPA.save !Co.save_file ctx) s0 in+  exit 1+*)++(*****************************************************************)+(*********************** Main ************************************)+(*****************************************************************)++let usage = "Usage: fixpoint.native <options> [source-files]\noptions are:"++let main () =+  let cfg  = usage |> Toplevel.read_inputs |> snd in +  if !Co.dump_imp then +    dump_imp cfg +  else if !Co.dump_smtlib then+    ToSmtLib.dump_smtlib cfg+  else if !Co.dump_simp <> "" then +    dump_simp cfg+  else+    dump_solve cfg ++++let _ = main ()
+ external/fixpoint/fixtop.ml view
@@ -0,0 +1,123 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)+++(** read a set of constraints, solve, and dump out the solution *)++module SM = Ast.Symbol.SMap+module Co = Constants +module C  = FixConstraint+module F  = Format+(*module Si = Simplification *)+module Misc = FixMisc +open Misc.Ops++let _ = FixLex.token (Lexing.from_string "int");;++let parse_string f = f FixLex.token <.> Lexing.from_string +++let dump cs ws =+  Format.printf "Printing Out Parsed Constraints \n \n \n" ;+  Format.printf "%a" (Misc.pprint_many true "\n" (FixConstraint.print_t None)) cs; +  Format.printf "\n \n";+  Format.printf "%a" (Misc.pprint_many true "\n" (FixConstraint.print_wf None)) ws;+  Format.printf "\n \n"++let usage = "Usage: fixtop <options> [source-files]\noptions are:"++let main () = print_string "Hello World \n"++(*+let main () =+  let fs, config = Toplevel.read_inputs usage in+  let cs = config.C.cs in+  let ws = config.C.ws in+  let cs = +    if !Co.simplify_t then+      Misc.map_partial begin fun t -> +        let st = Si.simplify_t t in+	if Si.is_tauto_t st then None else Some st+      end cs |> Si.simplify_ts+    else cs in+    begin+      match !Co.latex_file with+	| Some f ->+	    let out = open_out f in+	      ToLatex.to_latex out cs ws;+	      close_out out+	| None -> ()+    end;+  (*+    begin+      match !Co.armc_file with+	| Some f -> +	    let out = open_out f in+	      Printf.fprintf out "%% %s\n" (String.concat ", " fs);+	      ToHC.to_dataflow_armc out cs ws sol;+	      close_out out+	| None -> ()+    end;+  *)+    (*+    begin+      match !Co.horn_file with+	| Some f -> +	    let out = open_out f in+	      Printf.fprintf out "%% %s\n" (String.concat ", " fs);+	      ToHC.to_horn out cs ws sol;+	      close_out out+	| None -> ()+    end;+    *)+    begin+      match !Co.q_armc_file with+	| Some f -> +	    let out = open_out f in+	      Printf.fprintf out "%% %s\n" (String.concat ", " fs);+	      ToQARMC.to_qarmc out cs ws;+	      close_out out+	| None -> ()+    end;+(*+    begin+      match !Co.raw_horn_file with+	| Some f -> +	    let out = open_out f in+	      Printf.fprintf out "%% %s\n" (String.concat ", " fs);+	      ToRawHorn.to_raw_horn out cs ws sol;+	      close_out out+	| None -> ()+    end;+*)+    begin+      match !Co.dot_file with+	| Some f -> +	    let oc = open_out f in+	      ToDot.to_dot oc cs;+	      close_out oc+	| None -> ()+    end+*)++let _ = main ()
+ external/fixpoint/hornLex.mll view
@@ -0,0 +1,99 @@+(*+ * Copyright © 1990-2002 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * d + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++{+  module E = Errorline+  open E+  open HornParse +	       +  let lexerror msg lexbuf = +    E.error (Lexing.lexeme_start lexbuf) msg+      +}++let letdig   = ['0'-'9' 'a'-'z' 'A'-'Z' '_' '@' ''' '.' '#']+let small    = ['a'-'z']+let digit    = ['0'-'9']++rule token = parse+    ['\r''\t'' ']       { token lexbuf}+  | '\n'		{ begin+			    E.startNewline (Lexing.lexeme_end lexbuf);+			    token lexbuf +			  end }+  | "//"[^'\n']*'\n'+                        { begin+                            E.startNewline (Lexing.lexeme_end lexbuf);+			    token lexbuf+                          end }+  | '['                 { LB }+  | ']'                 { RB }+  | '('			{ LPAREN }+  | ')'			{ RPAREN }+  | '{'			{ LC }+  | '}'			{ RC }+  | '~'                 { NOT }+  | ';'                 { SEMI }+  | ','                 { COMMA }+  | ':'                 { COLON }+  | '+'                 { PLUS }+  | '-'                 { MINUS }+  | '*'                 { TIMES }+  | '/'                 { DIV }+  | '.'                 { DOT }+  | "hc"                { HC }+  | "Bexp"              { BEXP }+  | "false"             { FALSE }+  | "true"              { TRUE }+  | "&&"                { AND }+  | "||"                { OR  }+  | "!="		{ NE }+  | "="		        { EQ }+  | "=<"		{ LE }+  | "<"		        { LT }+  | ">="		{ GE }+  | ">"		        { GT }+  | "->"                { IMPL }+  | (digit)+	        { let str = Lexing.lexeme lexbuf in+			  let len = String.length str in+			  let zero = Char.code '0' in+			  let rec accum a d =+			    let acc c = a + (d * ((Char.code c) - zero)) in+			    function+			      0 -> let c = str.[0] in+				   if c='-' then - a else (acc c)+			    | i -> accum (acc str.[i]) (d * 10) (i - 1)+			  in+			  Num (accum 0 1 (len-1)) }+  +  | '_'(digit)+ 	{ Id (Lexing.lexeme lexbuf) }+  | (small)letdig+      { Var (Lexing.lexeme lexbuf) } +  | eof			{ EOF }+  | _			{ +                          begin+                            lexerror ("Illegal Character '" ^ +                                      (Lexing.lexeme lexbuf) ^ "'") lexbuf;+			    token lexbuf+			  end }+
+ external/fixpoint/hornParse.mly view
@@ -0,0 +1,147 @@++%{+module A  = Ast+module So = A.Sort+module Sy = A.Symbol+module E  = A.Expression+module P  = A.Predicate+module H  = A.Horn+module Su = A.Subst+module C  = FixConstraint++let parse_error msg =+  Errorline.error (symbol_start ()) msg++%}++%token <string> Var+%token <string> Id+%token <int> Num+%token BEXP+%token TRUE FALSE+%token LPAREN  RPAREN LB RB LC RC+%token EQ NE GT GE LT LE+%token AND OR NOT IMPL FORALL SEMI COMMA COLON DOT+%token EOF+%token PLUS+%token MINUS+%token TIMES +%token DIV+%token HC ++%right PLUS +%right MINUS+%right TIMES +%right DIV +++%start horns ++%type <A.pred list>                          preds, predsne+%type <A.pred>                               pred+%type <A.expr list>                          exprs, exprsne+%type <A.expr>                               expr+%type <A.brel>                               brel +%type <A.bop>                                bop ++%type <H.pr>                                 pr+%type <H.gd>                                 guard+%type <H.gd list>                            guards, guardsne+%type <Ast.Horn.t>                           hc+%type <Ast.Horn.t list>                      horns ++%%+preds:+    LB RB                               { [] }+  | LB predsne RB                       { $2 }+  ;++predsne:+    pred                                { [$1] }+  | pred SEMI predsne                   { $1 :: $3 }+;++pred:+    TRUE				{ A.pTrue }+  | FALSE				{ A.pFalse }+  | BEXP expr                           { A.pBexp $2 }+  | AND preds   			{ A.pAnd ($2) }+  | OR  preds 	        		{ A.pOr  ($2) }+  | NOT pred				{ A.pNot ($2) }+  | pred IMPL pred			{ A.pImp ($1, $3) }+  | expr brel expr                      { A.pAtom ($1, $2, $3) }+  | LPAREN pred RPAREN			{ $2 }+  ;++exprs:+    LB RB                               { [] }+  | LB exprsne RB                       { $2 }+  ;++exprsne:+    expr                                { [$1] }+  | expr SEMI exprsne                   { $1 :: $3 }+  ;++expr:+    Id				        { A.eVar (Sy.of_string $1) }+  | Num 				{ A.eCon (A.Constant.Int $1) }+  | MINUS Num 				{ A.eCon (A.Constant.Int (-1 * $2)) }+  | MINUS LPAREN expr RPAREN 	        { A.eBin (A.zero, A.Minus, $3) }+  | expr bop expr                       { A.eBin ($1, $2, $3) }+  | Id LPAREN  exprs RPAREN             { A.eApp ((Sy.of_string $1), $3) }+  | LPAREN expr RPAREN                  { $2 }+  ;++brel:+    EQ                                  { A.Eq }+  | NE                                  { A.Ne }+  | GT                                  { A.Gt }+  | GE                                  { A.Ge }+  | LT                                  { A.Lt }+  | LE                                  { A.Le }+  ;++bop:+    PLUS                                { A.Plus }+  | MINUS                               { A.Minus }+  | TIMES                               { A.Times }+  | DIV                                 { A.Div }+  ;+++idsne:+    Id                                  { [$1] }+  | Id COMMA idsne                      { $1 :: $3 }+  ;++pr: +    Var LPAREN RPAREN                    { ($1, []) }+  | Var LPAREN idsne RPAREN              { ($1, $3) }+  | Var                                  { ($1, []) }+  ;++guard:+    pr                                  { H.K ($1) }+  | pred                                { H.C ($1) }+  ;++guards:+    LB RB                               { [] }+  | LB guardsne RB                      { $2 }+  ;++guardsne:+    guard                               { [$1] }+  | guard COMMA guardsne                { $1 :: $3 }+  ;++hc: +  HC LPAREN pr COMMA guards RPAREN DOT {($3, $5)}+  ;+++horns:+                                        { [] }+  | hc horns                            { $1 :: $2 } +
+ external/fixpoint/hornToInterproc.ml view
@@ -0,0 +1,154 @@++module F  = Format+module BS = BNstats+module Co = Constants +module SM = Misc.StringMap +module H  = Ast.Horn+module Misc = FixMisc open Misc.Ops+++let tmpname1 = "tmp"++(***************************************************************************)+(************************* Parse Horn Clauses ******************************)+(***************************************************************************)++let clean f =+  Misc.map_lines_of_file f tmpname1 begin fun s ->+    if String.length s > 3 && String.sub s 0 3 = "hc(" then+        let ss = Misc.chop s ", " in+        match ss with+        | [s1; s2; _] -> Printf.sprintf "%s, %s).\n\n" s1 s2+        | ss          -> assertf "bad string: %s" (String.concat "####" ss)+    else ""+  end;+  tmpname1++let parse f : H.t list = +  let ic = f |> clean >> Errorline.startFile |> open_in in+  let rv = Lexing.from_channel ic |> HornParse.horns HornLex.token in+  let _  = close_in ic in+  rv++(****************************************************************************)+(******************* Preprocess HC to get global information ****************)+(****************************************************************************)++type t = {+  aritym : int SM.t;            (* k -> arity *)+  bindm  : string list SM.t;    (* k -> local bindings *)+  argn   : int;                 (* max-fun-args across all ks *)+  cm     : H.t list SM.t;       (* k -> cs *)+}++let create (cs: H.t list) : t =+  let cm = cs |> Misc.kgroupby (fun ((k,_),_) -> k) +              |> List.fold_left (fun cm (k,cs) -> SM.add k cs cm) SM.empty in+  let aritym = SM.map (function ((k, xs),_)::_ -> +                         let n = List.length xs in+                         (* let _ = Printf.printf "Arity(%s) using %s is %d \n" k+                         (String.concat "," xs) n in *)+                      n) cm in+  let bindm  = SM.map ((Misc.flap H.support) <+> Misc.sort_and_compact) cm in+  let argn   = SM.fold (fun _ a n -> max a n) aritym 0 in+  { aritym = aritym; bindm = bindm; argn = argn; cm = cm }++(****************************************************************************)+(**************************** Generic Sequencers ****************************)+(****************************************************************************)++let gen f sep xs =+  xs |> Misc.map f |> String.concat sep++let geni f sep xs = +  xs |> Misc.mapi f |> String.concat sep++let defn x n =+  geni (fun i _ -> Printf.sprintf "%s%d : int" x i) ", " (Misc.range 0 n)++(****************************************************************************)+(********************************* Translation ******************************)+(****************************************************************************)++let tx_gd = function+  | H.C p       -> Printf.sprintf "    assume %s;" (Misc.fsprintf Ast.Predicate.print p)+  | H.K (k, xs) -> Printf.sprintf "%s\n    () = %s(%s);" +                     (geni (Printf.sprintf "    a%d = %s;") "\n" xs)+                     k+                     (geni (fun i _ -> Printf.sprintf "a%d" i) "," xs)++let tx_hd = function +  | "error", _ -> "    fail;"+  | _, xs      -> Printf.sprintf "    assume %s;" +                     (geni (fun i x -> Printf.sprintf " z%d == %s " i x) " and " xs)++let tx_t k (head, guards) : string =+  Printf.sprintf "  if brandom then\n%s\n%s\n  else" (gen tx_gd "\n" guards) (tx_hd head)++let tx_def me = function+  | "error" -> +      ""+  | k -> +      let n = try SM.find k me.aritym with Not_found -> assertf "ERROR:no arity for %s" k in+      let _ = Printf.printf "Arity(%s) := %d \n" k n in +      Printf.sprintf "proc %s(%s) returns ()" k (defn "z" n) ++let tx_k me (k, cs) =  +  Printf.sprintf +"+%s+var %s, %s;+begin+%s+    halt;+  %s  +end+" +(tx_def me k) +(defn "a" me.argn) +(gen (Printf.sprintf "%s : int") ", " (SM.find k me.bindm)) +(gen (tx_t me) "\n" cs)+(gen (fun _ -> "endif;") " " cs)++let rewrite_eq s = +  if Misc.is_substring s "assume" then +    Misc.replace_substring " = " " == " s +  else s++let tx cs = +  let me = create cs in+  me.cm +  |> Misc.sm_to_list+  |> List.map (tx_k me)+  |> String.concat "\n\n"+  |> Misc.flip Misc.chop "\n" +  |> List.map rewrite_eq+  |> String.concat "\n"++(***************************************************************************)+(***************************** Output Clauses ******************************)+(***************************************************************************)++let dump f cs =+  cs >> Format.printf "*************Horn Clauses************\n\n%a\n\n\n" (Misc.pprint_many true "\n" H.print)+     |> tx +     >> Format.printf "***********Interproc Program*********\n\n%s\n\n\n" +     |> Misc.write_to_file (f^".ipc")++let usage = "hornToInterproc.native [filename.pl]"++let main usage = +  print_now "\n \n \n \n \n";+  print_now "========================================================\n";+  print_now "© Copyright 2009 Regents of the University of California.\n";+  print_now "All Rights Reserved.\n";+  print_now "========================================================\n";+  print_now (Sys.argv |> Array.to_list |> String.concat " ");+  print_now "\n========================================================\n";+  let fs = ref [] in+  let _  = Arg.parse Co.arg_spec (fun s -> fs := s::!fs) usage in+  match !fs with +  | [f] -> parse f |> dump f +  | _   -> assertf "I choke on too many/few files!" ++let _ = main usage
+ external/fixpoint/kvgraph.ml view
@@ -0,0 +1,211 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++module Sy = Ast.Symbol+module P  = Ast.Predicate +module Su = Ast.Subst+module C  = FixConstraint+module Misc = FixMisc open Misc.Ops++type rd = Bnd of Sy.t * Su.t | Lhs of Su.t | Grd | Junk++let print_rd ppf = function+  | Bnd (x, su) -> Format.fprintf ppf "Bnd (%a, %a)" Sy.print x Su.print su+  | Lhs su      -> Format.fprintf ppf "Lhs (%a)" Su.print su+  | Grd         -> Format.fprintf ppf "Grd"+  | Junk        -> Format.fprintf ppf "Junk"++(************************************************************************)+(********************* Build Graph of Kvar Dependencies *****************)+(************************************************************************)++module V : Graph.Sig.COMPARABLE with type t = C.refa = struct+  type t = C.refa+  let hash    = C.refa_to_string <+> Hashtbl.hash+  let compare = fun x y -> compare (C.refa_to_string x) (C.refa_to_string y)+  let equal   = fun x y -> C.refa_to_string x = C.refa_to_string y+end++module Id : Graph.Sig.ORDERED_TYPE_DFT with type t = int * rd = struct+  type t = int * rd+  let default = 0, Junk +  let compare = compare+end++module G   = Graph.Persistent.Digraph.ConcreteLabeled(V)(Id)+module VS  = Set.Make(V)++type t = G.t++(************************************************************************)+(*************************** Dumping to Dot *****************************) +(************************************************************************)++module DotGraph = struct+  type t = G.t+  module V = G.V+  module E = G.E+  let iter_vertex               = G.iter_vertex+  let iter_edges_e              = G.iter_edges_e+  let graph_attributes          = fun _ -> [`Size (11.0, 8.5); `Ratio (`Float 1.29)]+  let default_vertex_attributes = fun _ -> [`Shape `Box]+  let vertex_name               = function C.Kvar (_,k) -> Sy.to_string k | ra -> "C"^(string_of_int (V.hash ra))+  let vertex_attributes         = fun ra -> [`Label (C.refa_to_string ra)] +  let default_edge_attributes   = fun _ -> []+  let edge_attributes           = fun (_,(i,r),_) -> [`Label (Printf.sprintf "%d:%s" i (Misc.fsprintf print_rd r))]+  let get_subgraph              = fun _ -> None+end++module Dot = Graph.Graphviz.Dot(DotGraph) ++let dump_graph s g = +  s |> open_out +    >> (fun oc -> Dot.output_graph oc g)+    |> close_out ++(************************************************************************)+(********************* Constraints-to-Graph *****************************) +(************************************************************************)++let xkvars_of_env env = +  Sy.SMap.fold begin fun x r acc -> +    r |> C.kvars_of_reft +      |> List.map (fun z -> x,z) +      |> (fun xks -> xks ++ acc)+  end env []++let dsts_of_t c = +  c |> C.rhs_of_t +    |> C.ras_of_reft +    |> List.map (function C.Kvar (_,k) -> C.Kvar (Su.empty, k) | ra -> ra) ++let edges_of_t c =+  let eks = c |> C.env_of_t +              |> xkvars_of_env +              |> List.map (fun (x, (su, k)) -> (C.Kvar (Su.empty, k)), Bnd (x, su)) in+  let gps = c |> C.grd_of_t +              |> (fun p -> if P.is_tauto p then [] else [(C.Conc p, Grd)]) in+  let lks = c |> C.lhs_of_t +              |> C.ras_of_reft +              |> List.map (function C.Kvar (su, k) -> (C.Kvar (Su.empty, k), Lhs su) | ra -> (ra, Grd)) in +  c |> dsts_of_t+    |> Misc.cross_product (lks ++ gps ++ eks)  +    |> List.map (fun ((ra, l), ra') -> (ra, (C.id_of_t c, l), ra'))++(************************************************************************)+(*************************** Misc. Accessors ****************************) +(************************************************************************)++let vertices_of_graph = fun g -> G.fold_vertex (fun v acc -> v::acc) g []++(* API *)+let filter_kvars f g =+  g  |> vertices_of_graph+     |> List.filter (not <.> C.is_conc_refa)+     |> List.filter f +     |> Misc.sort_and_compact++let get_edges f g vs =+  vs |> Misc.flap (f g)+     |> List.map (fun (_,(i,_),_) -> i) +     |> Misc.sort_and_compact++(* APU *)+let writes  = get_edges G.pred_e +let reads   = get_edges G.succ_e++(* API *)+let k_reads g i k =+  k >> (C.refa_to_string <+> Format.printf "Kvgraph.k_reads [IN] id=%d, k=%s\n" i)+    |> G.succ_e g +    |> Misc.map_partial (function (_,(j,x),_) when i=j -> Some x | _ -> None)+    >> (Format.printf "Kvgraph.k_reads [OUT] %a \n" (Misc.pprint_many false "," print_rd))++(************************************************************************)+(********************* (Backwards) Reachability *************************) +(************************************************************************)++let vset_of_list vs = List.fold_left (fun s v -> VS.add v s) VS.empty vs+let pre_star g vs =+  (vs, VS.empty)+  |> Misc.fixpoint begin function +     | [], r -> ([], r), false+     | ws, r -> ws |> List.filter (fun v -> not (VS.mem v r)) +                   |> Misc.tmap2 (Misc.flap (G.pred g), vset_of_list <+> VS.union r)+                   |> (fun x -> x, true) +     end +  |> fst |> snd +  |> VS.elements++(************************************************************************)+(****************************** Predicates ******************************) +(************************************************************************)++let is_num_write g f v = +  [v] |> writes g +      |> List.length +      |> f++let undef_ks     = fun g -> filter_kvars (is_num_write g ((=) 0)) g+let multi_wr_ks  = fun g -> filter_kvars (is_num_write g ((<) 1)) g+let single_wr_ks = fun g -> filter_kvars (is_num_write g ((=) 1)) g++let cone_nodes g =  +  g |> vertices_of_graph+    |> List.filter C.is_conc_refa+    |> pre_star g++(*************************************************************************)+(******************************* API *************************************)+(*************************************************************************)++let print_ks s ks =+  ks |> Misc.map_partial (function C.Kvar (_,k) -> Some k | _ -> None)+     |> Format.printf "[KVG] %s %a \n" s (Misc.pprint_many false "," Sy.print) ++(* API *)+let is_single_wr = fun g -> is_num_write g ((=) 1)+let is_single_rd = fun g -> G.succ_e g <+> Misc.groupby (snd3 <+> fst) <+> List.for_all (function [_] -> true | _ -> false)++(* API *)+let empty  = G.empty+let add    = List.fold_left (fun g -> List.fold_left G.add_edge_e g <.> edges_of_t)+let remove = List.fold_left G.remove_vertex ++(* API *)+let cone_ks g = +  g |> cone_nodes+    |> List.filter (not <.> C.is_conc_refa)++(* API *)+let cone_ids g = +  g |> cone_nodes +    |> writes g++(* API *)+let print_stats g = +  g >> dump_graph (!Constants.save_file^".dot")+    >> (single_wr_ks <+> print_ks "single write kvs:")+    >> (multi_wr_ks  <+> print_ks "multi write kvs:")+    >> (undef_ks     <+> print_ks "undefined kvs:")+    >> (cone_ks      <+> print_ks "cone kvs:")+    |> ignore
+ external/fixpoint/kvgraph.mli view
@@ -0,0 +1,37 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++type t++type rd = Bnd of Ast.Symbol.t * Ast.Subst.t | Lhs of Ast.Subst.t | Grd | Junk++val empty        : t+val remove       : t -> FixConstraint.refa list -> t+val add          : t -> FixConstraint.t list -> t +val print_stats  : t -> unit+val cone_ids     : t -> FixConstraint.id list+val writes       : t -> FixConstraint.refa list -> FixConstraint.id list+val reads        : t -> FixConstraint.refa list -> FixConstraint.id list+val k_reads      : t -> FixConstraint.id -> FixConstraint.refa -> rd list+val filter_kvars : (FixConstraint.refa -> bool) -> t -> FixConstraint.refa list+val is_single_wr : t -> FixConstraint.refa -> bool+val is_single_rd : t -> FixConstraint.refa -> bool
+ external/fixpoint/predAbs.ml view
@@ -0,0 +1,839 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++ +(*************************************************************)+(******************** Solution Management ********************)+(*************************************************************)++module F   = Format+module A   = Ast+module E   = A.Expression+module P   = A.Predicate++module Q   = Qualifier+module QS  = Q.QSet+module Sy  = A.Symbol+module Su  = A.Subst+module SM  = Sy.SMap+module SS  = Sy.SSet+module C   = FixConstraint++module BS  = BNstats+module Co  = Constants+module Cg  = FixConfig+module H   = Hashtbl+module PH  = A.Predicate.Hash++module CX  = Counterexample+module Misc = FixMisc +module IM  = Misc.IntMap+open Misc.Ops++let mydebug = false ++module Q2S = Misc.ESet (struct+  type t = Sy.t * Sy.t+  let compare x y = compare x y +end)++module V : Graph.Sig.COMPARABLE with type t = Sy.t = struct+  type t = Sy.t+  let hash    = Sy.to_string <+> H.hash+  let compare = compare+  let equal   = (=) +end++++(*+let tag_of_qual2 = Misc.map_pair tag_of_qual++module Q2S = Misc.ESet (struct+  type t = Q.t * Q.t+  let compare x y = compare (tag_of_qual2 x) (tag_of_qual2 y)+end)++module V : Graph.Sig.COMPARABLE with type t = Q.t = struct+  type t = Q.t+  let hash    = tag_of_qual <+> H.hash+  let compare = fun q1 q2 -> compare (tag_of_qual q1) (tag_of_qual q2)+  let equal   = fun q1 q2 -> tag_of_qual q1 = tag_of_qual q2+end++*)++module Id : Graph.Sig.ORDERED_TYPE_DFT with type t = unit = struct+  type t = unit +  let default = ()+  let compare = compare +end++module G   = Graph.Persistent.Digraph.ConcreteLabeled(V)(Id)+module SCC = Graph.Components.Make(G)++type bind = Q.t list++type t   = +  { tpc  : ProverArch.prover+  ; m    : bind SM.t+  ; assm : FixConstraint.soln  (* invariant assumption for K, +                                 must be a fixpoint wrt constraints *)+  ; qm   : Q.t SM.t            (* map from names to qualifiers *)+  ; qleqs: Q2S.t               (* (q1,q2) \in qleqs implies q1 => q2 *)+  +  (* counterexamples *)+  ; step     : CX.step         (* which iteration *)+  ; ctrace   : CX.ctrace +  ; lifespan : CX.lifespan +  +  (* stats *)+  ; stat_simple_refines : int ref +  ; stat_tp_refines     : int ref +  ; stat_imp_queries    : int ref +  ; stat_valid_queries  : int ref +  ; stat_matches        : int ref +  ; stat_umatches       : int ref +  ; stat_unsatLHS       : int ref +  ; stat_emptyRHS       : int ref +}++let pprint_ps =+  Misc.pprint_many false ";" P.print ++ +let pprint_dep ppf q = +  F.fprintf ppf "(%a, %a)" P.print (Q.pred_of_t q) Q.print_args q++let pprint_ds = +  Misc.pprint_many false ";" pprint_dep++let pprint_qs ppf = +  F.fprintf ppf "[%a]" (Misc.pprint_many false ";" Q.print)++let pprint_qs' ppf = +  List.map (fst <+> snd <+> snd <+> fst) <+> pprint_qs ppf ++(*************************************************************)+(************* Breadcrumbs for Cex Generation ****************)+(*************************************************************)++let cx_iter c me = +  { me with step = me.step + 1 }          ++let cx_ctrace b c me = +  let _ = if mydebug then F.printf "\nPredAbs.refine iter = %d cid = %d b = %b\n" +                          me.step (C.id_of_t c) b in+  if b then { me with ctrace = IM.adds (C.id_of_t c) [me.step] me.ctrace } else me++let cx_update ks kqsm' me : t = +  List.fold_left begin fun me k -> +    let qs    = QS.of_list  (SM.finds k me.m)  in+    let qs'   = QS.of_list  (SM.finds k kqsm') in+    let kills = QS.elements (QS.diff qs qs')   in+    if Misc.nonnull kills +    then {me with lifespan = SM.adds k [(me.step, kills)] me.lifespan}+    else me+  end me ks++(*************************************************************)+(************* Constructing Initial Solution *****************)+(*************************************************************)++(*++let def_of_pred_qual (p, q) =+  let qp = Q.pred_of_t q in+  match A.unify_pred qp p with+  | Some su -> (p, q, su)+  | None    -> assertf "ERROR: unify q=%s p=%s" (P.to_string qp) (P.to_string p)++let map_of_bindings bs =+  List.fold_left begin fun s (k, ds) -> +    ds |> List.map Misc.single +       |> Misc.flip (SM.add k) s+  end SM.empty bs +*)++let quals_of_bindings bm =+  bm |> SM.range +     |> Misc.flatten+     (* |> Misc.map (snd <+> fst)  *)+     |> Misc.sort_and_compact+     >> (fun qs -> Co.bprintf mydebug "Quals of Bindings: \n%a" (Misc.pprint_many true "\n" Q.print) qs; flush stdout)++(************************************************************************)+(*************************** Dumping to Dot *****************************) +(************************************************************************)+++module DotGraph = struct+  type t = G.t+  module V = G.V+  module E = G.E+  let iter_vertex               = G.iter_vertex+  let iter_edges_e              = G.iter_edges_e+  let graph_attributes          = fun _ -> [`Size (11.0, 8.5); `Ratio (`Fill (* Float 1.29*))]+  let default_vertex_attributes = fun _ -> [`Shape `Box]+  let vertex_name               = Sy.to_string +  let vertex_attributes         = fun q -> [`Label (Sy.to_string q)] +  let default_edge_attributes   = fun _ -> []+  let edge_attributes           = fun (_,(),_) -> [] +  let get_subgraph              = fun _ -> None+end++module Dot = Graph.Graphviz.Dot(DotGraph) ++let dump_graph s g = +  s |> open_out +    >> (fun oc -> Dot.output_graph oc g)+    |> close_out ++let p_read s k =+  let _ = asserts (SM.mem k s.m) "ERROR: p_read : unknown kvar %s\n" (Sy.to_string k) in+  SM.find k s.m  |>: (fun q -> ((k, q), Q.pred_of_t q))++(* INV: qs' \subseteq qs *)+let update m k ds' =+  let ds = SM.finds k m in+  let n  = List.length ds  in+  let n' = List.length ds' in +  let _  = asserts (n = 0 || n' <= n) "PredAbs.update: Non-monotone k = %s |ds| = %d |ds'| = %d \n" (Sy.to_string k) n n' in +  ((n != n'), SM.add k ds' m)+  (* >> begin fun _ -> +        if n' > n && n > 0 then +          Co.bprintflush mydebug  <| Printf.sprintf "OMFG: update k = %s |ds| = %d |ds'| = %d \n" +                          (Sy.to_string k) n n'+     end+   *)++(* We must ensure there are NO duplicate k-q pairs in the update list.+ * If there are duplicate KVars in the ks then the kqs must be grouped:+ * a "k-q" binding is ONLY preserved  IF #bindings = #copies-of-k+ * If there are NO duplicate KVars there SHOULD BE no duplicate k-q pairs. *)++let group_ks_kqs ks kqs = +  if (Misc.cardinality ks = List.length ks) then +    kqs (* no duplicate kvars *) +  else +    let km = SM.frequency ks in+    kqs |> Misc.frequency +        |> Misc.filter (fun ((k, _), n) -> n = SM.find_default 0 k km)+        |> Misc.map fst ++let p_update me ks kqs = +  (* let _    = Co.bprintflush mydebug (Printf.sprintf "p_update A: |kqs| = %d \n" (List.length kqs)) in *)+  let kqs  = group_ks_kqs ks kqs in+  (* let _    = Co.bprintflush mydebug (Printf.sprintf "p_update B: |kqs| = %d \n" (List.length kqs)) in *)+  let kqsm = SM.of_alist kqs in+  let me   = me |> (!Co.cex <?> BS.time "cx_update" (cx_update ks) kqsm) in +  List.fold_left begin fun (b, m) k ->+    SM.finds k kqsm +    |> update m k +    |> Misc.app_fst ((||) b)+  end (false, me.m) ks+  |> Misc.app_snd (fun m -> { me with m = m })  +++(* API *)+let top s ks = +  ks (* |> List.partition (fun k -> SM.mem k s.m)+     >> (fun (_, badks) -> Co.bprintf mydebug "WARNING: Trueing Unbound KVars = %s \n" (Misc.fsprintf (Misc.pprint_many false "," Sy.print) badks))+     |> fst *)+     |> Misc.flip (p_update s) []+     |> snd++(***************************************************************)+(************************** Refinement *************************)+(***************************************************************)++let rhs_cands s = function+  | C.Kvar (su, k) -> k (* >> (fun k -> Co.bprintflush mydebug ("rhs_cands: k = "^(Sy.to_string k)^"\n")) *)+                        |> p_read s +                        (* >> (fun xs -> Co.bprintflush mydebug ("rhs_cands: size="^(string_of_int (List.length xs))^" BEGIN \n")) *)+                        |>: (Misc.app_snd (Misc.flip A.substs_pred su))+                        (* >> (fun xs -> Co.bprintflush mydebug ("rhs_cands: size="^(string_of_int (List.length xs))^" DONE\n")) *)+  | _ -> []++let check_tp me env vv t lps =  function [] -> [] | rcs ->+  (* let rv  = TP.set_filter me.tpc env vv lps rcs               in+  let _   = ignore(me.stat_tp_refines    += 1)+          ; ignore(me.stat_imp_queries   += (List.length rcs))+          ; ignore(me.stat_valid_queries += (List.length rv)) +  in rv *)+  me.tpc#set_filter env vv lps rcs+  >> (fun _  -> me.stat_tp_refines    += 1)+  >> (fun _  -> me.stat_imp_queries   += List.length rcs)+  >> (fun rv -> me.stat_valid_queries += List.length rv) +++++(* API *)+let read me k = (me.assm k) ++ (if SM.mem k me.m then p_read me k |>: snd else [])++(* API *)+let read_bind s k = failwith "PredAbs.read_bind"++let refine me c =+  let (_,_,ra2s) as r2 = C.rhs_of_t c in+  let k2s = r2 |> C.kvars_of_reft |> List.map snd in+  let rcs = BS.time "rhs_cands" (Misc.flap (rhs_cands me)) ra2s in+  if rcs = [] then+    let _ = me.stat_emptyRHS += 1 in+    (false, me)+  else +    let lps = BS.time "preds_of_lhs" (C.preds_of_lhs (read me)) c in+    if BS.time "lhs_contra" (List.exists P.is_contra) lps then +    let _ = me.stat_unsatLHS += 1 in+    let _ = me.stat_umatches += List.length rcs in+    (false, me)+  else +    let rcs     = List.filter (fun (_,p) -> not (P.is_contra p)) rcs in+    let lt      = PH.create 17 in+    let _       = List.iter (fun p -> PH.add lt p ()) lps in+    let (x1,x2) = List.partition (fun (_,p) -> PH.mem lt p) rcs in+    let _       = me.stat_matches += (List.length x1) in+    let kqs1    = List.map fst x1 in+    (if C.is_simple c +     then (ignore(me.stat_simple_refines += 1); kqs1) +     else let senv = C.senv_of_t c in+          let vv   = C.vv_of_t c   in+          let t    = C.sort_of_t c in+          kqs1 ++ (BS.time "check tp" (check_tp me senv vv t lps) x2))+    |> p_update me k2s++let refine me c = +  let me      = me |> (!Co.cex <?> cx_iter c)     in+  let (b, me) = refine me c                       in+  let me      = me |> (!Co.cex <?> cx_ctrace b c) in+  (b, me)+++(***************************************************************)+(****************** Sort Check Based Refinement ****************)+(***************************************************************)++let refts_of_c c =+  [ C.lhs_of_t c ; C.rhs_of_t c] ++ (C.env_of_t c |> C.bindings_of_env |>: snd)++let refine_sort_reft env me ((vv, so, ras) as r) = +  let env' = SM.add vv r env in +  let ks   = r |> C.kvars_of_reft |>: snd in+  (* let _    = let s =  String.concat ", " (List.map Sy.to_string ks) in Co.bprintflush mydebug ("\n refine_sort_reft ks = "^s^"\n")  in  *)+  ras +  |> Misc.flap (rhs_cands me) (* OMFG blowup due to FLAP if kv appears multiple times...*)+  |> Misc.filter (fun (_, p) -> C.wellformed_pred env' p)+  |> List.rev_map fst+(* |> (fun xs -> Co.bprintflush mydebug (Printf.sprintf "refine_sort_reft map: size = %d\n" (List.length xs)); +                List.rev_map fst xs)+  >> (fun _ -> Co.bprintflush mydebug "\n refine_sort_reft TICK 4 \n")+  *)+  |> p_update me ks+  |> snd++let refine_sort me c =+  let env = C.env_of_t c in+  c (* >> (fun _ -> Co.bprintflush mydebug ("\n refine_sort TICK 0 id = "^(string_of_int (C.id_of_t c))^"\n")) *)+    |> refts_of_c+    |> List.fold_left (refine_sort_reft env) me  +    (* >> (fun _ -> Co.bprintflush mydebug "\n refine_sort TICK 2 \n") *)++(***************************************************************)+(************************* Satisfaction ************************)+(***************************************************************)++let unsat me c = +  let s        = read me      in+  let (vv,t,_) = C.lhs_of_t c in+  let lps      = C.preds_of_lhs s c  in+  let rhsp     = c |> C.rhs_of_t |> C.preds_of_reft s |> A.pAnd in+  let k        = Sy.of_string "k" in+  let kq       = (k, Q.create k k Ast.Sort.t_int [] A.pTrue) in+  not ((check_tp me (C.senv_of_t c) vv t lps [(kq, rhsp)]) = [kq])++(****************************************************************)+(************* Minimization: For Prettier Output ****************)+(****************************************************************)++(*+let canonize_subs = +  Su.to_list <+> List.sort (fun (x,_) (y,_) -> compare x y)++let subst_leq =+  Misc.map_pair canonize_subs <+> Misc.isPrefix+*)++let args_leq q1 q2 =+  let xe1s, xe2s = (Q.args_of_t q1, Q.args_of_t q2) in+  let xe1e2s     = Misc.join fst xe1s xe2s          in+  List.for_all (fun ((_,e1),(_,e2)) -> e1 = e2) xe1e2s ++(* P(v,x,y,z) => Q(v,x) if P => Q held and _intersection_ of args match. *)+let def_leq s q1 q2 = +     Q2S.mem (Q.name_of_t q1, Q.name_of_t q2) s.qleqs && args_leq q1 q2++let pred_of_bind_name q = +  let name = q |> Q.name_of_t                 in+  let args = q |> Q.args_of_t |> List.map snd in+  A.pBexp (A.eApp (name, args)) ++let pred_of_bind_raw = Q.pred_of_t ++let pred_of_bind q = +  if !Co.shortannots +  then pred_of_bind_name q +  else pred_of_bind_raw q ++let min_binds_bot ds = +  match Misc.list_find_maybe (P.is_contra <.> pred_of_bind_raw) ds with+    | None   -> ds+    | Some d -> [d] ++(* API *)+let min_binds s ds = ds |> min_binds_bot |> Misc.rootsBy (def_leq s)+let min_read s k   = SM.finds k s.m |> min_binds s |>: pred_of_bind+let min_read s k   = if !Co.minquals then min_read s k else read s k+let min_read s k   = BS.time "min_read" (min_read s) k++let close_env qs sm =+  qs |> Misc.flap   (Q.pred_of_t <+> P.support) +     |> Misc.filter (not <.> Misc.flip SM.mem sm)+     |> Misc.map    (fun x -> (x, Ast.Sort.t_int))+     |> SM.of_list+     |> SM.extend sm++let rename_vv q q' =+  List.combine (Q.all_params_of_t q |>: fst) (Q.all_params_of_t q' |>: fst)+  |> List.filter (fun (x, y) -> not (x = y))+  |> List.map (fun (x, y) -> (y, A.eVar x))+  |> Su.of_list+  |> A.substs_pred (Q.pred_of_t q')+  |> (fun p' -> (q', p'))++let sm_of_qual sm q = +  q |> Q.all_params_of_t +    |> SM.of_list +    |> SM.extend sm++(*  check_leq tp sm q qs = [q' | q' <- qs, Z3 |- q => q'] *)+let check_leq (tp : ProverArch.prover) sm (q : Q.t) (qs : Q.t list) : Q.t list = +  let vv  = Q.vv_of_t q in+  let lps = [Q.pred_of_t q] in+  let sm  = q |> sm_of_qual sm |> close_env qs in+  qs |> List.map (rename_vv q) (* (fun q -> (q, Q.pred_of_t q)) *)+     (* >> (List.map fst <+> F.printf "CHECK_TP: %a IN %a \n" Q.print q pprint_qs) *)+     |> tp#set_filter sm vv lps+     (* >> F.printf "CHECK_TP: %a OUT %a \n" Q.print q pprint_qs *)++let qimps_of_partition tp sm qs =+  foreach qs begin fun q ->+    let qs' = check_leq tp sm q qs in+    foreach qs' begin fun q' ->+      (q, q')+    end+  end++let wellformed_qual sm q =+  let sm = sm_of_qual sm q in+  A.sortcheck_pred Theories.is_interp (fun x -> SM.maybe_find x sm) (Q.pred_of_t q)++let qleqs_of_qs ts sm cs ps qs  =+  let tp = TpNull.create ts sm cs ps in+  qs |> Misc.filter (wellformed_qual sm)+     |> Misc.groupby (List.map snd <.> Q.all_params_of_t) (* Q.sort_of_t *)+     |> Misc.flap (qimps_of_partition tp sm)+     |> Misc.flatten+     |> Misc.map (Misc.map_pair Q.name_of_t) +     |> Q2S.of_list++(***************************************************************)+(******************** Qualifier Instantiation ******************)+(***************************************************************)++type qual_binding = (Sy.t * Sy.t) list++(* DEBUG ONLY *)+let print_param ppf (x, t) =+  F.fprintf ppf "%a:%a" Sy.print x Ast.Sort.print t +let print_params ppf args =+  F.fprintf ppf "%a" (Misc.pprint_many false ", " print_param) args+let print_valid_binding ppf (x,y) =+  F.fprintf ppf "[%a := %a]" Sy.print x Sy.print y+let print_valid_bindings ppf xys =+  F.printf "[%a]" (Misc.pprint_many false "" print_valid_binding) xys++(* +let dupfree_binding xys : bool = +  let ys  = List.map snd xys in+  let ys' = Misc.sort_and_compact ys in+  List.length ys = List.length ys'+*)++let varmatch_ctr = ref 0++let varmatch (x, y) = +  let _ = varmatch_ctr += 1 in+  let (x,y) = Misc.map_pair Sy.to_string (x,y) in+  if x.[0] = '@' then+    let x' = Misc.suffix_of_string x 1 in+    Misc.is_prefix x' y+  else true++let sort_compat t1 t2 = A.Sort.unify [t1] [t2] <> None++(* {{{ DONT DELETE FOR NOW let valid_bindings_sort env (x, t) =+  let _ = failwith "valid_bindings_sort: slow AND incorrect. suppressed!" in+  env |> SM.to_list+      |> Misc.filter (snd <+> C.sort_of_reft <+> (sort_compat t))+      |> Misc.map (fun (y,_) -> (x, y))+      |> Misc.filter varmatch++let valid_bindings env ys (x, t) =+  if !Co.sorted_quals+  then valid_bindings_sort env (x, t)+  else valid_bindings ys x+}}} *)++let wellformed_qual wf f q = +  q |> Q.pred_of_t +    |> A.sortcheck_pred Theories.is_interp f+    (* >> (F.printf "\nwellformed: id = %d q = @[%a@] result %b\n" (C.id_of_wf wf) Q.print q) *)+    (* NEVER uncomment out the above. *)++(********************************************************************************)+(****** Brute Force (Post-Selection based) Qualifier Instantiation **************)+(********************************************************************************)++let is_valid_binding (xys : qual_binding) : bool = +  List.for_all varmatch xys++let valid_bindings ys (x,_) =+  ys |> List.map (fun y -> (x, y))+     |> List.filter varmatch++let inst_qual env ys evv (q : Q.t) : Q.t list =+  let vve = (Q.vv_of_t q, evv) in+  match Q.params_of_t q with+  | [] ->+      [(Q.inst q [vve])]+  | xts ->+      xts+      (* >> F.printf "\n\ninst_qual: params q = %a: %a" Q.print q print_params          *)+      |> List.map (valid_bindings ys)                       (* candidate bindings    *)+      |> Misc.product                                       (* generate combinations *) +      (* >> (List.iter (F.printf "\ninst_qual: pre-binds = %a\n" print_valid_bindings)) *)+      |> List.filter is_valid_binding                       (* remove bogus bindings *)+      (* >> (List.iter (F.printf "\ninst_qual: post-binds = %a\n" print_valid_bindings)) *)+      |> List.rev_map (List.map (Misc.app_snd A.eVar))      (* instantiations        *)+      |> List.rev_map (fun xes -> Q.inst q (vve::xes))      (* quals *)+      (* >> (F.printf "\n\ninst_qual: result q = %a:\n%a DONE\n" Q.print q (Misc.pprint_many true "" Q.print)) *)++let inst_vars env = +  env |> Sy.SMap.to_list +      |> List.filter (fun (_, (_,so,_)) -> not (A.Sort.is_func so))+      |> List.map fst ++let inst_ext qs wf = +  let _    = Misc.display_tick () in+  let r    = C.reft_of_wf wf in +  let ks   = C.kvars_of_reft r |> List.map snd in+  let env  = C.env_of_wf wf in+  let vv   = fst3 r in+  let t    = snd3 r in+  let ys   = inst_vars env   in+  let env' = Misc.maybe_map C.sort_of_reft <.> C.lookup_env (SM.add vv r env) in+  qs |> List.filter (Q.sort_of_t <+> sort_compat t)+     |> Misc.flap   (inst_qual env ys (A.eVar vv))+     |> Misc.filter (wellformed_qual wf env' <&&> C.filter_of_wf wf)+     |> Misc.cross_product ks+     +(********************************************************************************)+(****** Sort Based Qualifier Instantiation **************************************)+(********************************************************************************)++let inst_binds env = +  env |> SM.to_list +      |> Misc.map (Misc.app_snd snd3) +      |> Misc.filter (not <.> A.Sort.is_func <.> snd)++(* [ (su', (x,y) : xys) | (su, xys) <- wkl+                        , (y, ty)   <- yts+                        , varmatch (x, y)+                        , Some su'  <- unifyWith su [tx] [ty] ]  *)++let ext_bindings yts wkl (x, tx) =+  let yts = List.filter (fun (y,_) -> varmatch (x, y)) yts in+  Misc.tr_rev_flap (fun (su, xys) ->+    Misc.map_partial (fun (y, ty) -> +      match A.Sort.unifyWith su [tx] [ty] with+        | None     -> None+        | Some su' -> Some (su', (x,y) :: xys)+    ) yts+  ) wkl ++let inst_qual_sorted yts vv t q = +  let (qvv0, t0) :: xts = Q.all_params_of_t q     in+  match A.Sort.unify [t0] [t] with +    | Some su0 -> +        xts |> List.fold_left (ext_bindings yts) [(su0, [(qvv0, vv)])]  (* generate subs-bindings *)+            |> List.rev_map (List.rev <.> snd)                          (* extract sorted bindings *)+            |> List.rev_map (List.map (Misc.app_snd A.eVar))            (* instantiations        *)+            |> List.rev_map (Q.inst q)                                  (* quals *)+    | None    -> [] ++let inst_ext_sorted qs wf = +  let _    = Misc.display_tick ()               in+  let r    = C.reft_of_wf wf                    in +  let ks   = List.map snd <| C.kvars_of_reft r  in+  let env  = C.env_of_wf wf                     in+  let vv   = fst3 r                             in+  let t    = snd3 r                             in+  let yts  = inst_binds env                     in+  qs |> Misc.flap (inst_qual_sorted yts vv t)+     |> Misc.cross_product ks++(*************************************************************************************)++let inst_ext qs wf =+  if !Co.sorted_quals +  then inst_ext_sorted qs wf +  else inst_ext        qs wf+ +let inst_ext qs wf =+  if mydebug then +    let msg = Printf.sprintf "inst_ext wf id = %d" (C.id_of_wf wf) in+    Misc.trace msg (inst_ext qs) wf+    >> (List.length <+> F.printf "\n\ninst_ext wfid = %d: size = %d\n"  (C.id_of_wf wf))+  else inst_ext qs wf++(* API *)+let inst ws qs =+  Misc.flap (inst_ext qs) ws +  |> Misc.kgroupby fst +  |> Misc.map (Misc.app_snd (List.map snd)) ++++(*************************************************************************)+(*************************** Creation ************************************)+(*************************************************************************)++let create_qleqs ts sm ps consts qs =+  if !Co.minquals +  then BS.time "Annots: make qleqs" (qleqs_of_qs ts sm consts ps) qs +  else Q2S.empty++let create ts sm ps consts assm qs bm =+ {  m     = bm+  ; assm  = assm+  ; qm    = qs |>: Misc.pad_fst Q.name_of_t |> SM.of_list+  ; qleqs = Misc.with_ref_at Constants.strictsortcheck false +              (fun () -> create_qleqs ts sm consts ps qs) +  ; tpc   = TpNull.create ts sm ps consts+  +  (* Counterexamples *) +  ; step     = 0+  ; ctrace   = IM.empty+  ; lifespan = SM.empty++  (* Stats *)+  ; stat_simple_refines = ref 0+  ; stat_tp_refines     = ref 0; stat_imp_queries    = ref 0+  ; stat_valid_queries  = ref 0; stat_matches        = ref 0+  ; stat_umatches       = ref 0; stat_unsatLHS       = ref 0+  ; stat_emptyRHS       = ref 0+  } ++(* RJ: DO NOT DELETE! *)+let ppBinding (k, zs) = +  F.printf "ppBind %a := %a \n" +    Sy.print k +    (Misc.pprint_many false "," Q.print) zs++(* Take in a solution of things that are known to be true, kf. Using+   this, we can prune qualifiers whose negations are implied by+   information in kf *)+let update_pruned ks me fqm =+  List.fold_left begin fun m k ->+    if not (SM.mem k fqm) then m else+      let false_qs = SM.safeFind k fqm "update_pruned 1" in+      let qs = SM.safeFind k m "update_pruned 2" +               |> List.filter (fun q -> (not (List.mem (k,q) false_qs))) +      in SM.add k qs m+  end me.m ks++let apply_facts_c kf me c =+  let env = C.senv_of_t c in+  let (vv, t, lras) = C.lhs_of_t c in+  let (_,_,ras) as rhs = C.rhs_of_t c in+  let ks = rhs |> C.kvars_of_reft |> List.map snd in+  let lps = C.preds_of_lhs kf c in (* Use the known facts here *)+  let rcs = (Misc.flap (rhs_cands me)) ras in+    if rcs = [] then               (* Nothing on the right hand side *)+      me+    else if check_tp me env vv t lps [(0, A.pFalse)] = [0] then+      me+    else+      let rcs = List.filter (fun (_,p) -> not (P.is_contra p)) rcs+                |> List.map (fun (x,p) -> (x, A.pNot p)) in+	(* can we prove anything on lhs implies something on rhs is false? *)+      let fqs = BS.time "apply_facts tp" (check_tp me env vv t lps) rcs in+      let fqm = fqs |> Misc.kgroupby fst |> SM.of_list in+	  {me with m = BS.time "update pruned" (update_pruned ks me) fqm}++let apply_facts cs kf me =+  let numqs = me.m |> Ast.Symbol.SMap.to_list+              |> List.map snd |> List.concat |> List.length in+  let sol   = List.fold_left (apply_facts_c kf) me cs in+  let numqs' = sol.m |> Ast.Symbol.SMap.to_list+               |> List.map snd |> List.concat |> List.length in+  let _ = Printf.printf "Started with %d, proved %d false\n" numqs (numqs-numqs') in+    sol++let binds_of_quals ws qs =+  qs+  (* |> Q.normalize *)+  >> (fun qs -> Co.bprintf mydebug "Using Quals: \n%a" (Misc.pprint_many true "\n" Q.print) qs)+  >> (fun _  -> Co.bprintflush mydebug "\nBEGIN: Qualifier Instantiation\n")+  |> BS.time "Qual Inst" (inst ws) +  >> (fun _  -> Co.bprintflush mydebug "\nDONE: Qualifier Instantiation\n")+  (* >> List.iter ppBinding *)+  |> SM.of_list +  >> (fun _ -> Co.bprintflush mydebug "\nDONE: Qualifier Instantiation: Built Map \n")+++let binds_of_quals ws qs = +  match !Constants.dump_simp with+  | "" -> binds_of_quals ws qs  (* regular solving mode *)+  | _  -> SM.empty              (* constraint simplification mode *)+++(* API *)+let create c facts = +  binds_of_quals c.Cg.ws c.Cg.qs+  |> SM.extendWith (fun _ -> (++)) c.Cg.bm+  |> create c.Cg.ts c.Cg.uops c.Cg.ps c.Cg.cons c.Cg.assm c.Cg.qs+  >> (fun _ -> Co.bprintflush mydebug "\nBEGIN: refine_sort\n")+  |> ((!Constants.refine_sort) <?> Misc.flip (List.fold_left refine_sort) c.Cg.cs)+  >> (fun _ -> Co.bprintflush mydebug "\nEND: refine_sort\n")+  |> Misc.maybe_apply (apply_facts c.Cg.cs) facts+++++(* API *)+let empty = create Cg.empty None++(* API *)+let meet me you = {me with m = SM.extendWith (fun _ -> (++)) me.m you.m} ++(****************************************************************)+(************* Simplify Solution Using min_read *****************)+(****************************************************************)++(* let minb s bs = min_binds s bs +              >> Printf.printf "minBinds: [%a] \n\n"  pprint_ds+ *)++let simplify s = {s with m = SM.map (min_binds s) s.m} ++(************************************************************************)+(****************** Counterexample Generation ***************************)+(************************************************************************)++ +let ctr_examples me cs ucs = +  let cx = CX.create me.tpc (read me) cs me.ctrace me.lifespan in +  List.map (CX.explain cx) ucs+++(*******************************************************************************)+(******************************** Profile/Stats ********************************)+(*******************************************************************************)++let print_m ppf s = +  SM.iter begin fun k ds ->+    ds |> (<?>) (!Co.minquals) (min_binds s)+       |> F.fprintf ppf "solution: %a := [%a] \n\n"  Sy.print k pprint_ds +  end s.m + +let print_qs ppf s = +  SM.range s.qm+  >> (fun _ -> F.fprintf ppf "//QUALIFIERS \n\n")+  |> F.fprintf ppf "%a" (Misc.pprint_many true "\n" Q.print)+(*  |> List.iter (F.fprintf ppf "%a" Q.print) + *) |> ignore++(* API *)+let print ppf s = s >> print_m ppf >> print_qs ppf |> ignore++     +let botInt qs = if List.exists (Q.pred_of_t <+> P.is_contra) qs then 1 else 0++(* API *)+let print_stats ppf me =+  let (sum, max, min, bot) =   +    (SM.fold (fun _ qs x -> (+) x (List.length qs)) me.m 0,+     SM.fold (fun _ qs x -> max x (List.length qs)) me.m min_int,+     SM.fold (fun _ qs x -> min x (List.length qs)) me.m max_int,+     SM.fold (fun _ qs x -> x + botInt qs) me.m 0) in+  let n   = SM.length me.m in+  let avg = (float_of_int sum) /. (float_of_int n) in+  F.fprintf ppf "# Vars: (Total=%d, False=%d) Quals: (Total=%d, Avg=%f, Max=%d, Min=%d)\n" +    n bot sum avg max min;+  F.fprintf ppf "#Iteration Profile = (si=%d tp=%d unsatLHS=%d emptyRHS=%d) \n"+    !(me.stat_simple_refines) !(me.stat_tp_refines)+    !(me.stat_unsatLHS) !(me.stat_emptyRHS);+  F.fprintf ppf "#Queries: umatch=%d, match=%d, ask=%d, valid=%d\n" +    !(me.stat_umatches) !(me.stat_matches) !(me.stat_imp_queries)+    !(me.stat_valid_queries);+  me.tpc#print_stats ppf++(* API *)+let save fname s =+  let oc  = open_out fname in+  let ppf = F.formatter_of_out_channel oc in+  F.fprintf ppf "@[%a@] \n" print s;+  close_out oc++let key_of_quals qs = +  qs |> List.map P.to_string +     |> List.sort compare+     |> String.concat ","++(* API *)+let mkbind = id (* Misc.flatten <+> Misc.sort_and_compact *)++(* API *)+let dump s = +  s.m +  |> SM.to_list +  |> List.map (snd <+> List.map Q.pred_of_t)+  |> Misc.groupby key_of_quals+  |> List.map begin function +     | []             -> assertf "impossible" +     | (ps::_ as pss) -> Co.bprintf mydebug "SolnCluster: preds %d = size %d \n" (List.length ps) (List.length pss)+     end+  |> ignore++
+ external/fixpoint/predAbs.mli view
@@ -0,0 +1,16 @@+(* + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++include SolverArch.DOMAIN
+ external/fixpoint/prepass.ml view
@@ -0,0 +1,238 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)+++(** This module implements various constraint validation and simplification + *  prepasses *)++module BS = BNstats+module F  = Format+module A  = Ast+module Co = Constants+module P  = A.Predicate+module E  = A.Expression+module So = A.Sort+module Q  = Qualifier+module PH = A.Predicate.Hash+module Sy = A.Symbol+module SM = Sy.SMap+module C  = FixConstraint++module Misc = FixMisc +module IM = Misc.IntMap ++open Misc.Ops+let mydebug = false ++(***************************************************************)+(*********** Input Constraint & Solution Validation ************)+(***************************************************************)+++(* 3a. check that lhs/rhs have same sort *)+let phase3a = +  List.iter begin fun c ->+    let (vv1,t1,_) = C.lhs_of_t c in+    let (vv2,t2,_) = C.rhs_of_t c in+    if not (vv1 = vv2 && t1 = t2) then +      let msg = "Invalid Constraints 3a (LHS/RHS sort mismatch)" in+      let _   = Format.printf "%s in \n %a " msg (C.print_t None) c in+      raise (C.BadConstraint (C.id_of_t c, C.tag_of_t c, msg))+  end++(* 3b. check that sorts are consistent across constraints. + * DEPRECATED, due to the following counterexample.+ * Suppose you have a function:++	concatMap :: forall a, t. (a -> [t]) -> [a] -> [t]+	concatMap f [] 	   = []+	concatMap f (y:ys) = (f y) ++ (concatMap f ys)++ * Now, "f" gets a template+	+	(y:a) -> [t]++ * And inside the body of concatMap, the recursive call + * creates a function subtyping on "f" ++	... |- (y:a) -> [t] <: (y:a) -> t++ * which after splitting gives a constraint++	...,(y:a) |- t <: t			(1)++ * Now, suppose you have a call to concatMap++	baz = concatMap (\x -> [x])++ * Here, concatMap is actually "instantiated" with a + * different type variable, so at this instance,++	concatMap :: ((y:b) -> [b]) -> [b] -> [b]++ * That is, a, t are instantiated with b, b. Now, the + * application creates another function subtyping, and + * this time you end up with ++	...,(y:b) |- b <: b			(2)++let phase3b cs =+  let memo = Hashtbl.create 17 in+  List.iter begin fun c ->+    let env = C.env_of_t c in+    let id  = C.id_of_t c in+    SM.iter begin fun x (_,t,_) ->+      if Hashtbl.mem memo x then +        let xt = Hashtbl.find memo x in+        asserts (t = xt) "Invalid Constraints 3b: %d (%s is %s and %s)" +          id (Sy.to_string x) (So.to_string t) (So.to_string xt)+      else +        Hashtbl.replace memo x t+    end env+  end cs+*) ++(* 4. check that each tag has the same arity [a] *)+let phase4 a = +  List.iter begin fun c ->+    if (a = List.length (fst (C.tag_of_t c))) then () else+      raise (C.BadConstraint (C.id_of_t c, C.tag_of_t c, "Tag Arity Error"))+  end++(* 5. check that all refinements are well-formed *)+let validate_vars env msg vs = +  List.iter begin fun v -> +    if not (SM.mem v env) then +      let _ = F.printf "ERROR: out_of_scope variable %a (%s)" Sy.print v (Lazy.force msg) in+      failwith ("Out_of_scope: "^(Sy.to_string v))+  end vs ++let validate_pred env msg p = +  P.support p +  |> BS.time "validate_vars" (validate_vars env msg)++let validate_reft s env msg ((vv,t,_) as r) =+  let env = SM.add vv t env in+  r |> BS.time "preds_of_reft" (C.preds_of_reft s)+    |> List.iter (validate_pred env msg)++let phase5 s cs =+  Misc.filter begin fun c ->+    try+      let msg  = C.to_string c in+      let env  = C.senv_of_t c in+      let rhs  = C.rhs_of_t c  in+      List.iter (validate_pred env (lazy (msg^" BAD LHS"))) (C.preds_of_lhs s c);+      BS.time "valid rhs" (validate_reft s env (lazy (msg^"\n BAD RHS"))) rhs;+      true+    with ex -> begin +      let id  = C.id_of_t c           in+      let tag = C.tag_of_t c          in+      let msg = Printexc.to_string ex in+      Format.printf "Phase5: exn = %s on constraint: %a \n" msg (C.print_t None) c;+      raise (C.BadConstraint (id, tag, msg))+    end+  end cs+++(* API *)+let validate a s cs =+  cs >> phase3a +  (* >> phase3b : RJ: this invariant need not hold! *) +     >> phase4 a +     |> phase5 s+     |> (fun cs' -> asserts (List.length cs = List.length cs') "Validation")++(******************************************************************************)+(******************* Validating Well-Formedness Constraints *******************)+(******************************************************************************)++let validate_wf wfvs = +  C.reft_of_wf +  <+> C.kvars_of_reft +  <+> List.fold_left (fun wfvars (_, k) -> Sy.SSet.add k wfvars) wfvs+         (* if Sy.SSet.mem k wfvars then+           let _ = F.printf "ERROR: variable %a is checked for WF twice\n" Sy.print k in+             assert false+         else *)++(* API *)+let validate_wfs ws =+  ws |> List.fold_left begin fun (ws, wfvars) wf -> +          (wf :: ws, validate_wf wfvars wf)+        end ([], Sy.SSet.empty) +     |> fst+++(***************************************************************)+(*********************** Constraint Profiling  *****************)+(***************************************************************)++let profile_cstr im c = +  SM.fold begin fun _ (_,_,rs) ((a, b, c, d) as pfl) -> +    match rs with [] -> (a+1, b, c, d+1)  | _::_ -> begin +      List.fold_left begin fun (sz, csz, ksz, esz) r -> match r with +        | C.Conc _  -> (sz+1, csz+1, ksz, esz) +        | _         -> (sz+1, csz, ksz+1, esz)+      end pfl rs+    end+  end (C.env_of_t c) (0,0,0,0)+  |> fun pfl -> IM.add (C.id_of_t c) pfl im++let dump_profile im =+  let (tsz, tcsz, tksz, tesz) = +    IM.fold begin fun i (sz, csz, ksz, esz) (tsz, tcsz, tksz, tesz) -> +      Co.bprintf mydebug+        "ctag %d: binds=%d, cbinds=%d, kbinds=%d, ebinds=%d \n" +         i sz csz ksz esz;+      (tsz + sz, tcsz + csz, tksz + ksz, tesz + esz)+    end im (0,0,0,0) in+  Co.bprintf mydebug +    "Total binds=%d, cbinds=%d, kbinds=%d, ebinds=%d \n" +    tsz tcsz tksz tesz++let profile1 sri = +  sri |> Cindex.to_list+      |> List.fold_left profile_cstr IM.empty+      |> dump_profile++let key_of_cstr c = +  c |> C.env_of_t +    |> C.bindings_of_env +    |> List.map fst +    |> List.map Sy.to_string +    |> List.sort compare +    |> String.concat "," ++let profile2 sri =+  sri |> Cindex.to_list+      |> Misc.groupby key_of_cstr +      |> List.length+      |> fun n -> Co.bprintf mydebug "Constraint Clusters = %d \n" n++(* API *) +let profile sri = +  sri +  >> profile1 +  >> profile2 +  |> ignore +
+ external/fixpoint/prepass.mli view
@@ -0,0 +1,31 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)+++(** This module implements various constraint validation and simplification + *  prepasses *)++val validate           : int -> FixConstraint.soln -> FixConstraint.t list -> unit +val validate_wfs       : FixConstraint.wf list -> FixConstraint.wf list+(* val true_unconstrained : FixSolution.t -> Cindex.t -> FixSolution.t+*)+val profile            : Cindex.t -> unit
+ external/fixpoint/proverArch.ml view
@@ -0,0 +1,196 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(* Theories API *)++module type THEORY = sig+  type context+  type sort+  type ast+  type appDef +  type sortDef ++  val sym_sort    : appDef  -> Ast.Sort.t+  val sym_name    : appDef  -> Ast.Symbol.t+  val sort_name   : sortDef -> Ast.Sort.tycon+  val mk_thy_sort : sortDef -> context -> sort list -> sort+  val mk_thy_app  : appDef  -> context -> sort list -> ast list -> ast+  val theories    : sortDef list * appDef list+end++module type SMTSOLVER = sig+ +  (* Types *)+  type context+  type symbol +  type ast+  type sort+  type fun_decl++  (* Expression *)+  val mkAll : context -> sort array -> symbol array -> ast -> ast+  val mkApp : context -> fun_decl -> ast list -> ast+  val mkMul : context -> ast -> ast -> ast+  val mkAdd : context -> ast -> ast -> ast+  val mkSub : context -> ast -> ast -> ast+  val mkMod : context -> ast -> ast -> ast+  +  (* Predicates *)+  val mkIte     : context -> ast -> ast -> ast -> ast+  val mkInt     : context -> int -> sort -> ast+  val mkTrue    : context -> ast+  val mkFalse   : context -> ast+  val mkNot     : context -> ast -> ast+  val mkAnd     : context -> ast list -> ast+  val mkOr      : context -> ast list -> ast+  val mkImp     : context -> ast -> ast -> ast+  val mkIff     : context -> ast -> ast -> ast+  val mkRel     : context -> Ast.brel   -> ast -> ast -> ast ++  (* Conversions *)+  val astString : context -> ast -> string++  (* Set Theory Operations *)+  val mkSetSort     : context -> sort   -> sort+  val mkEmptySet    : context -> sort -> ast+  val mkSetAdd      : context -> ast -> ast -> ast+  val mkSetMem      : context -> ast -> ast -> ast+  val mkSetCup      : context -> ast -> ast -> ast+  val mkSetCap      : context -> ast -> ast -> ast+  val mkSetDif      : context -> ast -> ast -> ast+  val mkSetSub      : context -> ast -> ast -> ast++  (* Constructors *)+  val mkContext      : (string * string) array -> context+  val mkIntSort      : context -> sort+  val mkBoolSort     : context -> sort+  val var            : context -> symbol -> sort -> ast+  val boundVar       : context -> int    -> sort -> ast+  val stringSymbol   : context -> string -> symbol+  val funcDecl       : context -> symbol -> sort array -> sort -> fun_decl+  val isBool         : context -> ast -> bool+  +  (* Queries *)+  val bracket        : context -> (unit -> 'a) -> 'a+  val assertAxiom    : context -> ast -> unit+  val assertPreds    : context -> ast list -> unit+  val assertDistinct : context -> ast list -> unit+  val unsat          : context -> bool+ +  (* Stats *)+  val print_stats    : Format.formatter -> unit -> unit+end++class type prover = +  object+       (* AST/TC Interface *)+       method interp_syms :  (Ast.Symbol.t * Ast.Sort.t) list++       (* Query Interface *)+       method set_filter  :  'a . Ast.Sort.t Ast.Symbol.SMap.t +                          -> Ast.Symbol.t +                          -> Ast.pred list +                          -> ('a * Ast.pred) list +                          -> 'a list+++       (* method set_filter  :  Ast.Sort.t Ast.Symbol.SMap.t +                          -> Ast.Symbol.t +                          -> Ast.pred list +                          -> ((Ast.Symbol.t * Qualifier.t) * Ast.pred) list +                          -> (Ast.Symbol.t * Qualifier.t) list+        *)++       method print_stats : Format.formatter -> unit+  +       (* Counterexample Interface *) +       method is_contra   :  Ast.Sort.t Ast.Symbol.SMap.t +                          -> Ast.pred +                          -> bool+  ++       method unsat_suffix :  Ast.Sort.t Ast.Symbol.SMap.t +                           -> Ast.pred                     (* background predicate   *)+                           -> Ast.pred list                (* [p0,...,pn] *)+                           -> int option                   (* max j st. p /\i=j..n pi unsat *)++       (* method unsat_core  :  Ast.Sort.t Ast.Symbol.SMap.t +                          -> Ast.pred                      (* background predicate   *)+                          -> ('a * Ast.pred) list          (* [(index, killer-fact)] *)+                          -> 'a list                       (* [unsat-core-index]    *)+       *)+end++module type PROVER = sig+  +  val mkProver :  Ast.Sort.t list                      (* sorts        *) +               -> Ast.Sort.t Ast.Symbol.SMap.t         (* environment  *)+               -> Ast.pred list                        (* axioms       *) +               -> Ast.Symbol.t list                    (* distinct constants, sorts in env *)+               -> prover++(* {{{+  type t +  +  (* theory interface *)+  val is_interp   : Ast.Sort.tycon -> bool+  val interp_syms : unit -> (Ast.Symbol.t * Ast.Sort.t) list++  (* constraint solving interface *)+  val create      : Ast.Sort.t list                         (* sorts        *) +                    -> Ast.Sort.t Ast.Symbol.SMap.t         (* environment  *)+                    -> Ast.pred list                        (* axioms       *) +                    -> Ast.Symbol.t list                    (* distinct constants, sorts in env *)+                    -> t+ +  val set_filter  : t +                    -> Ast.Sort.t Ast.Symbol.SMap.t +                    -> Ast.Symbol.t +                    -> Ast.pred list +                    -> ('a * Ast.pred) list +                    -> 'a list++  val print_stats : Format.formatter -> t -> unit+  +  (* Counterexample Interface *) +  +  val is_contra   : t  +                    -> Ast.Sort.t Ast.Symbol.SMap.t +                    -> Ast.pred+                    -> bool++  val unsat_core  : t                                       +                    -> Ast.Sort.t Ast.Symbol.SMap.t +                    -> Ast.pred                             (* background predicate   *)+                    -> ('a * Ast.pred) list                 (* [(index, killer-fact)] *)+                    -> 'a list                              (* [unsat-core-index]    *)++  val unsat_suffix : t+                   -> Ast.Sort.t Ast.Symbol.SMap.t +                   -> Ast.pred                              (* background predicate   *)+                   -> Ast.pred list                         (* [p0,...,pn] *)+                   -> int option                            (* max j st. p /\i=j..n pi unsat *)+}}} *)++end++
+ external/fixpoint/qualifier.ml view
@@ -0,0 +1,366 @@+(*+ * Copyright © 2009-11 The Regents of the University of California. + * All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(**+ * This module implements a module for representing and manipulating Qualifiers.+ * *)+module Co = Constants++module F = Format++module P  = Ast.Predicate+module E  = Ast.Expression+module Sy = Ast.Symbol+module So = Ast.Sort+module Su = Ast.Subst+module SM = Sy.SMap+module SS = Sy.SSet++module Misc = FixMisc open Misc.Ops+module IM = Misc.IntMap+open Ast++let mydebug = false++(**************************************************************************)+(***************************** Qualifiers *********************************)+(**************************************************************************)+ +type q = { name    : Sy.t +         ; vvar    : Sy.t+         ; vsort   : So.t+         ; params  : (Sy.t * So.t) list+         ; pred    : pred+         ; args    : expr list option +           (* when args = Some es, es = vv'::[e1;...;en]+              where vv' is the applied vv and e1...en are the args applied to ~A1,...,~An *)+         }+++type t = q      (* to appease the functor gods. *)++let rename          = fun n -> fun q -> {q with name = n} +let name_of_t       = fun q -> q.name+let vv_of_t         = fun q -> q.vvar+let sort_of_t       = fun q -> q.vsort+let pred_of_t       = fun q -> q.pred+let params_of_t     = fun q -> q.params+let all_params_of_t = fun q -> (q.vvar, q.vsort) :: q.params++let args_of_t q  =+  let xs = all_params_of_t q |> List.map fst in+  let es = match q.args with+           | Some es -> es+           | None    -> List.map eVar xs+  in Misc.combine "Qualifier.args_of_t" xs es++let print_param ppf (x, t) =+  F.fprintf ppf "%a:%a" Sy.print x So.print t ++let print_params ppf args =+  F.fprintf ppf "%a" (Misc.pprint_many false ", " print_param) args++let print_args ppf q =+  q |> args_of_t |> List.map snd +    |> F.fprintf ppf "%a(%a)" Sy.print q.name (Misc.pprint_many false ", " E.print) + +(* API *) +let print ppf q = +  F.fprintf ppf "qualif %a(%a):%a" +    Sy.print q.name+    print_params (all_params_of_t q) +    P.print q.pred++  +(**********************************************************************)+(****************** Canonizing Wildcards (e.g. _ ---> ~A) *************)+(**********************************************************************)++let is_free params x = Misc.list_assoc_maybe x params |> Misc.maybe_bool |> not++let canonizer params =+  let fresh = Misc.mk_string_factory "~AA" |> fst |> (fun f -> f <+> Sy.of_string <+> eVar) in+  let memo  = Hashtbl.create 7 in+  function+    | (Var x, _) when is_free params x && Hashtbl.mem memo x -> +        Hashtbl.find memo x+    | (Var x, _) when is_free params x && Sy.is_wild_fresh x ->+        fresh () +    | (Var x, _) when is_free params x && Sy.is_wild_any x -> +        fresh () >> Hashtbl.replace memo x +    | e -> e ++(**************************************************************************)+(*************** Expanding Away Sets of Ops and Rels **********************)+(**************************************************************************)+ +let expand_with_list f g =+  List.map f <+> Misc.cross_flatten <+> Misc.map g++let expand_with_pair f g =+  Misc.map_pair f <+> Misc.uncurry Misc.cross_product <+> Misc.map g++let crunchExpr f e1s xs e2s =+  List.map begin fun e1 -> +    List.map begin fun e2 ->+      List.map begin fun x ->+        f (e1, x, e2)+      end xs+    end e2s+  end e1s+  |> List.flatten |> List.flatten++let rec expand_p ((p,_) as pred) = match p with +   | And ps             -> expand_ps pAnd ps+   | Or ps              -> expand_ps pOr ps+   | Not p              -> expand_p p |> List.map pNot +   | Imp (p1,p2)        -> expand_pp pImp (p1, p2)+   | Iff (p1,p2)        -> expand_pp pIff (p1, p2)+   | Forall(qs, p)      -> expand_p p |> List.map (fun p -> pForall (qs, p))+   | Bexp e             -> expand_e e |> List.map pBexp+   | MAtom (e1, rs, e2) -> let (e1s, e2s) = Misc.map_pair expand_e (e1,e2) in+                           crunchExpr pAtom e1s rs e2s+   | Atom (e1, r, e2)   -> let (e1s, e2s) = Misc.map_pair expand_e (e1,e2) in+                           crunchExpr pAtom e1s [r] e2s+   | _                  -> [pred]++and expand_e ((e,_) as expr) = match e with+   | MExp es            -> Misc.flap expand_e es+   | App (f, es)        -> expand_es (fun es -> eApp (f, es)) es+   | Bin (e1, op, e2)   -> expand_ep (fun (e1,e2) -> eBin (e1, op, e2)) (e1, e2) +   | MBin (e1, ops, e2) -> let e1s, e2s = Misc.map_pair expand_e (e1, e2) in+                           crunchExpr eBin e1s ops e2s+   | Fld (s, e)         -> expand_e e |> List.map (fun e -> eFld (s,e))+   | Cst (e, t)         -> expand_e e |> List.map (fun e -> eCst (e,t))+   | Ite (p,e1,e2)      -> let e1s, e2s = Misc.map_pair expand_e (e1, e2) in+                           let ps       = expand_p p in +                           List.map begin fun e1 ->+                             List.map begin fun e2 ->+                               List.map begin fun p ->+                                 eIte (p, e1, e2)+                               end ps+                             end e2s+                           end e1s+                           |> List.flatten |> List.flatten+   | _ -> [expr]++and expand_ps x = expand_with_list expand_p x+and expand_pp x = expand_with_pair expand_p x+and expand_es x = expand_with_list expand_e x+and expand_ep x = expand_with_pair expand_e x++(* API *)+let expand_qual q = +  expand_p q.pred+  |> List.map (fun p -> {q with pred = p})++(**************************************************************************)+(*************** Expanding Away Sets of Ops and Rels **********************)+(**************************************************************************)++let make_def_deps qnames q = +  let res = ref [] in+  let p' : pred  = P.map begin function +                         | Bexp (App (f, args),_), _ +                           when SS.mem f qnames -> res := (f, args) :: !res; pTrue +                         | p -> p +                         end id q.pred  +  in (q.name, !res) +(*  >> (fun (n, xs) ->  F.printf "qdep %a = %a \n" Sy.print n (Misc.pprint_many false ", " Sy.print) (List.map fst xs) )+  *)++let check_def_deps qm = +  List.iter begin fun (n, fargs) ->+      List.iter begin fun (f, args) ->+        match SM.finds f qm with+        | [q] -> asserts (List.length args = 1 + List.length q.params) +                 "Malformed Qualifier: %s with incorrect application of %s"+                 (Sy.to_string n) (Sy.to_string f)+        | _::_::_ -> assertf "Malformed Qualifier: %s refers to multiply defined %s" +                 (Sy.to_string n) (Sy.to_string f)+        | _   -> ()     +(*      | []  -> assertf "Malformed Qualifier: %s refers to unknown %s" +                 (Sy.to_string n) (Sy.to_string f) *)+ +      end fargs+  end++let order_by_defs qm qs = +  let is   = Misc.range 0 (List.length qs)                                      in+  let qis  = List.combine qs is                                                 in+  let i2q  = qis  |>: Misc.swap |> IM.of_list  |> Misc.flip IM.find             in+  let i2s  = i2q <+> name_of_t <+> Sy.to_string                                 in  +  let n2i  = qis  |>: Misc.app_fst name_of_t |> SM.of_list +             |> (fun m n -> SM.safeFind n m "order_by_defs") in+   +  let qnams= qs |>: name_of_t |> SS.of_list in+  let deps = qs |>: make_def_deps qnams >> check_def_deps qm                       in+  let ijs  = deps |> Misc.flap (fun (n, fargs) -> fargs |>: (fun (f,_) -> (n, f)))   +                  |> List.map (Misc.map_pair n2i)                               in+  let irs  = Fcommon.scc_rank "qualifier-deps" i2s is ijs                       in +  Misc.fsort snd irs +  |>: (fst <+> i2q)+(*   >> (F.printf "ORDERED QUALS:\n%a\n" (Misc.pprint_many true "\n" print)) *)++let expand_def qm p = match p with +  | Bexp (App (f, args),_), _ -> begin+    match SM.finds f qm with+    | _::_::_ -> assertf "Ambiguous Qualifier: %s" (Sy.to_string f)+    | [q]     -> q |> all_params_of_t+                   |> List.map fst+                   |> Misc.flip (Misc.combine ("Q.expand_def "^ (P.to_string p))) args+                   |> Su.of_list+                   |> substs_pred q.pred+    | []      -> p (* assertf "Unknown Qualifier: %s"   (Sy.to_string f)  *)+    end+  | _ -> p+    +(* this MUST precede any renaming as renaming can screw up name resolution *)+let compile_definitions qs = +  let qm   = List.fold_left (fun qm q -> SM.adds q.name [q] qm) SM.empty qs in+  let qs'  = order_by_defs qm qs                                       in +  List.fold_left begin fun qm q -> +    let q' = {q with pred = P.map (expand_def qm) id q.pred } in+    SM.adds q.name [q'] qm+  end SM.empty qs'+  |> SM.range |> Misc.flatten++(**************************************************************************)+(************************* Normalize Qualifier Sets ***********************)+(**************************************************************************)++let remove_duplicates qs = +  qs |> Misc.kgroupby (all_params_of_t <*> pred_of_t)+     |> List.map (fun (_,x::_) -> x)++let rename_qual q i = +  {q with name = Sy.suffix q.name (string_of_int i)}++let uniquely_rename qs =+  Misc.mapfold begin fun m q ->+    if SM.mem q.name m then+      let i = SM.safeFind q.name m "uniquelyRename" in+      (SM.add q.name (i+1) m, rename_qual q i)+    else +      (SM.add q.name 0 m, q)+  end SM.empty qs +  |> snd+++let check_dup t q = +  try +    let q' = Hashtbl.find t q.name in+    if (pred_of_t q' = pred_of_t q) then () else+      Format.printf "WARNING: duplicate qualifiers after normalization! (q = %a) (q' = %a)"+        print q +        print q'+  with Not_found -> ()++let qualifMap_set, qualifMap_get = +  let t = Hashtbl.create 37 in+  ( (fun qs -> Hashtbl.clear t; List.iter (fun q -> check_dup t q; Hashtbl.replace t q.name q) qs)+  , (fun n -> try Some (Hashtbl.find t  n) +              with Not_found -> (Format.printf "qualifMap_get fails on %a" Sy.print n; assert false) +    )+  )++let ticker = ref 0++(* API *)+let normalize qs =+  qs |> Misc.flap expand_qual+     |> compile_definitions+     |> remove_duplicates+     |> uniquely_rename+     >> qualifMap_set+(*   >> (fun qs -> ticker += 1; Co.logPrintf "normalize (%d):\n%a" (!ticker) +        (Misc.pprint_many true "\n" print) qs; flush stdout) *)++(* API *)+let expandPred n es = +  n |> qualifMap_get+    |> Misc.maybe_map begin fun q ->+         let xs = List.map fst <| args_of_t q in+         Misc.combine "expandPred" xs es +         |> Ast.Subst.of_list +         |> Ast.substs_pred (pred_of_t q)+       end++(*********************************************************************)+(***************************** Create ********************************)+(*********************************************************************)++let generalize_sorts vts = +  let vs, ts = List.split vts   in+  let ts'    = So.generalize ts in+  List.combine vs ts'++(* let generalize_sorts z = if !Co.gen_qual_sorts then generalize_sorts z else z *)++let close_params vts p =+  p |> P.support+    |> List.filter (Sy.is_wild <&&> is_free vts) +    |> List.map (fun x -> (x, So.t_int (* t_generic 0 causes blowup? *)))+    |> (@) vts (* Sy.SMap.of_list *)++(* API *)+let create n v t vts p =+  let p          = P.map id (canonizer vts) p    in+  let vts        = close_params vts p            in+  let (v,t)::vts = generalize_sorts ((v,t)::vts) in+  let _          = asserts (Misc.distinct vts) "Error: Q.create duplicate params %s \n" (Sy.to_string n)+  in { name   = n +     ; vvar   = v+     ; vsort  = t+     ; pred   = p+     ; params = vts +     ; args   = None }++(* DEBUG ONLY *)+let printb ppf (x, e) =+  F.fprintf ppf "%a:%a" Sy.print x E.print e +let printbs ppf args =+  F.fprintf ppf "%a" (Misc.pprint_many false ", " printb) args++(* API *)+let inst q args =+  let _   = if mydebug then F.printf "\nQ.inst with <<%a>>\n" printbs args in +  let xes = try q |> all_params_of_t |> List.map (fun (x,_) -> (x, List.assoc x args)) +            with Not_found -> +              let _ = F.printf "Error: Q.inst with bad args %a <<%a>>" print q printbs args +              in assertf "Error: Q.inst with bad args \n" +  in+  let v   = match xes with (_, (Var v, _)) :: _ -> v | _ -> assertf "Error: Q.inst with non-vvar arg" in+  let p   = xes |> Su.of_list |> Ast.substs_pred q.pred in+  { q with vvar = v; pred = p; args = Some (List.map snd xes)}+++module QSet = Misc.ESet (struct+  type t = q+  let compare q1 q2 = +    if (q1.name = q2.name) +    then compare q1.args q2.args +    else compare q1.name q2.name +end)+
+ external/fixpoint/qualifier.mli view
@@ -0,0 +1,53 @@+(*+ * Copyright © 2009-11 The Regents of the University of California. + * All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(**+ * This module implements a module for representing and manipulating Qualifiers.+ * *)++type t +module QSet : FixMisc.ESetType with type elt = t++val create          :  Ast.Symbol.t +                    -> Ast.Symbol.t +                    -> Ast.Sort.t +                    -> (Ast.Symbol.t * Ast.Sort.t) list +                    -> Ast.pred +                    -> t ++val name_of_t       : t -> Ast.Symbol.t+val vv_of_t         : t -> Ast.Symbol.t+val pred_of_t       : t -> Ast.pred+val sort_of_t       : t -> Ast.Sort.t+val params_of_t     : t -> (Ast.Symbol.t * Ast.Sort.t) list (* Ast.Sort.t Ast.Symbol.SMap.t *)+val all_params_of_t : t -> (Ast.Symbol.t * Ast.Sort.t) list +val vv_of_t         : t -> Ast.Symbol.t+val args_of_t       : t -> (Ast.Symbol.t * Ast.expr) list+val normalize       : t list -> t list+val inst            : t -> (Ast.Symbol.t * Ast.expr) list -> t+val print           : Format.formatter -> t -> unit+val print_args      : Format.formatter -> t -> unit+val expandPred      : Ast.Symbol.t -> Ast.expr list -> Ast.pred option++
+ external/fixpoint/smtLIB2.ml view
@@ -0,0 +1,419 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(********************************************************************************)+(*********** This module implements the binary interface with SMTLIB2   *********)+(*********** http://www.smt-lib.org/                                    *********)+(*********** http://www.grammatech.com/resource/smt/SMTLIBTutorial.pdf  *********)+(********************************************************************************)+++module H  = Hashtbl+module F  = Format+module Co = Constants+module BS = BNstats+module A  = Ast+module Sy = A.Symbol+module So = A.Sort+module SM = Sy.SMap+module P  = A.Predicate+module E  = A.Expression+module Misc = FixMisc open Misc.Ops+module SSM = Misc.StringMap+module Th = Theories++module SMTLib2 : ProverArch.SMTSOLVER = struct++let spr = Printf.sprintf++let mydebug = false ++let nb_unsat     = ref 0+let nb_pop       = ref 0+let nb_push      = ref 0++(***************************************************************)+(********************** Types **********************************)+(***************************************************************)++type symbol   = string  (* Sy.t *)+type sort     = string  (* So.t *)+type ast      = string  (* E of A.expr | P of A.pred *) +type fun_decl = symbol ++type cmd      = Push+              | Pop+              | CheckSat+              | Declare     of symbol * sort list * sort+              | AssertCnstr of ast+              | Distinct    of ast list (* {v: ast list | (len v) >= 2} *)++type resp     = Ok +              | Sat +              | Unsat +              | Unknown+              | Error of string++type solver   = Z3 | Mathsat | Cvc4 ++type context  = { cin  : in_channel+                ; cout : out_channel+                ; clog : out_channel }++let respString = function+  | Ok      -> "Ok"+  | Sat     -> "Sat"+  | Unsat   -> "Unsat"+  | Unknown -> "Unknown"+  | Error s -> "Error " ^ s++let solverString = function+  | Z3      -> "z3"+  | Mathsat -> "mathsat"+  | Cvc4    -> "cvc4"++(*******************************************************************)+(*********************** Set Theory ********************************)+(*******************************************************************)++let elt = "Elt"+let set = "Set"+let emp = "smt_set_emp"+let add = "smt_set_add"+let cup = "smt_set_cup"+let cap = "smt_set_cap"+let mem = "smt_set_mem"+let dif = "smt_set_dif"+let sub = "smt_set_sub"+let com = "smt_set_com"++(* +   (define-fun smt_set_emp () Set ((as const Set) false))+   (define-fun smt_set_mem ((x Elt) (s Set)) Bool (select s x))+   (define-fun smt_set_add ((s Set) (x Elt)) Set  (store s x true))+   (define-fun smt_set_cap ((s1 Set) (s2 Set)) Set ((_ map and) s1 s2))+   (define-fun smt_set_cup ((s1 Set) (s2 Set)) Set ((_ map or) s1 s2))+   (define-fun smt_set_com ((s Set)) Set ((_ map not) s))+   (define-fun smt_set_dif ((s1 Set) (s2 Set)) Set (smt_set_cap s1 (smt_set_com s2)))+   (define-fun smt_set_sub ((s1 Set) (s2 Set)) Bool (= smt_set_emp (smt_set_dif s1 s2)))+*)++(* z3 specific *)+let z3_preamble +  = [ spr "(define-sort %s () Int)"+        elt+    ; spr "(define-sort %s () (Array %s Bool))" +        set elt+    ; spr "(define-fun %s () %s ((as const %s) false))" +        emp set set +    ; spr "(define-fun %s ((x %s) (s %s)) Bool (select s x))"+        mem elt set+    ; spr "(define-fun %s ((s %s) (x %s)) %s (store s x true))"+        add set elt set+    ; spr "(define-fun %s ((s1 %s) (s2 %s)) %s ((_ map or) s1 s2))"+        cup set set set+    ; spr "(define-fun %s ((s1 %s) (s2 %s)) %s ((_ map and) s1 s2))"+        cap set set set+    ; spr "(define-fun %s ((s %s)) %s ((_ map not) s))"+        com set set+    ; spr "(define-fun %s ((s1 %s) (s2 %s)) %s (%s s1 (%s s2)))"+        dif set set set cap com+    ; spr "(define-fun %s ((s1 %s) (s2 %s)) Bool (= %s (%s s1 s2)))"+        sub set set emp dif +    ] + +let smtlib_preamble +  = [ spr "(set-logic QF_UFLIA)"+    ; spr "(define-sort %s () Int)"       elt+    ; spr "(define-sort %s () Int)"       set +    ; spr "(declare-fun %s () %s)"        emp set+    ; spr "(declare-fun %s (%s %s) %s)"   add set elt set+    ; spr "(declare-fun %s (%s %s) %s)"   cup set set set+    ; spr "(declare-fun %s (%s %s) %s)"   cap set set set+    ; spr "(declare-fun %s (%s %s) %s)"   dif set set set+    ; spr "(declare-fun %s (%s %s) Bool)" sub set set +    ; spr "(declare-fun %s (%s %s) Bool)" mem elt set +   +    (* HIDE? +    ; spr "(assert (forall ((x %s)) (not (%s x %s))))" +          elt mem emp+    ; spr "(assert (forall ((x %s) (s1 %s) (s2 %s)) +            (= (%s x (%s s1 s2)) (or (%s x s1) (%s x s2)))))"+            elt set set mem cup mem mem+    ; spr "(assert (forall ((x %s) (s1 %s) (s2 %s)) +            (= (%s x (%s s1 s2)) (and (%s x s1) (%s x s2)))))"+            elt set set mem cap mem mem+    ; spr "(assert (forall ((x %s) (s1 %s) (s2 %s)) +            (= (%s x (%s s1 s2)) (and (%s x s1) (not (%s x s2))))))"+            elt set set mem dif mem mem+    ; spr "(assert (forall ((x %s) (s %s) (y %s)) +            (= (%s x (%s s y)) (or (%s x s) (= x y)))))"+            elt set elt mem add mem +    *)+    ] +++let mkSetSort _ _  = set+let mkEmptySet _ _ = emp+let mkSetAdd _ s x = spr "(%s %s %s)" add s x+let mkSetMem _ x s = spr "(%s %s %s)" mem x s +let mkSetCup _ s t = spr "(%s %s %s)" cup s t+let mkSetCap _ s t = spr "(%s %s %s)" cap s t+let mkSetDif _ s t = spr "(%s %s %s)" dif s t+let mkSetSub _ s t = spr "(%s %s %s)" sub s t++(******************************************************************)+(**************** SMT IO ******************************************)+(** https://raw.github.com/ravichugh/djs/master/src/zzz.ml ********)+(******************************************************************)+        +(* "z3 -smt2 -in"                   *)+(* "z3 -smtc SOFT_TIMEOUT=1000 -in" *)+(* "z3 -smtc -in MBQI=false"        *)++let smt_cmd = function+  | Z3      -> "z3 -smt2 -in MODEL=false MODEL.PARTIAL=true smt.mbqi=false auto-config=false"+  | Mathsat -> "mathsat -input=smt2"+  | Cvc4    -> "cvc4 --incremental -L smtlib2"++let smt_preamble = function+  | Z3 -> z3_preamble+  | _  -> smtlib_preamble +++let smt_file = fun () -> !Co.out_file ^ ".smt2"++let smt_write_raw me s = +  output_now me.clog s; +  output_now me.cout s++let smt_read_raw me = +  input_line me.cin++let smt_write me ?nl:(nl=true) ?tab:(tab=false) s =+  let pre = if tab then "    " else "" in+  let suf = if nl  then "\n"   else "" in+  smt_write_raw me (pre^s^suf)++let rec smt_read me+  = match smt_read_raw me with+  | "sat"     -> Sat+  | "unsat"   -> Unsat+  | "success" -> smt_read me +  | "unknown" -> Unknown+  | s         -> Error s+++(* val interact : context -> cmd -> resp *)+let interact me = function +  | Declare (x, ts, t) -> +      let _ = smt_write me <| spr "(declare-fun %s (%s) %s)" x (String.concat " " ts) t in+      Ok +  | Push -> +      let _ = smt_write me <|     "(push 1)" in+      Ok+  | Pop -> +      let _ = smt_write me <|     "(pop 1)" in+      Ok+  | CheckSat -> +      let _ = smt_write me <|     "(check-sat)" in+      smt_read me +  | AssertCnstr a -> +      let _ = smt_write me <| spr "(assert %s)" a in+      Ok+  | Distinct az -> +      let _ = smt_write me <| spr "(assert (distinct %s))" (String.concat " " az) in+      Ok+++(* API *)+let smt_decl me x ts t +  = match interact me (Declare (x, ts, t)) with+  | Ok -> ()+  | _  -> assertf "crash: SMTLIB2 smt_decl"++(* API *)+let smt_push me +  = match interact me Push with+  | Ok -> incr nb_push; () +  | _  -> assertf "crash: SMTLIB2 smt_push"++(* API *)+let smt_pop me +  = match interact me Pop with+  | Ok -> incr nb_pop; () +  | _  -> assertf "crash: SMTLIB2 smt_pop"++(* API *)+let smt_check_unsat me +  = match interact me CheckSat with+  | Unsat   -> true+  | Sat     -> false+  | Unknown -> false +  | e       -> assertf "crash: SMTLIB2 smt_check_unsat %s" (respString e)++(* API *)+let smt_assert_cnstr me p +  = match interact me (AssertCnstr p) with+  | Ok -> ()+  | _  -> assertf "crash: SMTLIB2 smt_assert_cnstr"++(* API *)+let smt_assert_distinct me az+  = match interact me (Distinct az) with+  | Ok -> ()+  | _  -> assertf "crash: SMTLIB2 smt_assert_distinct"++let solver () =+  match !Co.smt_solver with+    | Some "z3"      -> Z3+    | Some "mathsat" -> Mathsat+    | Some "cvc4"    -> Cvc4+    | Some str       -> assertf "ERROR: fixpoint does not yet support SMTSOLVER: %s" str+    | None           -> assertf "ERROR: undefined solver for smtLIB2"++let mkContext _ =+  let s      = solver ()                          in+  let ci, co = Unix.open_process <| smt_cmd s     in+  let cl     = smt_file () |> open_out            in+  let pre    = smt_preamble s                     in+  let ctx    = { cin = ci; cout = co; clog = cl } in+  let _      = List.iter (smt_write ctx) pre      in+  ctx++(***********************************************************************)+(*********************** AST Constructors ******************************)+(***********************************************************************)++let stringSymbol _ s = s+let astString _ a    = a +let isBool c a       = failwith "TODO:SMTLib2.isBool"+let boundVar me i t  = failwith "TODO:SMTLib2.boundVar"++let var me x t =+  let _ = smt_decl me x [] t in  +  x ++let funcDecl me s ta t =+  let _ = smt_decl me s (Array.to_list ta) t in+  s++let mkIntSort _    = "Int"          +let mkBoolSort _   = "Bool"         ++let mkInt _ i _    = string_of_int i+let mkTrue _       = "true"+let mkFalse _      = "false" ++let mkAll _ _ _ _  = failwith "TODO:SMTLib2.mkAll"++let mkRel _ r a1 a2 +  = match r with +  | A.Eq -> spr "(= %s %s)"       a1 a2 +  | A.Ne -> spr "(not (= %s %s))" a1 a2 +  | A.Gt -> spr "(>  %s %s)"      a1 a2 +  | A.Ge -> spr "(>= %s %s)"      a1 a2 +  | A.Lt -> spr "(<  %s %s)"      a1 a2 +  | A.Le -> spr "(<= %s %s)"      a1 a2 ++++let mkApp _ f = function+  | [] -> f +  | az -> spr "(%s %s)" f (String.concat " " az)++let opStr = function+  | A.Plus  -> "+"+  | A.Minus -> "-"+  | A.Times -> "*"+  | A.Div   -> "/"+  | A.Mod   -> "mod"++let mkOp op a1 a2+  = spr "(%s %s %s)" (opStr op) a1 a2+  +let mkMul _ = mkOp A.Times  +let mkAdd _ = mkOp A.Plus+let mkSub _ = mkOp A.Minus+let mkMod _ = mkOp A.Mod++let mkIte _ a1 a2 a3 +  = spr "(ite %s %s %s)" a1 a2 a3++let mkNot _ a +  = spr "(not %s)" a ++let mkAnd _ az  +  = spr "(and %s)" (String.concat " " az) ++let mkOr _ az +  = spr "(or %s)" (String.concat " " az) ++let mkImp _ a1 a2 +  = spr "(=> %s %s)" a1 a2 ++let mkIff _ a1 a2 +  = spr "(= %s %s)" a1 a2 ++(*******************************************************************)+(*********************** Queries ***********************************)+(*******************************************************************)++let us_ref = ref 0++(* API *)+let unsat me =  +  let _  = if mydebug then begin +              Printf.printf "[%d] UNSAT 1 " (us_ref += 1);+              flush stdout+           end +  in+  let rv = BS.time "SMT.check_unsat" smt_check_unsat me               in+  let _  = if mydebug then (Printf.printf "UNSAT 2 \n"; flush stdout) in+  let _  = if rv then ignore (nb_unsat += 1) in +  rv++(* API *)+let assertAxiom me p+  = (* Co.bprintf mydebug "@[Pushing axiom %s@]@." (astString me p); *)+    BS.time "assertAxiom" (smt_assert_cnstr me) p;+    asserts (not (unsat me)) "ERROR: Axiom makes background theory inconsistent!"++(* API *)+let assertDistinct me = function +  | ((x1::x2::_) as az) -> smt_assert_distinct me az+  | _                   -> ()++(* API *)+let bracket me f +  = Misc.bracket (fun _ -> smt_push me) (fun _ -> smt_pop me) f++(* API *)+let assertPreds me ps +  = List.iter (fun p -> BS.time "assertPreds" (smt_assert_cnstr me) p) ps++(* API *)+let print_stats ppf () =+  F.fprintf ppf "SMT stats: pushes=%d, pops=%d, unsats=%d \n" +    !nb_push !nb_pop !nb_unsat++end
+ external/fixpoint/smtZ3.mem.ml view
@@ -0,0 +1,169 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(* This file is part of the LiquidC Project *)++module H  = Hashtbl+module F  = Format+module Co = Constants+module BS = BNstats+module A  = Ast+module Sy = A.Symbol+module So = A.Sort+module SM = Sy.SMap+module P  = A.Predicate+module E  = A.Expression+module Misc = FixMisc open Misc.Ops+module SSM = Misc.StringMap+module Th = Theories++module SMTZ3 : ProverArch.SMTSOLVER = struct++let mydebug = false ++(********************************************************************************)+(************ SMT INTERFACE *****************************************************) +(********************************************************************************)++let nb_unsat     = ref 0+let nb_pop       = ref 0+let nb_push      = ref 0++type context     = Z3.context+type symbol      = Z3.symbol+type sort        = Z3.sort+type ast         = Z3.ast+type fun_decl    = Z3.func_decl ++let var          = Z3.mk_const +let boundVar     = Z3.mk_bound+let stringSymbol = Z3.mk_string_symbol +let funcDecl     = Z3.mk_func_decl++let isBool c a =+  a |> Z3.get_sort c   +    |> Z3.sort_to_string c+    |> (=) "bool"++let isInt me a =+  a |> Z3.get_sort me   +    |> Z3.sort_to_string me+    |> (=) "int"++let mkAll me = Z3.mk_forall me 0 [||]++let mkRel c r a1 a2 +  = match r with+  | A.Eq -> Z3.mk_eq c          a1  a2  +  | A.Ne -> Z3.mk_distinct c [| a1; a2 |]+  | A.Gt -> Z3.mk_gt c          a1  a2 +  | A.Ge -> Z3.mk_ge c          a1  a2+  | A.Lt -> Z3.mk_lt c          a1  a2+  | A.Le -> Z3.mk_le c          a1  a2++let mkApp c f az  = Z3.mk_app c f (Array.of_list az)+let mkMul c a1 a2 = Z3.mk_mul c [| a1; a2|]+let mkAdd c a1 a2 = Z3.mk_add c [| a1; a2|]+let mkSub c a1 a2 = Z3.mk_sub c [| a1; a2|]+let mkMod = Z3.mk_mod +let mkIte = Z3.mk_ite++let mkInt      = Z3.mk_int +let mkTrue     = Z3.mk_true+let mkFalse    = Z3.mk_false+let mkNot      = Z3.mk_not+let mkAnd c az = Z3.mk_and c (Array.of_list az) +let mkOr c az  = Z3.mk_or c  (Array.of_list az) +let mkImp      = Z3.mk_implies+let mkIff      = Z3.mk_iff+let astString  = Z3.ast_to_string +let mkIntSort  = Z3.mk_int_sort  +let mkBoolSort = Z3.mk_bool_sort +let mkSetSort  = Z3.mk_set_sort  +let mkEmptySet = Z3.mk_empty_set +let mkSetAdd   = Z3.mk_set_add+let mkSetMem   = Z3.mk_set_member +let mkSetCup   = fun me s1 s2 -> Z3.mk_set_union     me [| s1; s2 |]+let mkSetCap   = fun me s1 s2 -> Z3.mk_set_intersect me [| s1; s2 |]+let mkSetDif   = Z3.mk_set_difference+let mkSetSub   = Z3.mk_set_subset +let mkContext  = Z3.mk_context_x ++(*********************************************************)++let z3push me =+  let _ = nb_push += 1 in+  let _ = BS.time "Z3.push" Z3.push me in+  () ++let z3pop me =+  let _ = incr nb_pop in+  BS.time "Z3.pop" (Z3.pop me) 1 +++(* Z3 API *)+let unsat =  +  let us_ref = ref 0 in+  fun me ->+    let _  = if mydebug then (Printf.printf "[%d] UNSAT 1 " (us_ref += 1); flush stdout) in+    let rv = (BS.time "Z3.check" Z3.check me) = Z3.L_FALSE in+    let _  = if mydebug then (Printf.printf "UNSAT 2 \n"; flush stdout) in+    let _  = if rv then ignore (nb_unsat += 1) in +    rv++(* API *)+let assertAxiom me p =+  Co.bprintf mydebug "@[Pushing axiom %s@]@." (astString me p); +  BS.time "Z3 assert axiom" (Z3.assert_cnstr me) p;+  asserts (not (unsat me)) "ERROR: Axiom makes background theory inconsistent!"++(* API *)+let assertDistinct me xs =+  xs |> Array.of_list |> Z3.mk_distinct me |> assertAxiom me++(* Z3 API *)+let bracket me f = Misc.bracket (fun _ -> z3push me) (fun _ -> z3pop me) f++(* Z3 API *)+let assertPreds me ps = List.iter (fun p -> BS.time "Z3.ass_cst" (Z3.assert_cnstr me) p) ps++(* Z3 API *)+let valid me p = +  bracket me begin fun _ ->+    assertPreds me [Z3.mk_not me p];+    BS.time "unsat" unsat me +  end++(* Z3 API *)+let contra me p = +  bracket me begin fun _ ->+    assertPreds me [p];+    BS.time "unsat" unsat me +  end++(* API *)+let print_stats ppf () =+  F.fprintf ppf+    "SMT stats: pushes=%d, pops=%d, unsats=%d \n" +    !nb_push !nb_pop !nb_unsat ++end
+ external/fixpoint/smtZ3.ml view
@@ -0,0 +1,169 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(* This file is part of the LiquidC Project *)++module H  = Hashtbl+module F  = Format+module Co = Constants+module BS = BNstats+module A  = Ast+module Sy = A.Symbol+module So = A.Sort+module SM = Sy.SMap+module P  = A.Predicate+module E  = A.Expression+module Misc = FixMisc open Misc.Ops+module SSM = Misc.StringMap+module Th = Theories++module SMTZ3 : ProverArch.SMTSOLVER = struct++let mydebug = false ++(********************************************************************************)+(************ SMT INTERFACE *****************************************************) +(********************************************************************************)++let nb_unsat     = ref 0+let nb_pop       = ref 0+let nb_push      = ref 0++type context     = Z3.context+type symbol      = Z3.symbol+type sort        = Z3.sort+type ast         = Z3.ast+type fun_decl    = Z3.func_decl ++let var          = Z3.mk_const +let boundVar     = Z3.mk_bound+let stringSymbol = Z3.mk_string_symbol +let funcDecl     = Z3.mk_func_decl++let isBool c a =+  a |> Z3.get_sort c   +    |> Z3.sort_to_string c+    |> (=) "bool"++let isInt me a =+  a |> Z3.get_sort me   +    |> Z3.sort_to_string me+    |> (=) "int"++let mkAll me = Z3.mk_forall me 0 [||]++let mkRel c r a1 a2 +  = match r with+  | A.Eq -> Z3.mk_eq c          a1  a2  +  | A.Ne -> Z3.mk_distinct c [| a1; a2 |]+  | A.Gt -> Z3.mk_gt c          a1  a2 +  | A.Ge -> Z3.mk_ge c          a1  a2+  | A.Lt -> Z3.mk_lt c          a1  a2+  | A.Le -> Z3.mk_le c          a1  a2++let mkApp c f az  = Z3.mk_app c f (Array.of_list az)+let mkMul c a1 a2 = Z3.mk_mul c [| a1; a2|]+let mkAdd c a1 a2 = Z3.mk_add c [| a1; a2|]+let mkSub c a1 a2 = Z3.mk_sub c [| a1; a2|]+let mkMod = Z3.mk_mod +let mkIte = Z3.mk_ite++let mkInt      = Z3.mk_int +let mkTrue     = Z3.mk_true+let mkFalse    = Z3.mk_false+let mkNot      = Z3.mk_not+let mkAnd c az = Z3.mk_and c (Array.of_list az) +let mkOr c az  = Z3.mk_or c  (Array.of_list az) +let mkImp      = Z3.mk_implies+let mkIff      = Z3.mk_iff+let astString  = Z3.ast_to_string +let mkIntSort  = Z3.mk_int_sort  +let mkBoolSort = Z3.mk_bool_sort +let mkSetSort  = Z3.mk_set_sort  +let mkEmptySet = Z3.mk_empty_set +let mkSetAdd   = Z3.mk_set_add+let mkSetMem   = Z3.mk_set_member +let mkSetCup   = fun me s1 s2 -> Z3.mk_set_union     me [| s1; s2 |]+let mkSetCap   = fun me s1 s2 -> Z3.mk_set_intersect me [| s1; s2 |]+let mkSetDif   = Z3.mk_set_difference+let mkSetSub   = Z3.mk_set_subset +let mkContext  = Z3.mk_context_x ++(*********************************************************)++let z3push me =+  let _ = nb_push += 1 in+  let _ = BS.time "Z3.push" Z3.push me in+  () ++let z3pop me =+  let _ = incr nb_pop in+  BS.time "Z3.pop" (Z3.pop me) 1 +++(* Z3 API *)+let unsat =  +  let us_ref = ref 0 in+  fun me ->+    let _  = if mydebug then (Printf.printf "[%d] UNSAT 1 " (us_ref += 1); flush stdout) in+    let rv = (BS.time "Z3.check" Z3.check me) = Z3.L_FALSE in+    let _  = if mydebug then (Printf.printf "UNSAT 2 \n"; flush stdout) in+    let _  = if rv then ignore (nb_unsat += 1) in +    rv++(* API *)+let assertAxiom me p =+  Co.bprintf mydebug "@[Pushing axiom %s@]@." (astString me p); +  BS.time "Z3 assert axiom" (Z3.assert_cnstr me) p;+  asserts (not (unsat me)) "ERROR: Axiom makes background theory inconsistent!"++(* API *)+let assertDistinct me xs =+  xs |> Array.of_list |> Z3.mk_distinct me |> assertAxiom me++(* Z3 API *)+let bracket me f = Misc.bracket (fun _ -> z3push me) (fun _ -> z3pop me) f++(* Z3 API *)+let assertPreds me ps = List.iter (fun p -> BS.time "Z3.ass_cst" (Z3.assert_cnstr me) p) ps++(* Z3 API *)+let valid me p = +  bracket me begin fun _ ->+    assertPreds me [Z3.mk_not me p];+    BS.time "unsat" unsat me +  end++(* Z3 API *)+let contra me p = +  bracket me begin fun _ ->+    assertPreds me [p];+    BS.time "unsat" unsat me +  end++(* API *)+let print_stats ppf () =+  F.fprintf ppf+    "SMT stats: pushes=%d, pops=%d, unsats=%d \n" +    !nb_push !nb_pop !nb_unsat ++end
+ external/fixpoint/smtZ3.nomem.ml view
@@ -0,0 +1,81 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(********************************************************************************)+(** DUMMY SMT-Z3 Solver (for non Z3MEM builds) **********************************)+(********************************************************************************)++let assertf = FixMisc.Ops.assertf+let msg     = "This build is NOT linked against Z3. Please rebuild with Z3MEM=true. Only possible on linux"++module SMTZ3 : ProverArch.SMTSOLVER = struct++type context     = ()+type symbol      = ()   +type sort        = () +type ast         = () +type fun_decl    = ()  ++let var          _   = failwith msg +let boundVar     _   = failwith msg+let stringSymbol _   = failwith msg+let funcDecl     _   = failwith msg+let isBool _         = failwith msg+let isInt _          = failwith msg+let mkAll _          = failwith msg+let mkRel _          = failwith msg+let mkApp _          = failwith msg  +let mkMul _          = failwith msg+let mkAdd _          = failwith msg+let mkSub _          = failwith msg+let mkMod _          = failwith msg+let mkIte _          = failwith msg+let mkInt _          = failwith msg  +let mkTrue _         = failwith msg+let mkFalse _        = failwith msg+let mkNot _          = failwith msg+let mkAnd _          = failwith msg +let mkOr _           = failwith msg +let mkImp _          = failwith msg +let mkIff _          = failwith msg+let astString _      = failwith msg+let mkIntSort _      = failwith msg+let mkBoolSort _     = failwith msg+let mkSetSort _      = failwith msg+let mkEmptySet _     = failwith msg+let mkSetAdd _       = failwith msg+let mkSetMem _       = failwith msg+let mkSetCup _       = failwith msg+let mkSetCap _       = failwith msg+let mkSetDif _       = failwith msg+let mkSetSub _       = failwith msg+let mkContext _      = failwith msg+let unsat _          = failwith msg  +let assertAxiom _    = failwith msg+let assertDistinct _ = failwith msg+let bracket _        = failwith msg+let assertPreds _    = failwith msg+let valid _          = failwith msg +let contra _         = failwith msg+let print_stats _    = failwith msg++end
+ external/fixpoint/solve.ml view
@@ -0,0 +1,271 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)+++(** This module implements a fixpoint solver *)+module BS = BNstats+module F  = Format+module A  = Ast+module Co = Constants+module P  = A.Predicate+module E  = A.Expression+module So = A.Sort+module Su = A.Subst+module Q  = Qualifier+module Sy = A.Symbol+module SM = Sy.SMap+module C  = FixConstraint+module Ci = Cindex+module PP = Prepass+module Cg = FixConfig+(* module TP   = TpNull.Prover *)+module Misc = FixMisc open Misc.Ops+++let mydebug = false ++type t = {+   sri : Ci.t+ ; ws  : C.wf list+ ; tt  : Timer.t+   + (* Stats *)+ ; stat_refines        : int ref+ ; stat_cfreqt         : (int * bool, int) Hashtbl.t +}++module type SOLVER = sig+  type soln+  type bind+  val create    : bind Cg.cfg -> FixConstraint.soln option -> (t * soln)+  val solve     : t -> soln -> (soln * (FixConstraint.t list) * Counterexample.cex list) +  val save      : string -> t -> soln -> unit +  val read      : soln -> FixConstraint.soln+  val min_read  : soln -> FixConstraint.soln+  val read_bind : soln -> Ast.Symbol.t -> bind+  val cone      : t -> FixConstraint.id -> FixConstraint.tag Ast.Cone.t+  (* val meet   : soln -> soln -> soln  *)+end++module Make (Dom : SolverArch.DOMAIN) = struct+  type soln     = Dom.t+  type bind     = Dom.bind+  let min_read  = Dom.min_read+  let read      = Dom.read+  let read_bind = Dom.read_bind  +(* let meet = Dom.meet *)+++(*************************************************************)+(********************* Stats *********************************)+(*************************************************************)++let hashtbl_incr_frequency t k = +  let n = try Hashtbl.find t k with Not_found -> 0 in+  Hashtbl.replace t k (n+1)++let hashtbl_print_frequency t = +  Misc.hashtbl_to_list t +  |> Misc.kgroupby (fun ((k,b),n) -> (n,b))+  |> List.map (fun ((n,b), xs) -> (n, b, List.map (fst <+> fst) xs))+  |> List.sort compare+  |> List.iter begin fun (n, b, xs) -> +       Co.bprintf mydebug "ITERFREQ: %d times (ch = %b) %d constraints %s \n"+         n b (List.length xs) (Misc.map_to_string string_of_int xs) +     end++(***************************************************************)+(************************ Debugging/Stats **********************)+(***************************************************************)++let print_constr_stats ppf cs = +  let cn   = List.length cs in+  let scn  = List.length (List.filter C.is_simple cs) in+  F.fprintf ppf "#Constraints: %d (simple = %d) \n" cn scn++let print_solver_stats ppf me = +  print_constr_stats ppf (Ci.to_list me.sri); +  F.fprintf ppf "#Iterations = %d\n" !(me.stat_refines);+  F.fprintf ppf "Iteration Frequency: \n"; +    hashtbl_print_frequency me.stat_cfreqt;+  F.fprintf ppf "Iteration Periods: @[%a@] \n" Timer.print me.tt++let dump me s = +  Co.bprintf mydebug "%a \n" print_solver_stats me;+  Co.bprintf mydebug "%a \n" Dom.print_stats s;+  Dom.dump s++let log_iter_stats me s =+  (if Co.ck_olev Co.ol_insane then Co.bprintf mydebug "log_iter_stats\n%a" Dom.print s);+  (if !(me.stat_refines) mod 100 = 0 then +     let msg = Printf.sprintf "\n num refines=%d" !(me.stat_refines) in +     let _   = Timer.log_event me.tt (Some msg)                      in+     let _   = Co.bprintf mydebug "%s\n %a\n" msg Dom.print_stats s  in+     let _   = Format.print_flush ()                                 in+     ());+  ()++(***************************************************************)+(******************** Iterative Refinement *********************)+(***************************************************************)++let is_solved s c = +  let sol = read s in+  c |> C.rhs_of_t +    |> C.kvars_of_reft+    |> List.map (sol <.> snd)+    |> List.for_all ((=) [])++let refine_constraint s c =+  try BS.time "refine" (Dom.refine s) c with ex ->+    let _ = F.printf "constraint refinement fails with: %s\n" (Printexc.to_string ex) in+    let _ = F.printf "Failed on constraint:\n%a\n" (C.print_t None) c in+    assert false++let update_worklist me s' c w' = +  c |> Ci.deps me.sri +    |> Misc.filter (not <.> is_solved s')+    |> Ci.wpush me.sri w'++let rec acsolve me w s =+  let _ = log_iter_stats me s in+  let _ = Misc.display_tick () in+  match Ci.wpop me.sri w with +  | (None,_) -> +      let _ = Timer.log_event me.tt (Some "Finished") in +      s +  | (Some c, w') ->+      let _        = me.stat_refines += 1             in +      let (ch, s') = BS.time "refine" (refine_constraint s) c in+      let _        = hashtbl_incr_frequency me.stat_cfreqt (C.id_of_t c, ch) in  +      let _        = Co.bprintf mydebug "iter=%d id=%d ch=%b %a \n" +                      !(me.stat_refines) (C.id_of_t c) ch C.print_tag (C.tag_of_t c) in+      let w''      = if ch then update_worklist me s' c w' else w' in +      acsolve me w'' s' ++let unsat_constraints me s =+  me.sri |> Ci.to_list |> List.filter (Dom.unsat s)++let simplify_solution me s = Dom.simplify s+++(***************************************************************)+(****************** Pruning Unconstrained Vars *****************)+(***************************************************************)++let rhs_ks cs =+  cs  |> Misc.flap (Misc.compose C.kvars_of_reft C.rhs_of_t)+      |> List.fold_left (fun rhss (_, kv) -> Sy.SSet.add kv rhss) Sy.SSet.empty++let unconstrained_kvars cs =+  let rhss = rhs_ks cs in+  cs  |> Misc.flap C.kvars_of_t+      |> List.map snd+      |> List.filter (fun kv -> not (Sy.SSet.mem kv rhss))++let true_unconstrained sri s =+  sri |> Ci.to_list +      |> unconstrained_kvars+      |> Dom.top s++(* +let true_unconstrained sri s = +  if !Co.true_unconstrained then +    let _ = Co.logPrintf "Fixpoint: Pruning unconstrained kvars \n" +    in true_unconstrained sri s+  else +    let _ = Co.logPrintf "Fixpoint: NOT Pruning unconstrained kvars \n" +    in s+*)++(* API *)+let solve me s = +  let _  = Co.bprintflush mydebug "Fixpoint: Validating Initial Solution \n" in+  (* let _ = F.printf "create: SOLUTION \n %a \n" Dom.print s in *)+  let _  = BS.time "Prepass.profile" PP.profile me.sri in+  let _  = Co.bprintflush mydebug "\nBEGIN: Fixpoint: Trueing Unconstrained Variables \n" in+  let s  = s |> (!Co.true_unconstrained <?> BS.time "Prepass.true_unconstr" (true_unconstrained me.sri)) in+  let _  = Co.bprintflush mydebug "\nDONE: Fixpoint: Trueing Unconstrained Variables \n" in+  (* let _ = F.printf "create: SOLUTION1 \n %a \n" Dom.print s in *)+  let _  = Co.bprintflush mydebug "\nBEGIN: Fixpoint: Initialize Worklist \n" in+  let w  = BS.time "Cindex.winit" Ci.winit me.sri in +  let _  = Co.bprintflush mydebug "\nDONE: Fixpoint: Initialize Worklist \n" in+  let _  = Co.bprintflush mydebug "\nBEGIN: Fixpoint Refinement Loop \n" in+  let s  = BS.time "Solve.acsolve"  (acsolve me w) s in+  let _  = Co.bprintflush mydebug "\nDONE: Fixpoint Refinement Loop \n" in+  (* let _ = F.printf "create: SOLUTION2 \n %a \n" Dom.print s in *)+  let s  = if !Co.minquals then simplify_solution me s else s in+  let _  = Co.bprintflush mydebug "\nDONE: Simplify Solution \n" in+  let _  = BS.time "Solve.dump" (dump me) s in+  let _  = Co.bprintflush mydebug "Fixpoint: Testing Solution \n" in+  let u  = BS.time "Solve.unsatcs" (unsat_constraints me) s in+  let _  = if u != [] then F.printf "Unsatisfied Constraints:\n %a" (Misc.pprint_many true "\n" (C.print_t None)) u in+  let cx = if !Co.cex && Misc.nonnull u then Dom.ctr_examples s (Ci.to_list me.sri) u else [] in+  (s, u, cx)++let global_symbols cfg = +     (SM.to_list cfg.Cg.uops)   (* specified globals *) +  ++ (Theories.interp_syms)     (* theory globals    *)++(* API *)+let create cfg kf =+  let gts = global_symbols cfg in+  let sri = cfg.Cg.cs+            >> Co.bprintf mydebug "Pre-Simplify Stats\n%a" print_constr_stats+            |> BS.time  "Constant Env" (List.map (C.add_consts_t gts))+            |> BS.time  "Simplify" FixSimplify.simplify_ts+            >> Co.bprintf mydebug "Post-Simplify Stats\n%a" print_constr_stats+            |> BS.time  "Ref Index" Ci.create cfg.Cg.kuts cfg.Cg.ds+            |> (!Co.slice <?> BS.time "Slice" Ci.slice) in+  let ws  = cfg.Cg.ws+            |> (!Co.slice <?> BS.time "slice_wf" (Ci.slice_wf sri))+            |> BS.time  "Constant EnvWF" (List.map (C.add_consts_wf gts))+            |> PP.validate_wfs in+  let cfg = { cfg with Cg.cs = Ci.to_list sri; Cg.ws = ws } in+  let s   = if !Constants.dump_simp <> "" then Dom.empty else BS.time "Dom.create" (Dom.create cfg) kf in+  let _   = Co.bprintflush mydebug "\nDONE: Dom.create\n" in+  let _   = Co.bprintflush mydebug "\nBEGIN: PP.validate\n" in+  let _   = Ci.to_list sri+            |> BS.time "Validate" (PP.validate cfg.Cg.a (Dom.read s)) in+  let _   = Co.bprintflush mydebug "\nEND: PP.validate\n" in+  ({ sri          = sri+   ; ws           = ws+   (* stat *)+   ; tt           = Timer.create "fixpoint iters"+   ; stat_refines = ref 0+   ; stat_cfreqt  = Hashtbl.create 37+   }, s)+   >> (fun _ -> Co.bprintflush mydebug "DONE: Solve.create\n")++(* API *)+let save fname me s =+  let oc  = open_out fname in+  let ppf = F.formatter_of_out_channel oc in+  F.fprintf ppf "@[%a@] \n" Ci.print me.sri;+  F.fprintf ppf "@[%a@] \n" (Misc.pprint_many true "\n" (C.print_wf None)) me.ws;+  F.fprintf ppf "@[%a@] \n" Dom.print s;+  close_out oc++(* API *)+let cone me = Cindex.data_cones (Ci.to_list me.sri)++end
+ external/fixpoint/solve.mli view
@@ -0,0 +1,34 @@+(* + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++type t++module type SOLVER = sig+  type soln+  type bind+  val create    : bind FixConfig.cfg -> FixConstraint.soln option -> (t * soln) +  val solve     : t -> soln -> (soln * (FixConstraint.t list) * Counterexample.cex list) +  val save      : string -> t -> soln -> unit +  val read      : soln -> FixConstraint.soln+  val min_read  : soln -> FixConstraint.soln+  val read_bind : soln -> Ast.Symbol.t -> bind+  val cone      : t -> FixConstraint.id -> FixConstraint.tag Ast.Cone.t+  (* val meet   : soln -> soln -> soln *)++end++module Make (Dom : SolverArch.DOMAIN) : SOLVER +  with type bind = Dom.bind +  with type soln = Dom.t
+ external/fixpoint/solverArch.ml view
@@ -0,0 +1,44 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++type qbind   = Qualifier.t list++module type DOMAIN = sig+  type t+  type bind+  val empty        : t +  (* val meet         : t -> t -> t *)+  val min_read     : t -> FixConstraint.soln+  val read         : t -> FixConstraint.soln+  val read_bind    : t -> Ast.Symbol.t -> bind+  val top          : t -> Ast.Symbol.t list -> t+  val refine       : t -> FixConstraint.t -> (bool * t)+  val unsat        : t -> FixConstraint.t -> bool+  val create       : bind FixConfig.cfg -> FixConstraint.soln option -> t+  val print        : Format.formatter -> t -> unit+  val print_stats  : Format.formatter -> t -> unit+  val dump         : t -> unit+  val simplify     : t -> t+  val ctr_examples : t -> FixConstraint.t list -> FixConstraint.t list -> Counterexample.cex list +  val mkbind       : qbind -> bind+end
+ external/fixpoint/theories.ml view
@@ -0,0 +1,198 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++module So = Ast.Sort+module Sy = Ast.Symbol+(* module SMT  = SmtZ3.SMTZ3 *)++open ProverArch+open FixMisc.Ops++let set_tycon  = So.tycon "Set_Set"+let t_set a    = So.t_app set_tycon [a]++(* API *)+let is_interp t = t = set_tycon++(* API *)+let emp = ( Sy.of_string "Set_emp"+          , So.t_func 1 [t_set (So.t_generic 0); So.t_bool] )++let sng = ( Sy.of_string "Set_sng"+          , So.t_func 1 [So.t_generic 0; t_set (So.t_generic 0)] )++let mem = ( Sy.of_string "Set_mem"+          , So.t_func 1 [So.t_generic 0; t_set (So.t_generic 0); So.t_bool] )+++let cup = ( Sy.of_string "Set_cup"+          , So.t_func 1 [t_set (So.t_generic 0); t_set (So.t_generic 0); t_set (So.t_generic 0)])++let cap = ( Sy.of_string "Set_cap"+          , So.t_func 1 [t_set (So.t_generic 0); t_set (So.t_generic 0); t_set (So.t_generic 0)])++let dif = ( Sy.of_string "Set_dif"+          , So.t_func 1 [t_set (So.t_generic 0); t_set (So.t_generic 0); t_set (So.t_generic 0)])++let sub = ( Sy.of_string "Set_sub" +          , So.t_func 1 [t_set (So.t_generic 0); t_set (So.t_generic 0); So.t_bool] )++let interp_syms = [emp; sng; mem; cup; cap; dif; sub]++module MakeTheory(SMT : SMTSOLVER): +  (THEORY with type context = SMT.context +          and  type sort    = SMT.sort+          and  type ast     = SMT.ast) +  = struct ++type context = SMT.context+type sort    = SMT.sort+type ast     = SMT.ast+++type appDef  = { sy_name  : Sy.t+               ; sy_sort  : So.t+               ; sy_emb   : SMT.context -> SMT.sort list -> SMT.ast list -> SMT.ast+               }++type sortDef = { so_name  : Ast.Sort.tycon+               ; so_arity : int+               ; so_emb   : SMT.context -> SMT.sort list -> SMT.sort +               }++(* API *)+let sort_name d = d.so_name+let sym_name d  = d.sy_name+let sym_sort d  = d.sy_sort++(***************************************************************************)+(******************** Theory of Sets ***************************************)+(***************************************************************************)++let set_set : sortDef = +  { so_name  = set_tycon +  ; so_arity = 1 +  ; so_emb   = fun c -> function +                 [t] -> SMT.mkSetSort c t+                 | _ -> assertf "Set_set: type mismatch"+  }  ++let set_emp : appDef  = +  { sy_name  = fst emp +  ; sy_sort  = snd emp +  ; sy_emb   = fun c ts es -> match ts, es with+                 | [t], [e] -> SMT.mkRel c Ast.Eq e (SMT.mkEmptySet c t)+                 | _        -> assertf "Set_emp: type mismatch"+  }++let set_sng : appDef  = +  { sy_name = fst sng +  ; sy_sort = snd sng  +  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e] -> SMT.mkSetAdd c (SMT.mkEmptySet c t) e+                 | _        -> assertf "Set_sng: type mismatch"+  }+++let set_mem : appDef  = +  { sy_name = fst mem +  ; sy_sort = snd mem+  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e;es] -> SMT.mkSetMem c e es +                 | _           -> assertf "Set_mem: type mismatch"+  }++let set_cup : appDef  = +  { sy_name = fst cup +  ; sy_sort = snd cup+  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e1;e2] -> SMT.mkSetCup c e1 e2+                 | _            -> assertf "Set_cup: type mismatch"+  }++let set_cap : appDef  = +  { sy_name = fst cap +  ; sy_sort = snd cap +  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e1;e2] -> SMT.mkSetCap  c e1 e2+                 | _            -> assertf "Set_cap: type mismatch"+  }++let set_dif : appDef  = +  { sy_name = fst dif +  ; sy_sort = snd dif+  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e1;e2] -> SMT.mkSetDif c e1 e2 +                 | _            -> assertf "Set_dif: type mismatch"+  }++let set_sub : appDef =+  { sy_name = fst sub +  ; sy_sort = snd sub+  ; sy_emb  = fun c ts es -> match ts, es with+                 | [t], [e1;e2] -> SMT.mkSetSub c e1 e2 +                 | _            -> assertf "Set_dif: type mismatch"+  }++(***************************************************************************)+(********* Wrappers Around Z3 Constructors For Last-Minute Checking ********)+(***************************************************************************)++let app_sort_arity def = match So.func_of_t def.sy_sort with+  | Some (n,_,_) -> n+  | None         -> assertf "Theories: app with non-function symbol %s" +                    (Sy.to_string def.sy_name)++let check_app_arities def tArgs eArgs = match So.func_of_t def.sy_sort with+  | Some (n, ts,_) +     -> asserts (n = List.length tArgs)  +          "Theories: app with mismatched sorts %s" (Sy.to_string def.sy_name);+        asserts (List.length ts = List.length eArgs) +          "Theories: app with mismatched args %s" (Sy.to_string def.sy_name) +  | None         +     -> assertf "Theories: app with non-function symbol %s" +          (Sy.to_string def.sy_name)+++(* API *)+let mk_thy_app def c ts es = +  check_app_arities def ts es;+  def.sy_emb c ts es++(* API *)+let mk_thy_sort def c ts = +  asserts (List.length ts = def.so_arity) +    "Theories: app with mismatched sorts %s" (So.tycon_string def.so_name);+  def.so_emb c ts ++(* API *)+let theories = +  ([set_set], [set_emp; +               set_sng; +               set_mem; +               set_cup; +               set_cap; +               set_dif; +               set_sub])++  +end
+ external/fixpoint/theories.mli view
@@ -0,0 +1,27 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++val is_interp   : Ast.Sort.tycon -> bool+val interp_syms : (Ast.Symbol.t * Ast.Sort.t) list++module MakeTheory(SMT : ProverArch.SMTSOLVER): (ProverArch.THEORY with type context = SMT.context and  type sort = SMT.sort and type ast = SMT.ast) +
+ external/fixpoint/timeout.ml view
@@ -0,0 +1,30 @@+++module M = Mutex+module T = Thread++let get_time () = int_of_float (Unix.time ())++let mk_task =+  fun f x lk (ret, rd) -> let rv = f x in+    M.lock lk; ret := Some rv; rd := true; M.unlock lk++let not_done lk (ret, rd) = +  M.lock lk; let trd = !rd in (M.unlock lk; not(trd))++let fail thread (ret, rd) =+  T.kill thread; ret := None; rd := true ++let do_timeout i f x =+  let task = mk_task f x in+  let (ret, rd) as rr = (ref None, ref false) in+  let stime = get_time () in+  let lk = M.create () in +  let t  = T.create (task lk) rr in+  while not_done lk rr do+    if (get_time () - stime < i) then+      T.yield ()+    else+      fail t rr+  done; !ret+
+ external/fixpoint/timeout.mli view
@@ -0,0 +1,4 @@+(* simple timeout mechanism executes a function for a number of seconds+ * specified by the first argument *)++val do_timeout: int -> ('a -> 'b) -> 'a  -> 'b option
+ external/fixpoint/toARMC.ml view
@@ -0,0 +1,333 @@+(* translation to ARMC *)++module C  = FixConstraint+module StrMap = Map.Make (struct type t = string let compare = compare end)+module StrSet = Set.Make (struct type t = string let compare = compare end)+module Misc = FixMisc open Misc.Ops+++(* Andrey: TODO get rid of grd in t? grd p is a binding v:{v:b|p} *)+(* Andrey: TODO move to fixConstraint.ml? *)+++(* Andrey: TODO move to ast.ml? *)+let pred_is_atomic (p, _) =+  match p with+    | Ast.True | Ast.False | Ast.Bexp _ | Ast.Atom _ -> true+    | Ast.And _ | Ast.Or _ | Ast.Not _ | Ast.Imp _ | Ast.Forall _ -> false++(* +let negate_brel = function+  | Ast.Eq -> Ast.Ne+  | Ast.Ne -> Ast.Eq+  | Ast.Gt -> Ast.Le+  | Ast.Ge -> Ast.Lt+  | Ast.Lt -> Ast.Ge+  | Ast.Le -> Ast.Gt++let deep_negate_pred (p, t) =+  match p with+    | Ast.True -> Ast.pFalse+    | Ast.False -> Ast.pTrue+    | Ast.Atom (e1, r, e2) -> Ast.pAtom (e1, negate_brel r, e2)+    | _ -> Ast.pNot (p, t)+*)++let start_pc = "start"+let loop_pc = "loop"+let error_pc = "error"+let val_vname = "VVVV"+let card_vname = "CARD"+let exists_kv = "EX"+let primed_suffix = "p"+let str__cil_tmp = "__cil_tmp"++type kv_scope = {+  kvs : string list;+  kv_scope : string list StrMap.t+}++let sanitize_symbol s = +  Str.global_replace (Str.regexp "@") "_at_"  s |> Str.global_replace (Str.regexp "#") "_hash_" ++let symbol_to_armc s = Ast.Symbol.to_string s |> sanitize_symbol++let mk_data_var ?(suffix = "") kv v = +  Printf.sprintf "_%s_%s%s%s" +    (sanitize_symbol kv) (sanitize_symbol v) (if suffix = "" then "" else "_") suffix++let constant_to_armc = Ast.Constant.to_string+let bop_to_armc = function +  | Ast.Plus  -> "+"+  | Ast.Minus -> "-"+  | Ast.Times -> "*"+  | Ast.Div   -> "/"+let brel_to_armc = function +  | Ast.Eq -> "="+  | Ast.Ne -> "=\\="+  | Ast.Gt -> ">" (*  ">= 1+" *)+  | Ast.Ge -> ">="+  | Ast.Lt -> "<" (*  "+1 =<" *)+  | Ast.Le -> "=<"+let bind_to_armc (s, t) = (* Andrey: TODO support binders *)+  Printf.sprintf "%s:%s" (symbol_to_armc s) (Ast.Sort.to_string t |> sanitize_symbol)+let rec expr_to_armc (e, _) = +  match e with+    | Ast.Con c -> constant_to_armc c+    | Ast.Var s -> mk_data_var exists_kv (symbol_to_armc s)+    | Ast.App (s, es) ->+	let str = symbol_to_armc s in+	  if es = [] then str else+	    Printf.sprintf "f_%s(%s)" str (List.map expr_to_armc es |> String.concat ", ")+    | Ast.Bin (e1, op, e2) ->+	Printf.sprintf "(%s %s %s)" +	  (expr_to_armc e1) (bop_to_armc op) (expr_to_armc e2)+    | Ast.Ite (ip, te, ee) -> +	Printf.sprintf "ite(%s, %s, %s)" +	  (pred_to_armc ip) (expr_to_armc te) (expr_to_armc ee)+    | Ast.Fld (s, e) -> +	Printf.sprintf "fld(%s, %s)" (expr_to_armc e) (symbol_to_armc s)+and pred_to_armc (p, _) = +  match p with+    | Ast.True -> "1=1"+    | Ast.False -> "0=1"+    | Ast.Bexp e -> expr_to_armc e+    | Ast.Not p -> Printf.sprintf "neg(%s)" (pred_to_armc p) +    | Ast.Imp (p1, p2) -> Printf.sprintf "(neg(%s); %s)" (pred_to_armc p1) (pred_to_armc p2)+    | Ast.And [] -> "1=1"+    | Ast.And [p] -> pred_to_armc p+    | Ast.And (_::_ as ps) -> Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat ", ")+    | Ast.Or [] -> "0=1"+    | Ast.Or [p] -> pred_to_armc p+    | Ast.Or (_::_ as ps) -> Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat "; ")+    | Ast.Atom (e1, r, e2) ->+	Printf.sprintf "%s %s %s" +          (expr_to_armc e1) (brel_to_armc r) (expr_to_armc e2)+    | Ast.Forall (qs,p) -> (* Andrey: TODO support forall *) +	Printf.sprintf "forall([%s], %s)" +          (List.map bind_to_armc qs |> String.concat ", ") +	  (pred_to_armc p)+++let mk_kv_scope out ts wfs =+  output_string out "% kv -> scope:\n";+  let kvs = List.map C.kvars_of_t ts |> List.flatten |> List.map snd+    |> List.map symbol_to_armc |> Misc.sort_and_compact in+  let kv_scope =+    List.fold_left+      (fun m wf ->+	   match C.reft_of_wf wf |> C.ras_of_reft with+	     | [C.Kvar([], kvar)] ->+		 let v = symbol_to_armc kvar in+		 let scope = +		   card_vname :: val_vname ::+		     (C.env_of_wf wf |> C.bindings_of_env |> List.map fst |> List.map symbol_to_armc+		     |> List.filter (fun s -> not (Misc.is_prefix str__cil_tmp s)) |> List.sort compare) in+		   Printf.fprintf out "%% %s -> %s\n"+		     v (String.concat ", " scope);+		   StrMap.add v scope m+	     | _ ->  (* Andrey: TODO print ill-formed wf *)+		 failure "ERROR: kname_scope_map: ill-formed wf"+      ) StrMap.empty wfs in+    {kvs = kvs; kv_scope = kv_scope}++let mk_data ?(suffix = "") ?(skip_kvs = []) s = +  Printf.sprintf "[%s]"+    (List.map +       (fun kv ->+	  try +	    StrMap.find kv s.kv_scope |> +		List.map (mk_data_var ~suffix:(if List.mem kv skip_kvs then "" else suffix) kv)+	  with Not_found -> failure "ERROR: rel_state_vs: scope not found for %s" kv+       ) s.kvs |> List.flatten |> String.concat ", ")++let mk_var2names state = +  List.map+    (fun kv ->+       List.map +	 (fun v -> +	    Printf.sprintf "(%s, \'%s_%s\')"+	      (mk_data_var kv v)  kv v+	 ) (StrMap.find kv state.kv_scope) |> String.concat ", "+    ) state.kvs |> String.concat ", "++let mk_skip_update state kvs = +  if kvs = [] then "1=1" else+    List.map+      (fun kv ->+	 List.map +	   (fun v -> +	      Printf.sprintf "%s = %s"+		(mk_data_var ~suffix:primed_suffix kv v) (mk_data_var kv v)+	   ) (StrMap.find kv state.kv_scope) |> String.concat ", "+      ) kvs |> String.concat ", "++let mk_update_str from_vs to_vs updates = +  List.map2+    (fun v vp ->+       Printf.sprintf "%s = %s" vp (try StrMap.find v updates with Not_found -> v)+    ) from_vs to_vs |> String.concat ", "++let split_scope scope = +  match scope with+    | card :: value :: data -> card, value, data+    | _ -> failure "ERROR: split_scope: empty scope %s" (String.concat ", " scope)++let reft_to_armc ?(suffix = "") state reft = +  let vv = C.vv_of_reft reft |> symbol_to_armc in+  let rs = C.ras_of_reft reft in+    if rs = [] then "1=1" else+      List.map+	(function+	   | C.Conc pred -> pred_to_armc pred+	   | C.Kvar (subs, sym) -> +	       let subs_map = List.fold_left+		 (fun m (s, e) -> StrMap.add (symbol_to_armc s) e m) StrMap.empty subs in+	       let find_subst v default = +		 try StrMap.find v subs_map |> expr_to_armc with Not_found -> default in+	       let kv = symbol_to_armc sym in+	       let card, value, data = StrMap.find kv state.kv_scope |> split_scope in+		 Printf.sprintf "%s = 1" (mk_data_var ~suffix:suffix  kv card) +		 :: Printf.sprintf "%s = %s" +		   (mk_data_var ~suffix:suffix kv value) +		   (find_subst vv (mk_data_var exists_kv vv)) +		 :: List.map+		   (fun v -> +		      Printf.sprintf "%s = %s"+			(mk_data_var ~suffix:suffix kv v)+			(find_subst v (mk_data_var exists_kv v))+		   ) data |> String.concat ", "+	) rs |> String.concat ", "++let mk_rule from_pc from_data to_pc to_data annot_guards annot_updates id = +(*+  let unless_error l = if to_pc = error_pc then to_pc else l in+  let from_pc, to_pc = +    if id = "t_init" then+      from_pc, unless_error "l0"+    else if List.mem id ["11"; "12"; "13"; "14"; "15"; "16"; "17"; "18"; "19"] then+      "l0", unless_error "l1"+    else if List.mem id ["1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "20"; "21"; "22"; "23"; "24"; "25"; "26"; "27"; "28"] then+      "l1", unless_error "l1"+    else if List.mem id ["29"; "30"; "31"; "32"; "33"; "34"; "35"; "36"; "37"; "38"; "39"; "40"; "41"; "42"; "43"; "44"; "45"] then+      "l1", unless_error "l2"+    else+      "l2", unless_error "l2"+  in+*)+  let rec annot_conj_to_armc = function+    | (g, a) :: rest -> +	if rest = [] then Printf.sprintf "\n   %s \t%% %s\n  ]," g a+	else Printf.sprintf "\n   %s, \t%% %s%s" g a (annot_conj_to_armc rest)+    | [] -> "],"+  in+    Printf.sprintf+      "+r(p(pc(%s), data(%s)), +  p(pc(%s), data(%s)),+  [%s+  [%s+  %s).+" +      from_pc from_data to_pc to_data+      (annot_conj_to_armc annot_guards)+      (annot_conj_to_armc annot_updates)+      id++let t_to_armc from_data to_data state t = +  let grd = C.grd_of_t t in+  let lhs = C.lhs_of_t t in+  let rhs = C.rhs_of_t t in+  let rhs_s = C.reft_to_string rhs in+  let tag = try string_of_int (C.id_of_t t) with _ -> +    failure "ERROR: t_to_armc: anonymous constraint %s" (C.to_string t) in+  let annot_guards = +    List.map+      (fun (bv, reft) ->+	 reft_to_armc state (C.theta [(C.vv_of_reft reft, Ast.eVar bv)] reft),+	 C.binding_to_string (bv, reft)+      ) (C.env_of_t t |> C.bindings_of_env) +    ++ [(pred_to_armc grd, Ast.Predicate.to_string grd); +	(reft_to_armc state lhs, "|- " ^ (C.reft_to_string lhs))] in+  let ps, kvs =  +    List.fold_left (fun (ps', kvs') refa ->+		      match refa with+			| C.Conc p -> p::ps', kvs'+			| C.Kvar (subs, sym) -> ps', (subs, sym)::kvs'+		   ) ([], []) (C.ras_of_reft rhs) in+    (if ps <> [] then+       [mk_rule loop_pc from_data error_pc to_data annot_guards +	  [(Ast.pAnd ps |> Ast.pNot |> pred_to_armc, "<: " ^ rhs_s)]+	  tag]+     else +       [])+    +++      (List.map +	 (fun (_, sym) ->+	    let kv = symbol_to_armc sym in+	    let skip_kvs = List.filter (fun kv' -> kv <> kv') state.kvs in+	      mk_rule loop_pc from_data loop_pc +		(mk_data ~suffix:primed_suffix ~skip_kvs:skip_kvs state)+		annot_guards +		[(reft_to_armc ~suffix:primed_suffix state rhs, "<: " ^ rhs_s)]+		tag+	 ) kvs)++let to_armc out ts wfs =+  print_endline "Translating to ARMC.";+  let state = mk_kv_scope out ts wfs in+  let from_data =  mk_data state in+  let to_data = mk_data ~suffix:primed_suffix state in+    Printf.fprintf out+      ":- multifile r/5,implicit_updates/0,var2names/2,preds/2,trans_preds/3,cube_size/1,start/1,error/1,refinement/1,cutpoint/1,invgen_template/2,invgen_template/1,cfg_exit_relation/1,stmtsrc/2,strengthening/2.++refinement(inter).+cube_size(1).++start(pc(%s)).+error(pc(%s)).+cutpoint(pc(%s)).++preds(p(_, data(%s)), [%s]).++trans_preds(p(_, data(%s)), p(_, data(%s)), []).++var2names(p(_, data(%s)), [%s]).+"+      start_pc error_pc loop_pc +      from_data (List.map (fun kv ->+			     let card, _, _ = StrMap.find kv state.kv_scope |> split_scope in+			     let kv_card = mk_data_var kv card in+			       Printf.sprintf "%s = 0, %s = 1" kv_card kv_card+			  ) state.kvs |> String.concat ", ") (* preds *)+      from_data to_data (* trans_preds *)+      from_data (mk_var2names state); (* var2names *)+    output_string out +      (mk_rule start_pc from_data loop_pc to_data [] +	 [(List.map +	     (fun kv -> +		let card, _, _ = StrMap.find kv state.kv_scope |> split_scope in+		  Printf.sprintf "%s = 0" (mk_data_var ~suffix:primed_suffix kv card)+	     ) state.kvs |> String.concat ", ", +	   "")]+         "t_init");+    List.iter (fun t -> t_to_armc from_data to_data state t |> List.iter (output_string out)) ts+++(*+  make -f Makefile.fixtop && ./f -latex /tmp/main.tex -armc /tmp/a.pl tests/pldi08-max.fq && cat /tmp/a.pl++tests:++for file in `ls pldi08-*-atom.fq`; do ../f -latex /tmp/main.tex -armc /tmp/a.pl $file; head -n 1 /tmp/a.pl; armc a.pl | grep correct; done++pldi08-arraymax-atom.fq  pass+pldi08-max-atom.fq       pass+pldi08-foldn-atom.fq     pass+pldi08-sum-atom.fq       pass+mask-atom.fq             pass+samples-atom.fq          pass ++test00.c                 pass++*)
+ external/fixpoint/toDot.ml view
@@ -0,0 +1,173 @@+module C = FixConstraint+module StrSet = Set.Make (struct type t = string let compare = compare end)+module StrStrSet = Set.Make (struct type t = StrSet.t let compare = StrSet.compare end)++module S2 = StrSet+module S3 = StrStrSet+module Misc = FixMisc open Misc.Ops+++module V = struct+  type t = string+  let compare = Pervasives.compare+  let hash = Hashtbl.hash+  let equal = (=)+end+module E = struct+  type t = string+  let compare = Pervasives.compare+  let default = ""+end+++module G = Graph.Persistent.Digraph.ConcreteLabeled(V)(E)++module Display = struct+  include G+  let vertex_name v = "\"" ^ String.escaped v ^ "\""+  let graph_attributes _ = []+  let default_vertex_attributes _ = []+  let vertex_attributes _ = []+  let default_edge_attributes _ = []+  let edge_attributes e = [`Label (G.E.label e)]+  let get_subgraph _ = None+end++module DotOutput = Graph.Graphviz.Dot(Display)++module SCC = Graph.Components.Make(G) ++let vertices_of_graph g = G.fold_vertex (fun v vs -> v::vs) g []+let edges_e_of_graph g = G.fold_edges_e (fun e es -> e::es) g []++let set_of_strings = List.fold_left (fun s x -> StrSet.add x s) StrSet.empty++let set_to_string default s = +  if StrSet.is_empty s then default else StrSet.elements s |> List.map String.escaped |> String.concat ", "++let edges_e_to_graph es = List.fold_left (fun g e -> G.add_edge_e g e) G.empty es++(* k_1, ..., k_n <: k_0 depends on l_1, ..., l_m <: l_0 iff l_0 = k_i for some 1 \leq i \leq n *)+++let t_to_dep t = +  let env = C.env_of_t t in+  let lhs = C.lhs_of_t t in+  let rhs = C.rhs_of_t t in+  let tag = try string_of_int (C.id_of_t t) with _ -> +    failure "ERROR: t_to_edge: anonymous constraint %s" (C.to_string t) in+  let src =+    C.kvars_of_reft lhs :: List.map (fun b -> snd b |> C.kvars_of_reft) (C.bindings_of_env env) |> +	List.flatten |> List.map snd |> List.map Ast.Symbol.to_string |> set_of_strings in+  let dst = C.kvars_of_reft rhs |> List.map snd |> List.map Ast.Symbol.to_string |> set_of_strings in+    src, tag, dst++let sccs_to_dot g prefix =+  let n, scc_of = SCC.scc g in+  let vs = vertices_of_graph g in+    Printf.printf "%s #scc = %d\n" prefix n;+    for i = 0 to n-1 do+      let scc, rest = List.partition (fun v -> scc_of v = i) vs in+      let g' = List.fold_left (fun g'' v -> G.remove_vertex g'' v) g rest in +      let out = open_out (Printf.sprintf "/tmp/%s-scc-%d.dot" prefix i) in+	Printf.printf "%s scc %d %s\n" prefix i (String.concat ", " scc);+	DotOutput.output_graph out g';+	close_out out+    done+++let mk_dep_graph ts =+  let ds' = List.map t_to_dep ts in+  let ds = List.map (fun (src, tag, dst) ->+		       (if StrSet.is_empty src then StrSet.singleton "start" else src),+		       tag,+		       (if StrSet.is_empty dst then StrSet.singleton "error" else dst)+		    ) ds' in+  let g = +    List.map+      (fun (src, tag, dst) ->+	 Misc.map_partial+	   (fun (src', tag', dst') ->+	      let inter = StrSet.inter dst src' in+		if StrSet.is_empty inter then +		  None+		else +		  begin+		    Printf.printf "self loop %s\n" tag;+		    Some(G.E.create tag (set_to_string "" inter) tag') (* tag depends on tag' via inter   *)+		  end+	   ) ds+      ) ds |> List.flatten |> edges_e_to_graph in+  let srcs = List.fold_left (fun xs (src, tag, dst) -> src::xs) [] ds' in++(*+  let veanu = +    List.fold_left (fun xs src ->+		      S3.fold (fun x ys -> +				 ys |> S3.add (S2.diff x src) |> S3.add (S2.diff src x) |> S3.add (S2.inter x src) +			      ) xs S3.empty +		   ) (List.hd srcs |> S3.singleton) (List.tl srcs) in+*)+  let oc = open_out "/tmp/dep.dot" in+    DotOutput.output_graph oc g;+    close_out oc;+    sccs_to_dot g "dep";+    print_endline "start deps";+    List.iter (fun (src, tag, dst) -> +		 Printf.printf "%s <: %s  (%s)\n" (set_to_string "" src) (set_to_string "" dst) tag) ds;+    print_endline "end deps";+    print_endline "start dep graph";+    List.iter (fun e -> +		 Printf.printf "%s - %s -> %s\n" (G.E.src e) (G.E.label e) (G.E.dst e)) (edges_e_of_graph g);+    print_endline "end dep graph"+(*+    Printf.printf "Veanu %d sets\n%s\n" +      (S3.cardinal veanu)+      (S3.fold (fun x s -> +		  (Printf.sprintf "{%s}" (set_to_string "empty" x))::s+	       ) veanu [] |> String.concat ",\n")+*)+++let other_graph ts =+  let deps = List.map t_to_dep ts in+  let srcs, dsts = List.map (fun (s, _, d) -> s, d) deps |> List.split in+  let es = List.map (fun (src, tag, dst) ->+		       G.E.create (set_to_string "start" src) tag (set_to_string "error" dst) +		    ) deps in+  let es' = List.fold_left (fun es'' dst ->+			      Misc.map_partial (fun src -> +						  if StrSet.diff dst src |> StrSet.is_empty then+						    Some (G.E.create (set_to_string "error" dst) "" (set_to_string "start" src))+						  else+						    None+					       ) srcs ++ es''+			   ) es dsts in+  let g = List.fold_left (fun g e -> G.add_edge_e g e) G.empty es' in+    g++let t_to_edge t = +  let srcs', tag, dsts' = t_to_dep t in+  let srcs = if StrSet.is_empty srcs' then ["start"] else StrSet.elements srcs' in+  let dsts = if StrSet.is_empty dsts' then ["error"] else StrSet.elements dsts' in+    List.fold_left (fun es src -> List.map (G.E.create src tag) dsts ++ es) [] srcs+++    ++let to_dot oc ts =+  let _ =  List.fold_left (fun g e -> G.add_edge_e g e ) G.empty (List.map t_to_edge ts |> List.flatten) in+  let g = other_graph ts in+  let vs = G.fold_vertex (fun v vs' -> v::vs') g [] in+  let n, scc_of = SCC.scc g in+    DotOutput.output_graph oc g;+    Printf.printf "#scc = %d\n" n;+    for i = 0 to n-1 do+      let scc, rest = List.partition (fun v -> scc_of v = i) vs in+      let g' = List.fold_left (fun g'' v -> G.remove_vertex g'' v) g rest in +      let out = open_out (Printf.sprintf "/tmp/scc-%d.dot" i) in+	Printf.printf "scc %d %s\n" i (String.concat ", " scc);+	DotOutput.output_graph out g';+	close_out out+    done;+    mk_dep_graph ts
+ external/fixpoint/toHC.ml view
@@ -0,0 +1,613 @@+(* translation to HC'ARMC *)+++module C  = FixConstraint+module Co = Constants +module Sy = Ast.Symbol+module Su = Ast.Subst+module P = Ast.Predicate+module E = Ast.Expression+module StrMap = Map.Make (struct type t = string let compare = compare end)+module StrSet = Set.Make (struct type t = string let compare = compare end)+module Misc = FixMisc open Misc.Ops++let strlist_to_strset = List.fold_left (fun s x -> StrSet.add x s) StrSet.empty+++let armc_true = "1=1"+let armc_false = "0=1"+(*+let armc_true = "true"+let armc_false = "false"+*)+let loop_pc = "loop"+let start_pc = "start"+let error_pc = "error"+let val_vname = "AA_0"+let card_vname = "CARD"+let exists_kv = "EX"+let primed_suffix = "p"+let str__cil_tmp = "__cil_tmp"++type kv_scope = {+  kvs : string list;+  kv_scope : string list StrMap.t;+  sol : Ast.pred list Sy.SMap.t;+}++type horn_clause = {+  body_pred : Ast.pred;+  body_kvars : (Su.t * Sy.t) list;+  head_pred : Ast.pred;+  head_kvar_opt : (Su.t * Sy.t) option;+  tag : string;+}++let sanitize_symbol s = +  Str.global_replace (Str.regexp "@") "_at_"  s |> Str.global_replace (Str.regexp "#") "_hash_" |>+      Str.global_replace (Str.regexp "\\.") "_dot_" |> Str.global_replace (Str.regexp "'") "_q_" ++let symbol_to_armc s = Sy.to_string s |> sanitize_symbol++let mk_data_var ?(suffix = "") kv v = +  Printf.sprintf "_%s_%s%s%s" +    (sanitize_symbol v) (sanitize_symbol kv) (if suffix = "" then "" else "_") suffix++let mk_data ?(suffix = "") ?(skip_kvs = []) s = +  Printf.sprintf "[%s]"+    (List.map +       (fun kv ->+	  try +	    StrMap.find kv s.kv_scope |> +		List.map (mk_data_var ~suffix:(if List.mem kv skip_kvs then "" else suffix) kv)+	  with Not_found -> failure "ERROR: rel_state_vs: scope not found for %s" kv+       ) s.kvs |> List.flatten |> String.concat ", ")++let constant_to_armc = Ast.Constant.to_string+let bop_to_armc = function +  | Ast.Plus  -> "+"+  | Ast.Minus -> "-"+  | Ast.Times -> "*"+  | Ast.Div   -> "/"+let brel_to_armc = function +  | Ast.Eq -> "="+  | Ast.Ne -> "=\\="+  | Ast.Gt -> ">"+  | Ast.Ge -> ">="+  | Ast.Lt -> "<"+  | Ast.Le -> "=<"+let bind_to_armc (s, t) = (* Andrey: TODO support binders *)+  Printf.sprintf "%s:%s" (symbol_to_armc s) (Ast.Sort.to_string t |> sanitize_symbol)+let rec expr_to_armc expr = +  let e = E.unwrap expr in+    match e with+      | Ast.Con c -> constant_to_armc c+      | Ast.Var s -> mk_data_var exists_kv (symbol_to_armc s)+      | Ast.App (s, es) -> +	  if !Co.purify_function_application then "_" else+	    let str = symbol_to_armc s in+	      if es = [] then str else+		Printf.sprintf "f_%s(%s)" str (List.map expr_to_armc es |> String.concat ", ")+      | Ast.Bin (e1, op, e2) ->+	  Printf.sprintf "(%s %s %s)" +	    (expr_to_armc e1) (bop_to_armc op) (expr_to_armc e2)+      | Ast.Ite (ip, te, ee) -> +	  Printf.sprintf "ite(%s, %s, %s)" +	    (pred_to_armc ip) (expr_to_armc te) (expr_to_armc ee)+      | Ast.Fld (s, e) -> +	  Printf.sprintf "fld(%s, %s)" (expr_to_armc e) (symbol_to_armc s) +      | _ -> failwith (Printf.sprintf "expr_to_armc: %s" (E.to_string expr))+and pred_to_armc pred = +  let p = P.unwrap pred in +    match p with+      | Ast.True -> armc_true+      | Ast.False -> armc_false+      | Ast.Bexp e -> Printf.sprintf "%s = 1" (expr_to_armc e)+      | Ast.Not (Ast.True, _) -> armc_false+      | Ast.Not (Ast.False, _) -> armc_true+      | Ast.Not p -> Printf.sprintf "neg(%s)" (pred_to_armc p) +      | Ast.Imp (p1, p2) -> Printf.sprintf "imp(%s, %s)" (pred_to_armc p1) (pred_to_armc p2)+      | Ast.And [] -> armc_true+      | Ast.And [p] -> pred_to_armc p+      | Ast.And (_::_ as ps) -> +	  Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat ", ")+      | Ast.Or [] -> armc_false+      | Ast.Or [p] -> pred_to_armc p+      | Ast.Or (_::_ as ps) -> Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat "; ")+      | Ast.Atom (e1, Ast.Eq, (Ast.Ite(ip, te, ee), _)) ->+	  let ip_str = pred_to_armc ip in+	  let e1_str = expr_to_armc e1 in+	    Printf.sprintf "((%s, %s = %s); (neg(%s), %s = %s))"+	      ip_str e1_str (expr_to_armc te) +	      ip_str e1_str (expr_to_armc ee) +      | Ast.Atom (e1, r, e2) ->+	  Printf.sprintf "%s %s %s" +            (expr_to_armc e1) (brel_to_armc r) (expr_to_armc e2)+      | Ast.Forall (qs,p) -> (* Andrey: TODO support forall *) +	  Printf.sprintf "forall([%s], %s)" +            (List.map bind_to_armc qs |> String.concat ", ") +	    (pred_to_armc p)++let preds_kvars_of_reft reft =+  List.fold_left +    (fun (ps, ks) r ->+       match r with+	 | C.Conc p -> p :: ps, ks+	 | C.Kvar (subs, kvar) -> ps, (subs, kvar) :: ks+    ) ([], []) (C.ras_of_reft reft)++let preds_to_pred ps =+  match ps with +    | [] -> Ast.pTrue+    | [p] -> p+    | _ :: _ -> Ast.pAnd ps	 ++let rec flatten_pAnd pred =+  match P.unwrap pred with+    | Ast.And [] -> []+    | Ast.And [p] -> flatten_pAnd p+    | Ast.And ps -> List.map flatten_pAnd ps |> List.flatten+    | _ -> [pred]++let t_to_horn_clause t =+  let lhs_ps, lhs_ks = C.lhs_of_t t |> preds_kvars_of_reft in+  let body_ps, body_ks = +    Sy.SMap.fold +      (fun bv reft (ps, ks) -> +	 let ps', ks' = preds_kvars_of_reft (C.theta (Su.of_list [(C.vv_of_reft reft, Ast.eVar bv)]) reft) in+	   List.rev_append ps' ps, List.rev_append ks' ks+      ) (C.env_of_t t) (C.grd_of_t t :: lhs_ps, lhs_ks) in+  let head_ps, head_ks = C.rhs_of_t t |> preds_kvars_of_reft in+  let head_kvar_opt =+    match head_ks with +      | [] -> None+      | [head_kvar] -> Some head_kvar+      | _ ->+	  failwith (Printf.sprintf "t_to_horn_clause: multiple k's in rhs of %d" (C.id_of_t t));+  in+    {+      body_pred = Ast.pAnd body_ps |> flatten_pAnd |> preds_to_pred; +      body_kvars = body_ks; +      head_pred = Ast.pAnd head_ps |> flatten_pAnd |> preds_to_pred;+      head_kvar_opt = head_kvar_opt;+      tag = C.id_of_t t |> string_of_int;+    }++let horn_clause_to_string hc = +  Printf.sprintf "%s: %s, %s :- %s, %s."+    hc.tag +    (P.to_string hc.head_pred)+    (match hc.head_kvar_opt with+       | Some (subs, kvar) -> C.refa_to_string (C.Kvar (subs, kvar))+       | None -> "none"+    )+    (P.to_string hc.body_pred)+    (List.map (fun (subs, kvar) -> C.refa_to_string (C.Kvar (subs, kvar))) hc.body_kvars |> String.concat ", ")+++module CFGNodeSet = Set.Make (struct type t = StrSet.t let compare = StrSet.compare end)+++module DepV = struct+  type t = string+  let compare = Pervasives.compare+  let hash = Hashtbl.hash+  let equal = (=)+end+module DepE = struct+  type t = string+  let compare = Pervasives.compare+  let default = ""+end+module DepG = Graph.Persistent.Digraph.ConcreteLabeled(DepV)(DepE)++module Display = struct+  include DepG+  let vertex_name v = DepG.V.label v+  let graph_attributes _ = []+  let default_vertex_attributes _ = []+  let vertex_attributes _ = []+  let default_edge_attributes _ = []+  let edge_attributes _ = []+  let get_subgraph _ = None+end+module DepGToDot = Graph.Graphviz.Dot(Display)+module DepGOper = Graph.Oper.P(DepG)++module DepGSCC = Graph.Components.Make(DepG)++module G = Graph.Pack.Digraph++let hc_to_dep hc =+  (match hc.head_kvar_opt with+     | Some (_, sym) -> Some (symbol_to_armc sym) +     | None -> None+  ),+  List.map (fun (_, sym) -> symbol_to_armc sym) hc.body_kvars |> List.sort compare++(*+let mk_cfg state hcs =+  let nodes = ref (CFGNodeSet.singleton StrSet.empty) in+  let nodes_size = ref 0 in+  let nodes_size' = ref 1 in+    while !nodes_size < !nodes_size' do+      nodes_size := CFGNodeSet.cardinal !nodes;+      List.iter (fun hc ->+		   let heads, body = hc_to_dep hc in+		   let body_set = List.fold_left (fun sofar b -> StrSet.add b sofar) StrSet.empty body in+		     List.iter (fun node ->+				  List.iter (fun head ->+					       if StrSet.subset body_set node then+						 nodes := CFGNodeSet.add (StrSet.add head node) !nodes+					    ) heads+			       ) (CFGNodeSet.elements !nodes)+		) hcs;+      nodes_size' := CFGNodeSet.cardinal !nodes+    done;+    Printf.printf "nodes: %s\n" (List.sort compare state.kvs |> String.concat ", ");+    CFGNodeSet.iter (fun node -> +		       Printf.printf "node: %s\n" (StrSet.elements node |> List.sort compare |> String.concat ", ")+		    ) !nodes;+    let g = G.create () in+      List.iter (fun hc -> +		   let heads, body = hc_to_dep hc in+		     List.iter (fun b -> +				  List.iter (fun head -> +					       G.add_edge g (G.V.create 1) (G.V.create 2)+					    ) heads+			       ) body+		) hcs;+    let depg = +      List.fold_left+	(fun g hc -> +	   let heads, body = hc_to_dep hc in+	     List.fold_left +	       (fun g' b -> +		  List.fold_left +		    (fun g'' head -> +		       DepG.add_edge_e g'' (DepG.E.create b (* hc.tag *) "" head)+		    ) g' heads+	       ) g body+	) DepG.empty hcs in+    let dep_cs = +      List.fold_left+	(fun g hc -> +	   let heads, _ = hc_to_dep hc in+	     List.fold_left +	       (fun g' hc' -> +		  (* check if heads intersect body' *)+		  let _, body' = hc_to_dep hc' in+		    if hc.tag <> hc'.tag && List.exists (fun head -> List.mem head body') heads then +		      DepG.add_edge g' hc.tag hc'.tag+		    else +		      g'+	       ) g hcs+	) DepG.empty hcs in+    let out = open_out "/var/tmp/awesome/g.dot" in+      DepGToDot.output_graph out depg;+      close_out out;+    let out = open_out "/var/tmp/awesome/t.dot" in+      DepGToDot.output_graph out (DepGOper.transitive_closure depg);+      close_out out;+    let out = open_out "/var/tmp/awesome/cs.dot" in+      DepGToDot.output_graph out dep_cs;+      close_out out+*)+    ++let kvar_to_hc_armcs ?(suffix = "") state (subs, sym) = +  let subs_map = List.fold_left (fun m (s, e) -> StrMap.add (symbol_to_armc s) e m) StrMap.empty (Su.to_list subs) in+  let find_subst v default = try StrMap.find v subs_map |> expr_to_armc with Not_found -> default in+  let kv = symbol_to_armc sym in+    try+      let scope = StrMap.find kv state.kv_scope in +	Printf.sprintf "%s(%s)" +	  kv (List.map (mk_data_var ~suffix:suffix kv) scope |> String.concat ", ")+	:: List.map (fun v -> +		       Printf.sprintf "%s = %s" +			 (mk_data_var ~suffix:suffix kv v) (find_subst v (mk_data_var exists_kv v))+		    ) scope +    with Not_found -> [armc_true] (* input variable *)++let kvar_to_armcs ?(suffix = "") ?(with_card=true) state (subs, sym) = +  let subs_map = +    List.fold_left (fun m (s, e) -> StrMap.add (symbol_to_armc s) (expr_to_armc e) m) StrMap.empty (Su.to_list subs) in+  let find_subst v default = try StrMap.find v subs_map with Not_found -> default in+  let kv = symbol_to_armc sym in+  try+    let scope = StrMap.find kv state.kv_scope in+    let card_armc, data = +      if with_card then+	[Printf.sprintf "%s = 1" (mk_data_var ~suffix:suffix kv card_vname)], List.tl scope+      else +	[], scope+    in+      card_armc+      @ List.map (fun v -> +		     Printf.sprintf "%s = %s" +		       (mk_data_var ~suffix:suffix kv v) (find_subst v (mk_data_var exists_kv v))+		  ) data |> String.concat ", "+  with Not_found -> armc_true (* input variable *)++let hc_to_rule state hc =+  let mk_rule head body tag = Printf.sprintf "rule(%s, %s, [%s])." tag head body in+  let body = +    pred_to_armc hc.body_pred :: (List.map (kvar_to_hc_armcs state) hc.body_kvars |> List.flatten) |>  +	String.concat ", " in+  let prules = +    if P.is_tauto hc.head_pred then []+    else [mk_rule error_pc  (Printf.sprintf "%s, %s" body (Ast.pNot hc.head_pred |> pred_to_armc)) hc.tag] in+  let krules =+    match hc.head_kvar_opt with+      | Some kvar ->+	 let head_armcs = kvar_to_hc_armcs ~suffix:primed_suffix state kvar in+	   [mk_rule +	     (List.hd head_armcs) (* kv *)+	     (body :: (List.tl head_armcs (* subs *)) |> String.concat ", ")+	     hc.tag]+      | None -> []+  in+    krules @ prules++let mk_rule from_pc from_data to_pc to_data guard update tag = +  Printf.sprintf "r(p(pc(%s), data(%s)),\np(pc(%s), data(%s)),\n[%s],\n[%s], %s).%s"+    from_pc from_data to_pc to_data guard update tag+    (if guard = "" && update = "" then Printf.sprintf "\nid_trans(%s)." tag else "")++let hc_to_armc ?(cfg=false) ?(with_card=true) ?(with_dataflow=false) state hc = +  let from_data = mk_data state in+  let to_data = mk_data ~suffix:primed_suffix state in+  let body = pred_to_armc hc.body_pred :: List.map (kvar_to_armcs ~with_card:with_card state) hc.body_kvars in+  let body_kv_strs = hc_to_dep hc |> snd |> List.filter (fun kv -> StrMap.mem kv state.kv_scope) in+  let prules =+    if P.is_tauto hc.head_pred then []+    else +      mk_rule +	(if cfg then Printf.sprintf "src_%s" hc.tag else loop_pc)+	from_data error_pc to_data +	((Ast.pNot hc.head_pred |> pred_to_armc) :: body |> String.concat ",\n") "" hc.tag+      :: +	if with_dataflow then+	  [Printf.sprintf "dataflow_transition(%s, [%s], [])." hc.tag (String.concat ", " body_kv_strs)]+	else [] in+  let krules =+    match hc.head_kvar_opt with+      | Some ((subs, sym) as kvar) ->+	  let kv = symbol_to_armc sym in+	  let skip_kvs = List.filter (fun kv' -> kv <> kv') state.kvs in+	    mk_rule +	      (if cfg then Printf.sprintf "src_%s" hc.tag else loop_pc)+	      from_data +	      (if cfg then Printf.sprintf "dst_%s" hc.tag else loop_pc)+	      (mk_data ~suffix:primed_suffix ~skip_kvs:skip_kvs state) +	      (body |> String.concat ",\n") +	      (kvar_to_armcs ~with_card:with_card ~suffix:primed_suffix state kvar) +	      hc.tag+	    ::+	      if with_dataflow then+		[Printf.sprintf "dataflow_transition(%s, [%s], [%s])." hc.tag (String.concat ", " body_kv_strs) kv]+	      else []+      | None -> []+  in+    krules @ prules++let mk_hc_var2names state = +  List.map+    (fun kv ->+       Printf.sprintf "var2names(p(pc(%s), data(%s)), [%s])."+	 kv+	 (List.map (mk_data_var kv) (StrMap.find kv state.kv_scope) |> String.concat ", ")+	 (List.map +	    (fun v -> +	       Printf.sprintf "(%s, \'%s_%s\')" (mk_data_var kv v)  v kv+	    ) (StrMap.find kv state.kv_scope) |> String.concat ", ")+    ) state.kvs |> String.concat "\n"++let mk_var2names state = +  Printf.sprintf "var2names(p(pc(_), data(%s)), [%s])."+    (mk_data state)+    (List.map+       (fun kv ->+	  List.map +	    (fun v -> +	       Printf.sprintf "(%s, \'%s_%s\')" (mk_data_var kv v)  v kv+	    ) (StrMap.find kv state.kv_scope) |> String.concat ", "+       ) state.kvs |> String.concat ", ")++let mk_hc_preds state = +  List.map+    (fun kv ->+       Printf.sprintf "preds(p(pc(%s), data(%s)), [])."+	 kv+	 (List.map (mk_data_var kv) (StrMap.find kv state.kv_scope) |> String.concat ", ")+    ) state.kvs |> String.concat "\n"++let mk_preds ?(with_card = true) state = +  let preds = +    if with_card then+      List.map (fun kv ->+		  let card = StrMap.find kv state.kv_scope |> List.hd in+		  let kv_card = mk_data_var kv card in+		    Printf.sprintf "%s = 0, %s = 1" kv_card kv_card+	       ) state.kvs |> String.concat ", "+    else +      ""+  in+    Printf.sprintf "preds(p(pc(_), data(%s)), [%s])." (mk_data state) preds++let mk_start_rule state = +  mk_rule start_pc (mk_data state) loop_pc (mk_data ~suffix:primed_suffix state) "" +    (List.map (fun kv ->+		 let card = StrMap.find kv state.kv_scope |> List.hd in+		   Printf.sprintf "%s = 0" (mk_data_var ~suffix:primed_suffix kv card)+	      ) state.kvs |> String.concat ", ")+    "start_t"++let find_kv_wf_scope wfs kv = +  let wf =+    try List.find (fun wf -> +		     match C.reft_of_wf wf |> C.kvars_of_reft with+		       | [(subs, kvar)] -> Su.is_empty subs && kv = symbol_to_armc kvar+		       | _ -> false+		  ) wfs +    with Not_found -> failwith (Printf.sprintf "find_wf_scope: %s" kv)+  in+    Sy.SMap.fold (fun kvar _ sofar -> StrSet.add (symbol_to_armc kvar) sofar) (C.env_of_wf wf) StrSet.empty++(* map each k variable to variables in its scope *)+(* k variables no appearing in any rhs don't have any scope *)+let mk_kv_scope ?(with_card=true) ?(hcs=[]) out ts wfs sol =+  (*+  List.iter (fun wf -> +	       let env = C.env_of_wf wf in+	       let bvs = Sy.SMap.fold (fun bv _ sofar -> symbol_to_armc bv :: sofar) env [] in+		 Printf.printf "wf: %s : %s\n" (C.reft_of_wf wf |> C.reft_to_string) (String.concat ", " bvs)+	    ) wfs;+  *)+  let hcs = if hcs = [] then List.map t_to_horn_clause ts else hcs in+  let hc_deps = List.map hc_to_dep hcs in+  let kv_scope_aux =+    ref (List.fold_left (fun kv_scope' t ->+			   (* collect bound vars of t *)+			   let scope =+			     Sy.SMap.fold (fun bv _ scope' ->+					     StrSet.add (symbol_to_armc bv) scope'+					  ) (C.env_of_t t) StrSet.empty in+			   let _, rhs_kvs = C.rhs_of_t t |> C.preds_kvars_of_reft in+			     (* add these bound vars to the scope of each k var in rhs of t *)+			     List.fold_left (fun kv_scope'' kv ->+					       StrMap.add kv (StrSet.union +								(try StrMap.find kv kv_scope'' with Not_found -> StrSet.empty) +								scope) kv_scope''+					    ) kv_scope' (List.map snd rhs_kvs |> List.map symbol_to_armc)+			) StrMap.empty ts) in+  let done_flag = ref false in+    (* if k' depends on k then scope(k') contains scope(k) *)+    while not(!done_flag) do+      done_flag := true;+      List.iter (fun (head_opt, body) ->+		   match head_opt with+		     | Some kv' -> +			 let scope_kv' = StrMap.find kv' !kv_scope_aux in +			 let size_scope_kv' = StrSet.cardinal scope_kv' in+			 let upd_scope_kv' = +			   List.fold_left (fun sofar kv ->+					     StrSet.union (try StrMap.find kv !kv_scope_aux with Not_found -> StrSet.empty) sofar+					  ) scope_kv' body +			 in+			   if size_scope_kv' < StrSet.cardinal upd_scope_kv' then+			     begin+			       kv_scope_aux := StrMap.add kv' upd_scope_kv' !kv_scope_aux;+			       done_flag := false+			     end+		     | None -> ()+		) hc_deps+    done;+    let kv_scope = +      (* sort scope, add value variable and, if needed, cardinality variable *)+      StrMap.mapi (fun kv scope -> +		     let scope' = val_vname :: (StrSet.inter scope (find_kv_wf_scope wfs kv) |> StrSet.elements |> List.sort compare) in+		       if with_card then card_vname :: scope' else scope'+		  ) !kv_scope_aux in+    let kvs = StrMap.fold (fun kv _ kvs -> kv :: kvs) kv_scope [] in+      StrMap.iter (fun kv scope ->+    		     Printf.fprintf out "%% %s -> %s\n" kv (String.concat ", " scope)) kv_scope;+      {kvs = kvs; kv_scope = kv_scope; sol = sol}+++let to_horn out ts wfs sol =+  print_endline "Translating to Horn clauses.";+(*  let cex = [1;2;4;5;9;23;24] in   *)+  let cex = [] in+  let ts = if cex = [] then ts else List.filter (fun t -> List.mem (C.id_of_t t) cex) ts in+  let state = mk_kv_scope out ~with_card:false ts wfs sol in+    Printf.fprintf out+      ":- multifile rule/3, var2names/2, preds/2, error/1.++error(%s).+%s+%s+"+      error_pc+      (mk_hc_var2names state)+      (mk_hc_preds state);+    List.iter (fun t -> +		 Printf.fprintf out "/*\n%s\n%s\n*/\n" (C.to_string t) (t_to_horn_clause t |> horn_clause_to_string);+		 List.iter (fun r -> +			      output_string out r;+			      output_string out "\n\n"+			   ) (t_to_horn_clause t |> hc_to_rule state)+	      ) ts++let to_armc out ts wfs sol =+  print_endline "Translating to ARMC. ToHC.to_armc";+(*  let cex = [1;5;13;14;68;69;54] in *)+  let cex = [] in+  let state = mk_kv_scope out ts wfs sol in+    Printf.fprintf out+      ":- multifile r/5,implicit_updates/0,var2names/2,preds/2,trans_preds/3,cube_size/1,start/1,error/1,refinement/1,cutpoint/1,invgen_template/2,invgen_template/1,cfg_exit_relation/1,stmtsrc/2,strengthening/2.+refinement(inter). +cube_size(1). ++start(pc(%s)).+error(pc(%s)).+cutpoint(pc(%s)).+\n%s\n\n%s\n+"+      start_pc error_pc loop_pc +      (mk_var2names state)+      (mk_preds state);+    Printf.fprintf out "%s\n\n" (mk_start_rule state);+    List.iter (fun t -> +		 if List.mem (C.id_of_t t) cex || List.length cex = 0 then+		   let hc = t_to_horn_clause t in+		     Printf.fprintf out "/*\n%s%s\n*/\n" (C.to_string t) (horn_clause_to_string hc);+		     List.iter (fun r -> +				  output_string out r;+				  output_string out "\n\n"+			       ) (hc_to_armc state hc)+		 else+		   ()+	      ) ts;+    List.iter (fun id ->  +		 List.iter (fun t -> +			      if List.mem (C.id_of_t t) cex then+				Printf.printf "%s\n" (C.to_string t)+			   ) ts+	      ) cex+++let to_dataflow_armc out ts wfs sol =+  print_endline "Translating to ARMC. ToHC.to_dataflow_armc ";+  let with_card_flag = false in+(*  let cex = [1;2;4;5;9;23;24] in   *)+  let cex = [] in+  let ts = (if cex = [] then ts else List.filter (fun t -> List.mem (C.id_of_t t) cex) ts) in+  let hcs = List.map t_to_horn_clause ts in+  let state = mk_kv_scope ~with_card:with_card_flag ~hcs:hcs out ts wfs sol in+    Printf.fprintf out+      ":- multifile r/5,implicit_updates/0,var2names/2,preds/2,trans_preds/3,cube_size/1,start/1,error/1,refinement/1,cutpoint/1,invgen_template/2,invgen_template/1,cfg_exit_relation/1,stmtsrc/2,strengthening/2,id_trans/1,dataflow_transition/3.+refinement(inter). +cube_size(1). ++start(pc(%s)).+error(pc(%s)).++\n%s\n\n%s\n+"+      start_pc error_pc +      (mk_var2names state)+      (mk_preds ~with_card:with_card_flag state);+    (* connect the start with the loop *)+    Printf.fprintf out "%s\n\n" (mk_rule start_pc (mk_data state) loop_pc (mk_data state) "" "" "start");+    Printf.fprintf out "dataflow_transition(%s, [], []).\n\n" "start";+    List.iter+      (fun hc -> +	 Printf.fprintf out "/*\n%s\n*/\n" (horn_clause_to_string hc);+	 (* the actual transition relation, each disjunct *) +	 List.iter (Printf.fprintf out "%s\n\n") (hc_to_armc ~cfg:false ~with_card:with_card_flag ~with_dataflow:true state hc)+      ) hcs;+    output_string out "/*\n";+    List.iter (fun t -> Printf.fprintf out "%s\n" (C.to_string t)) ts;+    List.iter (fun hc -> Printf.fprintf out "%s\n\n" (horn_clause_to_string hc)) hcs;+    output_string out "*/\n"
+ external/fixpoint/toImp.ml view
@@ -0,0 +1,378 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++(* This module implements the IMP language and translation from fixpoint constraints *)+++module F  = Format+module H  = Hashtbl+module A  = Ast+module E  = A.Expression+module P  = A.Predicate+module Sy = A.Symbol+module SM = Sy.SMap+module C  = FixConstraint+module Cg = FixConfig+(*module BS = BNstats*)++module Misc = FixMisc open Misc.Ops++(**********************************************************************)+(************* Datatypes for IMP Representation ***********************)+(**********************************************************************)++(* vars are always in lex order *)+(* We can have at most one set of temporaries in scope at a time+ * so we share names and mark temporaries *)++type var   = PVar of Sy.t+           | TVar of Sy.t++type kvar  = Ast.Subst.t * Sy.t++type decl  = RDecl of Sy.t * Sy.t list+           | PDecl of Sy.t++(* IMP commands *)++type tupl  = var list++type instr = Assm of A.pred list+           | Asst of A.pred list+           | Asgn of var * var+           | Rget of Sy.t * tupl+           | Rset of tupl * Sy.t+           | Havc of var++type block = instr list++type program = decl list * block list++(**********************************************************************)+(************* Datatypes for IMP Representation ***********************)+(**********************************************************************)++(* Convenience *)++let mk_temp = function+  | TVar v -> TVar v+  | PVar v -> TVar v++let rv_append v1 = function+  | TVar v2 | PVar v2 ->+      PVar (Sy.of_string (Sy.to_string v1 ^ "_" ^ Sy.to_string v2))+  +let collect_apps_from_pred p = +  let apps = ref [] in+  let f_exp e =+    match E.unwrap e with+    | A.App (s, es) -> apps := (s, List.length es) :: !apps+    | t -> () in+  P.iter (fun _ -> ()) f_exp p; !apps++let collect_apps_from_instr = function+  | Assm ps+  | Asst ps ->+      Misc.flap collect_apps_from_pred ps+  | _ -> []++let collect_apps_from_block block =+  Misc.flap collect_apps_from_instr block++let collect_apps_from_program (_, blocks) =+  Misc.flap collect_apps_from_block blocks++(*************************************************************************)+(************* Rendering IMP to String ***********************************)+(*************************************************************************)++let print_var ppf = function +  | PVar v -> F.fprintf ppf "%a" Sy.print v+  | TVar v -> F.fprintf ppf "'%a" Sy.print v++let print_tuple ppf =+  F.fprintf ppf "(%a)" (Misc.pprint_many false ", " print_var)++let print_instr ppf = function+  | Assm ps ->+      F.fprintf ppf "@[assume %a;@]" P.print (A.pAnd ps)+  | Asst ps ->+      F.fprintf ppf "@[assert %a;@]" P.print (A.pAnd ps)+  | Asgn (lhs, rhs) ->+      F.fprintf ppf "@[%a@ :=@ %a;@]" print_var lhs print_var rhs+  | Rget (rv, tupl) ->+      F.fprintf ppf "@[%a@ <|@ %a;@]" print_tuple tupl Sy.print rv+  | Rset (tupl, rv) ->+      F.fprintf ppf "@[%a@ |>@ %a;@]" print_tuple tupl Sy.print rv+  | Havc v ->+      F.fprintf ppf "@[havoc@ %a;@]" print_var v ++let print_decl ppf = function+  | RDecl (r, vs) ->+      F.fprintf ppf "@[rel@ (%a)@ (%a);@]" Sy.print r+        (Misc.pprint_many false ", " Sy.print) vs +  | PDecl v ->+      F.fprintf ppf "@[var@ %a;@]" Sy.print v++let print_block ppf block =+  F.fprintf ppf "@[%a@]"+    (Misc.pprint_many false "\n" print_instr) block++let print_program ppf (decls, blocks) =+  F.fprintf ppf "@[%a@.%a@]"+    (Misc.pprint_many false "\n" print_decl) decls+    (Misc.pprint_many false "\n" print_block) blocks ++(* Printing as C syntax *)++let print_brel_as_c ppf = function+  | A.Eq -> F.fprintf ppf "=="+  | A.Ne -> F.fprintf ppf "!="+  | A.Gt -> F.fprintf ppf ">"+  | A.Ge -> F.fprintf ppf ">="+  | A.Lt -> F.fprintf ppf "<"+  | A.Le -> F.fprintf ppf "<="++let print_bop_as_c ppf = function+  | A.Plus  -> F.fprintf ppf "+"+  | A.Minus -> F.fprintf ppf "-"+  | A.Times -> F.fprintf ppf "*"+  | A.Div   ->  F.fprintf ppf "/"+  +let rec print_predicate_as_c ppf pred =+  match P.unwrap pred with+  | A.True ->+      F.fprintf ppf "True"+  | A.False ->+      F.fprintf ppf "False"+  | A.Atom (e1, r, e2) ->+      F.fprintf ppf "(%a %a %a)" print_expr_as_c e1 print_brel_as_c r print_expr_as_c e2+  | A.And ps ->+      Misc.pprint_many false " && " P.print ppf ps+  | A.Or ps ->+      Misc.pprint_many false " || " P.print ppf ps+  | A.Not p ->+      F.fprintf ppf "!(%a)" print_predicate_as_c p+  | A.Imp (p1, p2) ->+      print_predicate_as_c ppf (A.pOr [A.pNot p1; p2])+  | A.Iff (p1, p2) ->+      print_predicate_as_c ppf (A.pAnd [A.pImp (p1, p2); A.pImp (p2, p1)])+  | A.Bexp e ->+      print_expr_as_c ppf e+  | A.Forall (ds, p) ->+      assert false+      +and print_expr_as_c ppf expr =+  match E.unwrap expr with+  | A.Con c ->+      F.fprintf ppf "%a" A.Constant.print c+  | A.Var v ->+      F.fprintf ppf "%a" Sy.print v+  | A.App (f, es) ->+      F.fprintf ppf "%a(%a)" Sy.print f+        (Misc.pprint_many false ", " print_expr_as_c) es+  | A.Bin (e1, op, e2) ->+      F.fprintf ppf "(%a %a %a)"+        print_expr_as_c e1+        print_bop_as_c op+        print_expr_as_c e2+  | A.Ite (p, e1, e2) ->+      F.fprintf ppf "(%a ? %a : %a)"+        print_predicate_as_c p+        print_expr_as_c e1+        print_expr_as_c e2+  | A.Fld (s, e) ->+      print_expr_as_c ppf (A.eApp (Sy.of_string ("field" ^ Sy.to_string s), [e]))+(*  | A.Mod (e1, i) ->+      F.fprintf ppf "(%a mod %d)" print_expr_as_c e1 i +*)++let print_var_as_c ppf = function+  | PVar v -> F.fprintf ppf "%a" Sy.print v+  | TVar v -> F.fprintf ppf "_%a" Sy.print v++let sy_append v1 v2 =+  Sy.of_string ((Sy.to_string v1) ^ "_" ^ (Sy.to_string v2))++let print_decl_as_c ppf = function+  | RDecl (rv, tupl) ->+      let pv v1 = (fun v2 -> F.fprintf ppf "@[int %a;@]@\n" Sy.print (sy_append v1 v2)) in+      List.iter (pv rv) tupl+  | PDecl v ->+      F.fprintf ppf "@[int %a;@]@\n" Sy.print v++let rec print_instr_as_c ppf = function+  | Havc v ->+      F.fprintf ppf "@[%a = nondet();@]" print_var_as_c v+  | Asgn (v1, v2) ->+      F.fprintf ppf "@[%a = %a@]" print_var_as_c v1 print_var_as_c v2+  | Assm ps ->+      F.fprintf ppf "@[if (!(%a)) { diverge(); }@]" print_predicate_as_c (A.pAnd ps)+  | Asst ps ->+      F.fprintf ppf "@[if (!(%a)) { error(); }@]" print_predicate_as_c (A.pAnd ps)+  | Rget (rv, tupl) ->+      List.map (fun v -> Asgn (mk_temp v, rv_append rv v)) tupl |>+      print_block_as_c ppf+  | Rset (tupl, rv) ->+      List.map (fun v -> Asgn (rv_append rv v, mk_temp v)) tupl |>+      print_block_as_c ppf++and print_block_as_c ppf block =+  F.fprintf ppf "@[%a@]"+    (Misc.pprint_many false "\n" print_instr_as_c) block++let print_list ppf = List.iter (F.fprintf ppf "%s")++let generate_uf (name, numargs) =+  let rec mkargs n s =+    if numargs > 0 then+      mkargs (n-1) ("int, " ^ s)+    else+      s in+  "int " ^ (Sy.to_string name) ^ "(" ^ (mkargs (numargs-1) "int") ^ ") {}"++let prologue =+  [ "void error() { ERROR: goto ERROR; }"+  ; "void diverge() { DIV: goto DIV; }"+  ; "int nondet() { int x; return x; }"+  ; "int main() {"+  ]++let epilogue =+  ["return 0; }"]++let print_program_as_c ppf ((decls, blocks) as program) =+  F.fprintf ppf "@[%a@.%a@.%a@.%a@.%a@.@]"+    print_list (collect_apps_from_program program |> List.map generate_uf)+    print_list prologue+    (Misc.pprint_many false "\n" print_decl_as_c) decls+    (Misc.pprint_many false "\n" print_block_as_c) blocks+    print_list epilogue++let check_imp (decls, instrs) = true+(* Translation from fixpoint to IMP *)++(*************************************************************************)+(************* Converting FixConfig.deft to SMTLIB ***********************)+(*************************************************************************)++(* Declarations *)++let filter_wfs cs =+  (* Misc.maybe_list (List.map (function Cg.Wfc x -> Some x | _ -> None) cs) *)+  Misc.map_partial (function Cg.Wfc x -> Some x | _ -> None) cs++let filter_subt cs =+  Misc.map_partial (function Cg.Cst x -> Some x | _ -> None) cs+  (* Misc.maybe_list (List.map (function Cg.Cst x -> Some x | _ -> None) cs)+   *)++let wf_to_decls wf =+  let vars  = wf |> C.env_of_wf+                 |> C.bindings_of_env+                 |> List.map fst+                 |> Misc.sort_and_compact+  in+  let kvars = C.kvars_of_reft (C.reft_of_wf wf) in+  ( List.map (fun k -> RDecl (snd k, vars)) kvars+  , List.map (fun v -> PDecl v) vars)++let constraints_to_decls cs =+  let decls = List.map wf_to_decls (filter_wfs cs) in+  let (rdecls, pdecls) = (Misc.flap fst decls, Misc.flap snd decls) in+  rdecls @ pdecls ++(* Constraint translation *)++let rec get_kdecl kvar decls =+  match decls with  +  | RDecl (k, vars) :: decls ->+      if k = kvar then+        vars+      else+        get_kdecl kvar decls+  | _ :: decls -> get_kdecl kvar decls+  | [] -> raise Not_found++let sub_to_assume (var, expr) =+  Assm [A.pAtom (A.eVar var, A.Eq, expr)]++(* [[{t | p}]]_get *)++let get_instrs vv decls (subs, kvar) =+  let vars = get_kdecl kvar decls |> List.map (fun v -> TVar v) in+  let assumes = subs |> Ast.Subst.to_list |> List.map sub_to_assume in+  Rget (kvar, vars) :: assumes @+  [Asgn (PVar vv, List.hd vars)]++let set_instr decls (subs, kvar) =+  Rset (List.map (fun v -> TVar v) (get_kdecl kvar decls), kvar)++let emptySol = PredAbs.read PredAbs.empty++let reft_to_get_instrs decls reft =+  let vv = C.vv_of_reft reft in+  let kvars = C.kvars_of_reft reft in+  let preds = C.preds_of_reft emptySol reft in+  match (kvars, preds) with+  | ([], preds) -> Havc (PVar vv) :: Assm preds :: []+  | (kvars, []) -> Misc.flap (get_instrs vv decls) kvars+  | (kvars, preds) -> Misc.flap (get_instrs vv decls) kvars @ ([Assm preds])++(* [[{t | p}]]_set *)++let reft_to_set_instrs decls reft =+  let kvars = C.kvars_of_reft reft in+  let preds = C.preds_of_reft emptySol reft in+  match (kvars, preds) with+  | ([], preds) -> Asst preds :: []+  | (kvars, []) -> List.map (set_instr decls) kvars+  | (kvars, preds) -> List.map (set_instr decls) kvars @ [(Asst preds)]++(* [[x:T; G]] *)++let binding_to_instrs decls (var, reft) =+  reft_to_get_instrs decls reft @ [Asgn (PVar var, PVar (C.vv_of_reft reft))]++let envt_to_instrs decls envt =+  Misc.flap (binding_to_instrs decls) (C.bindings_of_env envt)++let constraint_to_block decls c =+  let (env, grd, lhs, rhs) =+    (C.env_of_t c, C.grd_of_t c, C.lhs_of_t c, C.rhs_of_t c) in+  Assm [grd] ::+  envt_to_instrs decls env @+  reft_to_get_instrs decls lhs @+  reft_to_set_instrs decls rhs++let constraints_to_blocks decls cs =+  List.map (constraint_to_block decls) (filter_subt cs)++let mk_program cs =+  let decls = constraints_to_decls cs in+  (decls, constraints_to_blocks decls cs)++(* API *)+let render ppf cs = +  cs |> mk_program +     |> F.fprintf ppf "%a" print_program_as_c
+ external/fixpoint/toImp.mli view
@@ -0,0 +1,26 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++val render : Format.formatter -> FixConfig.deft list -> unit++
+ external/fixpoint/toLatex.ml view
@@ -0,0 +1,149 @@+(* translation of constraints to latex *)++module C = FixConstraint+module Su = Ast.Subst+module Misc = FixMisc open Misc.Ops++(* print linebreak after each connective in constraint *)+let c_linebreak = ref true++let q_mathit = Printf.sprintf "\\mathit{%s}"++let sort_to_latex s = Ast.Sort.to_string s |> q_mathit+let symbol_to_latex s = +  Ast.Symbol.to_string s+  |> Str.global_replace (Str.regexp "_") "\\_" +  |> Str.global_replace (Str.regexp "#") "\\#" |> q_mathit+let constant_to_latex = Ast.Constant.to_string++let bop_to_latex = function +  | Ast.Plus  -> "+"+  | Ast.Minus -> "-"+  | Ast.Times -> ""+  | Ast.Div   -> "/"+let brel_to_latex = function +  | Ast.Eq -> "="+  | Ast.Ne -> "!="+  | Ast.Gt -> ">"+  | Ast.Ge -> "\\geq"+  | Ast.Lt -> "<"+  | Ast.Le -> "\\leq"+let bind_to_latex (s, t) = +  Printf.sprintf "%s:%s" (symbol_to_latex s) (sort_to_latex t)+let rec expr_to_latex (e, _) = +  match e with+    | Ast.Con c -> constant_to_latex c+    | Ast.Var s -> symbol_to_latex s+    | Ast.App (s, es) ->+	Printf.sprintf "%s([%s])" +	  (symbol_to_latex s) (List.map expr_to_latex es |> String.concat " ")+    | Ast.Bin (e1, op, e2) ->+	Printf.sprintf "(%s %s %s)" +	  (expr_to_latex e1) (bop_to_latex op) (expr_to_latex e2)+    | Ast.Ite (ip, te, ee) -> +	Printf.sprintf "%s ? %s : %s" +	  (pred_to_latex ip) (expr_to_latex te) (expr_to_latex ee)+    | Ast.Fld (s, e) -> +	Printf.sprintf "%s.%s" (expr_to_latex e) (symbol_to_latex s)+and pred_to_latex (p, _) = +  match p with+    | Ast.True -> "\\ltrue"+    | Ast.False -> "\\lfalse"+    | Ast.Bexp e -> expr_to_latex e+    | Ast.Not p -> Printf.sprintf "\\neg (%s)" (pred_to_latex p) +    | Ast.Imp (p1, p2) -> +	Printf.sprintf "(%s \\limp %s)" (pred_to_latex p1) (pred_to_latex p2)+    | Ast.And ps -> +	if ps = [] then "\\ltrue" else+	  List.map pred_to_latex ps |> String.concat " \\land "+    | Ast.Or ps -> +	if ps = [] then "\\lfalse" else+	  List.map pred_to_latex ps |> String.concat " \\lor "+    | Ast.Atom (e1, r, e2) ->+	Printf.sprintf "(%s %s %s)" +          (expr_to_latex e1) (brel_to_latex r) (expr_to_latex e2)+    | Ast.Forall (qs,p) -> +	Printf.sprintf "\\forall %s: %s" +          (List.map bind_to_latex qs |> String.concat ", ") (pred_to_latex p)+let subst_to_latex (s, e) = +  Printf.sprintf "[%s/%s]" (expr_to_latex e) (symbol_to_latex s)+let refa_to_latex refa =+  match refa with +    | C.Conc pred -> pred_to_latex pred+    | C.Kvar (subs, sym) -> +	Printf.sprintf "%s%s" +	  (symbol_to_latex sym)+	  (List.map subst_to_latex (Su.to_list subs) |> String.concat "")+let reft_to_latex (v, b, r) = +  Printf.sprintf "\\{ %s:%s \\mid %s \\}"+    (symbol_to_latex v) (sort_to_latex b) +    (if r = [] then "\\ltrue" else+       (List.map refa_to_latex r |> String.concat " \\land "))+let envt_to_latex envt = +  if Ast.Symbol.SMap.is_empty envt then+    "\\ltrue;\\ "+  else+    Ast.Symbol.SMap.fold +      (fun sym reft sofar -> +	 Printf.sprintf "%s:%s;%s%s" +	   (symbol_to_latex sym) (reft_to_latex reft) +	   (if !c_linebreak then "\\\\\n" else "\\ ")+	   sofar) envt ""++let c_to_latex out c = +  Printf.fprintf out +    "\\begin{footnotesize}+  \\begin{verbatim}+%s+  \\end{verbatim}+\\end{footnotesize}+" (C.to_string c);+  Printf.fprintf out+    "\\begin{displaymath}+  \\begin{array}[t]{l}+  %s %s\\ \\deriv\\\\ %s\\ <:\\\\ %s\\qquad %s+  \\end{array}+\\end{displaymath}+\\hrule+" +    (C.env_of_t c |> envt_to_latex)  +    (C.grd_of_t c |> pred_to_latex)+    (C.lhs_of_t c |> reft_to_latex) +    (C.rhs_of_t c |> reft_to_latex)+    (try string_of_int (C.id_of_t c) with _ -> "")++let wf_to_latex out wf = +  Printf.fprintf out+    "\\begin{displaymath}+  \\begin{array}[t]{l}+  %s\\ \\deriv\\ %s\\qquad %s+  \\end{array}+\\end{displaymath}+\\hrule+" +    (C.env_of_wf wf |> envt_to_latex)  +    (C.reft_of_wf wf |> reft_to_latex)+    (try string_of_int (C.id_of_wf wf) with _ -> "")+++let to_latex out cs ws = +  print_endline "Translating to LaTeX.";+  Printf.fprintf out +"\\documentclass[10pt]{llncs}+\\pagestyle{plain}+\\usepackage{amsmath}+\\newcommand{\\ltrue}{\\mathit{true}}+\\newcommand{\\lfalse}{\\mathit{false}}+\\newcommand{\\limp}{\\rightarrow}+\\newcommand{\\deriv}{\\vdash}+\\begin{document}+";+  List.iter (c_to_latex out) cs;+  List.iter (wf_to_latex out) ws;+  Printf.fprintf out +"\\end{document}+%%%%%% Local Variables: +%%%%%% mode: latex+%%%%%% TeX-master: t+%%%%%% End: +"
+ external/fixpoint/toQARMC.ml view
@@ -0,0 +1,721 @@+(* translation to Q'ARMC *)+++module C  = FixConstraint+module Co = Constants +module Sy = Ast.Symbol+module Su = Ast.Subst+module P = Ast.Predicate+module E = Ast.Expression+module StrMap = Map.Make (struct type t = string let compare = compare end)+module StrSet = Set.Make (struct type t = string let compare = compare end)+module Misc = FixMisc open Misc.Ops++let strlist_to_strset = List.fold_left (fun s x -> StrSet.add x s) StrSet.empty++(* Andrey: TODO move to ast.ml? *)+let pred_is_atomic (p, _) =+  match p with+    | Ast.True | Ast.False | Ast.Bexp _ | Ast.Atom _ -> true+    | Ast.And _ | Ast.Or _ | Ast.Not _ | Ast.Imp _ | Ast.Forall _ -> false++let pred_is_true (p, _) = +  match p with +    | Ast.True -> true+    | Ast.Atom (e1, Ast.Eq, e2) -> E.to_string e1 = E.to_string e2 +    | _ -> false++let neg_brel = function +  | Ast.Eq -> Ast.Ne+  | Ast.Ne -> Ast.Eq+  | Ast.Gt -> Ast.Le+  | Ast.Ge -> Ast.Lt+  | Ast.Lt -> Ast.Ge+  | Ast.Le -> Ast.Gt++let rec push_neg ?(neg=false) ((p, _) as pred) =+  match p with+    | Ast.True -> if neg then Ast.pFalse else pred+    | Ast.False -> if neg then Ast.pTrue else pred+    | Ast.Bexp _ -> if neg then Ast.pNot pred else pred+    | Ast.Not p -> push_neg ~neg:(not neg) p+    | Ast.Imp (p, q) -> +	if neg then Ast.pAnd [push_neg p; push_neg ~neg:true q]+	else Ast.pImp (push_neg p, push_neg q)+    | Ast.Forall (qs, p) -> +	let pred' = Ast.pForall (qs, push_neg ~neg:false p) in+	  if neg then Ast.pNot pred' else pred'+    | Ast.And ps -> List.map (push_neg ~neg:neg) ps |> if neg then Ast.pOr else Ast.pAnd+    | Ast.Or ps -> List.map (push_neg ~neg:neg) ps |> if neg then Ast.pAnd else Ast.pOr+    | Ast.Atom (e1, brel, e2) -> if neg then Ast.pAtom (e1, neg_brel brel, e2) else pred++(* Andrey: TODO flatten nested conjunctions/disjunctions *)+let rec simplify_tauto ((p, _) as pred) =+  match p with+    | Ast.Not p -> Ast.pNot (simplify_tauto p)+    | Ast.Imp (p, q) -> Ast.pImp (simplify_tauto p, simplify_tauto q) +    | Ast.Forall (qs, p) -> Ast.pForall (qs, simplify_tauto p)+    | Ast.And ps -> +	let ps' = List.map simplify_tauto ps |> List.filter (fun p -> not(P.is_tauto p)) in+	  if List.mem Ast.pFalse ps' then Ast.pFalse else+	    begin+	      match ps' with+		| [] -> Ast.pTrue+		| [p'] -> p'+		| _ :: _ -> Ast.pAnd ps'+	    end+    | Ast.Or ps -> +	let ps' = List.map simplify_tauto ps in+	  if List.exists P.is_tauto ps' then Ast.pTrue else +	    begin+	      match ps' with+		| [] -> Ast.pFalse+		| [p'] -> p'+		| _ :: _ -> Ast.pOr ps'+	    end+    | _ -> pred++let rec partition_pred_defs edefs pdefs ((p, _) as pred) = +  match p with+    | Ast.Atom ((Ast.Var v, _), Ast.Eq, e) -> Ast.pTrue, Sy.SMap.add v e edefs, pdefs+    | Ast.And [Ast.Imp ((Ast.Bexp (Ast.Var v1, _), _), p1), _; +	       Ast.Imp (p2, (Ast.Bexp (Ast.Var v2, _), _)), _] when v1 = v2 && p1 = p2 -> +	Ast.pTrue, edefs, Sy.SMap.add v1 p1 pdefs+    | Ast.And preds -> +	let preds', edefs', pdefs' = List.fold_left +	  (fun (preds_sofar, edefs_sofar, pdefs_sofar) p ->+	     let p'', edefs'', pdefs'' = partition_pred_defs edefs_sofar pdefs_sofar p in+	       p'' :: preds_sofar, edefs'', pdefs''+	  ) ([], edefs, pdefs) preds in+	  (Ast.pAnd preds'), edefs', pdefs'+    | _ -> pred, edefs, pdefs++let rec defs_of_pred edefs pdefs (p, _) = +  match p with+    | Ast.Atom ((Ast.Var v, _), Ast.Eq, e) -> Sy.SMap.add v e edefs, pdefs+    | Ast.And [Ast.Imp ((Ast.Bexp (Ast.Var v1, _), _), p1), _; +	       Ast.Imp (p2, (Ast.Bexp (Ast.Var v2, _), _)), _] when v1 = v2 && p1 = p2 -> +	edefs, Sy.SMap.add v1 p1 pdefs+    | Ast.And preds -> +	let edefs', pdefs' = List.fold_left +	  (fun (edefs_sofar, pdefs_sofar) p ->+	     let edefs'', pdefs'' = defs_of_pred edefs_sofar pdefs_sofar p in+	       edefs'', pdefs''+	  ) (edefs, pdefs) preds in+	  edefs', pdefs'+    | _ -> edefs, pdefs+++let some_def_applied = ref false+let rec expr_apply_defs edefs pdefs ((e, _) as expr) = +  let current_some_def_applied = !some_def_applied in+    some_def_applied := false;+    let expr'' =+      match e with+	| Ast.Con _ -> expr+	| Ast.Var v -> +	    begin+	      try+		let expr' = Sy.SMap.find v edefs in+		  some_def_applied := true;+		  expr'+	      with Not_found -> expr+	    end+	| Ast.App (v, es) -> +	    let edefs' = Sy.SMap.remove v edefs in+	      Ast.eApp (v, List.map (expr_apply_defs edefs' pdefs) es)+	| Ast.Bin (e1, op, e2) -> +	    Ast.eBin (expr_apply_defs edefs pdefs e1, op, expr_apply_defs edefs pdefs e2)+	| Ast.Ite (p, e1, e2) -> +	    Ast.eIte (pred_apply_defs edefs pdefs p, +		      expr_apply_defs edefs pdefs e1,+		      expr_apply_defs edefs pdefs e2)+	| Ast.Fld (v, e) -> +	    let v' = +	      try+		match Sy.SMap.find v edefs with+		  | (Ast.Var v'', _) -> +		      some_def_applied := true;+		      v''+		  | _ -> v+	      with Not_found -> v+	    in+	      Ast.eFld (v', expr_apply_defs edefs pdefs e)+    in+      if !some_def_applied then+	let expr''' = expr_apply_defs edefs pdefs expr'' in+	  some_def_applied := current_some_def_applied;+	  expr'''+      else+	begin+	  some_def_applied := current_some_def_applied;+	  expr''+	end+and pred_apply_defs edefs pdefs ((p, _) as pred) =+  let current_some_def_applied = !some_def_applied in+    some_def_applied := false;+    let pred'' =+      match p with+	| Ast.And ps -> List.map (pred_apply_defs edefs pdefs) ps |> Ast.pAnd+	| Ast.Or ps -> List.map (pred_apply_defs edefs pdefs) ps |> Ast.pOr+	| Ast.Not p -> pred_apply_defs edefs pdefs p |> Ast.pNot+	| Ast.Imp (p, q) -> Ast.pImp (pred_apply_defs edefs pdefs p, pred_apply_defs edefs pdefs q)+	| Ast.Bexp (Ast.Var v, _) ->+	    begin+	      Printf.printf "Applying on Bexp: %s\n" (P.to_string pred);+	      (* Andrey: TODO also consider edefs *)+	      try+		let expr' = Sy.SMap.find v edefs in+		  some_def_applied := true;+		  Ast.pBexp expr'+	      with Not_found ->+		try+		  let pred' = Sy.SMap.find v pdefs in+		    some_def_applied := true;+		    pred'+		with Not_found ->+		  pred+	    end+	| Ast.Atom (e1, brel, e2) ->+	    Ast.pAtom (expr_apply_defs edefs pdefs e1, brel, expr_apply_defs edefs pdefs e2)+	| Ast.Forall (qs, p) ->+	    let vs = List.map fst qs in+	    let edefs' = List.fold_left (fun defs v -> Sy.SMap.remove v defs) edefs vs in+	    let pdefs' = List.fold_left (fun defs v -> Sy.SMap.remove v defs) pdefs vs in+	      Ast.pForall (qs, pred_apply_defs edefs' pdefs' p)+	| _ -> pred+    in+      if !some_def_applied then+	let pred''' = pred_apply_defs edefs pdefs pred'' in+	  some_def_applied := current_some_def_applied;+	  pred'''+      else +	begin+	  some_def_applied := current_some_def_applied;+	  pred''+	end+      ++let support_of_env sol env =+  Sy.SMap.fold+    (fun ksym reft sup -> +       let vv = C.vv_of_reft reft in+       let kv = Ast.eVar ksym in+       let syms = C.preds_of_reft sol reft |>+	   List.map (fun p -> P.subst p vv kv) |> List.filter (fun p -> not(pred_is_true p)) |>+	       List.map P.support |> List.flatten+       in+	 List.fold_left (fun sup' sym -> Sy.SSet.add sym sup') sup syms+    ) env Sy.SSet.empty++++let armc_true = "true"+let armc_false = "false"+let loop_pc = "loop"+let start_pc = "start"+let error_pc = "error"+let val_vname = "VVVV"+let exists_kv = "EX"+let primed_suffix = "p"+let str__cil_tmp = "__cil_tmp"++type kv_scope = {+  kvs : string list;+  kv_scope : string list StrMap.t+}++type horn_clause = {+  body_pred : Ast.pred;+  body_kvars : (Su.t * Sy.t) list;+  head_pred : Ast.pred;+  head_kvars : (Su.t * Sy.t) list;+  tag : string;+}++let sanitize_symbol s = +  Str.global_replace (Str.regexp "@") "_at_"  s |> Str.global_replace (Str.regexp "#") "_hash_" |>+      Str.global_replace (Str.regexp "\\.") "_dot_" |> Str.global_replace (Str.regexp "'") "_q_" ++let symbol_to_armc s = Sy.to_string s |> sanitize_symbol++let var_to_armc s = Sy.to_string s |> sanitize_symbol |> String.capitalize++let subs_to_map subs = +  List.fold_left +    (fun m (s, e) -> +      StrMap.add (symbol_to_armc s) e m+    ) StrMap.empty (Su.to_list subs)++let mk_data_var ?(suffix = "") kv v = +  Printf.sprintf "_%s_%s%s%s" +    (sanitize_symbol v) (sanitize_symbol kv) (if suffix = "" then "" else "_") suffix++	+(*+let defs_of_env state env = +  Sy.SMap.fold +    (fun ksym reft defs ->+       let vv = C.vv_of_reft reft in+       let kv = Ast.eVar ksym in+       let defs' = C.preds_of_reft state.sol reft |>+	   List.map (fun p -> P.subst p vv kv) |> List.filter (fun p -> not(pred_is_true p)) |>+	       List.map (defs_of_pred state) |> List.flatten+       in+	 defs' ++ defs+    ) env []+*)++let constant_to_armc = Ast.Constant.to_string+let bop_to_armc = function +  | Ast.Plus  -> "+"+  | Ast.Minus -> "-"+  | Ast.Times -> "*"+  | Ast.Div   -> "/"+let brel_to_armc = function +  | Ast.Eq -> "="+  | Ast.Ne -> "=\\="+  | Ast.Gt -> ">"+  | Ast.Ge -> ">="+  | Ast.Lt -> "<"+  | Ast.Le -> "=<"+let bind_to_armc (s, t) = (* Andrey: TODO support binders *)+  Printf.sprintf "%s:%s" (symbol_to_armc s) (Ast.Sort.to_string t |> sanitize_symbol)+let rec expr_to_armc (e, _) = +  match e with+    | Ast.Con c -> constant_to_armc c+    | Ast.Var s -> var_to_armc s+    | Ast.App (s, es) -> +	if !Co.purify_function_application then "_" else+	  let str = symbol_to_armc s in+	    if es = [] then str else+	      Printf.sprintf "f_%s(%s)" str (List.map expr_to_armc es |> String.concat ", ")+    | Ast.Bin (e1, op, e2) ->+	Printf.sprintf "(%s %s %s)" +	  (expr_to_armc e1) (bop_to_armc op) (expr_to_armc e2)+    | Ast.Ite (ip, te, ee) -> +	Printf.sprintf "ite(%s, %s, %s)" +	  (pred_to_armc ip) (expr_to_armc te) (expr_to_armc ee)+    | Ast.Fld (s, e) -> +	Printf.sprintf "fld(%s, %s)" (expr_to_armc e) (symbol_to_armc s)+and pred_to_armc ((p, _) as pred) = +  if pred_is_true pred then +    armc_true+  else+    match p with+      | Ast.True -> armc_true+      | Ast.False -> armc_false+      | Ast.Bexp e -> Printf.sprintf "bexp(%s)" (expr_to_armc e)+      | Ast.Not (Ast.True, _) -> armc_false+      | Ast.Not (Ast.False, _) -> armc_true+      | Ast.Not p -> Printf.sprintf "neg(%s)" (pred_to_armc p) +      | Ast.Imp (p1, p2) -> Printf.sprintf "imp(%s, %s)" (pred_to_armc p1) (pred_to_armc p2)+      | Ast.And [] -> armc_true+      | Ast.And [p] -> pred_to_armc p+      | Ast.And [Ast.Imp ((Ast.Bexp e1, _) as p, p1), _; +		 Ast.Imp (p2, (Ast.Bexp e2, _)), _] when e1 = e2 && p1 = p2 -> +	  Printf.sprintf "bexp_def(%s, %s)" (pred_to_armc p) (pred_to_armc p1)+      | Ast.And (_::_ as ps) -> +	  Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat ", ")+      | Ast.Or [] -> armc_false+      | Ast.Or [p] -> pred_to_armc p+      | Ast.Or (_::_ as ps) -> Printf.sprintf "(%s)" (List.map pred_to_armc ps |> String.concat "; ")+      | Ast.Atom (e1, Ast.Eq, (Ast.Ite(ip, te, ee), _)) ->+	  let ip_str = pred_to_armc ip in+	  let e1_str = expr_to_armc e1 in+	    Printf.sprintf "((%s, %s = %s); (neg(%s), %s = %s))"+	      ip_str e1_str (expr_to_armc te) +	      ip_str e1_str (expr_to_armc ee) +      | Ast.Atom (e1, r, e2) ->+	  Printf.sprintf "%s %s %s" +            (expr_to_armc e1) (brel_to_armc r) (expr_to_armc e2)+      | Ast.Forall (qs,p) -> (* Andrey: TODO support forall *) +	  Printf.sprintf "forall([%s], %s)" +            (List.map bind_to_armc qs |> String.concat ", ") +	    (pred_to_armc p)+++let mk_kv_scope out ts wfs =+  (*  let kvs = List.map C.kvars_of_t ts |> List.flatten |> List.map snd |> +      List.map symbol_to_armc |> (* (fun s -> Printf.sprintf "k%s" (symbol_to_armc s)) |> *)+      Misc.sort_and_compact in+  *)+  let kv_scope_wf =+    List.fold_left+      (fun m wf ->+	match C.reft_of_wf wf |> C.ras_of_reft with+	  | [C.Kvar (subs, kvar)] when Su.is_empty subs ->+	    let v = symbol_to_armc kvar in+	    let scope = +(*	      val_vname :: *)+		(C.env_of_wf wf +		    |> C.bindings_of_env +		    |> List.filter +			(fun (_, (_, typ, _)) ->+			  Ast.Sort.t_int = typ+			)+		    |> List.map fst +		    |> List.map symbol_to_armc +		    |> List.filter +			(fun s -> +			  not(Misc.is_prefix str__cil_tmp s +			      || Misc.is_prefix "FP_" s+			      || Misc.is_prefix "Open_" s+			      || Misc.is_prefix "None_0" s+			      || Misc.is_prefix "Some_0" s+			      || Misc.is_prefix "true_0" s+			      || Misc.is_prefix "false_0" s+			      || Misc.is_prefix "Pervasives_" s+			      || Misc.is_prefix "FIXPOINTSYMBOL_" s)) +		    |> List.sort compare) +	    in+	    StrMap.add v scope m+	  | _ -> m+      (* Andrey: TODO handle ill-formed wf *)+      (*		 Format.printf "%a" (C.print_wf None) wf;+			 +			 failure "ERROR: kname_scope_map: ill-formed wf"+      *)+      ) StrMap.empty wfs in+  let kv_scope_t =+    List.fold_left +      (fun m (subs, kvar) ->+	let v = symbol_to_armc kvar in+	let scope = +	  List.filter (fun (v, (e, _)) -> +	    match e with+	      | Ast.Var v' -> v <> v'+	      | _ -> true+	  ) (Su.to_list subs) |> +	      List.map fst |> List.map symbol_to_armc |> strlist_to_strset in+	let scope' = try StrMap.find v m with Not_found -> StrSet.empty in+	StrMap.add v (StrSet.union scope scope') m+      ) StrMap.empty (List.map C.kvars_of_t ts |> List.flatten) in+  let kv_scope = kv_scope_wf in+  let kv_scope_old = +    StrMap.map (fun scope -> val_vname :: (StrSet.elements scope |> List.sort compare)) kv_scope_t in+  let kvs = StrMap.fold (fun kv _ kvs -> kv :: kvs) kv_scope [] in+  (* +  StrMap.iter (fun kv scope ->+    Printf.fprintf out "%% %s -> %s\n" kv (String.concat ", " scope)) kv_scope;+  *)+  {kvs = kvs; kv_scope = kv_scope}++let mk_data ?(suffix = "") ?(skip_kvs = []) s = +  Printf.sprintf "[%s]"+    (List.map +       (fun kv ->+	  try +	    StrMap.find kv s.kv_scope |> +		List.map (mk_data_var ~suffix:(if List.mem kv skip_kvs then "" else suffix) kv)+	  with Not_found -> failure "ERROR: mk_data: scope not found for %s" kv+       ) s.kvs |> List.flatten |> String.concat ", ")++let mk_query ?(suffix = "") s kv = +  Printf.sprintf "k%s(%s)" +    kv (List.map (mk_data_var ~suffix:suffix kv) (StrMap.find kv s.kv_scope) |> String.concat ", ")++let mk_var2names state = +  List.map+    (fun kv ->+       Printf.sprintf "var2names(p(pc(k%s), data(%s)), [%s])."+	 kv+	 (List.map (mk_data_var kv) (StrMap.find kv state.kv_scope) |> String.concat ", ")+	 (List.map +	    (fun v -> +	       Printf.sprintf "(%s, \'%s_%s\')" (mk_data_var kv v)  v kv+	    ) (StrMap.find kv state.kv_scope) |> String.concat ", ")+    ) state.kvs |> String.concat "\n"++let mk_skip_update state kvs = +  if kvs = [] then armc_true else+    List.map+      (fun kv ->+	 List.map +	   (fun v -> +	      Printf.sprintf "%s = %s"+		(mk_data_var ~suffix:primed_suffix kv v) (mk_data_var kv v)+	   ) (StrMap.find kv state.kv_scope) |> String.concat ", "+      ) kvs |> String.concat ", "++let mk_update_str from_vs to_vs updates = +  List.map2+    (fun v vp ->+       Printf.sprintf "%s = %s" vp (try StrMap.find v updates with Not_found -> v)+    ) from_vs to_vs |> String.concat ", "++let split_scope scope = +  match scope with+    | value :: data -> value, data+    | _ -> failure "ERROR: split_scope: empty scope %s" (String.concat ", " scope)++let reft_to_armc ?(noquery = false) ?(suffix = "") state reft = +  let vv = C.vv_of_reft reft |> symbol_to_armc in+  let rs = C.ras_of_reft reft in+    if rs = [] then armc_true else+      List.map+	(function+	   | C.Conc pred -> pred_to_armc pred+	   | C.Kvar (subs, sym) -> +	     failwith "AR: toQARMC.ml reft_to_armc";+	     if true (* Sy.SMap.mem sym state.sol && Sy.SMap.find sym state.sol = [] *)then +		 armc_true  (* skip true *)+	       else+		 let subs_map = subs_to_map subs in+		 let find_subst v default = +		   try StrMap.find v subs_map |> expr_to_armc with Not_found -> default in+		 let kv = symbol_to_armc sym in+		 let value, data = StrMap.find kv state.kv_scope |> split_scope in+		   Printf.sprintf "%s%s = %s" +		     (if noquery then "" else (mk_query ~suffix:suffix state kv) ^ ", ")+		     (mk_data_var ~suffix:suffix kv value) +		     (find_subst vv (mk_data_var exists_kv vv)) +		   :: List.map+		     (fun v -> +			Printf.sprintf "%s = %s"+			  (mk_data_var ~suffix:suffix kv v)+			  (find_subst v (mk_data_var exists_kv v))+		     ) data |> String.concat ", "+	) rs |> String.concat ", "++let mk_rule head annot_guards annot_updates id = +  let rec annot_conj_to_armc = function+    | (g, a) :: rest -> +	if rest = [] then Printf.sprintf "\n   %s \t%% %s\n  ]," g a+	else Printf.sprintf "\n   %s, \t%% %s%s" g a (annot_conj_to_armc rest)+    | [] -> "],"+  in+    Printf.sprintf+      "+hc(%s, [%s  %s).+" +      head (annot_guards @ annot_updates |> List.filter (fun (g, _) -> g <> armc_true) |> annot_conj_to_armc) id++let preds_kvars_of_reft reft =+  List.fold_left +    (fun (ps, ks) r ->+       match r with+	 | C.Conc p -> p :: ps, ks+	 | C.Kvar (subs, kvar) -> ps, (subs, kvar) :: ks+    ) ([], []) (C.ras_of_reft reft)++let t_to_horn_clause t =+  let lhs_ps, lhs_ks = C.lhs_of_t t |> preds_kvars_of_reft in+  let body_ps, body_ks = +    Sy.SMap.fold +      (fun bv reft (ps, ks) -> +	 let ps', ks' = preds_kvars_of_reft (C.theta (Su.of_list [(C.vv_of_reft reft, Ast.eVar bv)]) reft) in+	   List.rev_append ps' ps, List.rev_append ks' ks+      ) (C.env_of_t t) (C.grd_of_t t :: lhs_ps, lhs_ks) in+  let head_ps, head_ks = C.rhs_of_t t |> preds_kvars_of_reft in+    {+      body_pred = Ast.pAnd body_ps |> simplify_tauto; +      body_kvars = body_ks; +      head_pred = Ast.pAnd head_ps |> simplify_tauto;+      head_kvars = head_ks;+      tag = try string_of_int (C.id_of_t t) with _ -> failure "ERROR: t_to_horn_clause: anonymous constraint %s" (C.to_string t)+    }++let simplify_horn_clause hc = +  let body_edefs, body_pdefs = defs_of_pred Sy.SMap.empty Sy.SMap.empty hc.body_pred in+  let edefs, pdefs = defs_of_pred body_edefs body_pdefs hc.head_pred in+    {+      body_pred = pred_apply_defs edefs pdefs hc.body_pred |> simplify_tauto; +      body_kvars = hc.body_kvars; +      head_pred = pred_apply_defs edefs pdefs hc.head_pred |> simplify_tauto;+      head_kvars = hc.head_kvars; +      tag = hc.tag+    }++let print_horn_clause hc = +  Printf.printf "%s: %s, %s :- %s, #%d %s\n"+    hc.tag +    (P.to_string hc.head_pred)+    (List.map (fun (subs, kvar) -> C.refa_to_string (C.Kvar (subs, kvar))) hc.head_kvars |> String.concat ", ")+    (P.to_string hc.body_pred)+    (List.length hc.body_kvars)+    (List.map (fun (subs, kvar) -> C.refa_to_string (C.Kvar (subs, kvar))) hc.body_kvars |> String.concat ", ")++    +let t_to_armc state t = +  t_to_horn_clause t |> simplify_horn_clause |> print_horn_clause;+  let env = C.env_of_t t in+  let grd = C.grd_of_t t in+  let lhs = C.lhs_of_t t in+  let rhs = C.rhs_of_t t in+  let rhs_s = C.reft_to_string rhs in+  let tag = try string_of_int (C.id_of_t t) with _ -> +    failure "ERROR: t_to_armc: anonymous constraint %s" (C.to_string t) in+(*   let defs = defs_of_env state env in *)+  let annot_guards = +    Misc.map_partial+      (fun (bv, reft) ->+	 if C.ras_of_reft reft <> [] then+	   Some (reft_to_armc state (C.theta (Su.of_list [(C.vv_of_reft reft, Ast.eVar bv)]) reft),+		 C.binding_to_string (bv, reft))+	 else+	   None+      ) (env |> C.bindings_of_env)+    ++ [(pred_to_armc grd, P.to_string grd); +	(reft_to_armc state lhs, "|- " ^ (C.reft_to_string lhs))] in+  let ps, kvs =  +    List.fold_left (fun (ps', kvs') refa ->+		      match refa with+			| C.Conc p -> p::ps', kvs'+			| C.Kvar (subs, sym) -> ps', (subs, sym)::kvs'+		   ) ([], []) (C.ras_of_reft rhs) in+(* Andrey: obsolete code+  let env_sup = support_of_env state.sol env |> Sy.SSet.elements in+    Printf.printf "Rule %s\n" tag;+    Printf.printf "Env support #%d: %s\n" +      (List.length env_sup) (env_sup |> List.map Sy.to_string |> String.concat ", ");+    Printf.printf "Guard support %s: %s\n" +      (P.to_string grd) +      (P.support grd |> List.map Sy.to_string |> String.concat ", ");+*)    +    (if ps <> [] then+       [mk_rule error_pc annot_guards [(Ast.pAnd ps |> Ast.pNot |> pred_to_armc, "<: " ^ rhs_s)] tag]+     else +       [])+    +++      (List.map +	 (fun (_, sym) ->+	    mk_rule (mk_query ~suffix:primed_suffix state (symbol_to_armc sym))+	      annot_guards +	      [(reft_to_armc ~noquery:true ~suffix:primed_suffix state rhs, "<: " ^ rhs_s)]+	      tag+	 ) kvs)+++(*+  make -f Makefile.fixtop && ./f -latex /tmp/main.tex -armc /tmp/a.pl tests/pldi08-max.fq && cat /tmp/a.pl++tests:++for file in `ls pldi08-*-atom.fq`; do ../f -latex /tmp/main.tex -armc /tmp/a.pl $file; head -n 1 /tmp/a.pl; armc a.pl | grep correct; done++pldi08-arraymax-atom.fq  pass+pldi08-max-atom.fq       pass+pldi08-foldn-atom.fq     pass+pldi08-sum-atom.fq       pass+mask-atom.fq             pass+samples-atom.fq          pass ++test00.c                 pass++*)++let subs_kvar_to_strs state ?(suffix = "") subs kvar =+  let kv = symbol_to_armc kvar in +  let scope = StrMap.find kv state.kv_scope in+  let scope_set = strlist_to_strset scope in+  let subs_map = subs_to_map subs in+  let kvar_str = +    Printf.sprintf "%s(%s)" kv+      (List.map +	 (fun v ->+	   let v_cap = String.capitalize v in+	   let v_cap_suffix = v_cap ^ suffix in+	   try +	     match StrMap.find v subs_map with+	       | (Ast.Var s, _) -> +		 let v_exp = var_to_armc s in+		 if StrSet.mem v_exp scope_set then v_cap_suffix+		 else v_exp+	       | _ -> v_cap_suffix+	   with Not_found -> v_cap+	 ) scope |> String.concat ", ") +  in+  let subs_strs = +    StrMap.fold (fun v e acc ->+      let subs_str = +	Printf.sprintf "%s%s = %s" +	  (String.capitalize v) suffix (StrMap.find v subs_map |> expr_to_armc)+      in+      match e with +	| (Ast.Var s, _) -> +	  let v_exp = var_to_armc s in+	  if StrSet.mem v_exp scope_set then subs_str :: acc+	  else acc+	| _ -> subs_str :: acc+    ) subs_map [] +  in+  kvar_str, subs_strs++let mk_query_naming state = +  List.map+    (fun kv ->+      Printf.sprintf "query_naming(%s(%s))." kv+	(StrMap.find kv state.kv_scope +	    |> List.map +		(fun v -> +		  if 'a' <= v.[0] && v.[0] <= 'z' then v+		  else Printf.sprintf "'%s'" v+		) +	    |> String.concat ", ")+    ) state.kvs |> String.concat "\n"++exception ValidClause+let horn_clause_to_tc state hc = +  let head_str, head_grd_strs = +(*+    match hc.head_kvars with+      | [(subs, kvar)] -> +	let head_kvar_str, head_subs_strs = +	  subs_kvar_to_strs state ~suffix:"_0" subs kvar +	in+	head_kvar_str, head_subs_strs+      | [] -> +	let head_pred = push_neg ~neg:true hc.head_pred |> simplify_tauto in+	"false", if P.is_tauto head_pred then [] else [pred_to_armc head_pred]+      | _ :: _ -> +	print_horn_clause hc;+	failwith ("horn_clause_to_tc: unexpected clause " ^ hc.tag)+*)+    match P.is_tauto hc.head_pred, hc.head_kvars with+    | true, [(subs, kvar)] -> +    let head_kvar_str, head_subs_strs = +    subs_kvar_to_strs state ~suffix:"_0" subs kvar +    in+    head_kvar_str, head_subs_strs+    | true, [] -> raise ValidClause+    | false, [] -> +    let head_pred = push_neg ~neg:true hc.head_pred |> simplify_tauto in+    "false", if P.is_tauto head_pred then [] else [pred_to_armc head_pred]+    | _, _ -> +    print_horn_clause hc;+    failwith ("horn_clause_to_tc: unexpected clause " ^ hc.tag)+  in +  let tag_str = Printf.sprintf "id(%s)" hc.tag in+  let simple_body_pred = hc.body_pred |> push_neg ~neg:false |> simplify_tauto in+  let grd_tag_strs = +    if P.is_tauto simple_body_pred then tag_str :: head_grd_strs+    else pred_to_armc simple_body_pred :: tag_str :: head_grd_strs+  in+  let body_strs, _ = +    List.fold_left (fun (s, n) (subs, kvar) -> +      let kvar_str, subs_strs = subs_kvar_to_strs state ~suffix:("_" ^ string_of_int n) subs kvar in+      kvar_str :: (subs_strs ++ s),+      n+1+    ) (grd_tag_strs, 1) hc.body_kvars+  in+  Printf.sprintf "%s :- %s.\n" head_str (body_strs |> List.rev |> String.concat ", ")++let to_qarmc out ts wfs =+  print_endline "Translating to QARMC.";+  +  print_endline "=========================";+  List.iter (Format.printf "%a" (C.print_t None)) ts;+  print_endline "=========================";++  let state = mk_kv_scope out ts wfs in+(*  let hcs = List.map (fun t -> t_to_horn_clause t |> simplify_horn_clause) ts in *)+  let hcs = List.map t_to_horn_clause ts in+  output_string out (mk_query_naming state);+  output_string out "\n\n";+  List.iter (fun hc -> +    try horn_clause_to_tc state hc |> output_string out+    with ValidClause -> ()+  ) hcs;+  print_endline "heheheheh";+  List.iter (fun hc -> print_horn_clause hc; output_string out "\n") hcs
+ external/fixpoint/toRawHorn.ml view
@@ -0,0 +1,200 @@+(* Dumping constraints as Horn clauses without any simplifications *)++module C  = FixConstraint+module Co = Constants +module Sy = Ast.Symbol+module Su = Ast.Subst+module P = Ast.Predicate+module E = Ast.Expression+module StrMap = Map.Make (struct type t = string let compare = compare end)+module StrSet = Set.Make (struct type t = string let compare = compare end)+module Misc = FixMisc open Misc.Ops++let raw_true = "1=1"+let raw_false = "0=1"+++let sanitize_symbol s = +  Str.global_replace (Str.regexp "@") "_at_"  s |> Str.global_replace (Str.regexp "#") "_hash_" |>+      Str.global_replace (Str.regexp "\\.") "_dot_" |> Str.global_replace (Str.regexp "'") "_q_" ++let symbol_to_raw s = Sy.to_string s |> sanitize_symbol+let constant_to_raw = Ast.Constant.to_string+let bop_to_raw = function +  | Ast.Plus  -> "+"+  | Ast.Minus -> "-"+  | Ast.Times -> "*"+  | Ast.Div   -> "/"+let brel_to_raw = function +  | Ast.Eq -> "="+  | Ast.Ne -> "=\\="+  | Ast.Gt -> ">"+  | Ast.Ge -> ">="+  | Ast.Lt -> "<"+  | Ast.Le -> "=<"+let bind_to_raw (s, t) = (* Andrey: TODO support binders *)+  Printf.sprintf "%s:%s" (symbol_to_raw s) (Ast.Sort.to_string t |> sanitize_symbol)+let rec expr_to_raw expr = +  let e = E.unwrap expr in+    match e with+      | Ast.Con c -> constant_to_raw c+      | Ast.Var s -> symbol_to_raw s+      | Ast.App (s, es) -> +	  if !Co.purify_function_application then "_" else+	    let str = symbol_to_raw s in+	      if es = [] then str else+		Printf.sprintf "f_%s(%s)" str (List.map expr_to_raw es |> String.concat ", ")+      | Ast.Bin (e1, op, e2) ->+	  Printf.sprintf "(%s %s %s)" +	    (expr_to_raw e1) (bop_to_raw op) (expr_to_raw e2)+      | Ast.Ite (ip, te, ee) -> +	  Printf.sprintf "ite(%s, %s, %s)" +	    (pred_to_raw ip) (expr_to_raw te) (expr_to_raw ee)+      | Ast.Fld (s, e) -> +	  Printf.sprintf "fld(%s, %s)" (expr_to_raw e) (symbol_to_raw s) +      | _ -> failwith (Printf.sprintf "expr_to_raw: %s" (E.to_string expr))+and pred_to_raw pred = +  if P.is_tauto pred then +    raw_true+  else +    let p = P.unwrap pred in +      match p with+	| Ast.True -> raw_true+	| Ast.False -> raw_false+	| Ast.Bexp e -> Printf.sprintf "%s = 1" (expr_to_raw e)+	| Ast.Not (Ast.True, _) -> raw_false+	| Ast.Not (Ast.False, _) -> raw_true+	| Ast.Not p -> Printf.sprintf "neg(%s)" (pred_to_raw p) +	| Ast.Imp (p1, p2) -> Printf.sprintf "imp(%s, %s)" (pred_to_raw p1) (pred_to_raw p2)+	| Ast.And [] -> raw_true+	| Ast.And [p] -> pred_to_raw p+	| Ast.And (_::_ as ps) -> +	    Printf.sprintf "(%s)" (List.map pred_to_raw ps |> String.concat ", ")+	| Ast.Or [] -> raw_false+	| Ast.Or [p] -> pred_to_raw p+	| Ast.Or (_::_ as ps) -> Printf.sprintf "(%s)" (List.map pred_to_raw ps |> String.concat "; ")+	| Ast.Atom (e1, Ast.Eq, (Ast.Ite(ip, te, ee), _)) ->+	    let ip_str = pred_to_raw ip in+	    let e1_str = expr_to_raw e1 in+	      Printf.sprintf "((%s, %s = %s); (neg(%s), %s = %s))"+		ip_str e1_str (expr_to_raw te) +		ip_str e1_str (expr_to_raw ee) +	| Ast.Atom (e1, r, e2) ->+	    Printf.sprintf "%s %s %s" +              (expr_to_raw e1) (brel_to_raw r) (expr_to_raw e2)+	| Ast.Forall (qs,p) -> (* Andrey: TODO support forall *) +	    Printf.sprintf "forall([%s], %s)" +              (List.map bind_to_raw qs |> String.concat ", ") +	      (pred_to_raw p)++let subst_to_raw subst =+  Misc.map_to_string+    (fun (sym, expr) ->+       Printf.sprintf "%s = %s" (symbol_to_raw sym) (expr_to_raw expr)+    ) (Ast.Subst.to_list subst)++let kvar_to_scope_tbl = Hashtbl.create 100++let wfs_option = ref None++let is_upper c = c = Char.uppercase c++let find_scope wfs sym =+  match Misc.map_partial +    (fun wf -> +       let reft = C.reft_of_wf wf in +       let vv = C.vv_of_reft reft in+	 match C.ras_of_reft reft with+	   | [C.Kvar (subst, sym')] when (Ast.Subst.is_empty subst) && sym = sym' ->+	       let vv_raw = symbol_to_raw vv in+		 Some (vv_raw, +		       StrSet.remove vv_raw+			 (Sy.SMap.fold (fun bv reft sofar ->+					  if not(C.sort_of_reft reft |> Ast.Sort.is_int)+(*					      is_upper (Sy.to_string bv).[0] *)+					  then +					    sofar+					  else +					    StrSet.add (symbol_to_raw bv) sofar+				       ) (C.env_of_wf wf) StrSet.empty))+	   | _ -> None+    ) wfs with+      | (vv, scope) :: _ -> vv, scope+      | [] -> failwith (Printf.sprintf "Not found wf constraint for %s" (Sy.to_string sym))++let scope_of_ksym ksym =  +  try+    Hashtbl.find kvar_to_scope_tbl ksym+  with Not_found ->+    begin+      match !wfs_option with+	| Some wfs -> +	    let scope = find_scope wfs ksym in+	      Hashtbl.add kvar_to_scope_tbl ksym scope;+	      scope+	| None -> failwith "Uninitialized wfs_option reference"+    end++let refa_to_raw = function +  | C.Conc pred -> pred_to_raw pred+  | C.Kvar (subst, sym) ->+      let vv, scope = scope_of_ksym sym in +      let subs = Ast.Subst.to_list subst in+      let params =+	List.map (fun param ->+		    try+		      let _, exp =+			List.find (fun (v, _) -> +				     symbol_to_raw v = param+				  ) subs in +			match exp with +			  | Ast.Var param', _ -> symbol_to_raw param'+			  | _ -> failwith (Printf.sprintf "substition by a non-variable %s" (E.to_string exp))+		    with Not_found -> param +		 ) (vv :: (StrSet.elements scope |> List.sort compare))+      in+	Printf.sprintf "%s(%s)" (symbol_to_raw sym) (String.concat ", " params)++let reft_to_raw reft = +  if C.sort_of_reft reft |> Ast.Sort.is_func then +    raw_true+  else +    let ras = C.ras_of_reft reft in+      match ras with+	| [] -> raw_true+	| _ :: _ ->+	    Misc.map_to_string refa_to_raw ras++let subst_refa refa sym exp = +  match refa with +    | C.Conc pred -> C.Conc (P.subst pred sym exp)+    | C.Kvar (subst, sym') -> C.Kvar (Ast.Subst.extend subst (sym, exp), sym')++let subst_reft reft sym exp =+  C.make_reft +    (C.vv_of_reft reft) (C.sort_of_reft reft) +    (List.map (fun refa -> subst_refa refa sym exp) (C.ras_of_reft reft))++let env_to_raw env =+  Sy.SMap.fold +      (fun bv reft sofar -> +	 [subst_reft reft (C.vv_of_reft reft) (Ast.eVar bv) |> reft_to_raw] ++ sofar+      ) env [] |> List.filter ((<>) "1=1") |> String.concat ", "+++let c_to_raw c =+  Printf.sprintf "rule(%d, %s, [\n%s,\n%s,\n%s\n]).\n\n"+    (C.id_of_t c)+    (C.rhs_of_t c |> reft_to_raw)+    (C.lhs_of_t c |> reft_to_raw)+    (C.grd_of_t c |> pred_to_raw)+    (C.env_of_t c |> env_to_raw)++let to_raw_horn out cs wfs sol = +  let cs = FixSimplify.simplify_ts cs in+    wfs_option := Some wfs;+    print_endline "Translating to raw Horn clauses.";+    List.iter (fun c -> +		 Printf.fprintf out "/*\n%s*/\n" (C.to_string c);+		 output_string out (c_to_raw c)+	      ) cs
+ external/fixpoint/toSmtLib.ml view
@@ -0,0 +1,503 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++(* This module implements the IMP language and translation from fixpoint constraints *)+++module F  = Format+module H  = Hashtbl+module A  = Ast+module E  = A.Expression+module P  = A.Predicate+module Sy = A.Symbol+module So = A.Sort+module SM = Sy.SMap+module SS = Sy.SSet+module C  = FixConstraint+module Cg = FixConfig+module Co = Constants+(*module BS = BNstats*)++module Misc = FixMisc open Misc.Ops++let mydebug = false++(*************************************************************************)+(************* Datatypes for SMTLIB Representation ***********************)+(*************************************************************************)+(*+type sort = Int | Bool | Func of (sort list * sort)+*)+type rpred  +  = A.pred                      (* Bexp (App (k, es)) *) ++type vdef+  = Sy.t * So.t                 (* variable, sort *)++type kdef+  = Sy.t * (vdef list)++type cstr+  = { lhs : A.pred +    ; rhs : rpred option+    ; id  : int +    }++type smtlib +  = { vars   : vdef list+    ; kvars  : kdef list+    ; cstrs  : cstr list +    ; consts : vdef list+  }++type kmap +  = kdef SM.t++let is_kvar x = Misc.is_prefix "k_" (Sy.to_string x) ++(*************************************************************************)+(************* Rendering SMTLIB to String ********************************)+(*************************************************************************)++(* Printing as C syntax *)++let print_brel ppf = function+  | A.Eq -> F.fprintf ppf "="+  | A.Ne -> F.fprintf ppf "!="+  | A.Gt -> F.fprintf ppf ">"+  | A.Ge -> F.fprintf ppf ">="+  | A.Lt -> F.fprintf ppf "<"+  | A.Le -> F.fprintf ppf "<="++let print_bop ppf = function+  | A.Plus  -> F.fprintf ppf "+"+  | A.Minus -> F.fprintf ppf "-"+  | A.Times -> F.fprintf ppf "*"+  | A.Div   -> F.fprintf ppf "/"+  | A.Mod   -> F.fprintf ppf "mod"++let rec print_pred ppf pred =+  match P.unwrap pred with+  | A.True ->+      F.fprintf ppf "true"+  | A.False ->+      F.fprintf ppf "false"+  | A.Atom (e1, A.Ne, e2) ->+      F.fprintf ppf "(not (= %a %a))" +        print_expr e1 +        print_expr e2+  | A.Atom (e1, r, e2) ->+      F.fprintf ppf "(%a %a %a)" +        print_brel r +        print_expr e1 +        print_expr e2+  | A.And ps ->+      Misc.pprint_many_prefix "and" A.pTrue print_pred ppf ps+  | A.Or ps ->+      Misc.pprint_many_prefix "or" A.pFalse print_pred ppf ps+  | A.Not p ->+      F.fprintf ppf "(not %a)" print_pred p+  | A.Imp (p1, p2) ->+      F.fprintf ppf "(=> %a %a)" +        print_pred p1 +        print_pred p2+  | A.Iff (p1, p2) ->+      F.fprintf ppf "(= %a %a)" +        print_pred p1 +        print_pred p2+  | A.Bexp e ->+      print_expr ppf e+  | _ -> assertf "ERROR: ToSmtLib.print_pred %s" (P.to_string pred)+     +and print_expr_app f ppf = function +  | [e] -> +      F.fprintf ppf "(select %a %a)" +        Sy.print f +        print_expr e+  | e::es ->+      F.fprintf ppf "(select %a %a)"+        (print_expr_app f) es+        print_expr e++and print_expr ppf expr =+  match E.unwrap expr with+  | A.Con c ->+      F.fprintf ppf "%a" A.Constant.print c+  | A.App (v, []) +  | A.Var v ->+      F.fprintf ppf "%a" Sy.print v+  | A.App (f, es) when is_kvar f ->+      F.fprintf ppf "(%a %a)" +        Sy.print f+        (Misc.pprint_many false " " print_expr) es ++  | A.App (f, es) ->+      print_expr_app f ppf (List.rev es)++      (*+      print_expr_app f ppf (List.rev es)+      F.fprintf ppf "(%a %a)" +        Sy.print f+        (Misc.pprint_many false " " print_expr) es *)+  | A.Bin (e1, op, e2) ->+      F.fprintf ppf "(%a %a %a)"+        print_bop  op+        print_expr e1+        print_expr e2+  | A.Ite (p, e1, e2) ->+      F.fprintf ppf "(ite %a %a %a)"+        print_pred p+        print_expr e1+        print_expr e2+  | A.Cst (e, _) ->+      F.fprintf ppf "%a" print_expr e+  | _ -> assertf "ERROR: ToSmtLib.print_expr %s" (E.to_string expr)++let print_sort_base ppf t = +  if So.is_bool t then +    Format.fprintf ppf "Bool"+  else+    Format.fprintf ppf "Int"++let rec print_sort ppf t = match So.func_of_t t with+  | Some (_, [], t) ->+      print_sort_base ppf t++  | Some (_, ts, t) -> +      Format.fprintf ppf "%a %a"+        (Misc.pprint_many false " " print_sort) ts+        print_sort t+  | None -> +      print_sort_base ppf t++      +(*+let print_vdef ppf (x, t) = match So.func_of_t t with+  | Some (_, ts, t') when So.is_bool t' -> +      Format.fprintf ppf ":extrapreds ((%a %a))" +        Sy.print x +        (Misc.pprint_many false " " print_sort) ts+  | _ ->+      Format.fprintf ppf ":extrafuns ((%a %a))" +        Sy.print x +        print_sort t+*)++let rec print_fun_sorts ppf = function+  | [t]   -> print_sort ppf t+  | t::ts -> Format.fprintf ppf "(Array %a %a)" +               print_sort t+               print_fun_sorts ts++let print_vdef ppf (x, t) = match So.func_of_t t with+  | Some (_, ts, t') -> +     Format.fprintf ppf "(%a %a)"+       Sy.print x+       print_fun_sorts (ts @ [t'])+  | _ ->+      Format.fprintf ppf "(%a %a)" +        Sy.print x +        print_sort t++let print_const ppf c = +  Format.fprintf ppf "; constant \n%a\n" print_vdef c++let groupConsts cs = +  cs |> Misc.kgroupby snd +     |> Misc.map (Misc.app_snd (List.map fst))+     |> List.filter (snd <+> List.length <+> (>) 0)++let print_distinct ppf (t, cs) =+  Format.fprintf ppf +    "; distinct constants of sort: %a\n(distinct %a)\n"   +     print_sort t+     (Misc.pprint_many false " " Sy.print) cs++(*+let print_kdef ppf (kf, xts) = +  Format.fprintf ppf ":extrapreds ((%a %a))"+    Sy.print kf+    (Misc.pprint_many false " " print_sort) (List.map snd xts)+*)+let print_kdef ppf (kf, xts) =+  Format.fprintf ppf "(declare-fun %a (%a) Bool)"+    Sy.print kf+    (Misc.pprint_many false " " print_sort) (List.map snd xts)+++let print_rhs ppf = function+  | None   -> Format.fprintf ppf "false"+  | Some p -> Format.fprintf ppf "%a" print_pred p++(*+let print_cstr ppf c = +  Format.fprintf ppf "\n; cid = %d\n:assumption\n(implies (%a) %a)\n"+    c.id print_pred c.lhs print_rhs c.rhs+*)++let binds_of_cstr env c =+  let lsyms = P.support c.lhs                                     in+  let rsyms = match c.rhs with None -> [] | Some p -> P.support p in+  Misc.sort_and_compact (lsyms ++ rsyms)    +  |> List.filter (fun x -> SM.mem x env)+  |> List.map (fun x -> (x, SM.safeFind x env "binds_of_cstr"))++let print_cstr env ppf c = +  Format.fprintf ppf "\n; cid = %d\n(assert (forall (%a) \n (=> %a %a))\n)"+    c.id +    (Misc.pprint_many true " " print_vdef) (binds_of_cstr env c)+    print_pred c.lhs +    print_rhs c.rhs+++(*+let print ppf smt = +  Format.fprintf ppf +    "(benchmark unknown\n:status unsat\n:logic AUFLIA\n%a\n%a\n%a\n%a\n%a\n)"+    (Misc.pprint_many true "\n" print_vdef)     smt.vars+    (Misc.pprint_many true "\n" print_const)    smt.consts+    (Misc.pprint_many true "\n" print_kdef)     smt.kvars+    (Misc.pprint_many true "\n" print_distinct) (groupConsts smt.consts)+    (Misc.pprint_many true "\n" print_cstr)     smt.cstrs+*)++let print ppf smt =+  let env = SM.of_list (smt.vars ++ smt.consts) in+  Format.fprintf ppf +    "(set-logic HORN)\n; KVARS\n\n%a\n\n; CONSTRAINTS\n%a\n"+    (Misc.pprint_many true "\n" print_kdef)     smt.kvars+    (Misc.pprint_many true "\n" (print_cstr env)) smt.cstrs++++(*************************************************************************)+(************* Helpers for extracting var-sort bindings ******************) +(*************************************************************************)++let sort_compat x t t' =+  Ast.Sort.compat t t'+  >> (fun b -> if not b then +               Printf.printf "WARNING: k-sort incompatible for %s" +               (Sy.to_string x))++(* HACKY sort_compat because in the end everything is an Int *)+let sort_compat x t1 t2 = +  not (So.is_bool t1) +  && not (So.is_bool t2) +  && (not (So.is_func t1) || (t1 = t2))+  && (not (So.is_func t2) || (t1 = t2))++let vdefs_of_env env r = +  env |> C.bindings_of_env+      |> (++) [(C.vv_of_reft r, r)]+      |> List.map (Misc.app_snd C.sort_of_reft)+      (* |> List.filter (not <.> So.is_func <.> snd)  *)+      |> Misc.fsort fst++(*************************************************************************)+(************* Build VMap : gather all vars/sorts for regular vars *******) +(*************************************************************************)++let update_vmap vm (x, t) =+  Misc.maybe_iter begin fun t' ->+    asserts (sort_compat x t t') "ERROR: v-sort incompatible %s" (Sy.to_string x)+  end (SM.maybe_find x vm);+  SM.add x t vm++let update_vmap_int vm (x, t) =+  SM.add x So.t_int vm++let add_c_var_to_vmap vm c =+  let vvl = C.vv_of_reft (C.lhs_of_t c) in+  let vvr = C.vv_of_reft (C.rhs_of_t c) in+  let _   = asserts (vvl = vvr) "Different VVs in Constr: %d" (C.id_of_t c) in+  vdefs_of_env (C.env_of_t c) (C.lhs_of_t c)+  |> List.fold_left update_vmap_int vm + +let add_wf_var_to_vmap vm w =+  vdefs_of_env (C.env_of_wf w) (C.reft_of_wf w)+  |> List.fold_left update_vmap_int vm +  +(*************************************************************************)+(************ Build KMap: gather scopes for each kvar from wfs** *********)+(*************************************************************************)++let check_no_subs wid suks = +  asserts +    (List.for_all (fst <+> A.Subst.is_empty) suks) +    "NonTriv Subst wid=%d" wid++let join vds vds' = +  let xm  = SM.of_list vds  in+  List.filter begin fun (x, t) ->+    match SM.maybe_find x xm with+    | None    -> false+    | Some t' -> sort_compat x t t'  +  end vds'       ++let update_kmap vdefs km k : kmap =+  match SM.maybe_find k km with+  | None            -> SM.add k (k, vdefs) km+  | Some (_,vdefs') -> SM.add k (k, join vdefs vdefs') km++let add_wf_to_kmap km wf =+  let vdefs = vdefs_of_env (C.env_of_wf wf) (C.reft_of_wf wf) +              |> List.filter (snd <+> So.is_func <+> not)+  in+  C.reft_of_wf wf+  |> C.kvars_of_reft  +  >> check_no_subs (C.id_of_wf wf) +  |> List.map snd+  |> List.fold_left (update_kmap vdefs) km++let make_kmap defs : kmap = +  defs +  |> Misc.map_partial (function Cg.Wfc x -> Some x | _ -> None)+  |> List.fold_left add_wf_to_kmap SM.empty++let mkFreshI, _   = Misc.mk_int_factory ()+let mkFresh cid x = +  Sy.of_string (Format.sprintf "%s_smt_%d_%d" (Sy.to_string x) cid (mkFreshI ())) +(*  >> (fun x' -> Format.printf "fresh_var: %a \n" Sy.print x')+ *)++let fresh_vars env cid es = +  let t   = Hashtbl.create 17 in+  let msg = "fresh_vars: cid = "^(string_of_int cid) in   +  let es' = List.map begin fun e -> match e with+            | (A.Var x, _) ->+                if Hashtbl.mem t x then+                  x |> mkFresh cid >> Hashtbl.add t x |> A.eVar+                else let _ = Hashtbl.add t x x in e +            | _ -> failwith ("ERROR: " ^ msg)+            end es in+  let l' = Misc.hashtbl_keys t +           |> Misc.flap begin fun x -> +                let so = SM.safeFind x env msg in+                foreach (Hashtbl.find_all t x) begin fun x' ->+                  (x', so), A.pEqual ((A.eVar x), (A.eVar x'))+                end+              end+           |> List.split+           |> Misc.app_snd A.pAnd in+  l', es'++(*************************************************************************)+(************* Translating using the KMap ********************************)+(*************************************************************************)++let pred_of_kdef (kf, xts) =+  A.pBexp <| A.eApp (kf, List.map (fst <+> A.eVar) xts)  ++let soln_of_kmap km k =+  [pred_of_kdef <| SM.safeFind k km "soln_of_kmap"]+  (* >> (Format.printf "soln_of_kmap: k = %a ps = %a \n" Sy.print k (Misc.pprint_many false " " P.print))+   *)++let tx_constraint s c =+  let cid     = C.id_of_t c                 in+  let lps     = C.preds_of_lhs_nofilter s c in+  let v,t,ras = C.rhs_of_t c                in+  ras |>: begin function +            | C.Conc p -> { lhs = A.pAnd ((A.pNot p) :: lps)+                          ; rhs = None +                          ; id  = cid }+            | ra       -> { lhs = A.pAnd lps+                          ; rhs = (match C.preds_of_refa s ra with +                                  | [p] -> Some p +                                  | _   -> failwith "tx_constraint")+                          ; id  = cid}+          end+       +       |>: begin function+         (* Ken needed this tx but it messes up with typeclasses... maybe not+          * needed any more?  +            +         | { rhs = Some (A.Bexp (A.App (f, es),_), _) } as c' ->+                let (xts, eqp), es' = fresh_vars (C.senv_of_t c) cid es in+                let r'              = A.pBexp (A.eApp (f, es')) in +                (xts, {c' with lhs = A.pAnd [eqp; c'.lhs]; rhs = Some r' })+          *)+          |  c' -> ([], c')+          end++let tx_defs cfg =+  let defs = List.map (fun c -> Cg.Cst c) cfg.Cg.cs ++ +             List.map (fun c -> Cg.Wfc c) cfg.Cg.ws     in+  let km   = defs |> make_kmap                          in+  let s    = soln_of_kmap km                            in +  let cs   = cfg.Cg.cs                                  in+  let ws   = cfg.Cg.ws                                  in+  let xts,cs' = List.split <| Misc.flap (tx_constraint s) cs in+  { vars   =  Misc.flatten xts +           ++ (SM.to_list <| List.fold_left add_c_var_to_vmap SM.empty cs) +           ++ (SM.to_list <| List.fold_left add_wf_var_to_vmap SM.empty ws)+  ; kvars  = SM.range km+  ; cstrs  = cs'+  ; consts = SM.to_list cfg.Cg.uops +  }++(*************************************************************************)+(************* Slicing into Single Assertions ****************************)+(*************************************************************************)+++let split_by_assertion cfg =+  let ccs, kcs = Misc.tr_partition C.is_conc_rhs cfg.Cg.cs in+  Misc.map (fun c -> { cfg with Cg.cs = c :: kcs }) ccs++let slice_by_assertion cfg = +  let cs' =  cfg.Cg.cs +          |> Cindex.create cfg.Cg.kuts cfg.Cg.ds +          |> Cindex.slice +          |> Cindex.to_list+  in {cfg with Cg.cs = cs' }+++(*************************************************************************)+(************* API *******************************************************)+(*************************************************************************)++let dump_smtlib_indexed (no, cfg) =+  let su = Misc.maybe_apply (fun x _ -> "." ^ (string_of_int x)) no "" in+  let fn = !Constants.out_file ^ su ^ ".smt2"  in +  let _  = Co.bprintflush mydebug ("BEGIN: Dump SMTLIB \n") in+  let me = tx_defs cfg                         in+  let _  = Misc.with_out_formatter fn (fun ppf -> F.fprintf ppf "%a" print me) in+  let _  = Co.bprintflush mydebug ("DONE: Dump SMTLIB to " ^ !Constants.out_file ^"\n") in+  ()++let dump_smtlib_mono cfg = +  dump_smtlib_indexed (None, cfg);+  exit 1++let dump_smtlib_sliced cfg = +  cfg |>  split_by_assertion+      |>: slice_by_assertion+      |>  Misc.index_from 0+      |>: (Misc.app_fst some) +      |>  List.iter dump_smtlib_indexed+      |>  (fun _ -> exit 1)++let dump_smtlib = dump_smtlib_sliced+
+ external/fixpoint/toSmtLib.mli view
@@ -0,0 +1,86 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++(* HIDE: all the sigs for defined binders+ +type rpred = A.pred+type vdef = Sy.t * So.t+type kdef = Sy.t * vdef list+type cstr = { lhs : A.pred; rhs : rpred option; id : int; }+type smtlib = {+  vars : vdef list;+  kvars : kdef list;+  cstrs : cstr list;+  consts : vdef list;+}+type kmap = kdef SM.t+val is_kvar : Sy.t -> bool+val print_brel : F.formatter -> A.brel -> unit+val print_bop : F.formatter -> A.bop -> unit+val print_pred : F.formatter -> A.pred -> unit+val print_expr_app : Sy.t -> F.formatter -> A.expr list -> unit+val print_expr : F.formatter -> A.expr -> unit+val print_sort_base : Format.formatter -> So.t -> unit+val print_sort : Format.formatter -> So.t -> unit+val print_fun_sorts : Format.formatter -> So.t list -> unit+val print_vdef : Format.formatter -> Sy.t * So.t -> unit+val print_const : Format.formatter -> Sy.t * So.t -> unit+val groupConsts : ('a * 'b) list -> ('b * 'a list) list+val print_distinct : Format.formatter -> So.t * Sy.t list -> unit+val print_kdef : Format.formatter -> Sy.t * ('a * So.t) list -> unit+val print_rhs : Format.formatter -> A.pred option -> unit+val binds_of_cstr : 'a SM.t -> cstr -> (SM.key * 'a) list+val print_cstr : So.t SM.t -> Format.formatter -> cstr -> unit+val print : Format.formatter -> smtlib -> unit+val sort_compat : 'a -> So.t -> So.t -> bool+val vdefs_of_env : C.envt -> C.reft -> (Ast.Symbol.t * Ast.Sort.t) list+val update_vmap : So.t SM.t -> Sy.t * So.t -> So.t SM.t+val update_vmap_int : So.t SM.t -> SM.key * 'a -> So.t SM.t+val add_c_var_to_vmap : So.t SM.t -> C.t -> So.t SM.t+val add_wf_var_to_vmap : So.t SM.t -> C.wf -> So.t SM.t+val check_no_subs : int -> (A.Subst.t * 'a) list -> unit+val join : (SM.key * So.t) list -> (SM.key * So.t) list -> (SM.key * So.t) list+val update_kmap : vdef list -> kdef SM.t -> SM.key -> kmap+val add_wf_to_kmap : kdef SM.t -> C.wf -> kdef SM.t+val make_kmap : Cg.deft list -> kmap+val mkFreshI : unit -> int+val mkFresh : int -> Sy.t -> Sy.t+val fresh_vars : 'a SM.t -> int -> A.expr list -> ((Sy.t * 'a) list * A.pred) * A.expr list+val pred_of_kdef : A.Symbol.t * (A.Symbol.t * 'a) list -> A.pred+val soln_of_kmap : (A.Symbol.t * (A.Symbol.t * 'a) list) SM.t -> SM.key -> A.pred list+val tx_constraint : C.soln -> C.t -> ('a list * cstr) list+val tx_defs : 'a Cg.cfg -> smtlib+val split_by_assertion : 'a Cg.cfg -> 'a Cg.cfg list+val slice_by_assertion : 'a Cg.cfg -> 'a Cg.cfg+val dump_smtlib_indexed : int option * 'a Cg.cfg -> unit+val dump_smtlib_mono : 'a Cg.cfg -> 'b+val dump_smtlib_sliced : 'a Cg.cfg -> 'b+val dump_smtlib : 'a Cg.cfg -> 'b++*)++(* val render : Format.formatter -> FixConfig.deft list -> unit +val render : Format.formatter -> 'a FixConfig.cfg -> unit+*)+val dump_smtlib : 'a FixConfig.cfg -> unit+
+ external/fixpoint/toplevel.ml view
@@ -0,0 +1,48 @@+module BS = BNstats+module SM = Ast.Symbol.SMap+module Co = Constants +module C  = FixConstraint+module F  = Format+module Misc = FixMisc open Misc.Ops+++(*+let parse_string str =+  let lb = Lexing.from_string str in+    ArithParser.aexpr ArithLexer.token lb++let token_list_of_string s =+  let lb = Lexing.from_string s in+  let rec helper l = +    try +      let t = ArithLexer.token lb in+      if t = ArithParser.EOF then List.rev l else helper (t::l)+    with _ -> List.rev l+  in helper []++let eval_string env str = ArithInterpreter.eval env (parse_string str) +*)++(*****************************************************************)+(********************* Command line options **********************)+(*****************************************************************)++let parse f = +  let _  = Errorline.startFile f in+  let ic = open_in f in+  let rv = Lexing.from_channel ic |> FixParse.defs FixLex.token in+  let _  = close_in ic in+  rv++let read_inputs usage = +  Co.bprintflush true "\n\n";+  Co.bprintflush true "========================================================\n";+  Co.bprintflush true "© Copyright 2009 Regents of the University of California.\n";+  Co.bprintflush true "All Rights Reserved.\n";+  Co.bprintflush true "========================================================\n";+  Co.bprintflush false (Sys.argv |> Array.to_list |> String.concat " ");+  Co.bprintflush false "\n========================================================\n";+  let fs = ref [] in+  let _  = Arg.parse Co.arg_spec (fun s -> fs := s::!fs) usage in+  let fq = !fs |> BS.time "parse" (Misc.flap parse) |> FixConfig.create in +  (!fs, fq)
+ external/fixpoint/toplevel.mli view
@@ -0,0 +1,25 @@+(*+ * Copyright © 2009 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONAst.Symbol.+ *+ *)++val read_inputs      : string -> (string list * SolverArch.qbind FixConfig.cfg)+
+ external/fixpoint/tpGen.ml view
@@ -0,0 +1,499 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++(* This file is part of the LiquidC Project *)++module H  = Hashtbl+module F  = Format+module Co = Constants+module BS = BNstats+module A  = Ast+module Sy = A.Symbol+module So = A.Sort+module SM   = Sy.SMap+module P    = A.Predicate+module E    = A.Expression+module Misc = FixMisc +module SSM  = Misc.StringMap+module SMT  = SmtZ3.SMTZ3++open Misc.Ops+open ProverArch++let mydebug = false ++module MakeProver(SMT : SMTSOLVER) : PROVER = struct++  module Th   = Theories.MakeTheory(SMT) ++(*************************************************************************)+(*************************** Type Definitions ****************************)+(*************************************************************************)++type decl    = Vbl of (Sy.t * So.t) | Fun of Sy.t * int | Barrier++type var_ast = Const of SMT.ast | Bound of int * So.t++type t = { +  c             : SMT.context;+  tint          : SMT.sort;+  tbool         : SMT.sort;+  vart          : (decl, var_ast) H.t;+  funt          : (decl, SMT.fun_decl) H.t;+  tydt          : (So.t, SMT.sort) H.t;+  mutable vars  : decl list ;+  mutable bnd   : int;+  thy_sortm     : (So.tycon, Th.sortDef) H.t;+  thy_symm      : (Sy.t,     Th.appDef)  H.t;+}++(*************************************************************************)+(************************** Pretty Printing ******************************)+(*************************************************************************)++let pprint_decl ppf = function+  | Vbl (x, t) 	-> F.fprintf ppf "%a:%a" Sy.print x So.print t +  | Barrier 	-> F.fprintf ppf "----@." +  | Fun (s, i) 	-> F.fprintf ppf "%a[%i]" Sy.print s i++let dump_decls me =+  F.printf "Vars: %a" (Misc.pprint_many true "," pprint_decl) me.vars       ++(************************************************************************)+(***************************** Stats Counters  **************************)+(************************************************************************)++let nb_set  		= ref 0+let nb_query 		= ref 0++(************************************************************************)+(********************** Misc. Constants *********************************)+(************************************************************************)++let div_n  = Sy.of_string "_DIV"+let tag_n  = Sy.of_string "_TAG"+let mul_n  = Sy.of_string "_MUL"++let axioms = []++(* TBD these are related to ML and should be in DSOLVE, not here *)+let builtins = +  SM.empty +  |> SM.add tag_n  (So.t_func 0 [So.t_obj; So.t_int])+  |> SM.add div_n  (So.t_func 0 [So.t_int; So.t_int; So.t_int]) +  |> SM.add mul_n  (So.t_func 0 [So.t_int; So.t_int; So.t_int]) ++let select_t = So.t_func 0 [So.t_int; So.t_int]++let mk_select, is_select =+  let ss = "SELECT" in+  (fun f -> Sy.to_string f |> (^) (ss ^ "_") |> Sy.of_string),+  (fun s -> Sy.to_string s |> Misc.is_prefix ss)++let fresh = +  let x = ref 0 in+  fun v -> incr x; (v^(string_of_int !x))++(*************************************************************************)+(********************** Typing *******************************************)+(*************************************************************************)++let varSort env s =+  try SM.find s env with Not_found -> +    failure "ERROR: varSort cannot type %s in TPZ3 \n" (Sy.to_string s) ++let funSort env s =+  try SM.find s builtins with Not_found -> +    try SM.find s env with Not_found -> +      if is_select s then select_t else +        failure "ERROR: could not type function %s in TPZ3 \n" (Sy.to_string s) ++let rec z3Type me t =+  Misc.do_memo me.tydt begin fun t -> +    if So.is_bool t then me.tbool else+      if So.is_int t then me.tint else+        match z3TypeThy me t with +          | Some t' -> t'+          | None    -> me.tint+  end t t++and z3TypeThy me t = match So.app_of_t t with+ | Some (c, ts) when H.mem me.thy_sortm c -> +     let def = H.find me.thy_sortm c   in+     let zts = List.map (z3Type me) ts in+     Some (Th.mk_thy_sort def me.c zts)+ | _ -> None + +(***********************************************************************)+(********************** Identifiers ************************************)+(***********************************************************************)++let getVbl env x = Vbl (x, varSort env x)++let z3Var_memo me env x =+  let vx  = getVbl env x in+  Misc.do_memo me.vart+    (fun () -> +      let t   = x |> varSort env |> z3Type me in+      let sym = fresh "z3v" +             (* >> F.printf "z3Var_memo: %a :->  %s\n" Sy.print x *)+                |> SMT.stringSymbol me.c in +      let rv  = Const (SMT.var me.c sym t) in+      let _   = me.vars <- vx :: me.vars in +      rv) +    () vx++let z3Var me env x =+  match BS.time "z3Var memo" (z3Var_memo me env) x with+  | Const v      -> v+  | Bound (b, t) -> SMT.boundVar me.c (me.bnd - b) (z3Type me t)+++let z3Fun me env p t k = +  Misc.do_memo me.funt begin fun _ -> +    match So.func_of_t t with+    | None             -> assertf "MATCH ERROR: z3ArgTypes" +    | Some (_, ts, rt) ->+        let ts = List.map (z3Type me) ts in+        let rt = z3Type me rt in+        let cf = SMT.stringSymbol me.c (fresh "z3f") in+        let rv = SMT.funcDecl me.c cf (Array.of_list ts) rt in+        let _  = me.vars <- (Fun (p,k))::me.vars in+        rv+  end () (Fun (p, k))++(**********************************************************************)+(********************** Pred/Expr Transl ******************************)+(**********************************************************************)++ +exception Z3RelTypeError++let z3Bind me env x t =+  let vx = Vbl (x, varSort env x) in+  me.bnd <- me.bnd + 1; +  H.replace me.vart vx (Bound (me.bnd, t)); +  me.vars <- vx :: me.vars;+  SMT.stringSymbol me.c (fresh "z3b")++let rec z3Rel me env (e1, r, e2) =+  let p  = A.pAtom (e1, r, e2)                                   in+  let ok = A.sortcheck_pred Theories.is_interp (Misc.flip SM.maybe_find env) p   in +  (* let _  = F.printf "z3Rel: e = %a, res = %b \n" P.print p ok in+     let _  = F.print_flush ()                                   in *)+  if ok then +    SMT.mkRel me.c r (z3Exp me env e1) (z3Exp me env e2)+  else begin +    SM.iter (fun s t -> F.printf "@[%a :: %a@]@." Sy.print s So.print t) env;+    F.printf "@[%a@]@.@." P.print (A.pAtom (e1, r, e2));+    F.print_flush ();+    raise Z3RelTypeError+  end++and z3App me env p zes =+  let t  = funSort env p                      in+  let cf = z3Fun me env p t (List.length zes) in+  SMT.mkApp me.c cf zes++and z3AppThy me env def tyo f es = +  match A.sortcheck_app Theories.is_interp (Misc.flip SM.maybe_find env) tyo f es with +    | Some (s, t) ->+        let zts = So.sub_args s |> List.map (snd <+> z3Type me) in+        let zes = es            |> List.map (z3Exp me env)      in+        Th.mk_thy_app def me.c zts zes+    | None ->+        A.eApp (f, es)+        |> E.to_string+        |> assertf "z3AppThy: sort error %s"++and z3Mul me env = function+  | ((A.Con (A.Constant.Int i), _), e) +  | (e, (A.Con (A.Constant.Int i), _)) ->+      SMT.mkMul me.c (SMT.mkInt me.c i me.tint) (z3Exp me env e) +  | (e1, e2) when !Co.uif_multiply -> +      z3App me env mul_n (List.map (z3Exp me env) [e1; e2])+  | (e1, e2) -> +      SMT.mkMul me.c (z3Exp me env e1) (z3Exp me env e2)++and z3Exp me env = function+  | A.Con (A.Constant.Int i), _ -> +      SMT.mkInt me.c i me.tint +  | A.Var s, _ -> +      z3Var me env s+  | A.Cst ((A.App (f, es), _), t), _ when (H.mem me.thy_symm f) -> +      z3AppThy me env (H.find me.thy_symm f) (Some t) f es+  | A.App (f, es), _ when (H.mem me.thy_symm f) -> +      z3AppThy me env (H.find me.thy_symm f) None f es+  | A.App (f, es), _  -> +      z3App me env f (List.map (z3Exp me env) es)+  | A.Bin (e1, A.Plus, e2), _ ->+      SMT.mkAdd me.c (z3Exp me env e1) (z3Exp me env e2)+  | A.Bin (e1, A.Minus, e2), _ ->+      SMT.mkSub me.c (z3Exp me env e1) (z3Exp me env e2)+  | A.Bin((A.Con (A.Constant.Int n1), _), A.Times, (A.Con (A.Constant.Int n2), _)),_ ->+      SMT.mkInt me.c (n1 * n2) me.tint+  | A.Bin (e1, A.Times, e2), _ ->+      z3Mul me env (e1, e2)+  | A.Bin (e1, A.Div, e2), _ -> +      z3App me env div_n (List.map (z3Exp me env) [e1;e2])+  | A.Bin (e, A.Mod, (A.Con (A.Constant.Int i), _)), _ ->+      SMT.mkMod me.c (z3Exp me env e) (SMT.mkInt me.c i me.tint)+  | A.Bin (e1, A.Mod, e2), _ ->+      SMT.mkMod me.c (z3Exp me env e1) (z3Exp me env e2)+  | A.Ite (e1, e2, e3), _ -> +      SMT.mkIte me.c (z3Pred me env e1) (z3Exp me env e2) (z3Exp me env e3)++  | A.Fld (f, e), _ -> +      z3App me env (mk_select f) [z3Exp me env e] (** REQUIRES: disjoint field names *)+  | A.Cst (e, _), _ -> +      z3Exp me env e+  | e -> +      assertf "z3Exp: Cannot Convert %s!" (E.to_string e) ++and z3Pred me env = function+  | A.True, _ -> +      SMT.mkTrue  me.c+  | A.False, _ ->+      SMT.mkFalse me.c+  | A.Not p, _ -> +      SMT.mkNot  me.c (z3Pred me env p)+  | A.And ps, _ -> +      SMT.mkAnd me.c (List.map (z3Pred me env) ps)+  | A.Or ps, _  -> +      SMT.mkOr  me.c (List.map (z3Pred me env) ps)+  | A.Imp (p1, p2), _ -> +      SMT.mkImp me.c (z3Pred me env p1) (z3Pred me env p2)+  | A.Iff (p1, p2), _ ->+      SMT.mkIff me.c (z3Pred me env p1) (z3Pred me env p2)+  | A.Atom (e1, r, e2), _ ->+      z3Rel me env (e1, r, e2)+  | A.Bexp e, _ -> +      let a  = z3Exp me env e in+      let s2  = E.to_string e in+      let Some so = A.sortcheck_expr Theories.is_interp (Misc.flip SM.maybe_find env) e in+      let sos = So.to_string so in+      (* let s1  = SMT.astString me.c a in+      let _   = asserts (SMT.isBool me.c a) +                        "Bexp is not bool (e = %s)! z3=%s, fix=%s, sort=%s" +                        (E.to_string e) s1 s2 sos +      in *)      +      a++  | A.Forall (xts, p), _ -> +      let (xs, ts) = List.split xts                                  in+      let zargs    = Array.of_list (List.map2 (z3Bind me env) xs ts) in+      let zts      = Array.of_list (List.map  (z3Type me) ts)        in +      let rv       = SMT.mkAll me.c zts zargs (z3Pred me env p)      in+      let _        = me.bnd <- me.bnd - (List.length xs)             in+      rv+  | p -> +      assertf "z3Pred: Cannot Convert %s!" (P.to_string p) +++  +let z3Pred me env p = +  try +    let p = BS.time "fixdiv" A.fixdiv p in+    BS.time "z3Pred" (z3Pred me env) p+  with ex -> (F.printf "z3Pred: error converting %a\n" P.print p) ; raise ex ++(***************************************************************************)+(***************** Binder/Stack Management *********************************)+(***************************************************************************)++let rec vpop (cs,s) =+  match s with +  | []           -> (cs,s)+  | Barrier :: t -> (cs,t)+  | h :: t       -> vpop (h::cs,t) ++let clean_decls me =+  let cs, vars' = vpop ([],me.vars) in+  let _         = me.vars <- vars'  in +  List.iter begin function +    | Barrier    -> failure "ERROR: TPZ3-cleanDecls" +    | Vbl _ as d -> H.remove me.vart d +    | Fun _ as d -> H.remove me.funt d+  end cs++let handle_vv me env vv = +  H.remove me.vart (getVbl env vv) (* RJ: why are we removing this? *) +++(************************************************************************)+(********************************* API **********************************)+(************************************************************************)++let create_theories () =+  Th.theories +  |> (Misc.hashtbl_of_list_with Th.sort_name <**> Misc.hashtbl_of_list_with Th.sym_name)++let assert_distinct_constants me env = function [] -> () | cs -> +  cs |> Misc.kgroupby (varSort env) +     |> List.iter begin fun (_, xs) ->+         xs >> Co.bprintf mydebug "Distinct Constants: %a \n" (Misc.pprint_many false ", " Sy.print)+            |> List.map (z3Var me env) +            |> SMT.assertDistinct me.c+         end++let prep_preds me env ps =+  let ps = List.rev_map (z3Pred me env) ps in+  let _  = me.vars <- Barrier :: me.vars in+  ps++let valid me p = +  SMT.bracket me begin fun _ ->+    SMT.assertPreds me [SMT.mkNot me p];+    BS.time "unsat" SMT.unsat me +  end++(* API *)+let set_filter (me: t) (env: So.t SM.t) (vv: Sy.t) ps qs =+  let _   = ignore(nb_set   += 1); ignore (nb_query += List.length qs) in+  let _   = handle_vv me env vv  in+  let zps = prep_preds me env ps in (* DO NOT PUSH INSIDE SMT.bracket or z3 blocks postests/ll3.c *)+  SMT.bracket me.c begin fun _ ->+    let _        = SMT.assertPreds me.c zps                      in+    let tqs, fqs = List.partition (snd <+> P.is_tauto) qs        in+    let fqs      = fqs |> List.rev_map (Misc.app_snd (z3Pred me env))+                       |> Misc.filter  (snd <+> valid me.c)      in +    let _        = clean_decls me                                in+    (List.map fst tqs) ++ (List.map fst fqs)+  end++(* API *)+let print_stats ppf me =+  SMT.print_stats ppf ();+  F.fprintf ppf "TP stats: sets=%d, queries=%d, count=%d\n"  +    !nb_set !nb_query (List.length me.vars) ++(*************************************************************************)+(****************** Unsat Core for CEX generation ************************)+(*************************************************************************)++let mk_prop_var me pfx i : SMT.ast =+  i |> string_of_int+    |> (^) pfx+    |> SMT.stringSymbol me.c +    |> Misc.flip (SMT.var me.c) me.tbool ++let mk_prop_var_idx me ipa : (SMT.ast array * (SMT.ast -> 'a option)) =+  let va  = Array.mapi (fun i _ -> mk_prop_var me "uc_p_" i) ipa in+  let vm  = va +            |> Array.map   (SMT.astString me.c)+            |> Misc.array_to_index_list +            |> List .map Misc.swap +            |> SSM.of_list in +  let f z = SSM.maybe_find (SMT.astString me.c z) vm+            |> Misc.maybe_map (fst <.> Array.get ipa) in+  (va, f)++let mk_pa me p2z pfx ics =+  ics |> List.map (Misc.app_snd p2z) +      |> Array.of_list +      |> Array.mapi (fun i (x, p) -> (x, p, mk_prop_var me pfx i))++(* API *)+let unsat_core me env bgp ips =+  let _     = H.clear me.vart                                       in +  let p2z   = A.fixdiv <+> z3Pred me env                            in+  let ipa   = ips |> List.map (Misc.app_snd p2z) |> Array.of_list   in +  let va, f = mk_prop_var_idx me ipa                                in+  let zp    = ipa |> Array.mapi (fun i (_, p) -> SMT.mkIff me.c va.(i) p)+                  |> Array.to_list+                  |> (++) [p2z bgp]+                  |> SMT.mkAnd me.c in+  SMT.bracket me.c begin fun _ ->+    let _   = SMT.assertPreds me.c [zp] in+    let n   = Array.length va in+    let va' = Array.map id va in+    failwith "SMT-UNSAT-CORE-TODO"+    (************************************+    match SMT.check_assumptions me.c va n va' with+      | (Z3.L_FALSE, m,_, n, ucore) +          -> Array.map f ucore |> Array.to_list |> Misc.map_partial id +      | _ -> []+      ************************************)+  end++let contra me p = +  SMT.bracket me begin fun _ ->+    SMT.assertPreds me [p];+    BS.time "unsat" SMT.unsat me +  end++(* API *)+let is_contra me env =  z3Pred me env <+> contra me.c ++(* API *)+let unsat_suffix me env p ps =+  let _ = if SMT.unsat me.c then assertf "ERROR: unsat_suffix" in+  SMT.bracket me.c begin fun _ ->+    let rec loop j = function [] -> None | zp' :: zps' -> +      SMT.assertPreds me.c [zp']; +      if SMT.unsat me.c then Some j else loop (j-1) zps'+    in loop (List.length ps) (List.map (z3Pred me env) (p :: List.rev ps)) +  end++(***********************************************************************)+(******** Prover Object ************************************************)+(***********************************************************************)++(* API *)+let create ts env ps consts =+  let _        = asserts (ts = []) "ERROR: TPZ3-create non-empty sorts!" in+  let c        = SMT.mkContext [|("MODEL", "false"); ("MODEL_PARTIAL", "true")|] in+  let som, sym = create_theories () in +  let me       = { c     = c; +                   tint  = SMT.mkIntSort  c; +                   tbool = SMT.mkBoolSort c; +                   tydt  = H.create 37; +                   vart  = H.create 37; +                   funt  = H.create 37; +                   vars  = []; +                   bnd   = 0;+                   thy_sortm = som; +                   thy_symm  = sym +                 } +  in+  let _  = List.iter (z3Pred me env <+> SMT.assertAxiom me.c) (axioms ++ ps) in+  let _  = assert_distinct_constants me env consts                      in+  me++class tprover ts env ps consts : prover = +  object (self)+    val me = create ts env ps consts +    method interp_syms  = Theories.interp_syms +    method set_filter :  'a. Ast.Sort.t Ast.Symbol.SMap.t +                          -> Ast.Symbol.t +                          -> Ast.pred list +                          -> ('a * Ast.pred) list +                          -> 'a list+                        = set_filter me  +    method print_stats  = fun ppf -> print_stats ppf me +    method is_contra    = is_contra me +    method unsat_suffix = unsat_suffix me+  end++let mkProver ts env ps consts = new tprover ts env ps consts++end
+ external/fixpoint/tpNull.ml view
@@ -0,0 +1,38 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++open FixMisc.Ops++module Mem : ProverArch.PROVER = TpGen.MakeProver(SmtZ3.SMTZ3)+module Smt : ProverArch.PROVER = TpGen.MakeProver(SmtLIB2.SMTLib2)++let mydebug = false++let create ts env ps cs  +  = match !Constants.smt_solver with+      | None   -> +          Constants.bprintflush mydebug "\nUSING z3 bindings \n"; +          Mem.mkProver ts env ps cs+      | Some s -> +          Constants.bprintflush mydebug ("\nUSING SMTLIB bindings with " ^ s ^ "\n"); +          Smt.mkProver ts env ps cs+
+ external/misc/bNstats.ml view
@@ -0,0 +1,118 @@+(*+ *+ * Copyright (c) 2001 by+ *  George C. Necula	necula@cs.berkeley.edu+ *  Scott McPeak        smcpeak@cs.berkeley.edu+ *  Wes Weimer          weimer@cs.berkeley.edu+ *   + * All rights reserved.  Permission to use, copy, modify and distribute+ * this software for research purposes only is hereby granted, + * provided that the following conditions are met: + * 1. XSRedistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the authors may not be used to endorse or promote products + * derived from  this software without specific prior written permission. + *+ * DISCLAIMER:+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS + * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ *+ *)++                                        (* A hierarchy of timings *)+type t = { name : string;+           mutable time : float;+           mutable sub  : t list}++                                        (* Create the top level *)+let top = { name = "TOTAL";+            time = 0.0;+            sub  = []; }++                                        (* The stack of current path through +                                         * the hierarchy. The first is the +                                         * leaf. *)+let current : t list ref = ref [top]++let reset () = top.sub <- []++let do_time = ref true ++let dont_time () = do_time := false++let print chn msg = +  (* Total up *)+  top.time <- List.fold_left (fun sum f -> sum +. f.time) 0.0 top.sub;+  let rec prTree ind node = +    Printf.fprintf chn "%s%-20s          %6.3f s\n" +      (String.make ind ' ') node.name node.time  ;+    List.iter (prTree (ind + 2)) node.sub+  in+  Printf.fprintf chn "%s" msg;+  List.iter (prTree 0) [ top ]+        +let time str f arg = +  (* Find the right stat *)+  let stat : t = +    let curr = match !current with h :: _ -> h | _ -> assert false in+    let rec loop = function+        h :: _ when h.name = str -> h+      | _ :: rest -> loop rest+      | [] -> +          let nw = {name = str; time = 0.0; sub = []} in+            curr.sub <- nw :: curr.sub;+            nw+    in+      loop curr.sub+  in+  let oldcurrent = !current in+    current := stat :: oldcurrent;+    let start = (Unix.times ()).Unix.tms_utime in+    let _ = if str == "interp" then Printf.printf "interp start = %6.3f\n" start in+    let res   = +      try (f arg) with+	  x -> (let finish   = Unix.times () in+		let diff = finish.Unix.tms_utime -. start in+		let _ = if str == "interp" then Printf.printf "interp elapsed = %6.3f\n" diff in+		  stat.time <- stat.time +. (diff);+		  current := oldcurrent;+                  raise x) (* Pop the current stat *)+    in+    let finish   = Unix.times () in+    let diff = finish.Unix.tms_utime -. start in+    let _ = if str == "interp" then Printf.printf "interp elapsed = %6.3f\n" diff in+      stat.time <- stat.time +. (diff);+      current := oldcurrent;+      res+	++let time str f arg = if !do_time then time str f arg else f arg  ++let print chn msg = if !do_time then print chn msg else ()++++++++++++++++
+ external/misc/bNstats.mli view
@@ -0,0 +1,48 @@+(*  + *+ * Copyright (c) 2001 by+ *  George C. Necula	necula@cs.berkeley.edu+ *  Scott McPeak        smcpeak@cs.berkeley.edu+ *  Wes Weimer          weimer@cs.berkeley.edu+ *   + * All rights reserved.  Permission to use, copy, modify and distribute+ * this software for research purposes only is hereby granted, + * provided that the following conditions are met: + * 1. XSRedistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the authors may not be used to endorse or promote products + * derived from  this software without specific prior written permission. + *+ * DISCLAIMER:+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS + * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ *+ *)++(** Utilities for maintaining timing statistics *)++val dont_time : unit -> unit++(** Reset all the timings *)+val reset : unit -> unit ++(** Time a function and associate the time with the given string. If some+    timing information is already associated with that string, then accumulate+    the times. If this function is invoked within another timed function then+    you can have a hierarchy of timings *)+val time : string -> ('a -> 'b) -> 'a -> 'b ++(** Print the current stats preceeded by a message *)+val print : out_channel -> string -> unit+
+ external/misc/constants.ml view
@@ -0,0 +1,405 @@+(*+ * Copyright © 2009 The Regents of the University of California. + * All rights reserved. Permission is hereby granted, without written + * agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++open FixMisc.Ops+module SS = FixMisc.StringSet++(******* This module contains globals representing "flags" **************)+let lib_path            = Sys.argv.(0) |> Filename.dirname |> ref+let annotsep_name       = "\n\n=+=\n\n"+let global_name         = "GLOBAL"+++let file: string option ref = ref None         (* last commandline param*)+let csolve_file_prefix  = ref "csolve"         (* where to find/place csolve-related files *)+let safe                = ref false            (* -safe *)+let manual              = ref false            (* -manual *)+let out_file            = ref "out"            (* -save *)+let save_file           = ref "out.fq"         (* -save *)+let dump_ref_constraints= ref false            (* -drconstr *)+let ctypes_only         = ref false            (* -ctypes *)+let verbose_level       = ref 0                (* -v *)+let inccheck            = ref SS.empty         (* -inccheck *)+let cex                 = ref false            (* -counterexamples *)+let shortannots         = ref true             (* -shortannots *)+let strictsortcheck     = ref false            (* -strictsortcheck *)+let latex_file: string option ref = ref None   (* translate to LaTeX *)+let armc_file: string option ref  = ref None   (* translate to ARMC *)+let horn_file: string option ref  = ref None   (* translate to Horn clauses *)+let raw_horn_file: string option ref  = ref None   (* translate to raw Horn clauses *)+let q_armc_file: string option ref = ref None   (* OBSOLETE translate to Q'ARMC file *)+let dot_file: string option ref = ref None   (* translate to dot file *)+let purify_function_application = ref true  (* replace fun-terms by existentially quantified variables *)+let z3_timeout           = ref 25++let fastscalar                  = ref false (* -fastscalar *)+let vannots                     = ref true  (* -noannots *)+let minquals                    = ref true  (* -allquals *)+let ptag                        = ref true  (* -ptag *)+let genspec                     = ref false (* -genspec *)+let simplify_t                  = ref false (* simplify and prune vacuous FixConstraint.t constraints *)+let copyprop                    = ref true  (* perform copyprop to eliminate tempvars *)+let root                        = ref ""    (* root function *)+let refine_sort                 = ref false (* -refinesort *)+let sorted_quals                = ref false (* -sortedquals *)+let true_unconstrained          = ref true  (* -true_unconstrained *)+let do_nothing                  = ref false (* -nop *)+let smt_solver                  = ref (Some "z3") (* -smtsolver [z3, yices, cvc4, ...] *)+let dump_imp                    = ref false (* -imp *)+let dump_smtlib                 = ref false (* -smtlib *)+let dump_simp                   = ref ""    (* -simp *)+let prune_live                  = ref false (* -prunelive *)+let print_nontriv               = ref false (* -print_nontriv *)+let heapify_nonarrays           = ref true  (* heapify all stack variables *)+let timeout                     = ref (-1)+let lfp                         = ref true  (* -nolfp *)+let slice                       = ref true  (* -slice  *)+let no_lib_hquals               = ref false (* -no-lib-hquals *)+let gen_qual_sorts              = ref true  (* -no-gen-qual-sorts  *)+let web_demo                    = ref false (* -web-demo *)+let simple                      = ref true  (* -simple  *) ++(* JHALA: what do these do ? *)+let psimple       = ref true            (* -psimple *)+let dump_graph    = ref false           (* -dgraph :: this probably caused the dsolve solver to dump the constraint graph *)+let dropcalls     = ref false           (* -dropcalls *)+let adjdeps       = ref true            (* -origdeps *)+let check_is      = ref false           (* -check-indices *)+let trace_scalar  = ref false           (* -trace-scalar *)+let prune_index   = ref false           (* -prune-index *)  +let uif_multiply  = ref true            (* -no-uif-multiply *) ++(****************************************************************)+(************* Output levels ************************************)+(****************************************************************)+ +(* verbosity levels by purpose *)+let ol_always = 0+let ol_solve_error = 1+let ol_warning = 1+let ol_solve_master = 2+let ol_solve_stats = 2+let ol_timing = 2+let ol_warn_mlqs = 3+let ol_normalized = 3+let ol_finals = 3+let ol_ctypes = 3+let ol_dquals = 4 +let ol_unique_names = 5 (* must be > ol_dquals *)+let ol_solve = 10 +let ol_refine = 11 +let ol_scc = 12 +let ol_dump_env = 10 +let ol_axioms = 5+let ol_dump_prover = 20+let ol_verb_constrs = 21+let ol_dump_wfs = 22+let ol_dump_meas = 30+let ol_dump_quals = 50+let ol_insane = 200++let verb_stack = ref []+let ck_olev l              = l <= !verbose_level+let null_formatter         = Format.make_formatter (fun a b c -> ()) ignore+let nprintf a              = Format.fprintf null_formatter a+let cprintf l              = if ck_olev l then Format.printf else nprintf+let ecprintf l             = if ck_olev l then Format.eprintf else nprintf+let fcprintf ppf l         = if ck_olev l then Format.fprintf ppf else nprintf+let icprintf printer l ppf = if ck_olev l then printer ppf else printer null_formatter+let cprintln l s           = if ck_olev l then Printf.ksprintf (Format.printf "@[%s@\n@]") s else nprintf+let elevate_olev l         = if ck_olev l then () else verb_stack := !verbose_level :: !verb_stack; verbose_level := l+let restore_olev           = match !verb_stack with +                               | x :: xs -> verbose_level := x; verb_stack := xs +                               | _       -> ()++let bprintf b       = if b || ck_olev 1 then Format.printf else nprintf+let bprintflush b s = bprintf b "%s" s; flush stdout++++(******************************************************************************)+(*********************************** Logging **********************************)+(******************************************************************************)++let logChannel   = ref stdout+let logFormatter = ref (Format.formatter_of_out_channel stdout)++let setLogChannel lc =+  logChannel   := lc;+  logFormatter := Format.formatter_of_out_channel lc++let logPrintf a  = Format.fprintf !logFormatter a+let blogPrintf b = if b then logPrintf else nprintf+let cLogPrintf l = if ck_olev l then logPrintf else nprintf++(*****************************************************************)+(*********** Command Line Options ********************************)+(*****************************************************************)++(* taken from dsolve/liquid/liquid.ml *)++let arg_spec = +  [("-out", +    Arg.String (fun s -> out_file := s), +    " Save solution to file [out]"); +   ("-save", +    Arg.String (fun s -> save_file := s), +    " Save constraints to file [out.fq]"); +   ("-inccheck", +    Arg.String (fun s -> true_unconstrained := false; +                         inccheck := SS.add s !inccheck), +    " Incrementally check the specified function"); +   ("-noslice",+   Arg.Clear slice,+   " Compute fixpoint for all kvars, not just those affecting property"); +   ("-nolfp",+   Arg.Clear lfp,+   " Weaken environment (do not produce least fixed-point solution)"); +   ("-origdeps",+     Arg.Clear adjdeps,+     " Don't adjust constraint dependencies [true]");+   ("-dropcalls",+     Arg.Set dropcalls,+     " Ignore function calls during consgen [false]");+   ("-drconstr", +    Arg.Set dump_ref_constraints, +    " Dump refinement constraints [false]");+   ("-noshortannots",+    Arg.Clear shortannots,+    " Annotations with full predicates (not names) [false]");+   ("-strictsortcheck",+    Arg.Set strictsortcheck,+    " Strict Sort Checking -- e.g. ptr/int comparisons -- for non-C constraints+    [false]");+   ("-ctypes",+    Arg.Set ctypes_only,+    " Infer ctypes only [false]");+   ("-safe", +    Arg.Set safe, +    " run in failsafe mode [false]");+   ("-manual",+    Arg.Set manual,+    " only verify manually-inserted checks");+   ("-fastscalar",+    Arg.Set fastscalar,+    " use new (experimental) fastscalar solver, eventually will be default"); +   ("-counterexamples",+    Arg.Set cex,+    " generate counterexamples [false] ");+   ("-noannots",+    Arg.Unit (fun () -> vannots := false; minquals := false),+    " generate vim readable annotation file [true] ");+   ("-allquals",+    Arg.Clear minquals,+    " don't minimize qualifiers by using pre-computed one-level implication [true] ");+   ("-timeout",+    Arg.Set_int timeout,+    " limit total time (in seconds, default no limit)");+   ("-ptag", +    Arg.Set ptag, +    " prioritize constraints using lexico-ordering on tags [true]");+   ("-genspec", +    Arg.Set genspec, +    " Generate spec file only [false]");+   ("-root",+    Arg.String (fun s -> root := s),+    " Use root function []");+   ( "-nosimple"+   , Arg.Clear simple+   , " Directly propagate qualifiers for simple constraints (K1 <: K2) [true]");+   ("-psimple", +    Arg.Set psimple, +    " prioritize simple constraints [true]");+   ("-dgraph", +    Arg.Set dump_graph, +    " dump constraints SCC to constraints.dot [false]");+   ("-sortedquals",+    Arg.Set sorted_quals,+    " use sorted parameters in the qualifiers, to speed up instantiation. Should+      become default after vetting.");+   ("-refinesort",+    Arg.Set refine_sort,+    " use sortchecking to refine constraints -- and toss out badly instantiated quals. +      Shouldn't need except for backward compatibility with dsolve constraints, DONT USE!");+   ("-notruekvars",+    Arg.Clear true_unconstrained,+    " don't true unconstrained kvars [true]");+   ("-v", Arg.Int (fun c -> verbose_level := c), +              " <level> Set degree of analyzer verbosity:\n\+               \032    0      No output\n\+               \032    1      +Verbose errors\n\+               \032    [2]    +Verbose stats, timing\n\+               \032    3      +Print normalized source\n\+               \032    11     +Verbose solver\n\+               \032    13     +Dump constraint graph\n\+               \032    64     +Drowning in output");+   ("-latex", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 || String.sub s (l-4) 4 <> ".tex" then+		      print_endline "-latex: invalid parameter"+		    else+		      latex_file := Some s),+    " translates constraints to LaTeX file"+   );+   ("-armc", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 then+		      print_endline "-armc: invalid parameter"+		    else+		      armc_file := Some s),+    " translate constraints to ARMC file"+   );+   ("-horn", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 then+		      print_endline "-rules: invalid parameter"+		    else+		      horn_file := Some s),+    " translate constraints to Horn clauses"+   );+   ("-raw-horn", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 then+		      print_endline "-rules: invalid parameter"+		    else+		      raw_horn_file := Some s),+    " translate constraints to raw Horn clauses"+   );+   ("-qarmc", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 then+		      print_endline "-qarmc: invalid parameter"+		    else+		      q_armc_file := Some s),+    " translate constraints to Q'ARMC file"+   );+   ("-dot", +    Arg.String (fun s -> +		  let l = String.length s in+		    if l = 0 || String.sub s (l-4) 4 <> ".dot" then+		      print_endline "-dot: invalid parameter"+		    else+		      dot_file := Some s),+    " translate constraints to dot file"+   );+   ("-keep-uif", +    Arg.Clear purify_function_application,+    " do not replace function terms by existentially quantified variables"+   );+   ("-no-simplify-t", +    Arg.Clear simplify_t,+    " do not simplify constraints"+   );+   ("-simplify-t", +    Arg.Set simplify_t,+    " simplify constraints"+   );+   ("-nocopyprop", +    Arg.Clear copyprop,+    " simplify constraints via local copy propagation [true]"+   );+   ("-libpath",+    Arg.String (fun s -> lib_path := s), +    (" library path for default spec, quals ["^(!lib_path)^"]")+   );+   ("-nop",+    Arg.Set do_nothing,+    " do nothing (useful for regression tests known to be broken)";+   );+   ("-imp",+    Arg.Set dump_imp,+    " print constraints as IMP program (experimental)"+   );+   ("-smtsolver",+    Arg.String (fun s -> smt_solver := if s = "z3mem" then None else Some s),+    (" SMT solver (default: Z3 SMTLIB2. z3mem for bindings)")+   );+   ("-smtlib",+    Arg.Set dump_smtlib,+    " print constraints as SMTLIB query (experimental)"+   );+   ("-prunelive",+    Arg.Set prune_live,+    " Restrict liquid types to live variables (experimental)"+   );+   ("-no-uif-multiply",+    Arg.Clear uif_multiply,+    " Don't encode non-linear multiplication with UIFs [true]"+   );+   ("-simp",+    Arg.String ((:=) dump_simp),+    " print simplified constraints to save-file (experimental) use [andrey] or [jhala] or [id]"+   );+   ("-print-nontriv",+    Arg.Set (print_nontriv),+    " print non-trivial bindings in each environment [false]"+   );+   ("-trace-scalar",+    Arg.Set(trace_scalar),+    " print constraints and index values in the Index solver");+   ("-check-indices",+    Arg.Set(check_is),+    " sanity check computed indices");+   ("-prune-index",+    Arg.Set(prune_index),+    " use the index domain to prune initial solution");+   ("-no-lib-hquals",+    Arg.Set(no_lib_hquals),+    " don't use qualifier library in type inference");+   ("-no-gen-qual-sorts",+    Arg.Clear(gen_qual_sorts),+    " don't generalize parameter sorts in qualifiers");+   ("-web-demo",+    Arg.Set(web_demo),+    " set HTML output to web demo mode");+  ]+++let is_prefix p s = +  let reg = Str.regexp p in+  Str.string_match reg s 0++(******************************************************************)+(*************** Paths for builtin specs, quals etc ***************)+(******************************************************************)++let get_lib_squals  = fun () -> Filename.concat !lib_path "lib.squals"+let get_lib_hquals  = fun () -> Filename.concat !lib_path "lib.hquals"+let get_lib_spec    = fun () -> Filename.concat !lib_path "lib.spec"+let get_lib_h       = fun () -> Filename.concat !lib_path "lib.h"+let get_csolve_h    = fun () -> Filename.concat !lib_path "../lib/csolve.h"+let get_c2html      = fun () -> Filename.concat !lib_path "../demo/jquery/cs2html.py"++(* TODO: FIX SHADY HACK *)+let set_csolve_file_prefix fn = csolve_file_prefix := fn+(*+  let fn' = try (Filename.chop_extension fn)^".c" with _ -> fn   in+  if Filename.check_suffix fn ".o" && Sys.file_exists fn' then +    csolve_file_prefix := fn'+  else +    csolve_file_prefix := fn+    *)
+ external/misc/errorline.ml view
@@ -0,0 +1,31 @@+type info =+    { mutable  linenum: int;   (* current line number *)+      mutable  linepos: int;   (* char position of beginning of current line *)	+      fileName        : string (* current file name *)+    }+      +let current : info ref = +  ref +    { linenum  = 1 ;+      linepos  = 0 ;+      fileName = ""+    }	++let startFile fname =+  current := { linenum  = 1 ;+               linepos  = 0 ;+               fileName = fname}++let startNewline n =+  let i = !current in+  begin+    i.linenum <- i.linenum + 1 ;+    i.linepos <- n+  end++    +let error n msg = +  let i = !current in+    Printf.eprintf "%s at %s: %d.%d\n" +      msg i.fileName i.linenum (n - i.linepos)+
+ external/misc/fcommon.ml view
@@ -0,0 +1,128 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++module F = Format+module C = Constants++let mydebug = false ++(****************************************************************)+(************* SCC Ranking **************************************)+(****************************************************************)++module Int : Graph.Sig.COMPARABLE with type t = int * string =+struct+   type t = int * string +   let compare = compare+   let hash = Hashtbl.hash+   let equal = (=)+end++module G = Graph.Imperative.Digraph.Concrete(Int)++module SCC = Graph.Components.Make(G)    ++(* Use of Graphviz *)++let io_to_string = function +  | Some i -> string_of_int i +  | None -> "*"++module DotGraph =+struct+   type t = G.t+   module V = G.V+   module E = G.E+   let iter_vertex = G.iter_vertex+   let iter_edges_e = G.iter_edges_e+   let graph_attributes g = [`Size (11.0, 8.5); `Ratio (`Float 1.29)]+   let default_vertex_attributes g = [`Shape `Box]+   let vertex_name (i,_) = string_of_int i (* Printf.sprintf "V_%d" i *) +   let vertex_attributes (_,s) = [`Label s]+   let default_edge_attributes g = []+   let edge_attributes e = []+   let get_subgraph v = None+end++module Dot = Graph.Graphviz.Dot(DotGraph) ++let dump_graph s g = +  let oc = open_out (s^".dot") in+  Dot.output_graph oc g; +  close_out oc++let int_s_to_string ppf (i,s) = +  F.fprintf ppf "(%d,%s)" i s ++let scc_print g a = +  C.bprintf mydebug "dep graph: vertices= %d, sccs= %d \n" (G.nb_vertex g) (Array.length a);+  C.bprintf mydebug "scc sizes: \n";+  Array.iteri begin fun i xs -> +    C.bprintf mydebug "%d : [%a] \n" i (FixMisc.pprint_many false "," int_s_to_string) xs+  end a;+  C.bprintf mydebug "\n"++let make_graph s f is ijs = +  let g = G.create () in+  let _ = List.iter (fun i -> G.add_vertex g (i, (f i))) is in+  let _ = List.iter (fun (i,j) -> G.add_edge g (i,(f i)) (j,(f j))) ijs in+  let _ = if !Constants.dump_graph then dump_graph s g in+  g+ +(* Given list [(u,v)] returns a numbering [(ui,ri)] s.t. + * 1. if ui,uj in same SCC then ri = rj+ * 2. if ui -> uj then ui >= uj *)+let scc_rank s f is ijs = +  let g = BNstats.time "making_graph" (make_graph s f is) ijs in+  let a = SCC.scc_array g in+  let _ = scc_print g a in+  let sccs = FixMisc.array_to_index_list a in+  FixMisc.flap (fun (i,vs) -> List.map (fun (j,_) -> (j,i)) vs) sccs++(*+let g1 = [(1,2);(2,3);(3,1);(2,4);(3,4);(4,5)];;+let g2 = [(0,1);(1,2);(2,0);(1,3);(4,3);+          (5,6);(5,7);(6,9);(7,9);(7,8);(8,5)];;+let g3 = (6,2)::g2;;+let g4 = (2,6)::g2;;+  +let n1 = make_scc_num g1 ;;+let n2 = make_scc_num g2 ;;+let n3 = make_scc_num g3 ;;+let n4 = make_scc_num g4 ;; *)++(*+type fc_id = int option +type subref_id = int ++module WH = +  Heaps.Functional(struct +      type t = subref_id * int * (int * bool * fc_id)+      let compare (_,ts,(i,j,k)) (_,ts',(i',j',k')) =+        if i <> i' then compare i i' else+          if ts <> ts' then -(compare ts ts') else+            if j <> j' then compare j j' else +              compare k' k+    end)+*)+
+ external/misc/fcommon.mli view
@@ -0,0 +1,24 @@+(*+ * Copyright © 2008 The Regents of the University of California. All rights reserved.+ *+ * Permission is hereby granted, without written agreement and without+ * license or royalty fees, to use, copy, modify, and distribute this+ * software and its documentation for any purpose, provided that the+ * above copyright notice and the following two paragraphs appear in+ * all copies of this software.+ *+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY+ * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES+ * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN+ * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY+ * OF SUCH DAMAGE.+ *+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION+ * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++val scc_rank : string -> (int -> string) -> int list -> (int * int) list -> (int * int) list
+ external/misc/fixMisc.ml view
@@ -0,0 +1,1353 @@+(*+ * Copyright ? 1990-2007 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(* $Id: misc.ml,v 1.14 2006/09/26 01:47:01 jhala Exp $+ *+ * This file is part of the SIMPLE Project.+ *)++(**+ * This module provides some miscellaneous useful helper functions.+ *)++module Ops = struct++  type ('a, 'b) either = Left of 'a | Right of 'b++  let (>|) _ x = x++  let (|>) x f = f x++  let (<|) f x = f x++  let (>>) x f = f x; x++  let (|>>) xo f = match xo with None -> None | Some x -> f x++  let (|>:) xs f = List.map f xs++  let (=+) x n = let v = !x in (x := v + n; v)++  let (+=) x n = x := !x + n; !x++  let (++) = List.rev_append++  let (+++)= fun (x1s, y1s) (x2s, y2s) -> (x1s ++ x2s, y1s ++ y2s)++  let id = fun x -> x++  let un = fun x -> ()++  let const x = fun _ -> x++  let (<.>) f g  = fun x -> x |> g |> f++  let (<+>) f g  = fun x -> x |> f |> g ++  let (<?>) b f  = fun x -> if b then f x else x++  let wwhen b f  = fun x -> if b then f x ++  let (<*>) f g  = fun x -> (f x, g x)+  +  let (<**>) f g = fun (x, y) -> (f x, g y)++  let (<&&>) f g = fun x -> f x && g x++  let failure fmt = Printf.ksprintf failwith fmt++  let foreach xs f = List.map f xs++  let asserts p fmt =+    Printf.ksprintf (fun x -> if not p then failwith x) fmt++let asserti = asserts+  (*+let asserti p fmt = +  Printf.ksprintf (fun x -> if not p then (print_string (x^"\n"); ignore(0/0)) else ()) fmt+*)++let assertf fmt =+  Printf.ksprintf failwith fmt++let halt _ =+  assert false++let fst3 (x,_,_) = x+let snd3 (_,x,_) = x+let thd3 (_,_,x) = x++let fst4 (x, _, _, _) = x+let snd4 (_, x, _, _) = x+let thd4 (_, _, x, _) = x+let fth4 (_, _, _, x) = x++let withfst3 (_,y,z) x = (x,y,z)+let withsnd3 (x,_,z) y = (x,y,z)+let withthd3 (x,y,_) z = (x,y,z)++let print_now s = +  print_string s;+  flush stdout++let print_now_error msg =+  prerr_string msg;+  flush stderr++let output_now c s = +  output_string c s; +  flush c++let some = fun x -> Some x++end++open Ops++let maybe_fold f b xs = +  let fo = fun bo x -> match bo with Some b -> f b x | _ -> None in+  List.fold_left fo (Some b) xs++let maybe_map f = function Some x -> Some (f x) | None -> None++let maybe_iter f = function Some x -> f x | None -> ()++let maybe = function Some x -> x | _ -> assertf "maybe called with None"++let maybe_apply f xo v = match xo with Some x -> f x v | None -> v++let maybe_default xo y = match xo with Some x -> x | None -> y++let maybe_string f = function Some x -> "Some " ^ (f x) | None -> "None"++let rec maybe_chain x d = function +  | f::fs -> (match f x with +              | Some y -> y +              | None -> maybe_chain x d fs)+  | []    -> d++++++let trace s f x =+  let _ = print_now <| Printf.sprintf "BEGIN: %s \n" s in+  let r = f x in+  let _ = print_now <| Printf.sprintf "END: %s \n" s   in+  r++(* ORIG+let rec pprint_many_box s f ppf = function+  | []     -> ()+  | x::[]  -> Format.fprintf ppf "%a" f x+  | x::xs' -> (Format.fprintf ppf "%a%s@\n" f x s; pprint_many_box s f ppf xs')+*)+let rec pprint_many_prefix sep base f ppf = function+  | x::xs -> Format.fprintf ppf "(%s %a %a)" +               sep f x (pprint_many_prefix sep base f) xs+  | []    -> Format.fprintf ppf "%a" f base+++let rec pprint_many_box brk s f ppf = function+  | []              -> ()+  | [x]             -> Format.fprintf ppf "%a" f x+  | x::xs' when brk -> Format.fprintf ppf "%a@\n%s" f x s; +                       pprint_many_box brk s f ppf xs'+  | x::xs'          -> Format.fprintf ppf "%a@,%s" f x s;+                       pprint_many_box brk s f ppf xs'++let pprint_many_box brk l s r f ppf = function+  | []     -> Format.fprintf ppf "[]"+  | xs     -> Format.fprintf ppf "@[%s%a%s@]" l (pprint_many_box brk s f) xs r++let pprint_many_brackets brk f ppf x = +  Format.fprintf ppf "%a" (pprint_many_box brk "[ " "; " "]" f) x++let rec pprint_many brk s f ppf = function+  | []              -> ()+  | [x]             -> Format.fprintf ppf "%a" f x+  | x::xs' when brk -> Format.fprintf ppf "%a%s@," f x s; pprint_many brk s f ppf xs'+  | x::xs'          -> Format.fprintf ppf "%a%s" f x s ; pprint_many brk s f ppf xs'++let pprint_maybe f ppf = function+  | Some x -> Format.fprintf ppf "Some %a" f x+  | None   -> Format.fprintf ppf "None"++let pprint_int ppf i =+  Format.fprintf ppf "%d" i++let pprint_int_o = pprint_maybe pprint_int+(*+let pprint_int_o ppf = function+  | None -> Format.fprintf ppf "None" +  | Some d -> Format.fprintf ppf "Some(%d)" d+*)++let pprint_str ppf s =+  Format.fprintf ppf "%s" s++let pprint_ints ppf is = +  pprint_many_brackets false (fun ppf i -> Format.fprintf ppf "%d" i) ppf is++let pprint_pretty_ints ppf is = +  is |> List.map string_of_int |> String.concat ";" |> Format.fprintf ppf "[%s]"++let pprint_tuple pp1 pp2 ppf (x1, x2) = +  Format.fprintf ppf "(%a, %a)" pp1 x1 pp2 x2++let rec subsets n = function+  | _ when n <= 0 +    -> [[]]+  | xs when n > List.length xs->+      []+  | x::xs +    -> (List.map (fun ys -> x :: ys) (subsets (n-1) xs))+    ++ (subsets n xs)+  | _ -> assertf "Misc.subsets"++let choose b f g = if b then f else g++let liftfst2 (f: 'a -> 'a -> 'b) (x: 'a * 'c) (y: 'a * 'c): 'b =+  f (fst x) (fst y)++let curry   = fun f x y   -> f (x,y)+let uncurry = fun f (x,y) -> f x y+let flip    = fun f x y   -> f y x++let maybe_bool = function+  | Some _ -> true+  | None   -> false++module type EMapType = sig+  include Map.S+  val extendWith   : (key -> 'a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t+  val extend       : 'a t -> 'a t -> 'a t+  val filter       : (key -> 'a -> bool) -> 'a t -> 'a t+  val of_list      : (key * 'a) list -> 'a t+  val to_list      : 'a t -> (key * 'a) list+  val length       : 'a t -> int+  val domain       : 'a t -> key list+  val range        : 'a t -> 'a list+  val join         : 'a t -> 'b t -> ('a * 'b) t+  val adds         : key -> 'a list -> 'a list t -> 'a list t+  val of_alist     : (key * 'a) list -> 'a list t+  val finds        : key -> 'a list t -> 'a list+  val safeFind     : key -> 'a t -> string -> 'a+  val safeAdd      : key -> 'a -> 'a t -> string -> 'a t+  val single       : key -> 'a -> 'a t+  val map_partial  : ('a -> 'b option) -> 'a t -> 'b t+  val maybe_find   : key -> 'a t -> 'a option+  val find_default : 'a -> key -> 'a t -> 'a+  val frequency    : key list -> int t+end++module type ESetType = sig+  include Set.S+  val of_list : elt list -> t+end++module ESet (K: Set.OrderedType) = +  struct+    include Set.Make(K)+    let of_list = List.fold_left (flip add) empty  +end++module type EOrderedType = sig+  include Map.OrderedType +  val print : Format.formatter -> t -> unit+end++(* module EMap (K: Map.OrderedType) = *) +module EMap (K: EOrderedType) = +  struct+    include Map.Make(K)++    let extendWith (f: key -> 'a -> 'a -> 'a) (m1: 'a t) (m2: 'a t) =+      fold begin fun k v m -> +        let v' = if mem k m then f k v (find k m) else v in+        add k v' m+      end m2 m1 +    +    let extend (m1: 'a t)  (m2: 'a t) : 'a t = fold add m2 m1++    (* in 3.12 *)+    let filter (f: key -> 'a -> bool) (m: 'a t) : 'a t =  +      fold (fun x y m -> if f x y then add x y m else m) m empty +    +    let of_list (kvs : (key * 'a) list) = +      List.fold_left (fun m (k, v) -> add k v m) empty kvs++        (* in 3.12 -- bindings *)+    let to_list (m : 'a t) : (key * 'a) list = +      fold (fun k v acc -> (k,v)::acc) m [] ++    (* in 3.12 -- cardinality *)+    let length (m : 'a t) : int = +      fold (fun _ _ i -> i+1) m 0++    (* in 3.12 -- singleton *)+    let single k v = add k v empty++    let domain m =+      fold (fun k _ acc -> k :: acc) m []++    let range (m : 'a t) : 'a list = +      fold (fun _ v acc -> v :: acc) m []+     +    let join (m1 : 'a t) (m2 : 'b t) : ('a * 'b) t =+      mapi begin fun k v1 ->+        let _  = asserts (mem k m2) "EMap.join" in+        (v1, find k m2) +      end m1++    let maybe_find k m = +      try Some (find k m) with Not_found -> None++    let find_default d k m = +      maybe_default (maybe_find k m) d ++    (* let finds k m = try find k m with Not_found -> [] *)+    let finds k m = find_default [] k m++    let adds (k: key) (vs: 'a list) (m : ('a list) t) : 'a list t = +      add k (vs ++ find_default [] k m) m++    let of_alist (kvs : (key * 'a) list) =+      List.fold_left (fun m (k, v) -> adds k [v] m) empty kvs+     +    let frequency (ks : key list) : int t =+      List.fold_left (fun m k -> +        add k (1 + (find_default 0 k m)) m+      ) empty ks ++    let safeFind k m msg =+      try find k m with Not_found -> +        let err = Format.fprintf Format.str_formatter +                    "ERROR: safeFind (%s): %a" msg K.print k; +                  Format.flush_str_formatter ()+        in failwith err++    let safeAdd k v m msg =+      if mem k m then +        let err = Format.fprintf Format.str_formatter +                    "ERROR: safeAdd (%s): %a" msg K.print k; +                  Format.flush_str_formatter ()+        in failwith err+      else add k v m++    let map_partial f m = +      fold (fun x yo m -> match yo with Some y -> add x y m | _ -> m) (map f m) empty +  end++module type KeyValType =+  sig+    type t+    val compare : t -> t -> int+    val print : Format.formatter -> t -> unit ++    type v+    val default : v+  end++module MapWithDefault (K: KeyValType) =+  struct+    include EMap(K)+    let find (i: K.t) (m: K.v t): K.v =+      try find i m with Not_found -> K.default+  end++module IntMap = +  EMap+  (struct+    type t = int+    let compare i1 i2 = compare i1 i2+    let print         = pprint_int+  end)++module IntSet =+  ESet+  (struct+    type t = int+    let compare i1 i2 =+      compare i1 i2+  end)++module IntIntMap = +  EMap +  (struct+    type t = int * int+    let compare i1 i2 = compare i1 i2+    let print ppf (i1, i2) = Format.fprintf ppf "(%d, %d)" i1 i2+   end)++module StringMap = +  EMap +  (struct+    type t = string +    let compare i1 i2 = compare i1 i2+    let print ppf s   = Format.fprintf ppf "%s" s+  end)++module StringSet =+  ESet+  (struct+    type t = string+    let compare i1 i2 = compare i1 i2+  end)++(* +let sm_join sm1 sm2 = +  StringMap.mapi (fun k v1 ->+    let v2 = asserts (StringMap.mem k sm2) "sm_join"; StringMap.find k sm2 in+    (v1, v2)+  ) sm1++let sm_extend sm1 sm2 =+  StringMap.fold StringMap.add sm2 sm1 ++let sm_filter f sm = +  StringMap.fold begin fun x y sm -> +    if f x y then StringMap.add x y sm else sm +  end sm StringMap.empty ++let sm_of_list kvs = +  List.fold_left (fun sm (k,v) -> StringMap.add k v sm) StringMap.empty kvs++let sm_to_list sm = +  StringMap.fold (fun k v acc -> (k,v)::acc) sm [] ++let sm_to_range sm = +  sm |> sm_to_list |> List.map snd+*)++let sm_print_keys name sm =+  sm |> StringMap.to_list +     |> List.map fst +     |> String.concat ", "+     |> Printf.printf "%s : %s \n" name++let foldn f n b = +  let rec foo acc i = +    if i >= n then acc else foo (f acc i) (i+1) +  in foo b 0 ++let rec range i j = +  if i >= j then [] else i::(range (i+1) j)++let dump s = +  print_string s; flush stdout++let mapn f n = +  foldn (fun acc i -> (f i) :: acc) n [] +  |> List.rev++let chop_last = function+  | [] -> failure "ERROR: Misc.chop_last"+  | xs -> xs |> List.rev |> List.tl |> List.rev++let list_snoc xs = +  match List.rev xs with +  | [] -> assertf "list_snoc with empty list!"+  | h::t  -> h, List.rev t++let negfilter f xs = +  List.fold_left (fun acc x -> if f x then acc else x::acc) [] xs +  |> List.rev++let get_option d = function  +  | Some x -> x +  | None   -> d++let list_somes xs =+  xs |> List.fold_left begin fun acc -> function +          | Some x -> x :: acc +          | None   -> acc +        end []+     |> List.rev++(* let map_partial f = list_somes <.> List.map f  *)++let map_partial f xs =+  List.rev +    (List.fold_left +      (fun acc x -> +        match f x with+        | None   -> acc+        | Some z -> (z::acc)) [] xs)+++let fold_left_partial f b xs =+  List.fold_left begin fun b xo ->+    match xo with+      | Some x -> f b x+      | None   -> b+  end b xs++let list_reduce msg f = function+  | []    -> assertf "ERROR: list_reduce with empty list: %s" msg +  | x::xs -> List.fold_left f x xs++let nonnull = function+  | [] -> false+  | _  -> true++(*+let list_is_empty = function+  | [] -> true+  | _::_ -> false+*)++let list_max x xs = +  List.fold_left max x xs++let list_min x xs = +  List.fold_left min x xs++let list_max_with msg f = function+  | []    -> assertf "ERROR: list_max_with with empty list: %s" msg +  | x::xs -> List.fold_left (fun acc x -> if f x > f acc then x else acc) x xs++let rec take_max n = function+  | x :: xs when n > 0 -> x :: take_max (n - 1) xs+  | _                  -> []+    +let rec drop n = function+  | x :: xs when n > 0 -> drop (n - 1) xs+  | []      when n > 0 -> assertf "ERROR: dropped too many"+  | xs -> xs++let getf a i fmt = +  try a.(i) with ex -> assertf fmt++let do_catchu f x g =+  try f x with ex -> (g ex; raise ex)++let do_catchf s f x =+  try f x with ex -> +    assertf "%s hits exn: %s \n" s (Printexc.to_string ex)++let do_catch s f x =+  try f x with ex -> +     (Printf.printf "%s hits exn: %s \n" s (Printexc.to_string ex); raise ex) ++let do_catch_ret s f x y = +  try f x with ex -> +     (Printf.printf "%s hits exn: %s \n" s (Printexc.to_string ex); y) ++let do_memo memo f args key = +  try Hashtbl.find memo key with Not_found ->+    let rv = f args in+    let _ = Hashtbl.replace memo key rv in+    rv++let do_bimemo fmemo rmemo f args key =+  try Hashtbl.find fmemo key with Not_found ->+    let rv = f args in+    let _ = Hashtbl.replace fmemo key rv in+    let _ = Hashtbl.replace rmemo rv key in+    rv++let rec exists_maybe f = function+  | []    -> None+  | x::xs -> (match f x with None -> exists_maybe f xs | z -> z)++let map_pair   = fun f (x1, x2)     -> (f x1, f x2)+let map_triple = fun f (x1, x2, x3) -> (f x1, f x2, f x3)+let app_fst    = fun f (a, b)       -> (f a, b)+let app_snd    = fun f (a, b)       -> (a, f b)+let app_fst3   = fun f (a, b, c)    -> (f a, b, c)++let app_snd3   = fun f (a, b, c)    -> (a, f b, c)++let app_thd3   = fun f (a, b, c)    -> (a, b, f c)+let pad_snd    = fun f x            -> (x, f x)+let pad_fst    = fun f y            -> (f y, y)+let tmap2      = fun (f, g) x       -> (f x, g x)+let tmap3      = fun (f, g, h) x    -> (f x, g x, h x)+let iter_fst   = fun f (a, b)       -> f a+let iter_snd   = fun f (a, b)       -> f b++let split3 lst =+  List.fold_right (fun (x, y, z) (xs, ys, zs) -> (x :: xs, y :: ys, z :: zs)) lst ([], [], [])++let split4 lst =+  List.fold_right (fun (w, x, y, z) (ws, xs, ys, zs) -> (w :: ws, x :: xs, y :: ys, z :: zs)) lst ([], [], [], [])++let twrap s f x =+  let _  = Printf.printf "calling %s \n" s in+  let rv = f x in+  let _  = Printf.printf "returned from %s \n" s in+  rv++let mapfold_rev f b xs = +  List.fold_left begin fun (acc, ys) x -> +    let (acc', y) = f acc x in +    (acc', y::ys)+  end (b, []) xs++let mapfold f b xs =+  mapfold_rev f b xs +  |> app_snd List.rev ++let rootsBy leq xs = +  let notDomBy x = not <.> (leq x) in+  let rec loop acc = function+    | [] -> +        acc+    | (x::xs) ->+        let acc', xs' = map_pair (List.filter (notDomBy x)) (acc, xs) in+        loop (x::acc') xs'+  in loop [] xs++let cov_filter cov f xs = +  let rec loop acc = function+    | [] -> +        acc+    | (x::xs) when f x ->+        let covs, uncovs = List.partition (cov x) xs in+        loop ((x, covs) :: acc) uncovs  +    | (_::xs) ->+      loop acc xs+  in loop [] xs++let filter f xs = +  List.fold_left (fun xs' x -> if f x then x::xs' else xs') [] xs+  |> List.rev++let iter f xs = +  List.fold_left (fun () x -> f x) () xs++let map2 f xs ys = +  let _ = asserti (List.length xs = List.length ys) "Misc.map2" in+  List.map2 f xs ys++let map f xs = +  List.rev_map f xs |> List.rev++let flatten xss =+  xss+  |> List.fold_left (fun acc xs -> xs ++ acc) []+  |> List.rev++let flatsingles xss =+  xss |> List.fold_left (fun acc -> function [x] -> x::acc | _ -> assertf "flatsingles") []+      |> List.rev++let splitflatten xsyss = +  let xss, yss = List.split xsyss in+  (flatten xss, flatten yss)++let splitflatten3 xsyszss =+  let xss, yss, zss = split3 xsyszss in+    (flatten xss, flatten yss, flatten zss)++let flap f xs =+  xs |> List.rev_map f |> flatten |> List.rev++let flap_pair f = splitflatten <.> map f++let tr_rev_flatten xs =+  List.fold_left (fun x xs -> x ++ xs) [] xs++let tr_rev_flap f xs =+  List.fold_left (fun xs x -> (f x) ++ xs) [] xs++let rec fast_unflat ys = function+  | x :: xs -> fast_unflat ([x] :: ys) xs+  | [] -> ys++let dup x = (x, x)+++let rec rev_perms s = function+  | [] -> s+  | e :: es -> rev_perms +    (tr_rev_flap (fun e -> List.rev_map (fun s -> e :: s) s) e) es ++let product = function+  | e :: es -> rev_perms (fast_unflat [] e) es+  | es -> es ++let pairs xs =+  let rec pairs_aux ps = function+    | [] -> ps+    | x :: xs -> pairs_aux (List.fold_left (fun ps y -> (x, y) :: ps) ps xs) xs+  in pairs_aux [] xs++let cross_product xs ys = +  map begin fun x ->+    map begin fun y ->+      (x,y)+    end ys+  end xs+  |> flatten++let rec cross_flatten = function+  | []      -> +      [[]]+  | xs::xss ->+      map begin fun x ->+        map begin fun ys ->+          (x::ys)+        end (cross_flatten xss)+      end xs+      |> flatten+++let append_pref p s =+  (p ^ "." ^ s)+++let fsort f xs =+  let cmp = fun (k1,_) (k2,_) -> compare k1 k2 in+  xs |> map (fun x -> ((f x), x)) +     |> List.sort cmp +     |> map snd++let sort_and_compact ls =+  let rec _sorted_compact l = +    match l with+	h1::h2::tl ->+	  let rest = _sorted_compact (h2::tl) in+	    if h1 = h2 then rest else h1::rest+      | tl -> tl+  in+    _sorted_compact (List.sort compare ls)   ++let sort_and_compact xs = +  List.sort compare xs +  |> List.fold_left +       (fun ys x -> match ys with+        | y::_ when x=y -> ys+        | _::_          -> x::ys+        | []            -> [x])+       [] +  |> List.rev++let hashtbl_to_list t = +  Hashtbl.fold (fun x y l -> (x,y)::l) t []++let hashtbl_keys t = +  Hashtbl.fold (fun x y l -> x::l) t []+  |> sort_and_compact++let hashtbl_invert t = +  let t' = Hashtbl.create 17 in+  hashtbl_to_list t +  |> List.iter (fun (x,y) -> Hashtbl.replace t' y x) +  |> fun _ -> t'+++let distinct xs = + List.length xs = List.length (sort_and_compact xs)++(** repeats f: unit - > unit i times *)+let rec repeat_fn f i = +  if i = 0 then ()+  else (f (); repeat_fn f (i-1))++(* chop s chopper returns ([x;y;z...]) if s = x.chopper.y.chopper ...*)+let chop s chopper = Str.split (Str.regexp chopper) s  ++(* like chop only the chop is by chop+ *)+let chop_star chopper s = +    Str.split (Str.regexp (Printf.sprintf "[%s+]" chopper)) s++let bounded_chop s chopper i = Str.bounded_split (Str.regexp chopper) s i ++let is_prefix p s = +  let (ls, lp) = (String.length s, String.length p) in+  if ls < lp+    then false+  else+    (String.sub s 0 lp) = p++let is_substring s subs = +  let reg = Str.regexp subs in+  try ignore(Str.search_forward reg s 0); true+  with Not_found -> false++let replace_substring src dst s =+  Str.global_replace (Str.regexp src) dst s++let is_suffix suffix s = +  let k = String.length suffix+  and n = String.length s in+  (n-k >= 0) && Str.string_match (Str.regexp suffix) s (n-k)++let iteri f xs =+  List.fold_left (fun i x -> f i x; i+1) 0 xs+  |> ignore++let numbered_list xs =+  xs |> List.fold_left (fun (i, acc) x -> (i+1, (i,x)::acc)) (0,[]) +     |> snd +     |> List.rev ++exception FalseException++let sm_protected_add fail k v sm = +  if not (StringMap.mem k sm) then StringMap.add k v sm else +    if not fail then sm else +      assertf "protected_add: duplicate binding for %s \n" k++let hashtbl_to_list_all t = +  hashtbl_keys t |> map (Hashtbl.find_all t) ++let clone x n =+  let rec f n xs = if n <= 0 then xs else f (n-1) (x::xs) in+  f n []++let single x = [x]++let distinct xs = +  List.length (sort_and_compact xs) = List.length xs++let trunc i j = +  let (ai,aj) = (abs i, abs j) in+  if aj <= ai then j else ai*j/aj ++let map_to_string f xs = +  String.concat "," (List.map f xs)++let suffix_of_string = fun s i -> String.sub s i (String.length s - 1)++(* [count_map xs] = fun x -> number of times x appears in xs if non-zero *)+let count_map rs =+  List.fold_left begin fun m r -> +      let c = try IntMap.find r m with Not_found -> 0 in+      IntMap.add r (c+1) m+  end IntMap.empty rs++let o2s f = function+  | Some x -> "Some "^ (f x)+  | None   -> "None"++let fixpoint f x =+  let rec acf b x =+    let x', b' = f x in+    if b' then acf true x' else (x', b) in+  acf false x+++let fsprintf f p = +  Format.fprintf Format.str_formatter "@[%a@]" f p;+  Format.flush_str_formatter ()++let rec same_length l1 l2 = match l1, l2 with+  | [], []           -> true+  | _ :: xs, _ :: ys -> same_length xs ys+  | _                -> false++let ex_one s = function+  | [x]    -> x+  | _ :: _ -> failwith s+  | _      -> failwith (s ^ ". empty")++let only_one s = function+    x :: [] -> Some x+  | _ :: _  -> failwith s+  | []      -> None++let maybe_one = function+  | [x] -> Some x+  | _   -> None+++let int_of_bool b = if b then 1 else 0++(*****************************************************************)+(******************** Mem Management *****************************)+(*****************************************************************)++open Gc+(* open Format *)++let pprint_gc s =+  (*printf "@[Gc@ Stats:@]@.";+  printf "@[minor@ words:@ %f@]@." s.minor_words;+  printf "@[promoted@ words:@ %f@]@." s.promoted_words;+  printf "@[major@ words:@ %f@]@." s.major_words;*)+  (*printf "@[total allocated:@ %fMB@]@." (floor ((s.major_words +. s.minor_words -. s.promoted_words) *. (4.0) /. (1024.0 *. 1024.0)));*)++  Format.printf "@[total allocated:@ %fMB@]@." (floor ((allocated_bytes ()) /. (1024.0 *. 1024.0)));+  Format.printf "@[minor@ collections:@ %i@]@." s.minor_collections;+  Format.printf "@[major@ collections:@ %i@]@." s.major_collections;+  Format.printf "@[heap@ size:@ %iMB@]@." (s.heap_words * 4 / (1024 * 1024));+  (*printf "@[heap@ chunks:@ %i@]@." s.heap_chunks;+  (*printf "@[live@ words:@ %i@]@." s.live_words;+  printf "@[live@ blocks:@ %i@]@." s.live_blocks;+  printf "@[free@ words:@ %i@]@." s.free_words;+  printf "@[free@ blocks:@ %i@]@." s.free_blocks;+  printf "@[largest@ free:@ %i@]@." s.largest_free;+  printf "@[fragments:@ %i@]@." s.fragments;*)*)+  Format.printf "@[compactions:@ %i@]@." s.compactions;+  (*printf "@[top@ heap@ words:@ %i@]@." s.top_heap_words*) ()++let dump_gc s =+  Format.printf "@[%s@]@." s;+  pprint_gc (Gc.quick_stat ())+++let append_to_file f s = +  let oc = Unix.openfile f [Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] 420  in+  ignore (Unix.write oc s 0 ((String.length s)-1) ); +  Unix.close oc++(*+let with_out_file file f =+  let oc = open_out file in+    f oc;+    close_out oc+*)++let display_tick = fun () -> print_now "."++let display_tick = +  let icona = [| "|"; "/" ; "-"; "\\" |] in+  let n     = ref 0                      in+  let pos   = ref 0                      in+  fun () -> +    let k   = !pos                       in+    let _   = pos := (k + 1) mod 4       in+    let _   = incr n                     in+    let suf = if (!n mod 76) = 0 +              then "\n" +              else icona.(k)             in+    let _   = print_now ("\b."^suf)      in+    ()++++let with_out_file file f = file |> open_out >> f |> close_out++let write_to_file f s =+  with_out_file f (fun oc -> output_string oc s)++let with_out_formatter file f =+  with_out_file file (fun oc -> f (Format.formatter_of_out_channel oc))++let get_unique =+  let cnt = ref 0 in+  (fun () -> let rv = !cnt in incr cnt; rv)++let lines_of_file filename = +  let lines = ref [] in+  let chan = open_in filename in+  try +    while true; do+      lines := input_line chan :: !lines+    done; [] +  with End_of_file ->+    close_in chan;+    List.rev !lines++let map_lines_of_file infile outfile f =+  let ic = open_in infile in+  let oc = open_out outfile in+  try+    while true; do+      ic |> input_line |> f |> output_string oc+    done;+  with End_of_file -> +    (close_in ic; close_out oc)++let maybe_cons m xs = match m with+  | None -> xs+  | Some x -> x :: xs++let maybe_list xs = +  List.fold_right maybe_cons xs []++let rec list_first_maybe f = function+  | x::xs -> begin match f x with +              | Some y -> Some y +              | _      -> list_first_maybe f xs+             end+  | []    -> None++let list_find_maybe f xs =+  try some <| List.find f xs with Not_found -> None++let list_assoc_maybe k kvs =+  try Some (List.assoc k kvs) with Not_found -> None++let list_assoc_default d kvs k =+  try List.assoc k kvs with Not_found -> d++let list_assoc_flip xs = +  let r (x, y) = (y, x) in+    List.map r xs++let fold_lefti f b xs =+  List.fold_left (fun (i,b) x -> ((i+1), f i b x)) (0,b) xs++let mapi f xs = +  xs |> fold_lefti (fun i acc x -> (f i x) :: acc) [] +     |> snd |> List.rev++let index_from n xs = +  let is = range n (n + List.length xs) in+  List.combine is xs++let fold_left_flip f b xs =+  List.fold_left (flip f) b xs++let fold_left_swap f xs b =+  List.fold_left f b xs++let rec map3 f xs ys zs = match (xs, ys, zs) with+  | ([], [], []) -> []+  | (x :: xs, y :: ys, z :: zs) -> f x y z :: map3 f xs ys zs+  | _ -> assert false++let rec fold_right3 f xs ys zs acc = match xs, ys, zs with+  | x :: xs, y :: ys, z :: zs -> f x y z (fold_right3 f xs ys zs acc)+  | [], [], []                -> acc+  | _                         -> assert false++let rec fold_left3 f acc xs ys zs = match xs, ys, zs with+  | x :: xs, y :: ys, z :: zs -> fold_left3 f (f acc x y z) xs ys zs+  | [], [], []                -> acc+  | _                         -> assert false++let zip_partition xs bs =+  let (xbs, xbs') = List.partition snd (List.combine xs bs) in+  (List.map fst xbs, List.map fst xbs')++let rec map4 f ws xs ys zs = match ws, xs, ys, zs with+  | [], [], [], []                     -> []+  | w :: ws, x :: xs, y :: ys, z :: zs -> f w x y z :: map4 f ws xs ys zs+  | _                                  -> asserti false "map4"; assert false+++let rec perms es =+  match es with+    | s :: [] ->+        List.map (fun c -> [c]) s+    | s :: es ->+        flap (fun c -> List.map (fun d -> c :: d) (perms es)) s+    | [] ->+        []++let flap2 f xs ys = +  List.flatten (List.map2 f xs ys)++let flap3 f xs ys zs =+  List.flatten (map3 f xs ys zs)++let combine msg xs ys =+  let _ = asserts (List.length xs = List.length ys) "%s" msg in+  List.combine xs ys++let combine3 xs ys zs =+  map3 (fun x y z -> (x, y, z)) xs ys zs++let combine4 ws xs ys zs =+  map4 (fun w x y z -> (w, x, y, z)) ws xs ys zs++let tr_partition f xs =+  List.fold_left begin fun (xs,ys) z -> +    if f z +    then (z::xs, ys) +    else (xs, z::ys)+  end ([],[]) xs++let either_partition f xs =+  List.fold_left begin fun (xs, ys) z -> +    match f z with+    | Left x  -> (x::xs, ys)+    | Right y -> (xs, y::ys)+  end ([], []) xs++(* these do odd things with order for performance + * it is possible that fast is a misnomer *)+let fast_flatten xs =+  List.fold_left (++) [] xs++let fast_append v v' =+  let (v, v') = if List.length v > List.length v' then (v', v) else (v, v') in+  List.rev_append v v'++let fast_flap f xs =+  List.fold_left (fun xs x -> List.rev_append (f x) xs) [] xs++let rec fast_unflat ys = function+  | x :: xs -> fast_unflat ([x] :: ys) xs+  | [] -> ys++let rec rev_perms s = function+  | [] -> s+  | e :: es -> rev_perms +    (fast_flap (fun e -> List.rev_map (fun s -> e :: s) s) e) es ++let rev_perms = function+  | e :: es -> rev_perms (fast_unflat [] e) es+  | es -> es ++let tflap2 (e1, e2) f =+  List.fold_left (fun bs b -> List.fold_left (fun aas a -> f a b :: aas) bs e1) [] e2++let tflap3 (e1, e2, e3) f =+  List.fold_left begin fun cs c -> +    List.fold_left begin fun bs b -> +      List.fold_left begin fun aas a -> +        f a b c :: aas+      end bs e1+    end cs e2+  end[] e3++let rec expand f xs ys =+  match xs with+  | []    -> ys+  | x::xs -> let (xs', ys') = f x in+             expand f (xs' ++  xs) (ys' ++ ys)++let rec get_first f = function+  | x::xs when f x -> Some x +  | _::xs          -> get_first f xs+  | []             -> None++let join f xs ys = +  let rec fuse acc xs ys = +    match xs, ys with +    | [],_ | _, []                              -> List.rev acc+    | ((kx, _)::xs', (ky,_)::_  ) when kx < ky  -> fuse acc xs' ys+    | ((kx, _)::_  , (ky,_)::ys') when kx > ky  -> fuse acc xs  ys' +    | ((kx, x)::xs', (ky,y)::ys') (* kx = ky *) -> fuse ((x,y)::acc) xs' ys' in+  let xs' = List.map (fun x -> (f x, x)) xs |> List.sort compare in+  let ys' = List.map (fun y -> (f y, y)) ys |> List.sort compare in+  fuse [] xs' ys'++let hashtbl_find_default d t x =+  try Hashtbl.find t x with Not_found -> d++let frequency (xs : 'a list) : ('a * int) list = +  let t = Hashtbl.create 17 in+  List.iter begin fun x ->+    let n =  hashtbl_find_default 0 t x in+    Hashtbl.replace t x (n + 1)+  end xs;+  hashtbl_to_list t++let kgroupby (f: 'a -> 'b) (xs: 'a list): ('b * 'a list) list =+  let t        = Hashtbl.create 17 in+  let lookup x = try Hashtbl.find t x with Not_found -> [] in+  (* build table *)+  List.iter begin fun x -> +    Hashtbl.replace t (f x) (x :: lookup (f x))+  end xs;+  (* build cluster *)+  Hashtbl.fold (fun k xs xxs -> (k, xs) :: xxs) t []++++let groupby (f: 'a -> 'b) (xs: 'a list): 'a list list =+  kgroupby f xs |> List.map (snd <+> List.rev)++let full_join f xs ys =+     (xs, ys)+  |> map_pair (kgroupby f)+  |> uncurry (join fst)+  |> flap (map_pair snd <+> uncurry cross_product)++let exists_pair (f: 'a -> 'a -> bool) (xs: 'a list): bool =+  fst (List.fold_left (fun (b, ys) x -> (b || List.exists (f x) ys, x :: ys)) (false, []) xs)++let rec find_pair (f: 'a -> 'a -> bool): 'a list -> 'a * 'a = function+  | []    -> raise Not_found+  | x::xs -> try (x, List.find (f x) xs) with Not_found -> find_pair f xs++let rec is_unique = function+  | []      -> true+  | x :: xs -> if List.mem x xs then false else is_unique xs++let map_opt f = function+  | Some o -> Some (f o)+  | None -> None++let resl_opt f = function+  | Some o -> f o+  | None -> []++let resi_opt f = function+  | Some o -> f o+  | None -> ()++let opt_iter f l = +  List.iter (resi_opt f) l++let array_findi p arr =+  let rec look i =+    if i < 0 then raise Not_found else+      if p arr.(i) then i else look i - 1+  in look (Array.length arr - 1)++let array_to_index_list a =+  Array.fold_left (fun (i, rv) v -> (i+1,(i,v)::rv)) (0,[]) a+  |> snd+  |> List.rev+++let hashtbl_of_list xys = +  let t = Hashtbl.create 37 in+  let _ = List.iter (fun (x,y) -> Hashtbl.add t x y) xys in+  t++let hashtbl_of_list_with kf xs = +  xs |>: pad_fst kf |> hashtbl_of_list++let array_flapi f a =+  Array.fold_left (fun (i, acc) x -> (i+1, (f i x) :: acc)) (0,[]) a+  |> snd +  |> List.rev+  |> flatten++let array_fold_lefti f acc a =+  Array.fold_left (fun (i, acc) x -> (i + 1, f i acc x)) (0, acc) a |> snd++let array_map2 f xa ya = +  Array.mapi (fun i x -> f x (ya.(i))) xa++let array_rev_iteri f a =+  for i = Array.length a - 1 downto 0 do+    f i a.(i)+  done++exception NotForall++let array_forall f a =+  try+    Array.iter (fun e -> if f e then () else raise NotForall) a; true+  with NotForall ->+    false++let array_combine a1 a2 = +  asserts (Array.length a1 = Array.length a2) "array_combine";+  Array.init (Array.length a1) (fun i -> (a1.(i), a2.(i)))+++let compose f g a = f (g a)+++let rec gcd (a: int) (b: int): int =+  if b = 0 then a else gcd b (a mod b)++let lcm (a: int) (b: int): int =+  if a = 0 then a else (abs (a * b)) / (gcd a b)++let mk_int_factory () =+  let id = ref (-1) in+    ((fun () -> incr id; !id), (fun () -> id := -1))++let mk_char_factory () =+  let (fresh_int, reset_fresh_int) = mk_int_factory () in+    ((fun () -> Char.chr (fresh_int () + Char.code 'a')), reset_fresh_int)++let mk_string_factory s =+  let (fresh_int, reset_fresh_int) = mk_int_factory () in+    ((fun () -> s^(string_of_int (fresh_int ()))), reset_fresh_int)++let swap (x,y) = (y,x)++(* ('a * (int * 'b) list) list -> (int * ('a * 'b) list) list *)+let transpose x_iys_s = +  let t = Hashtbl.create 17 in+  List.iter begin fun (x, iys) ->+    List.iter begin fun (i, y) -> +      Hashtbl.add t i (x,y) +    end iys+  end x_iys_s; +  hashtbl_keys t |> List.map (fun i -> (i, Hashtbl.find_all t i))++let basename_no_extension fname =+  fname |> Filename.basename |> Filename.chop_extension++let absolute_name name =+  if not (Filename.is_relative name) then name else+    let b    = Filename.basename name in+    let d    = Filename.dirname name in+    let dir  = Sys.getcwd () in+    let _    = Sys.chdir (Filename.concat dir d) in+    let dir' = Sys.getcwd () in+    let rv   = Filename.concat dir' b in+    let _    = Sys.chdir dir in+    rv++let cardinality = fun xs -> xs |> sort_and_compact |> List.length+let disjoint    = fun xs ys -> cardinality xs + cardinality ys = cardinality (xs ++ ys)++let bracket (l : unit -> unit) (r : unit -> unit) (f : unit -> 'a) : 'a = +  try l () |> f >> (fun _ -> r ())+  with ex -> assertf "bracket hits exn: %s \n" (Printexc.to_string ex)++(*+let with_ref_at x v f =+  let oldv  = !x in +  bracket (fun _ -> x := v) (fun _ -> x := oldv) f +*)++let with_ref_at x v f = +  let oldv = !x        in +  let _    = x := v    in+  let res  = f ()      in+  let _    = x := oldv in+  res++++let rec isPrefix = function+  | ([], _)                   -> true+  | (x::xs, y::ys) when x = y -> isPrefix (xs, ys)+  | _                         -> false++let find_first_true f lo hi =+  let rec go lo hi = +    let mid = lo + ((hi - lo) / 2) in+    match () with+    | _ when lo >= hi    -> None+    | _ when lo = hi - 1 -> Some hi +    | _ when f mid       -> go lo mid +    | _                  -> go mid hi +  in   if f lo then Some lo +  else if not (f hi) then None +  else go lo hi++let safeHead msg = function+  | [x] -> x+  | _   -> failwith ("ERROR: safeHead" ^ msg) ++let safeApply pp f x = match f x with+  | Some y -> y+  | None   -> failwith ("ERROR: safeApply " ^ (pp x)) ++let stringIsUpper = function+  | "" -> false+  | s  -> let c = s.[0] in c = Char.uppercase c++let stringIsLower = function+  | "" -> false+  | s  -> let c = s.[0] in c = Char.lowercase c+++
+ external/misc/heaps.ml view
@@ -0,0 +1,223 @@+(**************************************************************************)+(*                                                                        *)+(*  Copyright (C) Jean-Christophe Filliatre                               *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*s Heaps *)++module type Ordered = sig+  type t+  val compare : t -> t -> int+end++exception EmptyHeap++(*s Imperative implementation *)++module Imperative(X : Ordered) = struct++  (* The heap is encoded in the array [data], where elements are stored+     from [0] to [size - 1]. From an element stored at [i], the left +     (resp. right) subtree, if any, is rooted at [2*i+1] (resp. [2*i+2]). *)++  type t = { mutable size : int; mutable data : X.t array }++  (* When [create n] is called, we cannot allocate the array, since there is+     no known value of type [X.t]; we'll wait for the first addition to +     do it, and we remember this situation with a negative size. *)++  let create n = +    if n <= 0 then invalid_arg "create";+    { size = -n; data = [||] }++  let is_empty h = h.size <= 0++  (* [resize] doubles the size of [data] *)++  let resize h =+    let n = h.size in+    assert (n > 0);+    let n' = 2 * n in+    let d = h.data in+    let d' = Array.create n' d.(0) in+    Array.blit d 0 d' 0 n;+    h.data <- d'++  let add h x =+    (* first addition: we allocate the array *)+    if h.size < 0 then begin+      h.data <- Array.create (- h.size) x; h.size <- 0+    end;+    let n = h.size in+    (* resizing if needed *)+    if n == Array.length h.data then resize h;+    let d = h.data in+    (* moving [x] up in the heap *)+    let rec moveup i =+      let fi = (i - 1) / 2 in+      if i > 0 && X.compare d.(fi) x < 0 then begin+	d.(i) <- d.(fi);+	moveup fi+      end else+	d.(i) <- x+    in+    moveup n;+    h.size <- n + 1++  let maximum h =+    if h.size <= 0 then raise EmptyHeap;+    h.data.(0)++  let remove h =+    if h.size <= 0 then raise EmptyHeap;+    let n = h.size - 1 in+    h.size <- n;+    let d = h.data in+    let x = d.(n) in+    (* moving [x] down in the heap *)+    let rec movedown i =+      let j = 2 * i + 1 in+      if j < n then+	let j = +	  let j' = j + 1 in +	  if j' < n && X.compare d.(j') d.(j) > 0 then j' else j +	in+	if X.compare d.(j) x > 0 then begin +	  d.(i) <- d.(j); +	  movedown j +	end else+	  d.(i) <- x+      else+	d.(i) <- x+    in+    movedown 0++  let pop_maximum h = let m = maximum h in remove h; m++  let iter f h = +    let d = h.data in+    for i = 0 to h.size - 1 do f d.(i) done++  let fold f h x0 =+    let n = h.size in+    let d = h.data in+    let rec foldrec x i =+      if i >= n then x else foldrec (f d.(i) x) (succ i)+    in+    foldrec x0 0++end+++(*s Functional implementation *)++module type FunctionalSig = sig+  type elt+  type t+  val empty : t+  val add : elt -> t -> t+  val maximum : t -> elt+  val remove : t -> t+  val iter : (elt -> unit) -> t -> unit+  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a+end++module Functional(X : Ordered) = struct++  (* Heaps are encoded as complete binary trees, i.e., binary trees+     which are full expect, may be, on the bottom level. +     These trees also enjoy the heap property, namely the value of any node +     is greater or equal than those of its left and right subtrees.++     The representation invariant is the following: the number of nodes in+     the left subtree is equal to the number of nodes in the right+     subtree, or exceeds it by exactly once. In the first case, we use+     the constructor [Same] and in the second the constructor [Diff].+     Then it can be proved that [2^(h-1) <= n <= 2^h] when [n] is the+     number of elements and [h] the height of the tree. *)++  type elt = X.t++  type t = +    | Empty+    | Same of t * X.t * t (* same number of elements on both sides *)+    | Diff of t * X.t * t (* left has [n+1] nodes and right has [n] *)++  let empty = Empty+ +  let rec add x = function+    | Empty -> +	Same (Empty, x, Empty)+    (* insertion to the left *)+    | Same (l, y, r) ->+	if X.compare x y > 0 then Diff (add y l, x, r) else Diff (add x l, y,r)+    (* insertion to the right *)+    | Diff (l, y, r) ->+	if X.compare x y > 0 then Same (l, x, add y r) else Same (l,y, add x r)++  let maximum = function+    | Empty -> raise EmptyHeap+    | Same (_, x, _) | Diff (_, x, _) -> x++  (* extracts one element on the bottom level of the tree, while+     maintaining the representation invariant *)+  let rec extract_last = function+    | Empty -> raise EmptyHeap+    | Same (Empty, x, Empty) -> x, Empty+    | Same (l, x, r) -> let y,r' = extract_last r in y, Diff (l, x, r')+    | Diff (l, x, r) -> let y,l' = extract_last l in y, Same (l', x, r)++  (* removes the topmost element of the tree and inserts a new element [x] *)+  let rec descent x = function+    | Empty -> +	assert false+    | Same (Empty, _, Empty) -> +	Same (Empty, x, Empty)+    | Diff (Same (_, z, _) as l, _, Empty) -> +	if X.compare x z > 0 then Diff (l, x, Empty) +	else Diff (Same (Empty, x, Empty), z, Empty)+    | Same (l, _, r) ->+	let ml = maximum l in+	let mr = maximum r in+	if X.compare x ml > 0 && X.compare x mr > 0 then +	  Same (l, x, r)+	else +	  if X.compare ml mr > 0 then+	    Same (descent x l, ml, r)+	  else +	    Same (l, mr, descent x r)+    | Diff (l, _, r) ->+	let ml = maximum l in+	let mr = maximum r in+	if X.compare x ml > 0 && X.compare x mr > 0 then +	  Diff (l, x, r)+	else +	  if X.compare ml mr > 0 then+	    Diff (descent x l, ml, r)+	  else +	    Diff (l, mr, descent x r)++  let remove = function+    | Empty -> raise EmptyHeap+    | Same (Empty, x, Empty) -> Empty+    | h -> let y,h' = extract_last h in descent y h'++  let rec iter f = function+    | Empty -> ()+    | Same (l, x, r) | Diff (l, x, r) -> iter f l; f x; iter f r++  let rec fold f h x0 = match h with+    | Empty -> x0+    | Same (l, x, r) | Diff (l, x, r) -> fold f l (fold f r (f x x0))++end
+ external/misc/heaps.mli view
@@ -0,0 +1,98 @@+(**************************************************************************)+(*                                                                        *)+(*  Copyright (C) Jean-Christophe Filliatre                               *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* Heaps *)++module type Ordered = sig+  type t+  val compare : t -> t -> int+end++exception EmptyHeap++(*S Imperative implementation. *)++module Imperative(X: Ordered) : sig++  (* Type of imperative heaps.+     (In the following [n] refers to the number of elements in the heap) *)++  type t ++  (* [create c] creates a new heap, with initial capacity of [c] *)+  val create : int -> t++  (* [is_empty h] checks the emptiness of [h] *)+  val is_empty : t -> bool++  (* [add x h] adds a new element [x] in heap [h]; size of [h] is doubled+     when maximum capacity is reached; complexity $O(log(n))$ *)+  val add : t -> X.t -> unit++  (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(1)$ *)+  val maximum : t -> X.t++  (* [remove h] removes the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(log(n))$ *)+  val remove : t -> unit++  (* [pop_maximum h] removes the maximum element of [h] and returns it;+     raises [EmptyHeap] when [h] is empty; complexity $O(log(n))$ *)+  val pop_maximum : t -> X.t++  (* usual iterators and combinators; elements are presented in+     arbitrary order *)+  val iter : (X.t -> unit) -> t -> unit++  val fold : (X.t -> 'a -> 'a) -> t -> 'a -> 'a++end++(*S Functional implementation. *)++module type FunctionalSig = sig++  (* heap elements *)+  type elt++  (* Type of functional heaps *)+  type t++  (* The empty heap *)+  val empty : t++  (* [add x h] returns a new heap containing the elements of [h], plus [x];+     complexity $O(log(n))$ *)+  val add : elt -> t -> t++  (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(1)$ *)+  val maximum : t -> elt++  (* [remove h] returns a new heap containing the elements of [h], except+     the maximum of [h]; raises [EmptyHeap] when [h] is empty; +     complexity $O(log(n))$ *) +  val remove : t -> t++  (* usual iterators and combinators; elements are presented in+     arbitrary order *)+  val iter : (elt -> unit) -> t -> unit++  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a++end++module Functional(X: Ordered) : FunctionalSig with type elt = X.t
+ external/misc/misc.ml view
@@ -0,0 +1,1346 @@+(*+ * Copyright ? 1990-2007 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(* $Id: misc.ml,v 1.14 2006/09/26 01:47:01 jhala Exp $+ *+ * This file is part of the SIMPLE Project.+ *)++(**+ * This module provides some miscellaneous useful helper functions.+ *)++module Ops = struct++  type ('a, 'b) either = Left of 'a | Right of 'b++  let (>|) _ x = x++  let (|>) x f = f x++  let (<|) f x = f x++  let (>>) x f = f x; x++  let (|>>) xo f = match xo with None -> None | Some x -> f x++  let (|>:) xs f = List.map f xs++  let (=+) x n = let v = !x in (x := v + n; v)++  let (+=) x n = x := !x + n; !x++  let (++) = List.rev_append++  let (+++)= fun (x1s, y1s) (x2s, y2s) -> (x1s ++ x2s, y1s ++ y2s)++  let id = fun x -> x++  let un = fun x -> ()++  let const x = fun _ -> x++  let (<.>) f g  = fun x -> x |> g |> f++  let (<+>) f g  = fun x -> x |> f |> g ++  let (<?>) b f  = fun x -> if b then f x else x++  let wwhen b f  = fun x -> if b then f x ++  let (<*>) f g  = fun x -> (f x, g x)+  +  let (<**>) f g = fun (x, y) -> (f x, g y)++  let (<&&>) f g = fun x -> f x && g x++  let failure fmt = Printf.ksprintf failwith fmt++  let foreach xs f = List.map f xs++  let asserts p fmt =+    Printf.ksprintf (fun x -> if not p then failwith x) fmt++let asserti = asserts+  (*+let asserti p fmt = +  Printf.ksprintf (fun x -> if not p then (print_string (x^"\n"); ignore(0/0)) else ()) fmt+*)++let assertf fmt =+  Printf.ksprintf failwith fmt++let halt _ =+  assert false++let fst3 (x,_,_) = x+let snd3 (_,x,_) = x+let thd3 (_,_,x) = x++let fst4 (x, _, _, _) = x+let snd4 (_, x, _, _) = x+let thd4 (_, _, x, _) = x+let fth4 (_, _, _, x) = x++let withfst3 (_,y,z) x = (x,y,z)+let withsnd3 (x,_,z) y = (x,y,z)+let withthd3 (x,y,_) z = (x,y,z)++let print_now s = +  print_string s;+  flush stdout++let print_now_error msg =+  prerr_string msg;+  flush stderr++let output_now c s = +  output_string c s; +  flush c++let some = fun x -> Some x++end++open Ops++let maybe_fold f b xs = +  let fo = fun bo x -> match bo with Some b -> f b x | _ -> None in+  List.fold_left fo (Some b) xs++let maybe_map f = function Some x -> Some (f x) | None -> None++let maybe_iter f = function Some x -> f x | None -> ()++let maybe = function Some x -> x | _ -> assertf "maybe called with None"++let maybe_apply f xo v = match xo with Some x -> f x v | None -> v++let maybe_default xo y = match xo with Some x -> x | None -> y++let maybe_string f = function Some x -> "Some " ^ (f x) | None -> "None"++let rec maybe_chain x d = function +  | f::fs -> (match f x with +              | Some y -> y +              | None -> maybe_chain x d fs)+  | []    -> d++++++let trace s f x =+  let _ = print_now <| Printf.sprintf "BEGIN: %s \n" s in+  let r = f x in+  let _ = print_now <| Printf.sprintf "END: %s \n" s   in+  r++(* ORIG+let rec pprint_many_box s f ppf = function+  | []     -> ()+  | x::[]  -> Format.fprintf ppf "%a" f x+  | x::xs' -> (Format.fprintf ppf "%a%s@\n" f x s; pprint_many_box s f ppf xs')+*)+let rec pprint_many_prefix sep base f ppf = function+  | x::xs -> Format.fprintf ppf "(%s %a %a)" +               sep f x (pprint_many_prefix sep base f) xs+  | []    -> Format.fprintf ppf "%a" f base+++let rec pprint_many_box brk s f ppf = function+  | []              -> ()+  | [x]             -> Format.fprintf ppf "%a" f x+  | x::xs' when brk -> Format.fprintf ppf "%a@\n%s" f x s; +                       pprint_many_box brk s f ppf xs'+  | x::xs'          -> Format.fprintf ppf "%a@,%s" f x s;+                       pprint_many_box brk s f ppf xs'++let pprint_many_box brk l s r f ppf = function+  | []     -> Format.fprintf ppf "[]"+  | xs     -> Format.fprintf ppf "@[%s%a%s@]" l (pprint_many_box brk s f) xs r++let pprint_many_brackets brk f ppf x = +  Format.fprintf ppf "%a" (pprint_many_box brk "[ " "; " "]" f) x++let rec pprint_many brk s f ppf = function+  | []              -> ()+  | [x]             -> Format.fprintf ppf "%a" f x+  | x::xs' when brk -> Format.fprintf ppf "%a%s@," f x s; pprint_many brk s f ppf xs'+  | x::xs'          -> Format.fprintf ppf "%a%s" f x s ; pprint_many brk s f ppf xs'++let pprint_maybe f ppf = function+  | Some x -> Format.fprintf ppf "Some %a" f x+  | None   -> Format.fprintf ppf "None"++let pprint_int ppf i =+  Format.fprintf ppf "%d" i++let pprint_int_o = pprint_maybe pprint_int+(*+let pprint_int_o ppf = function+  | None -> Format.fprintf ppf "None" +  | Some d -> Format.fprintf ppf "Some(%d)" d+*)++let pprint_str ppf s =+  Format.fprintf ppf "%s" s++let pprint_ints ppf is = +  pprint_many_brackets false (fun ppf i -> Format.fprintf ppf "%d" i) ppf is++let pprint_pretty_ints ppf is = +  is |> List.map string_of_int |> String.concat ";" |> Format.fprintf ppf "[%s]"++let pprint_tuple pp1 pp2 ppf (x1, x2) = +  Format.fprintf ppf "(%a, %a)" pp1 x1 pp2 x2++let rec subsets n = function+  | _ when n <= 0 +    -> [[]]+  | xs when n > List.length xs->+      []+  | x::xs +    -> (List.map (fun ys -> x :: ys) (subsets (n-1) xs))+    ++ (subsets n xs)+  | _ -> assertf "Misc.subsets"++let choose b f g = if b then f else g++let liftfst2 (f: 'a -> 'a -> 'b) (x: 'a * 'c) (y: 'a * 'c): 'b =+  f (fst x) (fst y)++let curry   = fun f x y   -> f (x,y)+let uncurry = fun f (x,y) -> f x y+let flip    = fun f x y   -> f y x++let maybe_bool = function+  | Some _ -> true+  | None   -> false++module type EMapType = sig+  include Map.S+  val extendWith   : (key -> 'a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t+  val extend       : 'a t -> 'a t -> 'a t+  val filter       : (key -> 'a -> bool) -> 'a t -> 'a t+  val of_list      : (key * 'a) list -> 'a t+  val to_list      : 'a t -> (key * 'a) list+  val length       : 'a t -> int+  val domain       : 'a t -> key list+  val range        : 'a t -> 'a list+  val join         : 'a t -> 'b t -> ('a * 'b) t+  val adds         : key -> 'a list -> 'a list t -> 'a list t+  val of_alist     : (key * 'a) list -> 'a list t+  val finds        : key -> 'a list t -> 'a list+  val safeFind     : key -> 'a t -> string -> 'a+  val safeAdd      : key -> 'a -> 'a t -> string -> 'a t+  val single       : key -> 'a -> 'a t+  val map_partial  : ('a -> 'b option) -> 'a t -> 'b t+  val maybe_find   : key -> 'a t -> 'a option+  val find_default : 'a -> key -> 'a t -> 'a+  val frequency    : key list -> int t+end++module type ESetType = sig+  include Set.S+  val of_list : elt list -> t+end++module ESet (K: Set.OrderedType) = +  struct+    include Set.Make(K)+    let of_list = List.fold_left (flip add) empty  +end++module type EOrderedType = sig+  include Map.OrderedType +  val print : Format.formatter -> t -> unit+end++(* module EMap (K: Map.OrderedType) = *) +module EMap (K: EOrderedType) = +  struct+    include Map.Make(K)++    let extendWith (f: key -> 'a -> 'a -> 'a) (m1: 'a t) (m2: 'a t) =+      fold begin fun k v m -> +        let v' = if mem k m then f k v (find k m) else v in+        add k v' m+      end m2 m1 +    +    let extend (m1: 'a t)  (m2: 'a t) : 'a t = fold add m2 m1++    (* in 3.12 *)+    let filter (f: key -> 'a -> bool) (m: 'a t) : 'a t =  +      fold (fun x y m -> if f x y then add x y m else m) m empty +    +    let of_list (kvs : (key * 'a) list) = +      List.fold_left (fun m (k, v) -> add k v m) empty kvs++        (* in 3.12 -- bindings *)+    let to_list (m : 'a t) : (key * 'a) list = +      fold (fun k v acc -> (k,v)::acc) m [] ++    (* in 3.12 -- cardinality *)+    let length (m : 'a t) : int = +      fold (fun _ _ i -> i+1) m 0++    (* in 3.12 -- singleton *)+    let single k v = add k v empty++    let domain m =+      fold (fun k _ acc -> k :: acc) m []++    let range (m : 'a t) : 'a list = +      fold (fun _ v acc -> v :: acc) m []+     +    let join (m1 : 'a t) (m2 : 'b t) : ('a * 'b) t =+      mapi begin fun k v1 ->+        let _  = asserts (mem k m2) "EMap.join" in+        (v1, find k m2) +      end m1++    let maybe_find k m = +      try Some (find k m) with Not_found -> None++    let find_default d k m = +      maybe_default (maybe_find k m) d ++    (* let finds k m = try find k m with Not_found -> [] *)+    let finds k m = find_default [] k m++    let adds (k: key) (vs: 'a list) (m : ('a list) t) : 'a list t = +      add k (vs ++ find_default [] k m) m++    let of_alist (kvs : (key * 'a) list) =+      List.fold_left (fun m (k, v) -> adds k [v] m) empty kvs+     +    let frequency (ks : key list) : int t =+      List.fold_left (fun m k -> +        add k (1 + (find_default 0 k m)) m+      ) empty ks ++    let safeFind k m msg =+      try find k m with Not_found -> +        let err = Format.fprintf Format.str_formatter +                    "ERROR: safeFind (%s): %a" msg K.print k; +                  Format.flush_str_formatter ()+        in failwith err++    let safeAdd k v m msg =+      if mem k m then +        let err = Format.fprintf Format.str_formatter +                    "ERROR: safeAdd (%s): %a" msg K.print k; +                  Format.flush_str_formatter ()+        in failwith err+      else add k v m++    let map_partial f m = +      fold (fun x yo m -> match yo with Some y -> add x y m | _ -> m) (map f m) empty +  end++module type KeyValType =+  sig+    type t+    val compare : t -> t -> int+    val print : Format.formatter -> t -> unit ++    type v+    val default : v+  end++module MapWithDefault (K: KeyValType) =+  struct+    include EMap(K)+    let find (i: K.t) (m: K.v t): K.v =+      try find i m with Not_found -> K.default+  end++module IntMap = +  EMap+  (struct+    type t = int+    let compare i1 i2 = compare i1 i2+    let print         = pprint_int+  end)++module IntSet =+  ESet+  (struct+    type t = int+    let compare i1 i2 =+      compare i1 i2+  end)++module IntIntMap = +  EMap +  (struct+    type t = int * int+    let compare i1 i2 = compare i1 i2+    let print ppf (i1, i2) = Format.fprintf ppf "(%d, %d)" i1 i2+   end)++module StringMap = +  EMap +  (struct+    type t = string +    let compare i1 i2 = compare i1 i2+    let print ppf s   = Format.fprintf ppf "%s" s+  end)++module StringSet =+  ESet+  (struct+    type t = string+    let compare i1 i2 = compare i1 i2+  end)++(* +let sm_join sm1 sm2 = +  StringMap.mapi (fun k v1 ->+    let v2 = asserts (StringMap.mem k sm2) "sm_join"; StringMap.find k sm2 in+    (v1, v2)+  ) sm1++let sm_extend sm1 sm2 =+  StringMap.fold StringMap.add sm2 sm1 ++let sm_filter f sm = +  StringMap.fold begin fun x y sm -> +    if f x y then StringMap.add x y sm else sm +  end sm StringMap.empty ++let sm_of_list kvs = +  List.fold_left (fun sm (k,v) -> StringMap.add k v sm) StringMap.empty kvs++let sm_to_list sm = +  StringMap.fold (fun k v acc -> (k,v)::acc) sm [] ++let sm_to_range sm = +  sm |> sm_to_list |> List.map snd+*)++let sm_print_keys name sm =+  sm |> StringMap.to_list +     |> List.map fst +     |> String.concat ", "+     |> Printf.printf "%s : %s \n" name++let foldn f n b = +  let rec foo acc i = +    if i >= n then acc else foo (f acc i) (i+1) +  in foo b 0 ++let rec range i j = +  if i >= j then [] else i::(range (i+1) j)++let dump s = +  print_string s; flush stdout++let mapn f n = +  foldn (fun acc i -> (f i) :: acc) n [] +  |> List.rev++let chop_last = function+  | [] -> failure "ERROR: Misc.chop_last"+  | xs -> xs |> List.rev |> List.tl |> List.rev++let list_snoc xs = +  match List.rev xs with +  | [] -> assertf "list_snoc with empty list!"+  | h::t  -> h, List.rev t++let negfilter f xs = +  List.fold_left (fun acc x -> if f x then acc else x::acc) [] xs +  |> List.rev++let get_option d = function  +  | Some x -> x +  | None   -> d++let list_somes xs =+  xs |> List.fold_left begin fun acc -> function +          | Some x -> x :: acc +          | None   -> acc +        end []+     |> List.rev++(* let map_partial f = list_somes <.> List.map f  *)++let map_partial f xs =+  List.rev +    (List.fold_left +      (fun acc x -> +        match f x with+        | None   -> acc+        | Some z -> (z::acc)) [] xs)+++let fold_left_partial f b xs =+  List.fold_left begin fun b xo ->+    match xo with+      | Some x -> f b x+      | None   -> b+  end b xs++let list_reduce msg f = function+  | []    -> assertf "ERROR: list_reduce with empty list: %s" msg +  | x::xs -> List.fold_left f x xs++let nonnull = function+  | [] -> false+  | _  -> true++(*+let list_is_empty = function+  | [] -> true+  | _::_ -> false+*)++let list_max x xs = +  List.fold_left max x xs++let list_min x xs = +  List.fold_left min x xs++let list_max_with msg f = function+  | []    -> assertf "ERROR: list_max_with with empty list: %s" msg +  | x::xs -> List.fold_left (fun acc x -> if f x > f acc then x else acc) x xs++let rec take_max n = function+  | x :: xs when n > 0 -> x :: take_max (n - 1) xs+  | _                  -> []+    +let rec drop n = function+  | x :: xs when n > 0 -> drop (n - 1) xs+  | []      when n > 0 -> assertf "ERROR: dropped too many"+  | xs -> xs++let getf a i fmt = +  try a.(i) with ex -> assertf fmt++let do_catchu f x g =+  try f x with ex -> (g ex; raise ex)++let do_catchf s f x =+  try f x with ex -> +    assertf "%s hits exn: %s \n" s (Printexc.to_string ex)++let do_catch s f x =+  try f x with ex -> +     (Printf.printf "%s hits exn: %s \n" s (Printexc.to_string ex); raise ex) ++let do_catch_ret s f x y = +  try f x with ex -> +     (Printf.printf "%s hits exn: %s \n" s (Printexc.to_string ex); y) ++let do_memo memo f args key = +  try Hashtbl.find memo key with Not_found ->+    let rv = f args in+    let _ = Hashtbl.replace memo key rv in+    rv++let do_bimemo fmemo rmemo f args key =+  try Hashtbl.find fmemo key with Not_found ->+    let rv = f args in+    let _ = Hashtbl.replace fmemo key rv in+    let _ = Hashtbl.replace rmemo rv key in+    rv++let rec exists_maybe f = function+  | []    -> None+  | x::xs -> (match f x with None -> exists_maybe f xs | z -> z)++let map_pair   = fun f (x1, x2)     -> (f x1, f x2)+let map_triple = fun f (x1, x2, x3) -> (f x1, f x2, f x3)+let app_fst    = fun f (a, b)       -> (f a, b)+let app_snd    = fun f (a, b)       -> (a, f b)+let app_fst3   = fun f (a, b, c)    -> (f a, b, c)++let app_snd3   = fun f (a, b, c)    -> (a, f b, c)++let app_thd3   = fun f (a, b, c)    -> (a, b, f c)+let pad_snd    = fun f x            -> (x, f x)+let pad_fst    = fun f y            -> (f y, y)+let tmap2      = fun (f, g) x       -> (f x, g x)+let tmap3      = fun (f, g, h) x    -> (f x, g x, h x)+let iter_fst   = fun f (a, b)       -> f a+let iter_snd   = fun f (a, b)       -> f b++let split3 lst =+  List.fold_right (fun (x, y, z) (xs, ys, zs) -> (x :: xs, y :: ys, z :: zs)) lst ([], [], [])++let split4 lst =+  List.fold_right (fun (w, x, y, z) (ws, xs, ys, zs) -> (w :: ws, x :: xs, y :: ys, z :: zs)) lst ([], [], [], [])++let twrap s f x =+  let _  = Printf.printf "calling %s \n" s in+  let rv = f x in+  let _  = Printf.printf "returned from %s \n" s in+  rv++let mapfold_rev f b xs = +  List.fold_left begin fun (acc, ys) x -> +    let (acc', y) = f acc x in +    (acc', y::ys)+  end (b, []) xs++let mapfold f b xs =+  mapfold_rev f b xs +  |> app_snd List.rev ++let rootsBy leq xs = +  let notDomBy x = not <.> (leq x) in+  let rec loop acc = function+    | [] -> +        acc+    | (x::xs) ->+        let acc', xs' = map_pair (List.filter (notDomBy x)) (acc, xs) in+        loop (x::acc') xs'+  in loop [] xs++let cov_filter cov f xs = +  let rec loop acc = function+    | [] -> +        acc+    | (x::xs) when f x ->+        let covs, uncovs = List.partition (cov x) xs in+        loop ((x, covs) :: acc) uncovs  +    | (_::xs) ->+      loop acc xs+  in loop [] xs++let filter f xs = +  List.fold_left (fun xs' x -> if f x then x::xs' else xs') [] xs+  |> List.rev++let iter f xs = +  List.fold_left (fun () x -> f x) () xs++let map2 f xs ys = +  let _ = asserti (List.length xs = List.length ys) "Misc.map2" in+  List.map2 f xs ys++let map f xs = +  List.rev_map f xs |> List.rev++let flatten xss =+  xss+  |> List.fold_left (fun acc xs -> xs ++ acc) []+  |> List.rev++let flatsingles xss =+  xss |> List.fold_left (fun acc -> function [x] -> x::acc | _ -> assertf "flatsingles") []+      |> List.rev++let splitflatten xsyss = +  let xss, yss = List.split xsyss in+  (flatten xss, flatten yss)++let splitflatten3 xsyszss =+  let xss, yss, zss = split3 xsyszss in+    (flatten xss, flatten yss, flatten zss)++let flap f xs =+  xs |> List.rev_map f |> flatten |> List.rev++let flap_pair f = splitflatten <.> map f++let tr_rev_flatten xs =+  List.fold_left (fun x xs -> x ++ xs) [] xs++let tr_rev_flap f xs =+  List.fold_left (fun xs x -> (f x) ++ xs) [] xs++let rec fast_unflat ys = function+  | x :: xs -> fast_unflat ([x] :: ys) xs+  | [] -> ys++let dup x = (x, x)+++let rec rev_perms s = function+  | [] -> s+  | e :: es -> rev_perms +    (tr_rev_flap (fun e -> List.rev_map (fun s -> e :: s) s) e) es ++let product = function+  | e :: es -> rev_perms (fast_unflat [] e) es+  | es -> es ++let pairs xs =+  let rec pairs_aux ps = function+    | [] -> ps+    | x :: xs -> pairs_aux (List.fold_left (fun ps y -> (x, y) :: ps) ps xs) xs+  in pairs_aux [] xs++let cross_product xs ys = +  map begin fun x ->+    map begin fun y ->+      (x,y)+    end ys+  end xs+  |> flatten++let rec cross_flatten = function+  | []      -> +      [[]]+  | xs::xss ->+      map begin fun x ->+        map begin fun ys ->+          (x::ys)+        end (cross_flatten xss)+      end xs+      |> flatten+++let append_pref p s =+  (p ^ "." ^ s)+++let fsort f xs =+  let cmp = fun (k1,_) (k2,_) -> compare k1 k2 in+  xs |> map (fun x -> ((f x), x)) +     |> List.sort cmp +     |> map snd++let sort_and_compact ls =+  let rec _sorted_compact l = +    match l with+	h1::h2::tl ->+	  let rest = _sorted_compact (h2::tl) in+	    if h1 = h2 then rest else h1::rest+      | tl -> tl+  in+    _sorted_compact (List.sort compare ls)   ++let sort_and_compact xs = +  List.sort compare xs +  |> List.fold_left +       (fun ys x -> match ys with+        | y::_ when x=y -> ys+        | _::_          -> x::ys+        | []            -> [x])+       [] +  |> List.rev++let hashtbl_to_list t = +  Hashtbl.fold (fun x y l -> (x,y)::l) t []++let hashtbl_keys t = +  Hashtbl.fold (fun x y l -> x::l) t []+  |> sort_and_compact++let hashtbl_invert t = +  let t' = Hashtbl.create 17 in+  hashtbl_to_list t +  |> List.iter (fun (x,y) -> Hashtbl.replace t' y x) +  |> fun _ -> t'+++let distinct xs = + List.length xs = List.length (sort_and_compact xs)++(** repeats f: unit - > unit i times *)+let rec repeat_fn f i = +  if i = 0 then ()+  else (f (); repeat_fn f (i-1))++(* chop s chopper returns ([x;y;z...]) if s = x.chopper.y.chopper ...*)+let chop s chopper = Str.split (Str.regexp chopper) s  ++(* like chop only the chop is by chop+ *)+let chop_star chopper s = +    Str.split (Str.regexp (Printf.sprintf "[%s+]" chopper)) s++let bounded_chop s chopper i = Str.bounded_split (Str.regexp chopper) s i ++let is_prefix p s = +  let (ls, lp) = (String.length s, String.length p) in+  if ls < lp+    then false+  else+    (String.sub s 0 lp) = p++let is_substring s subs = +  let reg = Str.regexp subs in+  try ignore(Str.search_forward reg s 0); true+  with Not_found -> false++let replace_substring src dst s =+  Str.global_replace (Str.regexp src) dst s++let is_suffix suffix s = +  let k = String.length suffix+  and n = String.length s in+  (n-k >= 0) && Str.string_match (Str.regexp suffix) s (n-k)++let iteri f xs =+  List.fold_left (fun i x -> f i x; i+1) 0 xs+  |> ignore++let numbered_list xs =+  xs |> List.fold_left (fun (i, acc) x -> (i+1, (i,x)::acc)) (0,[]) +     |> snd +     |> List.rev ++exception FalseException++let sm_protected_add fail k v sm = +  if not (StringMap.mem k sm) then StringMap.add k v sm else +    if not fail then sm else +      assertf "protected_add: duplicate binding for %s \n" k++let hashtbl_to_list_all t = +  hashtbl_keys t |> map (Hashtbl.find_all t) ++let clone x n =+  let rec f n xs = if n <= 0 then xs else f (n-1) (x::xs) in+  f n []++let single x = [x]++let distinct xs = +  List.length (sort_and_compact xs) = List.length xs++let trunc i j = +  let (ai,aj) = (abs i, abs j) in+  if aj <= ai then j else ai*j/aj ++let map_to_string f xs = +  String.concat "," (List.map f xs)++let suffix_of_string = fun s i -> String.sub s i (String.length s - 1)++(* [count_map xs] = fun x -> number of times x appears in xs if non-zero *)+let count_map rs =+  List.fold_left begin fun m r -> +      let c = try IntMap.find r m with Not_found -> 0 in+      IntMap.add r (c+1) m+  end IntMap.empty rs++let o2s f = function+  | Some x -> "Some "^ (f x)+  | None   -> "None"++let fixpoint f x =+  let rec acf b x =+    let x', b' = f x in+    if b' then acf true x' else (x', b) in+  acf false x+++let fsprintf f p = +  Format.fprintf Format.str_formatter "@[%a@]" f p;+  Format.flush_str_formatter ()++let rec same_length l1 l2 = match l1, l2 with+  | [], []           -> true+  | _ :: xs, _ :: ys -> same_length xs ys+  | _                -> false++let ex_one s = function+  | [x]    -> x+  | _ :: _ -> failwith s+  | _      -> failwith (s ^ ". empty")++let only_one s = function+    x :: [] -> Some x+  | _ :: _  -> failwith s+  | []      -> None++let maybe_one = function+  | [x] -> Some x+  | _   -> None+++let int_of_bool b = if b then 1 else 0++(*****************************************************************)+(******************** Mem Management *****************************)+(*****************************************************************)++open Gc+(* open Format *)++let pprint_gc s =+  (*printf "@[Gc@ Stats:@]@.";+  printf "@[minor@ words:@ %f@]@." s.minor_words;+  printf "@[promoted@ words:@ %f@]@." s.promoted_words;+  printf "@[major@ words:@ %f@]@." s.major_words;*)+  (*printf "@[total allocated:@ %fMB@]@." (floor ((s.major_words +. s.minor_words -. s.promoted_words) *. (4.0) /. (1024.0 *. 1024.0)));*)++  Format.printf "@[total allocated:@ %fMB@]@." (floor ((allocated_bytes ()) /. (1024.0 *. 1024.0)));+  Format.printf "@[minor@ collections:@ %i@]@." s.minor_collections;+  Format.printf "@[major@ collections:@ %i@]@." s.major_collections;+  Format.printf "@[heap@ size:@ %iMB@]@." (s.heap_words * 4 / (1024 * 1024));+  (*printf "@[heap@ chunks:@ %i@]@." s.heap_chunks;+  (*printf "@[live@ words:@ %i@]@." s.live_words;+  printf "@[live@ blocks:@ %i@]@." s.live_blocks;+  printf "@[free@ words:@ %i@]@." s.free_words;+  printf "@[free@ blocks:@ %i@]@." s.free_blocks;+  printf "@[largest@ free:@ %i@]@." s.largest_free;+  printf "@[fragments:@ %i@]@." s.fragments;*)*)+  Format.printf "@[compactions:@ %i@]@." s.compactions;+  (*printf "@[top@ heap@ words:@ %i@]@." s.top_heap_words*) ()++let dump_gc s =+  Format.printf "@[%s@]@." s;+  pprint_gc (Gc.quick_stat ())+++let append_to_file f s = +  let oc = Unix.openfile f [Unix.O_WRONLY; Unix.O_APPEND; Unix.O_CREAT] 420  in+  ignore (Unix.write oc s 0 ((String.length s)-1) ); +  Unix.close oc++(*+let with_out_file file f =+  let oc = open_out file in+    f oc;+    close_out oc+*)++let display_tick = fun () -> print_now "."++let display_tick = +  let icona = [| "|"; "/" ; "-"; "\\" |] in+  let pos   = ref 0 in+  fun () -> +    let k = !pos in+    let _ = print_now ("\b."^icona.(k)) in+    let _ = pos := (k + 1) mod 4 in+    ()++let with_out_file file f = file |> open_out >> f |> close_out++let write_to_file f s =+  with_out_file f (fun oc -> output_string oc s)++let with_out_formatter file f =+  with_out_file file (fun oc -> f (Format.formatter_of_out_channel oc))++let get_unique =+  let cnt = ref 0 in+  (fun () -> let rv = !cnt in incr cnt; rv)++let lines_of_file filename = +  let lines = ref [] in+  let chan = open_in filename in+  try +    while true; do+      lines := input_line chan :: !lines+    done; [] +  with End_of_file ->+    close_in chan;+    List.rev !lines++let map_lines_of_file infile outfile f =+  let ic = open_in infile in+  let oc = open_out outfile in+  try+    while true; do+      ic |> input_line |> f |> output_string oc+    done;+  with End_of_file -> +    (close_in ic; close_out oc)++let maybe_cons m xs = match m with+  | None -> xs+  | Some x -> x :: xs++let maybe_list xs = +  List.fold_right maybe_cons xs []++let rec list_first_maybe f = function+  | x::xs -> begin match f x with +              | Some y -> Some y +              | _      -> list_first_maybe f xs+             end+  | []    -> None++let list_find_maybe f xs =+  try some <| List.find f xs with Not_found -> None++let list_assoc_maybe k kvs =+  try Some (List.assoc k kvs) with Not_found -> None++let list_assoc_default d kvs k =+  try List.assoc k kvs with Not_found -> d++let list_assoc_flip xs = +  let r (x, y) = (y, x) in+    List.map r xs++let fold_lefti f b xs =+  List.fold_left (fun (i,b) x -> ((i+1), f i b x)) (0,b) xs++let mapi f xs = +  xs |> fold_lefti (fun i acc x -> (f i x) :: acc) [] +     |> snd |> List.rev++let index_from n xs = +  let is = range n (n + List.length xs) in+  List.combine is xs++let fold_left_flip f b xs =+  List.fold_left (flip f) b xs++let fold_left_swap f xs b =+  List.fold_left f b xs++let rec map3 f xs ys zs = match (xs, ys, zs) with+  | ([], [], []) -> []+  | (x :: xs, y :: ys, z :: zs) -> f x y z :: map3 f xs ys zs+  | _ -> assert false++let rec fold_right3 f xs ys zs acc = match xs, ys, zs with+  | x :: xs, y :: ys, z :: zs -> f x y z (fold_right3 f xs ys zs acc)+  | [], [], []                -> acc+  | _                         -> assert false++let rec fold_left3 f acc xs ys zs = match xs, ys, zs with+  | x :: xs, y :: ys, z :: zs -> fold_left3 f (f acc x y z) xs ys zs+  | [], [], []                -> acc+  | _                         -> assert false++let zip_partition xs bs =+  let (xbs, xbs') = List.partition snd (List.combine xs bs) in+  (List.map fst xbs, List.map fst xbs')++let rec map4 f ws xs ys zs = match ws, xs, ys, zs with+  | [], [], [], []                     -> []+  | w :: ws, x :: xs, y :: ys, z :: zs -> f w x y z :: map4 f ws xs ys zs+  | _                                  -> asserti false "map4"; assert false+++let rec perms es =+  match es with+    | s :: [] ->+        List.map (fun c -> [c]) s+    | s :: es ->+        flap (fun c -> List.map (fun d -> c :: d) (perms es)) s+    | [] ->+        []++let flap2 f xs ys = +  List.flatten (List.map2 f xs ys)++let flap3 f xs ys zs =+  List.flatten (map3 f xs ys zs)++let combine msg xs ys =+  let _ = asserts (List.length xs = List.length ys) "%s" msg in+  List.combine xs ys++let combine3 xs ys zs =+  map3 (fun x y z -> (x, y, z)) xs ys zs++let combine4 ws xs ys zs =+  map4 (fun w x y z -> (w, x, y, z)) ws xs ys zs++let tr_partition f xs =+  List.fold_left begin fun (xs,ys) z -> +    if f z +    then (z::xs, ys) +    else (xs, z::ys)+  end ([],[]) xs++let either_partition f xs =+  List.fold_left begin fun (xs, ys) z -> +    match f z with+    | Left x  -> (x::xs, ys)+    | Right y -> (xs, y::ys)+  end ([], []) xs++(* these do odd things with order for performance + * it is possible that fast is a misnomer *)+let fast_flatten xs =+  List.fold_left (++) [] xs++let fast_append v v' =+  let (v, v') = if List.length v > List.length v' then (v', v) else (v, v') in+  List.rev_append v v'++let fast_flap f xs =+  List.fold_left (fun xs x -> List.rev_append (f x) xs) [] xs++let rec fast_unflat ys = function+  | x :: xs -> fast_unflat ([x] :: ys) xs+  | [] -> ys++let rec rev_perms s = function+  | [] -> s+  | e :: es -> rev_perms +    (fast_flap (fun e -> List.rev_map (fun s -> e :: s) s) e) es ++let rev_perms = function+  | e :: es -> rev_perms (fast_unflat [] e) es+  | es -> es ++let tflap2 (e1, e2) f =+  List.fold_left (fun bs b -> List.fold_left (fun aas a -> f a b :: aas) bs e1) [] e2++let tflap3 (e1, e2, e3) f =+  List.fold_left begin fun cs c -> +    List.fold_left begin fun bs b -> +      List.fold_left begin fun aas a -> +        f a b c :: aas+      end bs e1+    end cs e2+  end[] e3++let rec expand f xs ys =+  match xs with+  | []    -> ys+  | x::xs -> let (xs', ys') = f x in+             expand f (xs' ++  xs) (ys' ++ ys)++let rec get_first f = function+  | x::xs when f x -> Some x +  | _::xs          -> get_first f xs+  | []             -> None++let join f xs ys = +  let rec fuse acc xs ys = +    match xs, ys with +    | [],_ | _, []                              -> List.rev acc+    | ((kx, _)::xs', (ky,_)::_  ) when kx < ky  -> fuse acc xs' ys+    | ((kx, _)::_  , (ky,_)::ys') when kx > ky  -> fuse acc xs  ys' +    | ((kx, x)::xs', (ky,y)::ys') (* kx = ky *) -> fuse ((x,y)::acc) xs' ys' in+  let xs' = List.map (fun x -> (f x, x)) xs |> List.sort compare in+  let ys' = List.map (fun y -> (f y, y)) ys |> List.sort compare in+  fuse [] xs' ys'++let hashtbl_find_default d t x =+  try Hashtbl.find t x with Not_found -> d++let frequency (xs : 'a list) : ('a * int) list = +  let t = Hashtbl.create 17 in+  List.iter begin fun x ->+    let n =  hashtbl_find_default 0 t x in+    Hashtbl.replace t x (n + 1)+  end xs;+  hashtbl_to_list t++let kgroupby (f: 'a -> 'b) (xs: 'a list): ('b * 'a list) list =+  let t        = Hashtbl.create 17 in+  let lookup x = try Hashtbl.find t x with Not_found -> [] in+  (* build table *)+  List.iter begin fun x -> +    Hashtbl.replace t (f x) (x :: lookup (f x))+  end xs;+  (* build cluster *)+  Hashtbl.fold (fun k xs xxs -> (k, xs) :: xxs) t []++++let groupby (f: 'a -> 'b) (xs: 'a list): 'a list list =+  kgroupby f xs |> List.map (snd <+> List.rev)++let full_join f xs ys =+     (xs, ys)+  |> map_pair (kgroupby f)+  |> uncurry (join fst)+  |> flap (map_pair snd <+> uncurry cross_product)++let exists_pair (f: 'a -> 'a -> bool) (xs: 'a list): bool =+  fst (List.fold_left (fun (b, ys) x -> (b || List.exists (f x) ys, x :: ys)) (false, []) xs)++let rec find_pair (f: 'a -> 'a -> bool): 'a list -> 'a * 'a = function+  | []    -> raise Not_found+  | x::xs -> try (x, List.find (f x) xs) with Not_found -> find_pair f xs++let rec is_unique = function+  | []      -> true+  | x :: xs -> if List.mem x xs then false else is_unique xs++let map_opt f = function+  | Some o -> Some (f o)+  | None -> None++let resl_opt f = function+  | Some o -> f o+  | None -> []++let resi_opt f = function+  | Some o -> f o+  | None -> ()++let opt_iter f l = +  List.iter (resi_opt f) l++let array_findi p arr =+  let rec look i =+    if i < 0 then raise Not_found else+      if p arr.(i) then i else look i - 1+  in look (Array.length arr - 1)++let array_to_index_list a =+  Array.fold_left (fun (i, rv) v -> (i+1,(i,v)::rv)) (0,[]) a+  |> snd+  |> List.rev+++let hashtbl_of_list xys = +  let t = Hashtbl.create 37 in+  let _ = List.iter (fun (x,y) -> Hashtbl.add t x y) xys in+  t++let hashtbl_of_list_with kf xs = +  xs |>: pad_fst kf |> hashtbl_of_list++let array_flapi f a =+  Array.fold_left (fun (i, acc) x -> (i+1, (f i x) :: acc)) (0,[]) a+  |> snd +  |> List.rev+  |> flatten++let array_fold_lefti f acc a =+  Array.fold_left (fun (i, acc) x -> (i + 1, f i acc x)) (0, acc) a |> snd++let array_map2 f xa ya = +  Array.mapi (fun i x -> f x (ya.(i))) xa++let array_rev_iteri f a =+  for i = Array.length a - 1 downto 0 do+    f i a.(i)+  done++exception NotForall++let array_forall f a =+  try+    Array.iter (fun e -> if f e then () else raise NotForall) a; true+  with NotForall ->+    false++let array_combine a1 a2 = +  asserts (Array.length a1 = Array.length a2) "array_combine";+  Array.init (Array.length a1) (fun i -> (a1.(i), a2.(i)))+++let compose f g a = f (g a)+++let rec gcd (a: int) (b: int): int =+  if b = 0 then a else gcd b (a mod b)++let lcm (a: int) (b: int): int =+  if a = 0 then a else (abs (a * b)) / (gcd a b)++let mk_int_factory () =+  let id = ref (-1) in+    ((fun () -> incr id; !id), (fun () -> id := -1))++let mk_char_factory () =+  let (fresh_int, reset_fresh_int) = mk_int_factory () in+    ((fun () -> Char.chr (fresh_int () + Char.code 'a')), reset_fresh_int)++let mk_string_factory s =+  let (fresh_int, reset_fresh_int) = mk_int_factory () in+    ((fun () -> s^(string_of_int (fresh_int ()))), reset_fresh_int)++let swap (x,y) = (y,x)++(* ('a * (int * 'b) list) list -> (int * ('a * 'b) list) list *)+let transpose x_iys_s = +  let t = Hashtbl.create 17 in+  List.iter begin fun (x, iys) ->+    List.iter begin fun (i, y) -> +      Hashtbl.add t i (x,y) +    end iys+  end x_iys_s; +  hashtbl_keys t |> List.map (fun i -> (i, Hashtbl.find_all t i))++let basename_no_extension fname =+  fname |> Filename.basename |> Filename.chop_extension++let absolute_name name =+  if not (Filename.is_relative name) then name else+    let b    = Filename.basename name in+    let d    = Filename.dirname name in+    let dir  = Sys.getcwd () in+    let _    = Sys.chdir (Filename.concat dir d) in+    let dir' = Sys.getcwd () in+    let rv   = Filename.concat dir' b in+    let _    = Sys.chdir dir in+    rv++let cardinality = fun xs -> xs |> sort_and_compact |> List.length+let disjoint    = fun xs ys -> cardinality xs + cardinality ys = cardinality (xs ++ ys)++let bracket (l : unit -> unit) (r : unit -> unit) (f : unit -> 'a) : 'a = +  try l () |> f >> (fun _ -> r ())+  with ex -> assertf "bracket hits exn: %s \n" (Printexc.to_string ex)++(*+let with_ref_at x v f =+  let oldv  = !x in +  bracket (fun _ -> x := v) (fun _ -> x := oldv) f +*)++let with_ref_at x v f = +  let oldv = !x        in +  let _    = x := v    in+  let res  = f ()      in+  let _    = x := oldv in+  res++++let rec isPrefix = function+  | ([], _)                   -> true+  | (x::xs, y::ys) when x = y -> isPrefix (xs, ys)+  | _                         -> false++let find_first_true f lo hi =+  let rec go lo hi = +    let mid = lo + ((hi - lo) / 2) in+    match () with+    | _ when lo >= hi    -> None+    | _ when lo = hi - 1 -> Some hi +    | _ when f mid       -> go lo mid +    | _                  -> go mid hi +  in   if f lo then Some lo +  else if not (f hi) then None +  else go lo hi++let safeHead msg = function+  | [x] -> x+  | _   -> failwith ("ERROR: safeHead" ^ msg) ++let safeApply pp f x = match f x with+  | Some y -> y+  | None   -> failwith ("ERROR: safeApply " ^ (pp x)) ++let stringIsUpper = function+  | "" -> false+  | s  -> let c = s.[0] in c = Char.uppercase c++let stringIsLower = function+  | "" -> false+  | s  -> let c = s.[0] in c = Char.lowercase c+++
+ external/misc/tagtime.ml view
@@ -0,0 +1,125 @@+(*+ *+ * Copyright (c) 2001 by+ *  George C. Necula	necula@cs.berkeley.edu+ *  Scott McPeak        smcpeak@cs.berkeley.edu+ *  Wes Weimer          weimer@cs.berkeley.edu+ *   + * All rights reserved.  Permission to use, copy, modify and distribute+ * this software for research purposes only is hereby granted, + * provided that the following conditions are met: + * 1. XSRedistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the authors may not be used to endorse or promote products + * derived from  this software without specific prior written permission. + *+ * DISCLAIMER:+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS + * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+ *+ *)++open Misc.Ops++(******************************************************************)+(************************* Definitions ****************************)+(******************************************************************)++                                        (* A hierarchy of timings *)+type t = { name : string * (string list);+           mutable time : float;+           mutable sub  : t list}++                                        (* Create the top level *)+let top = { name = "TOTAL", [];+            time = 0.0;+            sub  = []; }++                                        (* The stack of current path through +                                         * the hierarchy. The head is the +                                         * leaf. *)+let current : t list ref = ref [top]++let subtime x = +  x.sub |> List.map (fun y -> y.time) +        |> List.fold_left (+.) 0.0 ++(******************************************************************)+(************************* Printing *******************************)+(******************************************************************)++let _print x chn msg = +  x.time <- subtime x; +  let rec prTree ind node = +    Printf.fprintf chn "%s%-20s          %6.3f s\n" +      (String.make ind ' ') (fst node.name) node.time  ;+    List.iter (prTree (ind + 2)) node.sub+  in Printf.fprintf chn "%s" msg; prTree 0 x+ +let collapse (x: t) : t = failwith "TBD: Tagtime.collapse"++(* API *)+let print chn msg = _print (collapse top) chn msg++(******************************************************************)+(************************* Timing *********************************)+(******************************************************************)++let restore_stat (oldcurrent, start, stat) = +  let stop = Unix.times () in+  let diff = stop.Unix.tms_utime -. start in+  stat.time <- stat.time +. diff; +  current := oldcurrent++let find_stat stags =+  let curr = (match !current with h :: _ -> h | _ -> assert false) in+  let rec loop = function+    | h :: _ when h.name = stags -> h+    | _ :: rest -> loop rest+    | [] -> let nw = {name = stags; time = 0.0; sub = []} in+            curr.sub <- nw :: curr.sub;+            nw+  in loop curr.sub++(* API *)+let time (str, tags) f arg = +  let stat = find_stat (str, List.sort compare tags) in +  let oldcurrent = !current in+  let _ = current := stat :: oldcurrent in+  let start = (Unix.times ()).Unix.tms_utime in+  try +    let res = f arg in+    restore_stat (oldcurrent, start, stat);+    res  +  with x -> begin+    restore_stat (oldcurrent, start, stat);+    raise x+  end ++(******************************************************************)+(************************* Logging ********************************)+(******************************************************************)++let dump_to_channel chn = +  top.time <- subtime top;+  let rec prTree tags node =+    let s, ts = node.name in+    let tags' = [s] ++ ts ++ tags in+    let time' = max 0.0 (node.time -. (subtime node)) in+    Printf.fprintf chn "%s,%6.3f\n" (String.concat "," tags') time';+    List.iter (prTree tags') node.sub+  in prTree [] top ++(* API *)+let dump = fun fn -> fn |> open_out >> dump_to_channel |> close_out
+ external/misc/tagtime.mli view
@@ -0,0 +1,37 @@+(*+ * Copyright ? 1990-2007 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++(* Based on "Stats" by George Necula, Westley Weimer and Scott McPeak *)++(** Time a function and associate the time with the given +    (key) string and the list of (tags) strings. If some+    timing information is already associated with the key +    string, then accumulate the times. If this function is +    invoked within another timed function then you can have +    a hierarchy of timings *)+val time : string * string list -> ('a -> 'b) -> 'a -> 'b ++(** [dump fname] saves the tagged profile to file *)+val dump : string -> unit++val print: out_channel -> string -> unit
+ external/misc/timer.ml view
@@ -0,0 +1,59 @@+(*+ * Copyright ? 1990-2010 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *)++open FixMisc.Ops++type t = {+  name          : string; +  mutable last  : float;+  mutable events: (int * string option * float) list;+}++let get_time  = fun _ -> (Unix.times ()).Unix.tms_utime++let create n = +  let now = get_time () in+  { name   = n; +    events = [(0, None, 0.0)];+    last   = now;+  }++let log_event t so =+  match t.events with+  | []         -> assertf "impossible" +  | (i,_,_)::_ -> let now = get_time () in+                  t.events <- (i+1, so, now -. t.last)::t.events; +                  t.last   <- now ++let to_events = fun t -> List.rev t.events+let to_name   = fun t -> t.name++let print_event ppf = function+  | (i, Some s, f) -> Format.fprintf ppf "<%6d, %6.3f, %s>@\n" i f s+  | (i, None  , f) -> Format.fprintf ppf "<%6d, %6.3f, *>@\n"  i f++let print ppf t = +  Format.fprintf ppf "Timer %s :: @[%a@] \n" +    t.name +    (FixMisc.pprint_many false "" print_event) (to_events t) ++
+ external/misc/timer.mli view
@@ -0,0 +1,28 @@+(*+ * Copyright ? 1990-2010 The Regents of the University of California. All rights reserved. + *+ * Permission is hereby granted, without written agreement and without + * license or royalty fees, to use, copy, modify, and distribute this + * software and its documentation for any purpose, provided that the + * above copyright notice and the following two paragraphs appear in + * all copies of this software. + * + * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY + * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + * ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN + * IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY + * OF SUCH DAMAGE. + * + * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, + * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY + * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS + * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION + * TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.+ *+ *)++type t+val create   : string -> t+val log_event: t -> string option -> unit+val print    : Format.formatter -> t -> unit +
+ external/misc/timetest.ml view
@@ -0,0 +1,29 @@+(**************************************************************)+(*************** Unit Test For Time Modules *******************)+(**************************************************************)++open Misc.Ops++let rec repeat f n = if n > 0 then (f (); repeat f (n-1)) ++let pause_1_sec () = repeat (fun () -> ()) 112516096+let pause_n_sec n  = repeat pause_1_sec n++let rec sim n c b t = +  if n > 0 then begin+    let id = "downtick "^(string_of_int n) in+    let _  = Printf.printf "%s \n" id in+    Timer.log_event t (Some id); +    Tagtime.time ("pause",[id]) pause_n_sec b; +    sim (n-1) c (c*b) t+  end++let sim n c b t = +  sim n c b t; +  Timer.log_event t None++let c = try Sys.argv.(1) |> int_of_string with _ -> 1+let _ = Timer.create "boo" +        >> (fun t -> Tagtime.time ("sim", []) (sim 4 c 1) t)+        |> Format.printf "%a" Timer.print+let _ = Tagtime.dump "timetest.stat"
+ external/ocamlgraph/.depend view
@@ -0,0 +1,128 @@+lib/bitv.cmo: lib/bitv.cmi+lib/bitv.cmx: lib/bitv.cmi+lib/heap.cmo: lib/heap.cmi+lib/heap.cmx: lib/heap.cmi+lib/unionfind.cmo: lib/unionfind.cmi+lib/unionfind.cmx: lib/unionfind.cmi+lib/bitv.cmi:+lib/heap.cmi:+lib/unionfind.cmi:+src/blocks.cmo: src/util.cmi src/sig.cmi+src/blocks.cmx: src/util.cmx src/sig.cmi+src/builder.cmo: src/sig.cmi src/builder.cmi+src/builder.cmx: src/sig.cmi src/builder.cmi+src/classic.cmo: src/sig.cmi src/builder.cmi src/classic.cmi+src/classic.cmx: src/sig.cmi src/builder.cmx src/classic.cmi+src/cliquetree.cmo: src/util.cmi src/sig.cmi src/persistent.cmi src/oper.cmi \+    src/gmap.cmi src/builder.cmi src/cliquetree.cmi+src/cliquetree.cmx: src/util.cmx src/sig.cmi src/persistent.cmx src/oper.cmx \+    src/gmap.cmx src/builder.cmx src/cliquetree.cmi+src/components.cmo: src/util.cmi src/sig.cmi src/components.cmi+src/components.cmx: src/util.cmx src/sig.cmi src/components.cmi+src/delaunay.cmo: src/delaunay.cmi+src/delaunay.cmx: src/delaunay.cmi+src/dot.cmo: src/dot_parser.cmi src/dot_lexer.cmo src/dot_ast.cmi \+    src/builder.cmi src/dot.cmi+src/dot.cmx: src/dot_parser.cmx src/dot_lexer.cmx src/dot_ast.cmi \+    src/builder.cmx src/dot.cmi+src/dot_lexer.cmo: src/dot_parser.cmi src/dot_ast.cmi+src/dot_lexer.cmx: src/dot_parser.cmx src/dot_ast.cmi+src/dot_parser.cmo: src/dot_ast.cmi src/dot_parser.cmi+src/dot_parser.cmx: src/dot_ast.cmi src/dot_parser.cmi+src/flow.cmo: src/util.cmi src/sig.cmi src/flow.cmi+src/flow.cmx: src/util.cmx src/sig.cmi src/flow.cmi+src/gcoloring.cmo: src/traverse.cmi src/sig.cmi src/gcoloring.cmi+src/gcoloring.cmx: src/traverse.cmx src/sig.cmi src/gcoloring.cmi+src/gmap.cmo: src/sig.cmi src/gmap.cmi+src/gmap.cmx: src/sig.cmi src/gmap.cmi+src/gml.cmo: src/builder.cmi src/gml.cmi+src/gml.cmx: src/builder.cmx src/gml.cmi+src/gpath.cmo: src/util.cmi src/sig.cmi lib/heap.cmi src/gpath.cmi+src/gpath.cmx: src/util.cmx src/sig.cmi lib/heap.cmx src/gpath.cmi+src/graphviz.cmo: src/graphviz.cmi+src/graphviz.cmx: src/graphviz.cmi+src/imperative.cmo: src/sig.cmi src/blocks.cmo lib/bitv.cmi \+    src/imperative.cmi+src/imperative.cmx: src/sig.cmi src/blocks.cmx lib/bitv.cmx \+    src/imperative.cmi+src/kruskal.cmo: src/util.cmi lib/unionfind.cmi src/sig.cmi src/kruskal.cmi+src/kruskal.cmx: src/util.cmx lib/unionfind.cmx src/sig.cmi src/kruskal.cmi+src/mcs_m.cmo: src/util.cmi src/sig.cmi src/persistent.cmi src/oper.cmi \+    src/imperative.cmi src/gmap.cmi src/builder.cmi src/mcs_m.cmi+src/mcs_m.cmx: src/util.cmx src/sig.cmi src/persistent.cmx src/oper.cmx \+    src/imperative.cmx src/gmap.cmx src/builder.cmx src/mcs_m.cmi+src/md.cmo: src/sig.cmi src/oper.cmi src/gmap.cmi src/cliquetree.cmi \+    src/builder.cmi src/md.cmi+src/md.cmx: src/sig.cmi src/oper.cmx src/gmap.cmx src/cliquetree.cmx \+    src/builder.cmx src/md.cmi+src/minsep.cmo: src/sig.cmi src/oper.cmi src/components.cmi src/minsep.cmi+src/minsep.cmx: src/sig.cmi src/oper.cmx src/components.cmx src/minsep.cmi+src/oper.cmo: src/sig.cmi src/builder.cmi src/oper.cmi+src/oper.cmx: src/sig.cmi src/builder.cmx src/oper.cmi+src/pack.cmo: src/traverse.cmi src/topological.cmi src/sig.cmi src/rand.cmi \+    src/oper.cmi src/kruskal.cmi src/imperative.cmi src/graphviz.cmi \+    src/gpath.cmi src/gml.cmi src/flow.cmi src/dot.cmi src/components.cmi \+    src/classic.cmi src/builder.cmi src/pack.cmi+src/pack.cmx: src/traverse.cmx src/topological.cmx src/sig.cmi src/rand.cmx \+    src/oper.cmx src/kruskal.cmx src/imperative.cmx src/graphviz.cmx \+    src/gpath.cmx src/gml.cmx src/flow.cmx src/dot.cmx src/components.cmx \+    src/classic.cmx src/builder.cmx src/pack.cmi+src/persistent.cmo: src/util.cmi src/sig.cmi src/blocks.cmo \+    src/persistent.cmi+src/persistent.cmx: src/util.cmx src/sig.cmi src/blocks.cmx \+    src/persistent.cmi+src/rand.cmo: src/sig.cmi src/delaunay.cmi src/builder.cmi src/rand.cmi+src/rand.cmx: src/sig.cmi src/delaunay.cmx src/builder.cmx src/rand.cmi+src/strat.cmo: src/sig.cmi src/strat.cmi+src/strat.cmx: src/sig.cmi src/strat.cmi+src/topological.cmo: src/sig.cmi src/topological.cmi+src/topological.cmx: src/sig.cmi src/topological.cmi+src/traverse.cmo: src/sig.cmi src/traverse.cmi+src/traverse.cmx: src/sig.cmi src/traverse.cmi+src/util.cmo: src/sig.cmi src/util.cmi+src/util.cmx: src/sig.cmi src/util.cmi+src/version.cmo:+src/version.cmx:+src/builder.cmi: src/sig.cmi+src/classic.cmi: src/sig.cmi+src/cliquetree.cmi: src/sig.cmi+src/components.cmi: src/util.cmi src/sig.cmi+src/delaunay.cmi:+src/dot.cmi: src/dot_ast.cmi src/builder.cmi+src/dot_ast.cmi:+src/dot_parser.cmi: src/dot_ast.cmi+src/flow.cmi: src/sig.cmi+src/gcoloring.cmi: src/sig.cmi+src/gmap.cmi: src/sig.cmi+src/gml.cmi: src/builder.cmi+src/gpath.cmi: src/sig.cmi+src/graphviz.cmi:+src/imperative.cmi: src/sig.cmi+src/kruskal.cmi: src/sig.cmi+src/mcs_m.cmi: src/sig.cmi+src/md.cmi: src/sig.cmi+src/minsep.cmi: src/sig.cmi+src/oper.cmi: src/sig.cmi src/builder.cmi+src/pack.cmi: src/sig_pack.cmi+src/persistent.cmi: src/sig.cmi+src/rand.cmi: src/sig.cmi src/builder.cmi+src/sig.cmi:+src/sig_pack.cmi:+src/strat.cmi: src/sig.cmi+src/topological.cmi: src/sig.cmi+src/traverse.cmi: src/sig.cmi+src/util.cmi: src/sig.cmi+editor/ed_display.cmo:+editor/ed_display.cmx:+editor/ed_draw.cmo: src/components.cmi+editor/ed_draw.cmx: src/components.cmx+editor/ed_graph.cmo: src/traverse.cmi src/imperative.cmi src/graphviz.cmi \+    src/gml.cmi src/dot_ast.cmi src/dot.cmi src/components.cmi \+    src/builder.cmi+editor/ed_graph.cmx: src/traverse.cmx src/imperative.cmx src/graphviz.cmx \+    src/gml.cmx src/dot_ast.cmi src/dot.cmx src/components.cmx \+    src/builder.cmx+editor/ed_hyper.cmo:+editor/ed_hyper.cmx:+editor/ed_main.cmo:+editor/ed_main.cmx:
+ external/ocamlgraph/META view
@@ -0,0 +1,5 @@+version = "0.99b"+description = "Generic Graph Library"+requires=""+archive(byte) = "graph.cma"+archive(native) = "graph.cmxa"
+ external/ocamlgraph/META.in view
@@ -0,0 +1,5 @@+version = "VERSION"+description = "Generic Graph Library"+requires=""+archive(byte) = "CMA"+archive(native) = "CMXA"
+ external/ocamlgraph/Makefile view
@@ -0,0 +1,386 @@+##########################################################################+#                                                                        #+#  Ocamlgraph: a generic graph library for OCaml                         #+#  Copyright (C) 2004-2007                                               #+#  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        #+#                                                                        #+#  This software is free software; you can redistribute it and/or        #+#  modify it under the terms of the GNU Library General Public           #+#  License version 2, with the special exception on linking              #+#  described in file LICENSE.                                            #+#                                                                        #+#  This software is distributed in the hope that it will be useful,      #+#  but WITHOUT ANY WARRANTY; without even the implied warranty of        #+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  #+#                                                                        #+##########################################################################++# Where to install the binaries+prefix=/usr/local+exec_prefix=${prefix}+BINDIR=${exec_prefix}/bin++# Where to install the man page+MANDIR=${prefix}/share/man++# Other variables set by ./configure+OCAMLC   = ocamlc+OCAMLOPT = ocamlopt+OCAMLDEP = ocamldep+OCAMLDOC = ocamldoc+OCAMLLEX = ocamllex+OCAMLYACC= ocamlyacc+OCAMLLIB = /usr/lib/ocaml+OCAMLBEST= opt+OCAMLVERSION = 3.12.1+OCAMLWEB = true+OCAMLWIN32 = no+OCAMLFIND = +EXE = +LIBEXT = .a+OBJEXT = .o++# Others global variables+SRCDIR	= src+LIBDIR	= lib++INCLUDES= -I $(SRCDIR) -I $(LIBDIR) +BFLAGS = $(INCLUDES)+OFLAGS = $(INCLUDES) -for-pack Graph++# main target+#############++NAME=ocamlgraph++all: byte $(OCAMLBEST)+#all: byte $(OCAMLBEST) editor-no++# bytecode and native-code compilation+######################################++LIB= unionfind heap bitv+LIB:=$(patsubst %, $(LIBDIR)/%.cmo, $(LIB))++CMO = util blocks persistent imperative \+	delaunay builder classic rand oper \+	gpath traverse gcoloring topological components kruskal flow \+        graphviz gml dot_parser dot_lexer dot pack \+	gmap minsep cliquetree mcs_m md strat+CMO := $(LIB) $(patsubst %, $(SRCDIR)/%.cmo, $(CMO))++CMX = $(CMO:.cmo=.cmx)+CMA = graph.cma+CMXA = graph.cmxa++CMI = sig dot_ast sig_pack+CMI := $(patsubst %, src/%.cmi, $(CMI))++GENERATED = META \+	src/gml.ml src/version.ml \+	src/dot_parser.ml src/dot_parser.mli src/dot_lexer.ml++byte: $(CMA)+opt: $(CMXA)++graph.cma: graph.cmo+	$(OCAMLC) $(INCLUDES) -a -o $@ $^++graph.cmxa: graph.cmx+	$(OCAMLOPT) $(INCLUDES) -a -o $@ $^++graph.cmo: $(CMI) $(CMO)+	$(OCAMLC) $(INCLUDES) -pack -o $@ $^++graph.cmx: $(CMI) $(CMX)+	$(OCAMLOPT) $(INCLUDES) -pack -o $@ $^++EXAMPLESBIN=bin/demo.$(OCAMLBEST) bin/demo_planar.$(OCAMLBEST) \+  bin/bench.$(OCAMLBEST) bin/color.$(OCAMLBEST) bin/sudoku.$(OCAMLBEST) \+  bin/test.$(OCAMLBEST) ++.PHONY: examples+examples: $(EXAMPLESBIN)++.PHONY: demo+demo: bin/demo.$(OCAMLBEST)++bin/demo.byte: $(CMA) examples/demo.cmo+	$(OCAMLC) -o $@ $^++bin/demo.opt: $(CMXA) examples/demo.cmx+	$(OCAMLOPT) -o $@ $^++bin/demo_planar.byte: $(CMA) examples/demo_planar.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/demo_planar.opt: $(CMXA) examples/demo_planar.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++bin/color.byte: $(CMA) examples/color.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/color.opt: $(CMXA) examples/color.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++bin/sudoku.byte: $(CMA) examples/sudoku.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/sudoku.opt: $(CMXA) examples/sudoku.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++test: $(CMA) tests/test.ml+	ocaml unix.cma graphics.cma $^++bin/test.byte: $(CMA) tests/test.cmo+	$(OCAMLC) -g -unsafe -o $@ unix.cma graphics.cma $^++bin/test.opt: $(CMXA) tests/test.cmx+	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa graphics.cmxa $^++bench: bin/bench.$(OCAMLBEST)+	bin/bench.opt++bin/bench.opt: $(CMXA) tests/bench.ml+	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa $^++check: $(CMA) tests/check.ml+	ocaml $^++# gtk2 graph editor++ED_DIR=editor++editor-no:+editor-yes: $(ED_DIR)/editor.$(OCAMLBEST)++editor: $(ED_DIR)/editor.byte editor-yes++ED_CMO = ed_hyper ed_graph ed_draw ed_display ed_main+ED_CMO:= $(patsubst %, $(ED_DIR)/%.cmo, $(ED_CMO))+ED_CMX = $(ED_CMO:.cmo=.cmx)++ED_INCLUDES =  -I +threads -I $(ED_DIR)++$(ED_CMO): BFLAGS+= $(ED_INCLUDES)+$(ED_CMX): OFLAGS+= $(ED_INCLUDES)++$(ED_DIR)/editor.byte: $(CMA) $(ED_CMO)+	$(OCAMLC) -g -o $@  \+		lablgtk.cma lablgnomecanvas.cma unix.cma $^++$(ED_DIR)/editor.opt: $(CMXA) $(ED_CMX)+	$(OCAMLOPT) -o $@  \+		lablgtk.cmxa lablgnomecanvas.cmxa unix.cmxa $^++VERSION=0.99b++src/version.ml: Makefile+	echo "let version = \""$(VERSION)"\"" > $@+	echo "let date = \""`date`"\"" >> $@++META: META.in Makefile+	sed -e s/VERSION/$(VERSION)/ -e s/CMA/$(CMA)/ -e s/CMXA/$(CMXA)/ \+		$@.in > $@++# Additional rules+##################++EXAMPLES = demo color demo_planar sudoku+EXAMPLES:= $(patsubst %, examples/%.ml, $(EXAMPLES))++TESTS = test check+TESTS := $(patsubst %, tests/%.ml, $(TESTS))++DPD_GRAPH_ML= $(TESTS) $(EXAMPLES)++$(DPD_GRAPH_ML:.ml=.cmo): $(CMA)+$(DPD_GRAPH_ML:.ml=.cmx): $(CMXA)++# installation+##############++install: install-$(OCAMLBEST) install-byte++install-byte: +	cp -f graph.cmo graph.cmi $(CMA) "$(OCAMLLIB)"++install-opt: install-byte+	cp -f graph$(LIBEXT) graph.cmx $(CMXA) "$(OCAMLLIB)"++install-findlib: META+ifdef OCAMLFIND+	$(OCAMLFIND) install ocamlgraph META *.mli \+		graph$(LIBEXT) graph.cmx graph.cmo graph.cmi $(CMA) $(CMXA)+endif++# documentation+###############++DOCFILES=$(NAME).ps $(NAME).html++NODOC	= util blocks dot_parser dot_lexer+NODOC	:= $(patsubst %, $(SRCDIR)/%.cmo, $(NODOC))+DOC_CMO	= $(filter-out $(NODOC) $(LIB), $(CMO))+DOC_SRC	= $(CMI:.cmi=.mli) $(DOC_CMO:.cmo=.mli) $(DOC_CMO:.cmo=.ml)++.PHONY: doc+doc: $(DOC_CMO)+	mkdir -p doc+	rm -f doc/*+	$(OCAMLDOC) -d doc -html $(INCLUDES) $(DOC_SRC)++# literate programming+$(NAME).tex: $(DOC_SRC)+	$(OCAMLWEB) -o $@ $^++wc:+	ocamlwc -p $(SRCDIRC)/*.mli $(SRCDIRC)/*.ml++# file headers+##############+headers:+	headache -c misc/headache_config.txt -h misc/header.txt \+		Makefile.in configure.in README \+		$(LIBDIR)*.ml $(LIBDIR)*.ml[ily] \+		$(SRCDIR)*.ml $(SRCDIR)*.ml[ily] \+		$(ED_DIR)/*.ml $(ED_DIR)/*.mli \++# export+########++EXPORTDIR=$(NAME)-$(VERSION)+TAR=$(EXPORTDIR).tar++FTP = $$HOME/ftp/$(NAME)+WWW = $$HOME/WWW/$(NAME)++FILES = src/*.ml* lib/*.ml* Makefile.in configure configure.in META.in  \+	.depend editor/ed_*.ml* editor/Makefile \+        editor/tests/*.dot editor/tests/*.gml \+	examples/*.ml tests/*.ml \+	.depend README FAQ CREDITS INSTALL COPYING LICENSE CHANGES++export: source export-doc export-web export-delaunay++source: +	mkdir -p export+	cd export; rm -rf $(EXPORTDIR)+	mkdir -p export/$(EXPORTDIR)/bin+	cp --parents $(FILES) export/$(EXPORTDIR)+	cd export ; tar cf $(TAR) $(EXPORTDIR) ; gzip -f --best $(TAR)+	cp export/$(TAR).gz $(FTP)+	cp README FAQ CREDITS COPYING LICENSE CHANGES $(EXAMPLES) $(FTP)++www/version.prehtml: Makefile.in+	echo "<#def version>$(VERSION)</#def>" > www/version.prehtml++export-web: www/version.prehtml+	make -C www install++export-doc: $(DOC_CMO)+	rm -f $(WWW)/doc/*+	-$(OCAMLDOC) -d $(WWW)/doc -html $(INCLUDES) $(DOC_SRC)++MISCFTP = $(HOME)/WWW/ftp/ocaml/misc+DELAUNAY=delaunay.ml delaunay.mli+export-delaunay:+	cd src; cp -f $(DELAUNAY) $(MISCFTP)+	cd src; caml2html -d $(MISCFTP) $(DELAUNAY)++# generic rules+###############++.SUFFIXES: .mli .ml .cmi .cmo .cmx .mll .mly .tex .dvi .ps .html++.mli.cmi:+	$(OCAMLC) -c $(BFLAGS) $<++.ml.cmo:+	$(OCAMLC) -c $(BFLAGS) $<++.ml.o:+	$(OCAMLOPT) -c $(OFLAGS) $<++.ml.cmx:+	$(OCAMLOPT) -c $(OFLAGS) $<++.mll.ml:+	$(OCAMLLEX) $<++.mly.ml:+	$(OCAMLYACC) -v $<++.mly.mli:+	$(OCAMLYACC) -v $<++.tex.dvi:+	latex $< && latex $<++.dvi.ps:+	dvips $< -o $@ ++.tex.html:+	hevea $<++# Emacs tags+############++otags:+	otags -r src editor++tags:+	find . -name "*.ml*" | sort -r | xargs \+	etags "--regex=/let[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/let[ \t]+rec[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/and[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/type[ \t]+\([^ \t]+\)/\1/" \+              "--regex=/exception[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/val[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/module[ \t]+\([^ \t]+\)/\1/"++# Makefile is rebuilt whenever Makefile.in or configure.in is modified+######################################################################++Makefile: Makefile.in config.status+	if test -e $@; then chmod a+w $@; fi		+	./config.status+	chmod a-w $@++config.status: configure+	./config.status --recheck++configure: configure.in+	autoconf ++# clean+#######++clean:+	rm -f *~+	for d in $(SRCDIR) $(LIBDIR) $(ED_DIR) tests examples; do \+	  rm -f $$d/*.cm[iox] $$d/*$(OBJEXT) $$d/*~; \+	done+	rm -f $(GENERATED) $(SRCDIR)/dot_parser.output+	rm -f graph.*a graph$(LIBEXT) bin/$(NAME).byte bin/$(NAME).opt+	rm -f *.haux *.aux *.log $(NAME).tex $(NAME).dvi $(DOCFILES)+	rm -f $(EXAMPLESBIN)++dist-clean distclean:: clean+	rm -f Makefile config.cache config.log config.status *.byte *.opt++svnclean svn-clean:: dist-clean+	rm -f config.* configure configure.lineno++# depend+########++.PHONY: depend+.depend depend: $(GENERATED)+	rm -f .depend+	$(OCAMLDEP) $(INCLUDES) \+		$(LIBDIR)/*.ml $(LIBDIR)/*.mli \+		$(SRCDIR)/*.ml $(SRCDIR)/*.mli \+		$(ED_DIR)/*.mli $(ED_DIR)/*.ml > .depend++include .depend
+ external/ocamlgraph/Makefile.in view
@@ -0,0 +1,386 @@+##########################################################################+#                                                                        #+#  Ocamlgraph: a generic graph library for OCaml                         #+#  Copyright (C) 2004-2007                                               #+#  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        #+#                                                                        #+#  This software is free software; you can redistribute it and/or        #+#  modify it under the terms of the GNU Library General Public           #+#  License version 2, with the special exception on linking              #+#  described in file LICENSE.                                            #+#                                                                        #+#  This software is distributed in the hope that it will be useful,      #+#  but WITHOUT ANY WARRANTY; without even the implied warranty of        #+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  #+#                                                                        #+##########################################################################++# Where to install the binaries+prefix=@prefix@+exec_prefix=@exec_prefix@+BINDIR=@bindir@++# Where to install the man page+MANDIR=@mandir@++# Other variables set by ./configure+OCAMLC   = @OCAMLC@+OCAMLOPT = @OCAMLOPT@+OCAMLDEP = @OCAMLDEP@+OCAMLDOC = @OCAMLDOC@+OCAMLLEX = @OCAMLLEX@+OCAMLYACC= @OCAMLYACC@+OCAMLLIB = @OCAMLLIB@+OCAMLBEST= @OCAMLBEST@+OCAMLVERSION = @OCAMLVERSION@+OCAMLWEB = @OCAMLWEB@+OCAMLWIN32 = @OCAMLWIN32@+OCAMLFIND = @OCAMLFIND@+EXE = @EXE@+LIBEXT = @LIBEXT@+OBJEXT = @OBJEXT@++# Others global variables+SRCDIR	= src+LIBDIR	= lib++INCLUDES= -I $(SRCDIR) -I $(LIBDIR) +BFLAGS = $(INCLUDES)+OFLAGS = $(INCLUDES) @FORPACK@++# main target+#############++NAME=ocamlgraph++all: byte $(OCAMLBEST)+#all: byte $(OCAMLBEST) editor-@LABLGTK2@++# bytecode and native-code compilation+######################################++LIB= unionfind heap bitv+LIB:=$(patsubst %, $(LIBDIR)/%.cmo, $(LIB))++CMO = util blocks persistent imperative \+	delaunay builder classic rand oper \+	gpath traverse gcoloring topological components kruskal flow \+        graphviz gml dot_parser dot_lexer dot pack \+	gmap minsep cliquetree mcs_m md strat+CMO := $(LIB) $(patsubst %, $(SRCDIR)/%.cmo, $(CMO))++CMX = $(CMO:.cmo=.cmx)+CMA = graph.cma+CMXA = graph.cmxa++CMI = sig dot_ast sig_pack+CMI := $(patsubst %, src/%.cmi, $(CMI))++GENERATED = META \+	src/gml.ml src/version.ml \+	src/dot_parser.ml src/dot_parser.mli src/dot_lexer.ml++byte: $(CMA)+opt: $(CMXA)++graph.cma: graph.cmo+	$(OCAMLC) $(INCLUDES) -a -o $@ $^++graph.cmxa: graph.cmx+	$(OCAMLOPT) $(INCLUDES) -a -o $@ $^++graph.cmo: $(CMI) $(CMO)+	$(OCAMLC) $(INCLUDES) -pack -o $@ $^++graph.cmx: $(CMI) $(CMX)+	$(OCAMLOPT) $(INCLUDES) -pack -o $@ $^++EXAMPLESBIN=bin/demo.$(OCAMLBEST) bin/demo_planar.$(OCAMLBEST) \+  bin/bench.$(OCAMLBEST) bin/color.$(OCAMLBEST) bin/sudoku.$(OCAMLBEST) \+  bin/test.$(OCAMLBEST) ++.PHONY: examples+examples: $(EXAMPLESBIN)++.PHONY: demo+demo: bin/demo.$(OCAMLBEST)++bin/demo.byte: $(CMA) examples/demo.cmo+	$(OCAMLC) -o $@ $^++bin/demo.opt: $(CMXA) examples/demo.cmx+	$(OCAMLOPT) -o $@ $^++bin/demo_planar.byte: $(CMA) examples/demo_planar.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/demo_planar.opt: $(CMXA) examples/demo_planar.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++bin/color.byte: $(CMA) examples/color.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/color.opt: $(CMXA) examples/color.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++bin/sudoku.byte: $(CMA) examples/sudoku.cmo+	$(OCAMLC) -o $@ graphics.cma unix.cma $^++bin/sudoku.opt: $(CMXA) examples/sudoku.cmx+	$(OCAMLOPT) -o $@ graphics.cmxa unix.cmxa $^++test: $(CMA) tests/test.ml+	ocaml unix.cma graphics.cma $^++bin/test.byte: $(CMA) tests/test.cmo+	$(OCAMLC) -g -unsafe -o $@ unix.cma graphics.cma $^++bin/test.opt: $(CMXA) tests/test.cmx+	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa graphics.cmxa $^++bench: bin/bench.$(OCAMLBEST)+	bin/bench.opt++bin/bench.opt: $(CMXA) tests/bench.ml+	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa $^++check: $(CMA) tests/check.ml+	ocaml $^++# gtk2 graph editor++ED_DIR=editor++editor-no:+editor-yes: $(ED_DIR)/editor.$(OCAMLBEST)++editor: $(ED_DIR)/editor.byte editor-yes++ED_CMO = ed_hyper ed_graph ed_draw ed_display ed_main+ED_CMO:= $(patsubst %, $(ED_DIR)/%.cmo, $(ED_CMO))+ED_CMX = $(ED_CMO:.cmo=.cmx)++ED_INCLUDES = @INCLUDEGTK2@ -I +threads -I $(ED_DIR)++$(ED_CMO): BFLAGS+= $(ED_INCLUDES)+$(ED_CMX): OFLAGS+= $(ED_INCLUDES)++$(ED_DIR)/editor.byte: $(CMA) $(ED_CMO)+	$(OCAMLC) -g -o $@ @INCLUDEGTK2@ \+		lablgtk.cma lablgnomecanvas.cma unix.cma $^++$(ED_DIR)/editor.opt: $(CMXA) $(ED_CMX)+	$(OCAMLOPT) -o $@ @INCLUDEGTK2@ \+		lablgtk.cmxa lablgnomecanvas.cmxa unix.cmxa $^++VERSION=0.99b++src/version.ml: Makefile+	echo "let version = \""$(VERSION)"\"" > $@+	echo "let date = \""`date`"\"" >> $@++META: META.in Makefile+	sed -e s/VERSION/$(VERSION)/ -e s/CMA/$(CMA)/ -e s/CMXA/$(CMXA)/ \+		$@.in > $@++# Additional rules+##################++EXAMPLES = demo color demo_planar sudoku+EXAMPLES:= $(patsubst %, examples/%.ml, $(EXAMPLES))++TESTS = test check+TESTS := $(patsubst %, tests/%.ml, $(TESTS))++DPD_GRAPH_ML= $(TESTS) $(EXAMPLES)++$(DPD_GRAPH_ML:.ml=.cmo): $(CMA)+$(DPD_GRAPH_ML:.ml=.cmx): $(CMXA)++# installation+##############++install: install-$(OCAMLBEST) install-byte++install-byte: +	cp -f graph.cmo graph.cmi $(CMA) "$(OCAMLLIB)"++install-opt: install-byte+	cp -f graph$(LIBEXT) graph.cmx $(CMXA) "$(OCAMLLIB)"++install-findlib: META+ifdef OCAMLFIND+	$(OCAMLFIND) install ocamlgraph META *.mli \+		graph$(LIBEXT) graph.cmx graph.cmo graph.cmi $(CMA) $(CMXA)+endif++# documentation+###############++DOCFILES=$(NAME).ps $(NAME).html++NODOC	= util blocks dot_parser dot_lexer+NODOC	:= $(patsubst %, $(SRCDIR)/%.cmo, $(NODOC))+DOC_CMO	= $(filter-out $(NODOC) $(LIB), $(CMO))+DOC_SRC	= $(CMI:.cmi=.mli) $(DOC_CMO:.cmo=.mli) $(DOC_CMO:.cmo=.ml)++.PHONY: doc+doc: $(DOC_CMO)+	mkdir -p doc+	rm -f doc/*+	$(OCAMLDOC) -d doc -html $(INCLUDES) $(DOC_SRC)++# literate programming+$(NAME).tex: $(DOC_SRC)+	$(OCAMLWEB) -o $@ $^++wc:+	ocamlwc -p $(SRCDIRC)/*.mli $(SRCDIRC)/*.ml++# file headers+##############+headers:+	headache -c misc/headache_config.txt -h misc/header.txt \+		Makefile.in configure.in README \+		$(LIBDIR)*.ml $(LIBDIR)*.ml[ily] \+		$(SRCDIR)*.ml $(SRCDIR)*.ml[ily] \+		$(ED_DIR)/*.ml $(ED_DIR)/*.mli \++# export+########++EXPORTDIR=$(NAME)-$(VERSION)+TAR=$(EXPORTDIR).tar++FTP = $$HOME/ftp/$(NAME)+WWW = $$HOME/WWW/$(NAME)++FILES = src/*.ml* lib/*.ml* Makefile.in configure configure.in META.in  \+	.depend editor/ed_*.ml* editor/Makefile \+        editor/tests/*.dot editor/tests/*.gml \+	examples/*.ml tests/*.ml \+	.depend README FAQ CREDITS INSTALL COPYING LICENSE CHANGES++export: source export-doc export-web export-delaunay++source: +	mkdir -p export+	cd export; rm -rf $(EXPORTDIR)+	mkdir -p export/$(EXPORTDIR)/bin+	cp --parents $(FILES) export/$(EXPORTDIR)+	cd export ; tar cf $(TAR) $(EXPORTDIR) ; gzip -f --best $(TAR)+	cp export/$(TAR).gz $(FTP)+	cp README FAQ CREDITS COPYING LICENSE CHANGES $(EXAMPLES) $(FTP)++www/version.prehtml: Makefile.in+	echo "<#def version>$(VERSION)</#def>" > www/version.prehtml++export-web: www/version.prehtml+	make -C www install++export-doc: $(DOC_CMO)+	rm -f $(WWW)/doc/*+	-$(OCAMLDOC) -d $(WWW)/doc -html $(INCLUDES) $(DOC_SRC)++MISCFTP = $(HOME)/WWW/ftp/ocaml/misc+DELAUNAY=delaunay.ml delaunay.mli+export-delaunay:+	cd src; cp -f $(DELAUNAY) $(MISCFTP)+	cd src; caml2html -d $(MISCFTP) $(DELAUNAY)++# generic rules+###############++.SUFFIXES: .mli .ml .cmi .cmo .cmx .mll .mly .tex .dvi .ps .html++.mli.cmi:+	$(OCAMLC) -c $(BFLAGS) $<++.ml.cmo:+	$(OCAMLC) -c $(BFLAGS) $<++.ml.o:+	$(OCAMLOPT) -c $(OFLAGS) $<++.ml.cmx:+	$(OCAMLOPT) -c $(OFLAGS) $<++.mll.ml:+	$(OCAMLLEX) $<++.mly.ml:+	$(OCAMLYACC) -v $<++.mly.mli:+	$(OCAMLYACC) -v $<++.tex.dvi:+	latex $< && latex $<++.dvi.ps:+	dvips $< -o $@ ++.tex.html:+	hevea $<++# Emacs tags+############++otags:+	otags -r src editor++tags:+	find . -name "*.ml*" | sort -r | xargs \+	etags "--regex=/let[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/let[ \t]+rec[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/and[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/type[ \t]+\([^ \t]+\)/\1/" \+              "--regex=/exception[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/val[ \t]+\([^ \t]+\)/\1/" \+	      "--regex=/module[ \t]+\([^ \t]+\)/\1/"++# Makefile is rebuilt whenever Makefile.in or configure.in is modified+######################################################################++Makefile: Makefile.in config.status+	if test -e $@; then chmod a+w $@; fi		+	./config.status+	chmod a-w $@++config.status: configure+	./config.status --recheck++configure: configure.in+	autoconf ++# clean+#######++clean:+	rm -f *~+	for d in $(SRCDIR) $(LIBDIR) $(ED_DIR) tests examples; do \+	  rm -f $$d/*.cm[iox] $$d/*$(OBJEXT) $$d/*~; \+	done+	rm -f $(GENERATED) $(SRCDIR)/dot_parser.output+	rm -f graph.*a graph$(LIBEXT) bin/$(NAME).byte bin/$(NAME).opt+	rm -f *.haux *.aux *.log $(NAME).tex $(NAME).dvi $(DOCFILES)+	rm -f $(EXAMPLESBIN)++dist-clean distclean:: clean+	rm -f Makefile config.cache config.log config.status *.byte *.opt++svnclean svn-clean:: dist-clean+	rm -f config.* configure configure.lineno++# depend+########++.PHONY: depend+.depend depend: $(GENERATED)+	rm -f .depend+	$(OCAMLDEP) $(INCLUDES) \+		$(LIBDIR)/*.ml $(LIBDIR)/*.mli \+		$(SRCDIR)/*.ml $(SRCDIR)/*.mli \+		$(ED_DIR)/*.mli $(ED_DIR)/*.ml > .depend++include .depend
+ external/ocamlgraph/configure view
@@ -0,0 +1,3485 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.68.+#+#+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software+# Foundation, Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH++if test "x$CONFIG_SHELL" = x; then+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '\${1+\"\$@\"}'='\"\$@\"'+  setopt NO_GLOB_SUBST+else+  case \`(set -o) 2>/dev/null\` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+"+  as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :++else+  exitcode=1; echo positional parameters were not saved.+fi+test x\$exitcode = x0 || exit 1"+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"+  if (eval "$as_required") 2>/dev/null; then :+  as_have_required=yes+else+  as_have_required=no+fi+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :++else+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+as_found=false+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  as_found=:+  case $as_dir in #(+	 /*)+	   for as_base in sh bash ksh sh5; do+	     # Try only shells that exist, to save several forks.+	     as_shell=$as_dir/$as_base+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :+  CONFIG_SHELL=$as_shell as_have_required=yes+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :+  break 2+fi+fi+	   done;;+       esac+  as_found=false+done+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :+  CONFIG_SHELL=$SHELL as_have_required=yes+fi; }+IFS=$as_save_IFS+++      if test "x$CONFIG_SHELL" != x; then :+  # We cannot yet assume a decent shell, so we have to provide a+	# neutralization value for shells without unset; and this also+	# works around shells that cannot unset nonexistent variables.+	# Preserve -v and -x to the replacement shell.+	BASH_ENV=/dev/null+	ENV=/dev/null+	(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+	export CONFIG_SHELL+	case $- in # ((((+	  *v*x* | *x*v* ) as_opts=-vx ;;+	  *v* ) as_opts=-v ;;+	  *x* ) as_opts=-x ;;+	  * ) as_opts= ;;+	esac+	exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}+fi++    if test x$as_have_required = xno; then :+  $as_echo "$0: This script requires a shell more modern than all"+  $as_echo "$0: the shells that I found on your system."+  if test x${ZSH_VERSION+set} = xset ; then+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."+  else+    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,+$0: including any error possibly output before this+$0: message. Then install a modern shell, or manually run+$0: the script under such a shell if you do have one."+  fi+  exit 1+fi+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++  as_lineno_1=$LINENO as_lineno_1a=$LINENO+  as_lineno_2=$LINENO as_lineno_2a=$LINENO+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)+  sed -n '+    p+    /[$]LINENO/=+  ' <$as_myself |+    sed '+      s/[$]LINENO.*/&-/+      t lineno+      b+      :lineno+      N+      :loop+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+      t loop+      s/-\n.*//+    ' >$as_me.lineno &&+  chmod +x "$as_me.lineno" ||+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensitive to this).+  . "./$as_me.lineno"+  # Exit status is that of the last command.+  exit+}++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in #(+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++test -n "$DJDIR" || exec 7<&0 </dev/null+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# Identity of this package.+PACKAGE_NAME=+PACKAGE_TARNAME=+PACKAGE_VERSION=+PACKAGE_STRING=+PACKAGE_BUGREPORT=+PACKAGE_URL=++ac_unique_file="src/sig.mli"+ac_subst_vars='LTLIBOBJS+LIBOBJS+INCLUDEGTK2+FORPACK+OBJEXT+LIBEXT+EXE+OCAMLWIN32+OCAMLLIB+OCAMLVERSION+OCAMLBEST+LABLGTK2+OCAMLFIND+OCAMLWEB+OCAMLDOCOPT+OCAMLDOC+OCAMLYACC+OCAMLLEXDOTOPT+OCAMLLEX+OCAMLDEP+OCAMLOPTDOTOPT+OCAMLCDOTOPT+OCAMLOPT+OCAMLC+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+'+      ac_precious_vars='build_alias+host_alias+target_alias'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval $ac_prev=\$ac_option+    ac_prev=+    continue+  fi++  case $ac_option in+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+  *=)   ac_optarg= ;;+  *)    ac_optarg=yes ;;+  esac++  # Accept the important Cygnus configure options, so we can diagnose typos.++  case $ac_dashdash$ac_option in+  --)+    ac_dashdash=yes ;;++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=*)+    datadir=$ac_optarg ;;++  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+  | --dataroo | --dataro | --datar)+    ac_prev=datarootdir ;;+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+    datarootdir=$ac_optarg ;;++  -disable-* | --disable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=no ;;++  -docdir | --docdir | --docdi | --doc | --do)+    ac_prev=docdir ;;+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+    docdir=$ac_optarg ;;++  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+    ac_prev=dvidir ;;+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+    dvidir=$ac_optarg ;;++  -enable-* | --enable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=\$ac_optarg ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+    ac_prev=htmldir ;;+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+  | --ht=*)+    htmldir=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localedir | --localedir | --localedi | --localed | --locale)+    ac_prev=localedir ;;+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+    localedir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst | --locals)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+    ac_prev=pdfdir ;;+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+    pdfdir=$ac_optarg ;;++  -psdir | --psdir | --psdi | --psd | --ps)+    ac_prev=psdir ;;+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+    psdir=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=\$ac_optarg ;;++  -without-* | --without-*)+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=no ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+    x_libraries=$ac_optarg ;;++  -*) as_fn_error $? "unrecognized option: \`$ac_option'+Try \`$0 --help' for more information"+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    case $ac_envvar in #(+      '' | [0-9]* | *[!_$as_cr_alnum]* )+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;+    esac+    eval $ac_envvar=\$ac_optarg+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  as_fn_error $? "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+  esac+fi++# Check all directory arguments for consistency.+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \+		datadir sysconfdir sharedstatedir localstatedir includedir \+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+		libdir localedir mandir+do+  eval ac_val=\$$ac_var+  # Remove trailing slashes.+  case $ac_val in+    */ )+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+      eval $ac_var=\$ac_val;;+  esac+  # Be sure to have absolute directory names.+  case $ac_val in+    [\\/$]* | ?:[\\/]* )  continue;;+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+  esac+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"+done++# There might be people who depend on the old broken behavior: `$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+    $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.+    If a cross compiler is detected then cross compile mode will be used" >&2+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+  as_fn_error $? "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  as_fn_error $? "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then the parent directory.+  ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_myself" : 'X\(//\)[^/]' \| \+	 X"$as_myself" : 'X\(//\)$' \| \+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_myself" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r "$srcdir/$ac_unique_file"; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"+fi+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"+	pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+  srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+  eval ac_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_env_${ac_var}_value=\$${ac_var}+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # Omit some internal or obsolete options to make the list less imposing.+  # This message is too long to be a string in the A/UX 3.1 sh.+  cat <<_ACEOF+\`configure' configures this package to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --help=short        display options specific to this package+      --help=recursive    display the short help of all the included packages+  -V, --version           display version information and exit+  -q, --quiet, --silent   do not print \`checking ...' messages+      --cache-file=FILE   cache test results in FILE [disabled]+  -C, --config-cache      alias for \`--cache-file=config.cache'+  -n, --no-create         do not create output files+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']++Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+                          [$ac_default_prefix]+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX+                          [PREFIX]++By default, \`make install' will install all the files in+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than \`$ac_default_prefix' using \`--prefix',+for instance \`--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR            user executables [EPREFIX/bin]+  --sbindir=DIR           system admin executables [EPREFIX/sbin]+  --libexecdir=DIR        program executables [EPREFIX/libexec]+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]+  --libdir=DIR            object code libraries [EPREFIX/lib]+  --includedir=DIR        C header files [PREFIX/include]+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]+  --infodir=DIR           info documentation [DATAROOTDIR/info]+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]+  --mandir=DIR            man documentation [DATAROOTDIR/man]+  --docdir=DIR            documentation root [DATAROOTDIR/doc/PACKAGE]+  --htmldir=DIR           html documentation [DOCDIR]+  --dvidir=DIR            dvi documentation [DOCDIR]+  --pdfdir=DIR            pdf documentation [DOCDIR]+  --psdir=DIR             ps documentation [DOCDIR]+_ACEOF++  cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then++  cat <<\_ACEOF++Report bugs to the package provider.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d "$ac_dir" ||+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+      continue+    ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++    cd "$ac_dir" || { ac_status=$?; continue; }+    # Check for guested configure.+    if test -f "$ac_srcdir/configure.gnu"; then+      echo &&+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive+    elif test -f "$ac_srcdir/configure"; then+      echo &&+      $SHELL "$ac_srcdir/configure" --help=recursive+    else+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi || ac_status=$?+    cd "$ac_pwd" || { ac_status=$?; break; }+  done+fi++test -n "$ac_init_help" && exit $ac_status+if $ac_init_version; then+  cat <<\_ACEOF+configure+generated by GNU Autoconf 2.68++Copyright (C) 2010 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+  exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##+cat >config.log <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by $as_me, which was+generated by GNU Autoconf 2.68.  Invocation command line was++  $ $0 $@++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    $as_echo "PATH: $as_dir"+  done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *\'*)+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+    2)+      as_fn_append ac_configure_args1 " '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      as_fn_append ac_configure_args " '$ac_arg'"+      ;;+    esac+  done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+  # Save into config.log some information that might help in debugging.+  {+    echo++    $as_echo "## ---------------- ##+## Cache variables. ##+## ---------------- ##"+    echo+    # The following way of writing the cache mishandles newlines in values,+(+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done+  (set) 2>&1 |+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      sed -n \+	"s/'\''/'\''\\\\'\'''\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+      ;; #(+    *)+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+)+    echo++    $as_echo "## ----------------- ##+## Output variables. ##+## ----------------- ##"+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=\$$ac_var+      case $ac_val in+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+      esac+      $as_echo "$ac_var='\''$ac_val'\''"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      $as_echo "## ------------------- ##+## File substitutions. ##+## ------------------- ##"+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=\$$ac_var+	case $ac_val in+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+	esac+	$as_echo "$ac_var='\''$ac_val'\''"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      $as_echo "## ----------- ##+## confdefs.h. ##+## ----------- ##"+      echo+      cat confdefs.h+      echo+    fi+    test "$ac_signal" != 0 &&+      $as_echo "$as_me: caught signal $ac_signal"+    $as_echo "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core core.conftest.* &&+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++$as_echo "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++cat >>confdefs.h <<_ACEOF+#define PACKAGE_NAME "$PACKAGE_NAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_VERSION "$PACKAGE_VERSION"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_STRING "$PACKAGE_STRING"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_URL "$PACKAGE_URL"+_ACEOF+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+ac_site_file1=NONE+ac_site_file2=NONE+if test -n "$CONFIG_SITE"; then+  # We do not want a PATH search for config.site.+  case $CONFIG_SITE in #((+    -*)  ac_site_file1=./$CONFIG_SITE;;+    */*) ac_site_file1=$CONFIG_SITE;;+    *)   ac_site_file1=./$CONFIG_SITE;;+  esac+elif test "x$prefix" != xNONE; then+  ac_site_file1=$prefix/share/config.site+  ac_site_file2=$prefix/etc/config.site+else+  ac_site_file1=$ac_default_prefix/share/config.site+  ac_site_file2=$ac_default_prefix/etc/config.site+fi+for ac_site_file in "$ac_site_file1" "$ac_site_file2"+do+  test "x$ac_site_file" = xNONE && continue+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+$as_echo "$as_me: loading site script $ac_site_file" >&6;}+    sed 's/^/| /' "$ac_site_file" >&5+    . "$ac_site_file" \+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "failed to load site script $ac_site_file+See \`config.log' for more details" "$LINENO" 5; }+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special files+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+$as_echo "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . "$cache_file";;+      *)                      . "./$cache_file";;+    esac+  fi+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+$as_echo "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val=\$ac_cv_env_${ac_var}_value+  eval ac_new_val=\$ac_env_${ac_var}_value+  case $ac_old_set,$ac_new_set in+    set,)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,set)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	# differences in whitespace do not lead to failure.+	ac_old_val_w=`echo x $ac_old_val`+	ac_new_val_w=`echo x $ac_new_val`+	if test "$ac_old_val_w" != "$ac_new_val_w"; then+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	  ac_cache_corrupted=:+	else+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+	  eval $ac_var=\$ac_old_val+	fi+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++# Check for Ocaml compilers++# we first look for ocamlc in the path; if not present, we fail+# Extract the first word of "ocamlc", so it can be a program name with args.+set dummy ocamlc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLC"; then+  ac_cv_prog_OCAMLC="$OCAMLC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLC="ocamlc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLC" && ac_cv_prog_OCAMLC="no"+fi+fi+OCAMLC=$ac_cv_prog_OCAMLC+if test -n "$OCAMLC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLC" >&5+$as_echo "$OCAMLC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLC" = no ; then+	as_fn_error $? "Cannot find ocamlc." "$LINENO" 5+fi++# we extract Ocaml version number and library path+OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+echo "ocaml version is $OCAMLVERSION"++case $OCAMLVERSION in+  0.*|1.*|2.*|3.00*|3.01*|3.02*|3.03*|3.04*|3.05*|3.06*|3.07*)+        as_fn_error $? "ocamlgraph needs ocaml version 3.08.0 or higher" "$LINENO" 5;;+  3.08*)+	FORPACK="";;+  *)+	FORPACK="-for-pack Graph";;+esac++# OCAMLLIB=`$OCAMLC -v | tail -n 1 | cut -f 4 -d " "`+# OCAMLLIB=`$OCAMLC -v | tail -n 1 | sed -e 's|[[^:]]*: \(.*\)|\1|' `+OCAMLLIB=`$OCAMLC -where`+echo "ocaml library path is $OCAMLLIB"++# then we look for ocamlopt; if not present, we issue a warning+# if the version is not the same, we also discard it+# we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not+# Extract the first word of "ocamlopt", so it can be a program name with args.+set dummy ocamlopt; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLOPT+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLOPT"; then+  ac_cv_prog_OCAMLOPT="$OCAMLOPT" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLOPT="ocamlopt"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLOPT" && ac_cv_prog_OCAMLOPT="no"+fi+fi+OCAMLOPT=$ac_cv_prog_OCAMLOPT+if test -n "$OCAMLOPT"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLOPT" >&5+$as_echo "$OCAMLOPT" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++OCAMLBEST=byte+if test "$OCAMLOPT" = no ; then+	{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find ocamlopt; bytecode compilation only." >&5+$as_echo "$as_me: WARNING: Cannot find ocamlopt; bytecode compilation only." >&2;}+else+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlopt version" >&5+$as_echo_n "checking ocamlopt version... " >&6; }+	TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVERSION" != "$OCAMLVERSION" ; then+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlopt discarded." >&5+$as_echo "differs from ocamlc; ocamlopt discarded." >&6; }+	    OCAMLOPT=no+	else+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5+$as_echo "ok" >&6; }+	    OCAMLBEST=opt+	fi+fi++# checking for ocamlc.opt+# Extract the first word of "ocamlc.opt", so it can be a program name with args.+set dummy ocamlc.opt; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLCDOTOPT+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLCDOTOPT"; then+  ac_cv_prog_OCAMLCDOTOPT="$OCAMLCDOTOPT" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLCDOTOPT="ocamlc.opt"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLCDOTOPT" && ac_cv_prog_OCAMLCDOTOPT="no"+fi+fi+OCAMLCDOTOPT=$ac_cv_prog_OCAMLCDOTOPT+if test -n "$OCAMLCDOTOPT"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLCDOTOPT" >&5+$as_echo "$OCAMLCDOTOPT" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLCDOTOPT" != no ; then+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlc.opt version" >&5+$as_echo_n "checking ocamlc.opt version... " >&6; }+	TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVERSION" != "$OCAMLVERSION" ; then+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlc.opt discarded." >&5+$as_echo "differs from ocamlc; ocamlc.opt discarded." >&6; }+	else+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5+$as_echo "ok" >&6; }+	    OCAMLC=$OCAMLCDOTOPT+	fi+fi++# checking for ocamlopt.opt+if test "$OCAMLOPT" != no ; then+    # Extract the first word of "ocamlopt.opt", so it can be a program name with args.+set dummy ocamlopt.opt; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLOPTDOTOPT+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLOPTDOTOPT"; then+  ac_cv_prog_OCAMLOPTDOTOPT="$OCAMLOPTDOTOPT" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLOPTDOTOPT="ocamlopt.opt"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLOPTDOTOPT" && ac_cv_prog_OCAMLOPTDOTOPT="no"+fi+fi+OCAMLOPTDOTOPT=$ac_cv_prog_OCAMLOPTDOTOPT+if test -n "$OCAMLOPTDOTOPT"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLOPTDOTOPT" >&5+$as_echo "$OCAMLOPTDOTOPT" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++    if test "$OCAMLOPTDOTOPT" != no ; then+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlc.opt version" >&5+$as_echo_n "checking ocamlc.opt version... " >&6; }+	TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVER" != "$OCAMLVERSION" ; then+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlopt.opt discarded." >&5+$as_echo "differs from ocamlc; ocamlopt.opt discarded." >&6; }+	else+	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5+$as_echo "ok" >&6; }+	    OCAMLOPT=$OCAMLOPTDOTOPT+	fi+    fi+fi++# ocamldep, ocamllex and ocamlyacc should also be present in the path+# Extract the first word of "ocamldep", so it can be a program name with args.+set dummy ocamldep; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLDEP+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLDEP"; then+  ac_cv_prog_OCAMLDEP="$OCAMLDEP" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLDEP="ocamldep"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLDEP" && ac_cv_prog_OCAMLDEP="no"+fi+fi+OCAMLDEP=$ac_cv_prog_OCAMLDEP+if test -n "$OCAMLDEP"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDEP" >&5+$as_echo "$OCAMLDEP" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLDEP" = no ; then+	as_fn_error $? "Cannot find ocamldep." "$LINENO" 5+fi++# Extract the first word of "ocamllex", so it can be a program name with args.+set dummy ocamllex; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLLEX+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLLEX"; then+  ac_cv_prog_OCAMLLEX="$OCAMLLEX" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLLEX="ocamllex"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLLEX" && ac_cv_prog_OCAMLLEX="no"+fi+fi+OCAMLLEX=$ac_cv_prog_OCAMLLEX+if test -n "$OCAMLLEX"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5+$as_echo "$OCAMLLEX" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLLEX" = no ; then+    as_fn_error $? "Cannot find ocamllex." "$LINENO" 5+else+    # Extract the first word of "ocamllex.opt", so it can be a program name with args.+set dummy ocamllex.opt; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLLEXDOTOPT+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLLEXDOTOPT"; then+  ac_cv_prog_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLLEXDOTOPT="ocamllex.opt"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLLEXDOTOPT" && ac_cv_prog_OCAMLLEXDOTOPT="no"+fi+fi+OCAMLLEXDOTOPT=$ac_cv_prog_OCAMLLEXDOTOPT+if test -n "$OCAMLLEXDOTOPT"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEXDOTOPT" >&5+$as_echo "$OCAMLLEXDOTOPT" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++    if test "$OCAMLLEXDOTOPT" != no ; then+	OCAMLLEX=$OCAMLLEXDOTOPT+    fi+fi++# Extract the first word of "ocamlyacc", so it can be a program name with args.+set dummy ocamlyacc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLYACC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLYACC"; then+  ac_cv_prog_OCAMLYACC="$OCAMLYACC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLYACC="ocamlyacc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLYACC" && ac_cv_prog_OCAMLYACC="no"+fi+fi+OCAMLYACC=$ac_cv_prog_OCAMLYACC+if test -n "$OCAMLYACC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5+$as_echo "$OCAMLYACC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLYACC" = no ; then+	as_fn_error $? "Cannot find ocamlyacc." "$LINENO" 5+fi++# Extract the first word of "ocamldoc", so it can be a program name with args.+set dummy ocamldoc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLDOC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLDOC"; then+  ac_cv_prog_OCAMLDOC="$OCAMLDOC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLDOC="ocamldoc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLDOC" && ac_cv_prog_OCAMLDOC="true"+fi+fi+OCAMLDOC=$ac_cv_prog_OCAMLDOC+if test -n "$OCAMLDOC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDOC" >&5+$as_echo "$OCAMLDOC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$OCAMLDOC" = true ; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find ocamldoc" >&5+$as_echo "$as_me: WARNING: Cannot find ocamldoc" >&2;}+else+    # Extract the first word of "ocamldoc.opt", so it can be a program name with args.+set dummy ocamldoc.opt; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLDOCOPT+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLDOCOPT"; then+  ac_cv_prog_OCAMLDOCOPT="$OCAMLDOCOPT" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLDOCOPT="ocamldoc.opt"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLDOCOPT" && ac_cv_prog_OCAMLDOCOPT="no"+fi+fi+OCAMLDOCOPT=$ac_cv_prog_OCAMLDOCOPT+if test -n "$OCAMLDOCOPT"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDOCOPT" >&5+$as_echo "$OCAMLDOCOPT" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++    if test "$OCAMLDOCOPT" != no ; then+	OCAMLDOC=$OCAMLDOCOPT+    fi+fi++# Extract the first word of "ocamlweb", so it can be a program name with args.+set dummy ocamlweb; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLWEB+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLWEB"; then+  ac_cv_prog_OCAMLWEB="$OCAMLWEB" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLWEB="ocamlweb"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_OCAMLWEB" && ac_cv_prog_OCAMLWEB="true"+fi+fi+OCAMLWEB=$ac_cv_prog_OCAMLWEB+if test -n "$OCAMLWEB"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLWEB" >&5+$as_echo "$OCAMLWEB" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi++++# Extract the first word of "ocamlfind", so it can be a program name with args.+set dummy ocamlfind; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_OCAMLFIND+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$OCAMLFIND"; then+  ac_cv_prog_OCAMLFIND="$OCAMLFIND" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_OCAMLFIND="ocamlfind"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+OCAMLFIND=$ac_cv_prog_OCAMLFIND+if test -n "$OCAMLFIND"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLFIND" >&5+$as_echo "$OCAMLFIND" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi++++# checking for lablgtk2+# Extract the first word of "lablgtk2", so it can be a program name with args.+set dummy lablgtk2; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_LABLGTK2+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$LABLGTK2"; then+  ac_cv_prog_LABLGTK2="$LABLGTK2" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_LABLGTK2="yes"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++  test -z "$ac_cv_prog_LABLGTK2" && ac_cv_prog_LABLGTK2="no"+fi+fi+LABLGTK2=$ac_cv_prog_LABLGTK2+if test -n "$LABLGTK2"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LABLGTK2" >&5+$as_echo "$LABLGTK2" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++if test "$LABLGTK2" = yes ; then+   if test -d "$OCAMLLIB/lablgtk2" ; then+      INCLUDEGTK2="-I +lablgtk2"+   else+      LABLGTK2=no+   fi+fi++# platform+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Win32 platform" >&5+$as_echo_n "checking Win32 platform... " >&6; }+if echo "let _ = Sys.os_type;;" | ocaml | grep -q Win32; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5+$as_echo "yes" >&6; }+    OCAMLWIN32=yes+    EXE=.exe+    LIBEXT=.lib+    OBJEXT=.obj+else+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+    OCAMLWIN32=no+    EXE=+    LIBEXT=.a+    OBJEXT=.o+fi++# substitutions to perform+++++++++++++++++++# Finally create the Makefile from Makefile.in+ac_config_files="$ac_config_files Makefile"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# `ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* `ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done++  (set) 2>&1 |+    case $as_nl`(ac_space=' '; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      # `set' does not quote correctly, so add quotes: double-quote+      # substitution turns \\\\ into \\, and sed turns \\ into \.+      sed -n \+	"s/'/'\\\\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+      ;; #(+    *)+      # `set' quotes correctly as required by POSIX, so do not add quotes.+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+) |+  sed '+     /^ac_cv_env_/b end+     t clear+     :clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/+     t end+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+  if test -w "$cache_file"; then+    if test "x$cache_file" != "x/dev/null"; then+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+$as_echo "$as_me: updating cache $cache_file" >&6;}+      if test ! -f "$cache_file" || test -h "$cache_file"; then+	cat confcache >"$cache_file"+      else+        case $cache_file in #(+        */* | ?:*)+	  mv -f confcache "$cache_file"$$ &&+	  mv -f "$cache_file"$$ "$cache_file" ;; #(+        *)+	  mv -f confcache "$cache_file" ;;+	esac+      fi+    fi+  else+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++# Transform confdefs.h into DEFS.+# Protect against shell expansion while executing Makefile rules.+# Protect against Makefile macro expansion.+#+# If the first sed substitution is executed (which looks for macros that+# take arguments), then branch to the quote section.  Otherwise,+# look for a macro that doesn't take arguments.+ac_script='+:mline+/\\$/{+ N+ s,\\\n,,+ b mline+}+t clear+:clear+s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\)/-D\1=\2/g+t quote+s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)/-D\1=\2/g+t quote+b any+:quote+s/[	 `~#$^&*(){}\\|;'\''"<>?]/\\&/g+s/\[/\\&/g+s/\]/\\&/g+s/\$/$$/g+H+:any+${+	g+	s/^\n//+	s/\n/ /g+	p+}+'+DEFS=`sed -n "$ac_script" confdefs.h`+++ac_libobjs=+ac_ltlibobjs=+U=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR+  #    will be set to the directory where LIBOBJS objects are built.+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: "${CONFIG_STATUS=./config.status}"+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in #(+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.+ac_log="+This file was extended by $as_me, which was+generated by GNU Autoconf 2.68.  Invocation command line was++  CONFIG_FILES    = $CONFIG_FILES+  CONFIG_HEADERS  = $CONFIG_HEADERS+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF++case $ac_config_files in *"+"*) set x $ac_config_files; shift; ac_config_files=$*;;+esac++++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_files="$ac_config_files"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+\`$as_me' instantiates files and other configuration actions+from templates according to the current configuration.  Unless the files+and actions are specified as TAGs, all are instantiated by default.++Usage: $0 [OPTION]... [TAG]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+      --config     print configuration, then exit+  -q, --quiet, --silent+                   do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+      --file=FILE[:TEMPLATE]+                   instantiate the configuration file FILE++Configuration files:+$config_files++Report bugs to the package provider."++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"+ac_cs_version="\\+config.status+configured by $0, generated by GNU Autoconf 2.68,+  with options \\"\$ac_cs_config\\"++Copyright (C) 2010 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=?*)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  --*=)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=+    ac_shift=:+    ;;+  *)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  esac++  case $ac_option in+  # Handling of the options.+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+    $as_echo "$ac_cs_version"; exit ;;+  --config | --confi | --conf | --con | --co | --c )+    $as_echo "$ac_cs_config"; exit ;;+  --debug | --debu | --deb | --de | --d | -d )+    debug=: ;;+  --file | --fil | --fi | --f )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    '') as_fn_error $? "missing file argument" ;;+    esac+    as_fn_append CONFIG_FILES " '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h |  --help | --hel | -h )+    $as_echo "$ac_cs_usage"; exit ;;+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) as_fn_error $? "unrecognized option: \`$1'+Try \`$0 --help' for more information." ;;++  *) as_fn_append ac_config_targets " $1"+     ac_need_defaults=false ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+  shift+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6+  CONFIG_SHELL='$SHELL'+  export CONFIG_SHELL+  exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+  $as_echo "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+  case $ac_config_target in+    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;++  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+  esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Hook for its removal unless debugging.+# Note that there is a small window in which the directory will not be cleaned:+# after its creation but before its name has been assigned to `$tmp'.+$debug ||+{+  tmp= ac_tmp=+  trap 'exit_status=$?+  : "${ac_tmp:=$tmp}"+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status+' 0+  trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp++# Set up the scripts for CONFIG_FILES section.+# No need to generate them if there are no CONFIG_FILES.+# This happens for instance with `./config.status config.h'.+if test -n "$CONFIG_FILES"; then+++ac_cr=`echo X | tr X '\015'`+# On cygwin, bash can eat \r inside `` if the user requested igncr.+# But we know of no other shell where ac_cr would be empty at this+# point, so we can use a bashism as a fallback.+if test "x$ac_cr" = x; then+  eval ac_cr=\$\'\\r\'+fi+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then+  ac_cs_awk_cr='\\r'+else+  ac_cs_awk_cr=$ac_cr+fi++echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&+_ACEOF+++{+  echo "cat >conf$$subs.awk <<_ACEOF" &&+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&+  echo "_ACEOF"+} >conf$$subs.sh ||+  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`+ac_delim='%!_!# '+for ac_last_try in false false false false false :; do+  . ./conf$$subs.sh ||+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5++  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`+  if test $ac_delim_n = $ac_delim_num; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done+rm -f conf$$subs.sh++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&+_ACEOF+sed -n '+h+s/^/S["/; s/!.*/"]=/+p+g+s/^[^!]*!//+:repl+t repl+s/'"$ac_delim"'$//+t delim+:nl+h+s/\(.\{148\}\)..*/\1/+t more1+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/+p+n+b repl+:more1+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t nl+:delim+h+s/\(.\{148\}\)..*/\1/+t more2+s/["\\]/\\&/g; s/^/"/; s/$/"/+p+b+:more2+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t delim+' <conf$$subs.awk | sed '+/^[^""]/{+  N+  s/\n//+}+' >>$CONFIG_STATUS || ac_write_fail=1+rm -f conf$$subs.awk+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACAWK+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&+  for (key in S) S_is_set[key] = 1+  FS = ""++}+{+  line = $ 0+  nfields = split(line, field, "@")+  substed = 0+  len = length(field[1])+  for (i = 2; i < nfields; i++) {+    key = field[i]+    keylen = length(key)+    if (S_is_set[key]) {+      value = S[key]+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)+      len += length(value) + length(field[++i])+      substed = 1+    } else+      len += 1 + keylen+  }++  print line+}++_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"+else+  cat+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \+  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5+_ACEOF++# VPATH may cause trouble with some makes, so we remove sole $(srcdir),+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{+h+s///+s/^/:/+s/[	 ]*$/:/+s/:\$(srcdir):/:/g+s/:\${srcdir}:/:/g+s/:@srcdir@:/:/g+s/^:*//+s/:*$//+x+s/\(=[	 ]*\).*/\1/+G+s/\n//+s/^[^=]*=[	 ]*$//+}'+fi++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+fi # test -n "$CONFIG_FILES"+++eval set X "  :F $CONFIG_FILES      "+shift+for ac_tag+do+  case $ac_tag in+  :[FHLC]) ac_mode=$ac_tag; continue;;+  esac+  case $ac_mode$ac_tag in+  :[FHL]*:*);;+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :[FH]-) ac_tag=-:-;;+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+  esac+  ac_save_IFS=$IFS+  IFS=:+  set x $ac_tag+  IFS=$ac_save_IFS+  shift+  ac_file=$1+  shift++  case $ac_mode in+  :L) ac_source=$1;;+  :[FH])+    ac_file_inputs=+    for ac_f+    do+      case $ac_f in+      -) ac_f="$ac_tmp/stdin";;+      *) # Look for the file first in the build tree, then in the source tree+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,+	 # because $ac_f cannot contain `:'.+	 test -f "$ac_f" ||+	   case $ac_f in+	   [\\/$]*) false;;+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;+	   esac ||+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;+      esac+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+      as_fn_append ac_file_inputs " '$ac_f'"+    done++    # Let's still pretend it is `configure' which instantiates (i.e., don't+    # use $as_me), people would be surprised to read:+    #    /* config.h.  Generated by config.status.  */+    configure_input='Generated from '`+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+	`' by configure.'+    if test x"$ac_file" != x-; then+      configure_input="$ac_file.  $configure_input"+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+$as_echo "$as_me: creating $ac_file" >&6;}+    fi+    # Neutralize special characters interpreted by sed in replacement strings.+    case $configure_input in #(+    *\&* | *\|* | *\\* )+       ac_sed_conf_input=`$as_echo "$configure_input" |+       sed 's/[\\\\&|]/\\\\&/g'`;; #(+    *) ac_sed_conf_input=$configure_input;;+    esac++    case $ac_tag in+    *:-:* | *:-) cat >"$ac_tmp/stdin" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+    esac+    ;;+  esac++  ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  as_dir="$ac_dir"; as_fn_mkdir_p+  ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++  case $ac_mode in+  :F)+  #+  # CONFIG_FILE+  #++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# If the template does not know about datarootdir, expand it.+# FIXME: This hack should be removed a few years after 2.60.+ac_datarootdir_hack=; ac_datarootdir_seen=+ac_sed_dataroot='+/datarootdir/ {+  p+  q+}+/@datadir@/p+/@docdir@/p+/@infodir@/p+/@localedir@/p+/@mandir@/p'+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in+*datarootdir*) ac_datarootdir_seen=yes;;+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  ac_datarootdir_hack='+  s&@datadir@&$datadir&g+  s&@docdir@&$docdir&g+  s&@infodir@&$infodir&g+  s&@localedir@&$localedir&g+  s&@mandir@&$mandir&g+  s&\\\${datarootdir}&$datarootdir&g' ;;+esac+_ACEOF++# Neutralize VPATH when `$srcdir' = `.'.+# Shell code in configure.ac might set extrasub.+# FIXME: do we really want to maintain this feature?+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_sed_extra="$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s|@configure_input@|$ac_sed_conf_input|;t t+s&@top_builddir@&$ac_top_builddir_sub&;t t+s&@top_build_prefix@&$ac_top_build_prefix&;t t+s&@srcdir@&$ac_srcdir&;t t+s&@abs_srcdir@&$ac_abs_srcdir&;t t+s&@top_srcdir@&$ac_top_srcdir&;t t+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t+s&@builddir@&$ac_builddir&;t t+s&@abs_builddir@&$ac_abs_builddir&;t t+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t+$ac_datarootdir_hack+"+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \+  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \+      "$ac_tmp/out"`; test -z "$ac_out"; } &&+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&5+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&2;}++  rm -f "$ac_tmp/stdin"+  case $ac_file in+  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;+  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;+  esac \+  || as_fn_error $? "could not create $ac_file" "$LINENO" 5+ ;;++++  esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || as_fn_exit 1+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi++chmod a-w Makefile
+ external/ocamlgraph/configure.in view
@@ -0,0 +1,193 @@+##########################################################################+#                                                                        #+#  Ocamlgraph: a generic graph library for OCaml                         #+#  Copyright (C) 2004-2007                                               #+#  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        #+#                                                                        #+#  This software is free software; you can redistribute it and/or        #+#  modify it under the terms of the GNU Library General Public           #+#  License version 2, with the special exception on linking              #+#  described in file LICENSE.                                            #+#                                                                        #+#  This software is distributed in the hope that it will be useful,      #+#  but WITHOUT ANY WARRANTY; without even the implied warranty of        #+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  #+#                                                                        #+##########################################################################++# the script generated by autoconf from this input will set the following+# variables:+#   OCAMLC        "ocamlc" if present in the path, or a failure+#                 or "ocamlc.opt" if present with same version number as ocamlc+#   OCAMLOPT      "ocamlopt" (or "ocamlopt.opt" if present), or "no"+#   OCAMLBEST     either "byte" if no native compiler was found, +#                 or "opt" otherwise+#   OCAMLDEP      "ocamldep"+#   OCAMLLEX      "ocamllex" (or "ocamllex.opt" if present)+#   OCAMLYACC     "ocamlyac"+#   OCAMLLIB      the path to the ocaml standard library+#   OCAMLVERSION  the ocaml version number+#   OCAMLWEB      "ocamlweb" (not mandatory)+#   OCAMLWIN32    "yes"/"no" depending on Sys.os_type = "Win32"+#   EXE           ".exe" if OCAMLWIN32=yes, "" otherwise++# check for one particular file of the sources +# ADAPT THE FOLLOWING LINE TO YOUR SOURCES!+AC_INIT(src/sig.mli)++# Check for Ocaml compilers++# we first look for ocamlc in the path; if not present, we fail+AC_CHECK_PROG(OCAMLC,ocamlc,ocamlc,no)+if test "$OCAMLC" = no ; then+	AC_MSG_ERROR(Cannot find ocamlc.)+fi++# we extract Ocaml version number and library path+OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+echo "ocaml version is $OCAMLVERSION"++case $OCAMLVERSION in+  0.*|1.*|2.*|3.00*|3.01*|3.02*|3.03*|3.04*|3.05*|3.06*|3.07*)+        AC_MSG_ERROR(ocamlgraph needs ocaml version 3.08.0 or higher);;+  3.08*)+	FORPACK="";;+  *)+	FORPACK="-for-pack Graph";;+esac++# OCAMLLIB=`$OCAMLC -v | tail -n 1 | cut -f 4 -d " "`+# OCAMLLIB=`$OCAMLC -v | tail -n 1 | sed -e 's|[[^:]]*: \(.*\)|\1|' `+OCAMLLIB=`$OCAMLC -where`+echo "ocaml library path is $OCAMLLIB"++# then we look for ocamlopt; if not present, we issue a warning+# if the version is not the same, we also discard it+# we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not+AC_CHECK_PROG(OCAMLOPT,ocamlopt,ocamlopt,no)+OCAMLBEST=byte+if test "$OCAMLOPT" = no ; then+	AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.)+else+	AC_MSG_CHECKING(ocamlopt version)+	TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVERSION" != "$OCAMLVERSION" ; then+	    AC_MSG_RESULT(differs from ocamlc; ocamlopt discarded.)+	    OCAMLOPT=no+	else+	    AC_MSG_RESULT(ok)+	    OCAMLBEST=opt+	fi+fi++# checking for ocamlc.opt+AC_CHECK_PROG(OCAMLCDOTOPT,ocamlc.opt,ocamlc.opt,no)+if test "$OCAMLCDOTOPT" != no ; then+	AC_MSG_CHECKING(ocamlc.opt version)+	TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVERSION" != "$OCAMLVERSION" ; then+	    AC_MSG_RESULT(differs from ocamlc; ocamlc.opt discarded.)+	else+	    AC_MSG_RESULT(ok)+	    OCAMLC=$OCAMLCDOTOPT+	fi+fi++# checking for ocamlopt.opt+if test "$OCAMLOPT" != no ; then+    AC_CHECK_PROG(OCAMLOPTDOTOPT,ocamlopt.opt,ocamlopt.opt,no)+    if test "$OCAMLOPTDOTOPT" != no ; then+	AC_MSG_CHECKING(ocamlc.opt version)+	TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version *\(.*\)$|\1|p' `+	if test "$TMPVER" != "$OCAMLVERSION" ; then+	    AC_MSG_RESULT(differs from ocamlc; ocamlopt.opt discarded.)+	else+	    AC_MSG_RESULT(ok)+	    OCAMLOPT=$OCAMLOPTDOTOPT+	fi+    fi+fi++# ocamldep, ocamllex and ocamlyacc should also be present in the path+AC_CHECK_PROG(OCAMLDEP,ocamldep,ocamldep,no)+if test "$OCAMLDEP" = no ; then+	AC_MSG_ERROR(Cannot find ocamldep.)+fi++AC_CHECK_PROG(OCAMLLEX,ocamllex,ocamllex,no)+if test "$OCAMLLEX" = no ; then+    AC_MSG_ERROR(Cannot find ocamllex.)+else+    AC_CHECK_PROG(OCAMLLEXDOTOPT,ocamllex.opt,ocamllex.opt,no)+    if test "$OCAMLLEXDOTOPT" != no ; then+	OCAMLLEX=$OCAMLLEXDOTOPT+    fi+fi++AC_CHECK_PROG(OCAMLYACC,ocamlyacc,ocamlyacc,no)+if test "$OCAMLYACC" = no ; then+	AC_MSG_ERROR(Cannot find ocamlyacc.)+fi++AC_CHECK_PROG(OCAMLDOC,ocamldoc,ocamldoc,true)+if test "$OCAMLDOC" = true ; then+    AC_MSG_WARN(Cannot find ocamldoc)+else+    AC_CHECK_PROG(OCAMLDOCOPT,ocamldoc.opt,ocamldoc.opt,no)+    if test "$OCAMLDOCOPT" != no ; then+	OCAMLDOC=$OCAMLDOCOPT+    fi+fi++AC_CHECK_PROG(OCAMLWEB,ocamlweb,ocamlweb,true)++AC_CHECK_PROG(OCAMLFIND,ocamlfind,ocamlfind)++# checking for lablgtk2+AC_CHECK_PROG(LABLGTK2,lablgtk2,yes,no)+if test "$LABLGTK2" = yes ; then+   if test -d "$OCAMLLIB/lablgtk2" ; then+      INCLUDEGTK2="-I +lablgtk2"+   else+      LABLGTK2=no+   fi      +fi++# platform+AC_MSG_CHECKING(Win32 platform)+if echo "let _ = Sys.os_type;;" | ocaml | grep -q Win32; then+    AC_MSG_RESULT(yes)+    OCAMLWIN32=yes+    EXE=.exe+    LIBEXT=.lib+    OBJEXT=.obj+else+    AC_MSG_RESULT(no)+    OCAMLWIN32=no+    EXE=+    LIBEXT=.a+    OBJEXT=.o+fi++# substitutions to perform+AC_SUBST(OCAMLC)+AC_SUBST(OCAMLOPT)+AC_SUBST(OCAMLDEP)+AC_SUBST(OCAMLLEX)+AC_SUBST(OCAMLDOC)+AC_SUBST(OCAMLYACC)+AC_SUBST(OCAMLBEST)+AC_SUBST(OCAMLVERSION)+AC_SUBST(OCAMLLIB)+AC_SUBST(OCAMLWEB)+AC_SUBST(LABLGTK2)+AC_SUBST(OCAMLWIN32)+AC_SUBST(EXE)+AC_SUBST(LIBEXT)+AC_SUBST(OBJEXT)+AC_SUBST(FORPACK)+AC_SUBST(INCLUDEGTK2)++# Finally create the Makefile from Makefile.in+AC_OUTPUT(Makefile)+chmod a-w Makefile
+ external/ocamlgraph/lib/bitv.ml view
@@ -0,0 +1,610 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*i $Id: bitv.ml,v 1.3 2004-07-13 12:54:42 filliatr Exp $ i*)++(*s Bit vectors. The interface and part of the code are borrowed from the +    [Array] module of the ocaml standard library (but things are simplified+    here since we can always initialize a bit vector). This module also+    provides bitwise operations. *)++(*s We represent a bit vector by a vector of integers (field [bits]),+    and we keep the information of the size of the bit vector since it+    can not be found out with the size of the array (field [length]). *)++type t = {+  length : int;+  bits   : int array }++let length v = v.length++(*s Each element of the array is an integer containing [bpi] bits, where+    [bpi] is determined according to the machine word size. Since we do not+    use the sign bit, [bpi] is 30 on a 32-bits machine and 62 on a 64-bits+    machines. We maintain the following invariant:+    {\em The unused bits of the last integer are always +    zeros.} This is ensured by [create] and maintained in other functions+    using [normalize]. [bit_j], [bit_not_j], [low_mask] and [up_mask]+    are arrays used to extract and mask bits in a single integer. *)++let bpi = Sys.word_size - 2++let max_length = Sys.max_array_length * bpi++let bit_j = Array.init bpi (fun j -> 1 lsl j)+let bit_not_j = Array.init bpi (fun j -> max_int - bit_j.(j))++let low_mask = Array.create (succ bpi) 0+let _ = +  for i = 1 to bpi do low_mask.(i) <- low_mask.(i-1) lor bit_j.(pred i) done++let keep_lowest_bits a j = a land low_mask.(j)++let high_mask = Array.init (succ bpi) (fun j -> low_mask.(j) lsl (bpi-j))++let keep_highest_bits a j = a land high_mask.(j)++(*s Creating and normalizing a bit vector is easy: it is just a matter of+    taking care of the invariant. Copy is immediate. *)++let create n b =+  let initv = if b then max_int else 0 in+  let r = n mod bpi in+  if r = 0 then+    { length = n; bits = Array.create (n / bpi) initv }+  else begin+    let s = n / bpi in+    let b = Array.create (succ s) initv in+    b.(s) <- b.(s) land low_mask.(r);+    { length = n; bits = b }+  end+    +let normalize v =+  let r = v.length mod bpi in+  if r > 0 then+    let b = v.bits in+    let s = Array.length b in+    b.(s-1) <- b.(s-1) land low_mask.(r)++let copy v = { length = v.length; bits = Array.copy v.bits }++(*s Access and assignment. The [n]th bit of a bit vector is the [j]th+    bit of the [i]th integer, where [i = n / bpi] and [j = n mod+    bpi]. Both [i] and [j] and computed by the function [pos].+    Accessing a bit is testing whether the result of the corresponding+    mask operation is non-zero, and assigning it is done with a+    bitwiwe operation: an {\em or} with [bit_j] to set it, and an {\em+    and} with [bit_not_j] to unset it. *)++let pos n = +  let i = n / bpi and j = n mod bpi in+  if j < 0 then (i - 1, j + bpi) else (i,j)++let unsafe_get v n =+  let (i,j) = pos n in +  ((Array.unsafe_get v.bits i) land (Array.unsafe_get bit_j j)) > 0++let unsafe_set v n b =+  let (i,j) = pos n in+  if b then+    Array.unsafe_set v.bits i +      ((Array.unsafe_get v.bits i) lor (Array.unsafe_get bit_j j))+  else +    Array.unsafe_set v.bits i +      ((Array.unsafe_get v.bits i) land (Array.unsafe_get bit_not_j j))++(*s The corresponding safe operations test the validiy of the access. *)++let get v n =+  if n < 0 or n >= v.length then invalid_arg "Bitv.get";+  let (i,j) = pos n in +  ((Array.unsafe_get v.bits i) land (Array.unsafe_get bit_j j)) > 0++let set v n b =+  if n < 0 or n >= v.length then invalid_arg "Bitv.set";+  let (i,j) = pos n in+  if b then+    Array.unsafe_set v.bits i+      ((Array.unsafe_get v.bits i) lor (Array.unsafe_get bit_j j))+  else+    Array.unsafe_set v.bits i+      ((Array.unsafe_get v.bits i) land (Array.unsafe_get bit_not_j j))++(*s [init] is implemented naively using [unsafe_set]. *)++let init n f =+  let v = create n false in+  for i = 0 to pred n do+    unsafe_set v i (f i)+  done;+  v++(*s Handling bits by packets is the key for efficiency of functions+    [append], [concat], [sub] and [blit]. +    We start by a very general function [blit_bits a i m v n] which blits +    the bits [i] to [i+m-1] of a native integer [a] +    onto the bit vector [v] at index [n]. It assumes that [i..i+m-1] and+    [n..n+m-1] are respectively valid subparts of [a] and [v]. +    It is optimized when the bits fit the lowest boundary of an integer +    (case [j == 0]). *)++let blit_bits a i m v n =+  let (i',j) = pos n in+  if j == 0 then+    Array.unsafe_set v i'+      ((keep_lowest_bits (a lsr i) m) lor+       (keep_highest_bits (Array.unsafe_get v i') (bpi - m)))+  else +    let d = m + j - bpi in+    if d > 0 then begin+      Array.unsafe_set v i'+	(((keep_lowest_bits (a lsr i) (bpi - j)) lsl j) lor+	 (keep_lowest_bits (Array.unsafe_get v i') j));+      Array.unsafe_set v (succ i')+	((keep_lowest_bits (a lsr (i + bpi - j)) d) lor+	 (keep_highest_bits (Array.unsafe_get v (succ i')) (bpi - d)))+    end else +      Array.unsafe_set v i'+	(((keep_lowest_bits (a lsr i) m) lsl j) lor+	 ((Array.unsafe_get v i') land (low_mask.(j) lor high_mask.(-d))))++(*s [blit_int] implements [blit_bits] in the particular case when+    [i=0] and [m=bpi] i.e. when we blit all the bits of [a]. *)++let blit_int a v n =+  let (i,j) = pos n in+  if j == 0 then+    Array.unsafe_set v i a+  else begin+    Array.unsafe_set v i +      ( (keep_lowest_bits (Array.unsafe_get v i) j) lor+       ((keep_lowest_bits a (bpi - j)) lsl j));+    Array.unsafe_set v (succ i)+      ((keep_highest_bits (Array.unsafe_get v (succ i)) (bpi - j)) lor+       (a lsr (bpi - j)))+  end++(*s When blitting a subpart of a bit vector into another bit vector, there+    are two possible cases: (1) all the bits are contained in a single integer+    of the first bit vector, and a single call to [blit_bits] is the+    only thing to do, or (2) the source bits overlap on several integers of+    the source array, and then we do a loop of [blit_int], with two calls+    to [blit_bits] for the two bounds. *)++let unsafe_blit v1 ofs1 v2 ofs2 len =+  let (bi,bj) = pos ofs1 in+  let (ei,ej) = pos (ofs1 + len - 1) in+  if bi == ei then+    blit_bits (Array.unsafe_get v1 bi) bj len v2 ofs2+  else begin+    blit_bits (Array.unsafe_get v1 bi) bj (bpi - bj) v2 ofs2;+    let n = ref (ofs2 + bpi - bj) in+    for i = succ bi to pred ei do+      blit_int (Array.unsafe_get v1 i) v2 !n;+      n := !n + bpi+    done;+    blit_bits (Array.unsafe_get v1 ei) 0 (succ ej) v2 !n+  end++let blit v1 ofs1 v2 ofs2 len =+  if len < 0 or ofs1 < 0 or ofs1 + len > v1.length+             or ofs2 < 0 or ofs2 + len > v2.length+  then invalid_arg "Bitv.blit";+  unsafe_blit v1.bits ofs1 v2.bits ofs2 len++(*s Extracting the subvector [ofs..ofs+len-1] of [v] is just creating a+    new vector of length [len] and blitting the subvector of [v] inside. *)++let sub v ofs len =+  if ofs < 0 or len < 0 or ofs + len > v.length then invalid_arg "Bitv.sub";+  let r = create len false in+  unsafe_blit v.bits ofs r.bits 0 len;+  r++(*s The concatenation of two bit vectors [v1] and [v2] is obtained by +    creating a vector for the result and blitting inside the two vectors.+    [v1] is copied directly. *)++let append v1 v2 =+  let l1 = v1.length +  and l2 = v2.length in+  let r = create (l1 + l2) false in+  let b1 = v1.bits in+  let b2 = v2.bits in+  let b = r.bits in+  for i = 0 to Array.length b1 - 1 do +    Array.unsafe_set b i (Array.unsafe_get b1 i) +  done;  +  unsafe_blit b2 0 b l1 l2;+  r++(*s The concatenation of a list of bit vectors is obtained by iterating+    [unsafe_blit]. *)++let concat vl =+  let size = List.fold_left (fun sz v -> sz + v.length) 0 vl in+  let res = create size false in+  let b = res.bits in+  let pos = ref 0 in+  List.iter+    (fun v ->+       let n = v.length in+       unsafe_blit v.bits 0 b !pos n;+       pos := !pos + n)+    vl;+  res++(*s Filling is a particular case of blitting with a source made of all+    ones or all zeros. Thus we instanciate [unsafe_blit], with 0 and+    [max_int]. *)++let blit_zeros v ofs len =+  let (bi,bj) = pos ofs in+  let (ei,ej) = pos (ofs + len - 1) in+  if bi == ei then+    blit_bits 0 bj len v ofs+  else begin+    blit_bits 0 bj (bpi - bj) v ofs;+    let n = ref (ofs + bpi - bj) in+    for i = succ bi to pred ei do+      blit_int 0 v !n;+      n := !n + bpi+    done;+    blit_bits 0 0 (succ ej) v !n+  end++let blit_ones v ofs len =+  let (bi,bj) = pos ofs in+  let (ei,ej) = pos (ofs + len - 1) in+  if bi == ei then+    blit_bits max_int bj len v ofs+  else begin+    blit_bits max_int bj (bpi - bj) v ofs;+    let n = ref (ofs + bpi - bj) in+    for i = succ bi to pred ei do+      blit_int max_int v !n;+      n := !n + bpi+    done;+    blit_bits max_int 0 (succ ej) v !n+  end++let fill v ofs len b =+  if ofs < 0 or len < 0 or ofs + len > v.length then invalid_arg "Bitv.fill";+  if b then blit_ones v.bits ofs len else blit_zeros v.bits ofs len++(*s All the iterators are implemented as for traditional arrays, using+    [unsafe_get]. For [iter] and [map], we do not precompute [(f+    true)] and [(f false)] since [f] is likely to have+    side-effects. *)++let iter f v =+  for i = 0 to v.length - 1 do f (unsafe_get v i) done++let map f v =+  let l = v.length in+  let r = create l false in+  for i = 0 to l - 1 do+    unsafe_set r i (f (unsafe_get v i))+  done;+  r++let iteri f v =+  for i = 0 to v.length - 1 do f i (unsafe_get v i) done++let mapi f v =+  let l = v.length in+  let r = create l false in+  for i = 0 to l - 1 do+    unsafe_set r i (f i (unsafe_get v i))+  done;+  r++let fold_left f x v =+  let r = ref x in+  for i = 0 to v.length - 1 do+    r := f !r (unsafe_get v i)+  done;+  !r++let fold_right f v x =+  let r = ref x in+  for i = v.length - 1 downto 0 do+    r := f (unsafe_get v i) !r+  done;+  !r++let foldi_left f x v =+  let r = ref x in+  for i = 0 to v.length - 1 do+    r := f !r i (unsafe_get v i)+  done;+  !r++let foldi_right f v x =+  let r = ref x in+  for i = v.length - 1 downto 0 do+    r := f i (unsafe_get v i) !r+  done;+  !r++(*s Bitwise operations. It is straigthforward, since bitwise operations+    can be realized by the corresponding bitwise operations over integers.+    However, one has to take care of normalizing the result of [bwnot]+    which introduces ones in highest significant positions. *)++let bw_and v1 v2 = +  let l = v1.length in+  if l <> v2.length then invalid_arg "Bitv.bw_and";+  let b1 = v1.bits +  and b2 = v2.bits in+  let n = Array.length b1 in+  let a = Array.create n 0 in+  for i = 0 to n - 1 do+    a.(i) <- b1.(i) land b2.(i)+  done;+  { length = l; bits = a }+  +let bw_or v1 v2 = +  let l = v1.length in+  if l <> v2.length then invalid_arg "Bitv.bw_or";+  let b1 = v1.bits +  and b2 = v2.bits in+  let n = Array.length b1 in+  let a = Array.create n 0 in+  for i = 0 to n - 1 do+    a.(i) <- b1.(i) lor b2.(i)+  done;+  { length = l; bits = a }+  +let bw_xor v1 v2 = +  let l = v1.length in+  if l <> v2.length then invalid_arg "Bitv.bw_xor";+  let b1 = v1.bits +  and b2 = v2.bits in+  let n = Array.length b1 in+  let a = Array.create n 0 in+  for i = 0 to n - 1 do+    a.(i) <- b1.(i) lxor b2.(i)+  done;+  { length = l; bits = a }+  +let bw_not v = +  let b = v.bits in+  let n = Array.length b in+  let a = Array.create n 0 in+  for i = 0 to n - 1 do+    a.(i) <- max_int land (lnot b.(i))+  done;+  let r = { length = v.length; bits = a } in+  normalize r;+  r++(*s Shift operations. It is easy to reuse [unsafe_blit], although it is +    probably slightly less efficient than a ad-hoc piece of code. *)++let rec shiftl v d =+  if d == 0 then +    copy v+  else if d < 0 then+    shiftr v (-d)+  else begin+    let n = v.length in+    let r = create n false in+    if d < n then unsafe_blit v.bits 0 r.bits d (n - d);+    r+  end+  +and shiftr v d =+  if d == 0 then +    copy v+  else if d < 0 then+    shiftl v (-d)+  else begin+    let n = v.length in+    let r = create n false in+    if d < n then unsafe_blit v.bits d r.bits 0 (n - d);+    r+  end++(*s Testing for all zeros and all ones. *)++let all_zeros v = +  let b = v.bits in+  let n = Array.length b in+  let rec test i = +    (i == n) || ((Array.unsafe_get b i == 0) && test (succ i)) +  in+  test 0++let all_ones v = +  let b = v.bits in+  let n = Array.length b in+  let rec test i = +    if i == n - 1 then+      let m = v.length mod bpi in+      (Array.unsafe_get b i) == (if m == 0 then max_int else low_mask.(m))+    else+      ((Array.unsafe_get b i) == max_int) && test (succ i)+  in+  test 0++(*s Conversions to and from strings. *)++let to_string v = +  let n = v.length in+  let s = String.make n '0' in+  for i = 0 to n - 1 do+    if unsafe_get v i then s.[i] <- '1'+  done;+  s++let print fmt v = Format.pp_print_string fmt (to_string v)++let of_string s =+  let n = String.length s in+  let v = create n false in+  for i = 0 to n - 1 do+    let c = String.unsafe_get s i in+    if c = '1' then +      unsafe_set v i true+    else +      if c <> '0' then invalid_arg "Bitv.of_string"+  done;+  v++(*s Iteration on all bit vectors of length [n] using a Gray code. *)++let first_set v n = +  let rec lookup i = +    if i = n then raise Not_found ;+    if unsafe_get v i then i else lookup (i + 1)+  in +  lookup 0++let gray_iter f n = +  let bv = create n false in +  let rec iter () =+    f bv; +    unsafe_set bv 0 (not (unsafe_get bv 0));+    f bv; +    let pos = succ (first_set bv n) in+    if pos < n then begin+      unsafe_set bv pos (not (unsafe_get bv pos));+      iter ()+    end+  in+  if n > 0 then iter ()+++(*s Coercions to/from lists of integers *)++let of_list l =+  let n = List.fold_left max 0 l in+  let b = create (succ n) false in+  let add_element i = +    (* negative numbers are invalid *)+    if i < 0 then invalid_arg "Bitv.of_list";+    unsafe_set b i true +  in+  List.iter add_element l;+  b++let of_list_with_length l len =+  let b = create len false in+  let add_element i =+    if i < 0 || i >= len then invalid_arg "Bitv.of_list_with_length";+    unsafe_set b i true+  in+  List.iter add_element l;+  b++let to_list b =+  let n = length b in+  let rec make i acc = +    if i < 0 then acc +    else make (pred i) (if unsafe_get b i then i :: acc else acc)+  in+  make (pred n) []+++(*s To/from integers. *)++(* [int] *)+let of_int_us i = +  { length = bpi; bits = [| i land max_int |] }+let to_int_us v = +  if v.length < bpi then invalid_arg "Bitv.to_int_us"; +  v.bits.(0)++let of_int_s i = +  { length = succ bpi; bits = [| i land max_int; (i lsr bpi) land 1 |] }+let to_int_s v = +  if v.length < succ bpi then invalid_arg "Bitv.to_int_s"; +  v.bits.(0) lor (v.bits.(1) lsl bpi)++(* [Int32] *)+let of_int32_us i = match Sys.word_size with+  | 32 -> { length = 31; +	    bits = [| (Int32.to_int i) land max_int; +		      let hi = Int32.shift_right_logical i 30 in+		      (Int32.to_int hi) land 1 |] }+  | 64 -> { length = 31; bits = [| (Int32.to_int i) land 0x7fffffff |] }+  | _ -> assert false+let to_int32_us v =+  if v.length < 31 then invalid_arg "Bitv.to_int32_us"; +  match Sys.word_size with+    | 32 -> +	Int32.logor (Int32.of_int v.bits.(0))+	            (Int32.shift_left (Int32.of_int (v.bits.(1) land 1)) 30)+    | 64 ->+	Int32.of_int (v.bits.(0) land 0x7fffffff)+    | _ -> assert false++(* this is 0xffffffff (ocaml >= 3.08 checks for literal overflow) *)+let ffffffff = (0xffff lsl 16) lor 0xffff++let of_int32_s i = match Sys.word_size with+  | 32 -> { length = 32; +	    bits = [| (Int32.to_int i) land max_int; +		      let hi = Int32.shift_right_logical i 30 in+		      (Int32.to_int hi) land 3 |] }+  | 64 -> { length = 32; bits = [| (Int32.to_int i) land ffffffff |] }+  | _ -> assert false++let to_int32_s v =+  if v.length < 32 then invalid_arg "Bitv.to_int32_s"; +  match Sys.word_size with+    | 32 -> +	Int32.logor (Int32.of_int v.bits.(0))+	            (Int32.shift_left (Int32.of_int (v.bits.(1) land 3)) 30)+    | 64 ->+	Int32.of_int (v.bits.(0) land ffffffff)+    | _ -> assert false++(* [Int64] *)+let of_int64_us i = match Sys.word_size with+  | 32 -> { length = 63; +	    bits = [| (Int64.to_int i) land max_int; +		      (let mi = Int64.shift_right_logical i 30 in+		       (Int64.to_int mi) land max_int);+		      let hi = Int64.shift_right_logical i 60 in+		      (Int64.to_int hi) land 1 |] }+  | 64 -> { length = 63; +	    bits = [| (Int64.to_int i) land max_int;+		      let hi = Int64.shift_right_logical i 62 in +		      (Int64.to_int hi) land 1 |] }+  | _ -> assert false+let to_int64_us v = failwith "todo"++let of_int64_s i = failwith "todo"+let to_int64_s v = failwith "todo"++(* [Nativeint] *)+let select_of f32 f64 = match Sys.word_size with +  | 32 -> (fun i -> f32 (Nativeint.to_int32 i))+  | 64 -> (fun i -> f64 (Int64.of_nativeint i))+  | _ -> assert false+let of_nativeint_s = select_of of_int32_s of_int64_s+let of_nativeint_us = select_of of_int32_us of_int64_us+let select_to f32 f64 = match Sys.word_size with +  | 32 -> (fun i -> Nativeint.of_int32 (f32 i))+  | 64 -> (fun i -> Int64.to_nativeint (f64 i))+  | _ -> assert false+let to_nativeint_s = select_to to_int32_s to_int64_s+let to_nativeint_us = select_to to_int32_us to_int64_us++
+ external/ocamlgraph/lib/bitv.mli view
@@ -0,0 +1,195 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*s {\bf Module Bitv}.+    This module implements bit vectors, as an abstract datatype [t]. +    Since bit vectors are particular cases of arrays, this module provides+    the same operations as the module [Array] (Sections~\ref{barray} +    up to \ref{earray}). It also provides bitwise operations +    (Section~\ref{bitwise}). In the following, [false] stands for the bit 0 +    and [true] for the bit 1. *)++type t++(*s {\bf Creation, access and assignment.} \label{barray}+    [(Bitv.create n b)] creates a new bit vector of length [n],+    initialized with [b].+    [(Bitv.init n f)] returns a fresh vector of length [n],+    with bit number [i] initialized to the result of [(f i)]. +    [(Bitv.set v n b)] sets the [n]th bit of [v] to the value [b].+    [(Bitv.get v n)] returns the [n]th bit of [v]. +    [Bitv.length] returns the length (number of elements) of the given +    vector. *)++val create : int -> bool -> t++val init : int -> (int -> bool) -> t++val set : t -> int -> bool -> unit+    +val get : t -> int -> bool++val length : t -> int++(*s [max_length] is the maximum length of a bit vector (System dependent). *)++val max_length : int++(*s {\bf Copies and concatenations.}+   [(Bitv.copy v)] returns a copy of [v],+   that is, a fresh vector containing the same elements as+   [v]. [(Bitv.append v1 v2)] returns a fresh vector containing the+   concatenation of the vectors [v1] and [v2]. [Bitv.concat] is+   similar to [Bitv.append], but catenates a list of vectors. *)++val copy : t -> t++val append : t -> t -> t++val concat : t list -> t++(*s {\bf Sub-vectors and filling.} +    [(Bitv.sub v start len)] returns a fresh+    vector of length [len], containing the bits number [start] to+    [start + len - 1] of vector [v].  Raise [Invalid_argument+    "Bitv.sub"] if [start] and [len] do not designate a valid+    subvector of [v]; that is, if [start < 0], or [len < 0], or [start+    + len > Bitv.length a].++    [(Bitv.fill v ofs len b)] modifies the vector [v] in place,+    storing [b] in elements number [ofs] to [ofs + len - 1].  Raise+    [Invalid_argument "Bitv.fill"] if [ofs] and [len] do not designate+    a valid subvector of [v].++    [(Bitv.blit v1 o1 v2 o2 len)] copies [len] elements from vector+    [v1], starting at element number [o1], to vector [v2], starting at+    element number [o2]. It {\em does not work} correctly if [v1] and [v2] are+    the same vector with the source and destination chunks overlapping.+    Raise [Invalid_argument "Bitv.blit"] if [o1] and [len] do not+    designate a valid subvector of [v1], or if [o2] and [len] do not+    designate a valid subvector of [v2]. *)++val sub : t -> int -> int -> t++val fill : t -> int -> int -> bool -> unit++val blit : t -> int -> t -> int -> int -> unit++(*s {\bf Iterators.} \label{earray}+    [(Bitv.iter f v)] applies function [f] in turn to all+    the elements of [v]. Given a function [f], [(Bitv.map f v)] applies+    [f] to all+    the elements of [v], and builds a vector with the results returned+    by [f]. [Bitv.iteri] and [Bitv.mapi] are similar to [Bitv.iter]+    and [Bitv.map] respectively, but the function is applied to the+    index of the element as first argument, and the element itself as+    second argument.++    [(Bitv.fold_left f x v)] computes [f (... (f (f x (get v 0)) (get+    v 1)) ...) (get v (n-1))], where [n] is the length of the vector+    [v]. ++    [(Bitv.fold_right f a x)] computes [f (get v 0) (f (get v 1)+    ( ... (f (get v (n-1)) x) ...))], where [n] is the length of the+    vector [v]. *)++val iter : (bool -> unit) -> t -> unit+val map : (bool -> bool) -> t -> t++val iteri : (int -> bool -> unit) -> t -> unit+val mapi : (int -> bool -> bool) -> t -> t++val fold_left : ('a -> bool -> 'a) -> 'a -> t -> 'a+val fold_right : (bool -> 'a -> 'a) -> t -> 'a -> 'a+val foldi_left : ('a -> int -> bool -> 'a) -> 'a -> t -> 'a+val foldi_right : (int -> bool -> 'a -> 'a) -> t -> 'a -> 'a++(*s [gray_iter f n] iterates function [f] on all bit vectors+    of length [n], once each, using a Gray code. The order in which+    bit vectors are processed is unspecified. *)++val gray_iter : (t -> unit) -> int -> unit++(*s {\bf Bitwise operations.} \label{bitwise} [bwand], [bwor] and+    [bwxor] implement logical and, or and exclusive or.  They return+    fresh vectors and raise [Invalid_argument "Bitv.xxx"] if the two+    vectors do not have the same length (where \texttt{xxx} is the+    name of the function).  [bwnot] implements the logical negation. +    It returns a fresh vector.+    [shiftl] and [shiftr] implement shifts. They return fresh vectors.+    [shiftl] moves bits from least to most significant, and [shiftr]+    from most to least significant (think [lsl] and [lsr]).+    [all_zeros] and [all_ones] respectively test for a vector only+    containing zeros and only containing ones. *)++val bw_and : t -> t -> t+val bw_or  : t -> t -> t+val bw_xor : t -> t -> t+val bw_not : t -> t++val shiftl : t -> int -> t+val shiftr : t -> int -> t++val all_zeros : t -> bool+val all_ones  : t -> bool++(*s {\bf Conversions to and from strings.} +    Least significant bit comes first. *)++val to_string : t -> string+val of_string : string -> t+val print : Format.formatter -> t -> unit++(*s {\bf Conversions to and from lists of integers.} +    The list gives the indices of bits which are set (ie [true]). *)++val to_list : t -> int list+val of_list : int list -> t+val of_list_with_length : int list -> int -> t++(*s Interpretation of bit vectors as integers. Least significant bit +    comes first (ie is at index 0 in the bit vector). +    [to_xxx] functions truncate when the bit vector is too wide, +    and raise [Invalid_argument] when it is too short. +    Suffix [_s] indicates that sign bit is kept, +    and [_us] that it is discarded. *) ++(* type [int] (length 31/63 with sign, 30/62 without) *)+val of_int_s : int -> t+val to_int_s : t -> int+val of_int_us : int -> t+val to_int_us : t -> int+(* type [Int32.t] (length 32 with sign, 31 without) *)+val of_int32_s : Int32.t -> t+val to_int32_s : t -> Int32.t+val of_int32_us : Int32.t -> t+val to_int32_us : t -> Int32.t+(* type [Int64.t] (length 64 with sign, 63 without) *)+val of_int64_s : Int64.t -> t+val to_int64_s : t -> Int64.t+val of_int64_us : Int64.t -> t+val to_int64_us : t -> Int64.t+(* type [Nativeint.t] (length 32/64 with sign, 31/63 without) *)+val of_nativeint_s : Nativeint.t -> t+val to_nativeint_s : t -> Nativeint.t+val of_nativeint_us : Nativeint.t -> t+val to_nativeint_us : t -> Nativeint.t++(*s Only if you know what you are doing... *)++val unsafe_set : t -> int -> bool -> unit+val unsafe_get : t -> int -> bool
+ external/ocamlgraph/lib/heap.ml view
@@ -0,0 +1,236 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++module type Ordered = sig+  type t+  val compare : t -> t -> int+end++exception EmptyHeap++(*s Imperative implementation *)++module Imperative(X : Ordered) = struct++  (* The heap is encoded in the array [data], where elements are stored+     from [0] to [size - 1]. From an element stored at [i], the left +     (resp. right) subtree, if any, is rooted at [2*i+1] (resp. [2*i+2]). *)++  type t = { mutable size : int; mutable data : X.t array }++  (* When [create n] is called, we cannot allocate the array, since there is+     no known value of type [X.t]; we'll wait for the first addition to +     do it, and we remember this situation with a negative size. *)++  let create n = +    if n <= 0 then invalid_arg "create";+    { size = -n; data = [||] }++  let is_empty h = h.size <= 0++  (* [resize] doubles the size of [data] *)++  let resize h =+    let n = h.size in+    assert (n > 0);+    let n' = 2 * n in+    let d = h.data in+    let d' = Array.create n' d.(0) in+    Array.blit d 0 d' 0 n;+    h.data <- d'++  let add h x =+    (* first addition: we allocate the array *)+    if h.size < 0 then begin+      h.data <- Array.create (- h.size) x; h.size <- 0+    end;+    let n = h.size in+    (* resizing if needed *)+    if n == Array.length h.data then resize h;+    let d = h.data in+    (* moving [x] up in the heap *)+    let rec moveup i =+      let fi = (i - 1) / 2 in+      if i > 0 && X.compare d.(fi) x < 0 then begin+	d.(i) <- d.(fi);+	moveup fi+      end else+	d.(i) <- x+    in+    moveup n;+    h.size <- n + 1++  let maximum h =+    if h.size <= 0 then raise EmptyHeap;+    h.data.(0)++  let remove h =+    if h.size <= 0 then raise EmptyHeap;+    let n = h.size - 1 in+    h.size <- n;+    let d = h.data in+    let x = d.(n) in+    (* moving [x] down in the heap *)+    let rec movedown i =+      let j = 2 * i + 1 in+      if j < n then+	let j = +	  let j' = j + 1 in +	  if j' < n && X.compare d.(j') d.(j) > 0 then j' else j +	in+	if X.compare d.(j) x > 0 then begin +	  d.(i) <- d.(j); +	  movedown j +	end else+	  d.(i) <- x+      else+	d.(i) <- x+    in+    movedown 0++  let pop_maximum h = let m = maximum h in remove h; m++  let iter f h = +    let d = h.data in+    for i = 0 to h.size - 1 do f d.(i) done++  let fold f h x0 =+    let n = h.size in+    let d = h.data in+    let rec foldrec x i =+      if i >= n then x else foldrec (f d.(i) x) (succ i)+    in+    foldrec x0 0++end+++(*s Functional implementation *)++module type FunctionalSig = sig+  type elt+  type t+  val empty : t+  val add : elt -> t -> t+  val maximum : t -> elt+  val remove : t -> t+  val iter : (elt -> unit) -> t -> unit+  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a+end++module Functional(X : Ordered) = struct++  (* Heaps are encoded as complete binary trees, i.e., binary trees+     which are full expect, may be, on the bottom level where it is filled +     from the left. +     These trees also enjoy the heap property, namely the value of any node +     is greater or equal than those of its left and right subtrees.++     There are 4 kinds of complete binary trees, denoted by 4 constructors:+     [FFF] for a full binary tree (and thus 2 full subtrees);+     [PPF] for a partial tree with a partial left subtree and a full+     right subtree;+     [PFF] for a partial tree with a full left subtree and a full right subtree+     (but of different heights);+     and [PFP] for a partial tree with a full left subtree and a partial+     right subtree. *)++  type elt = X.t++  type t = +    | Empty+    | FFF of t * X.t * t (* full    (full,    full) *)+    | PPF of t * X.t * t (* partial (partial, full) *)+    | PFF of t * X.t * t (* partial (full,    full) *)+    | PFP of t * X.t * t (* partial (full,    partial) *)++  let empty = Empty+ +  (* smart constructors for insertion *)+  let p_f l x r = match l with+    | Empty | FFF _ -> PFF (l, x, r)+    | _ -> PPF (l, x, r)++  let pf_ l x = function+    | Empty | FFF _ as r -> FFF (l, x, r)+    | r -> PFP (l, x, r)++  let rec add x = function+    | Empty -> +	FFF (Empty, x, Empty)+    (* insertion to the left *)+    | FFF (l, y, r) | PPF (l, y, r) ->+	if X.compare x y > 0 then p_f (add y l) x r else p_f (add x l) y r+    (* insertion to the right *)+    | PFF (l, y, r) | PFP (l, y, r) ->+	if X.compare x y > 0 then pf_ l x (add y r) else pf_ l y (add x r)++  let maximum = function+    | Empty -> raise EmptyHeap+    | FFF (_, x, _) | PPF (_, x, _) | PFF (_, x, _) | PFP (_, x, _) -> x++  (* smart constructors for removal; note that they are different+     from the ones for insertion! *)+  let p_f l x r = match l with+    | Empty | FFF _ -> FFF (l, x, r)+    | _ -> PPF (l, x, r)++  let pf_ l x = function+    | Empty | FFF _ as r -> PFF (l, x, r)+    | r -> PFP (l, x, r)++  let rec remove = function+    | Empty -> +	raise EmptyHeap+    | FFF (Empty, _, Empty) -> +	Empty+    | PFF (l, _, Empty) ->+	l+    (* remove on the left *)+    | PPF (l, x, r) | PFF (l, x, r) ->+        let xl = maximum l in+	let xr = maximum r in+	let l' = remove l in+	if X.compare xl xr >= 0 then +	  p_f l' xl r +	else +	  p_f l' xr (add xl (remove r))+    (* remove on the right *)+    | FFF (l, x, r) | PFP (l, x, r) ->+        let xl = maximum l in+	let xr = maximum r in+	let r' = remove r in+	if X.compare xl xr > 0 then +	  pf_ (add xr (remove l)) xl r'+	else +	  pf_ l xr r'++  let rec iter f = function+    | Empty -> +	()+    | FFF (l, x, r) | PPF (l, x, r) | PFF (l, x, r) | PFP (l, x, r) -> +	iter f l; f x; iter f r++  let rec fold f h x0 = match h with+    | Empty -> +	x0+    | FFF (l, x, r) | PPF (l, x, r) | PFF (l, x, r) | PFP (l, x, r) -> +	fold f l (fold f r (f x x0))++end
+ external/ocamlgraph/lib/heap.mli view
@@ -0,0 +1,99 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)+++module type Ordered = sig+  type t+  val compare : t -> t -> int+end++exception EmptyHeap++(*S Imperative implementation. *)++module Imperative(X: Ordered) : sig++  (* Type of imperative heaps.+     (In the following [n] refers to the number of elements in the heap) *)++  type t ++  (* [create c] creates a new heap, with initial capacity of [c] *)+  val create : int -> t++  (* [is_empty h] checks the emptiness of [h] *)+  val is_empty : t -> bool++  (* [add x h] adds a new element [x] in heap [h]; size of [h] is doubled+     when maximum capacity is reached; complexity $O(log(n))$ *)+  val add : t -> X.t -> unit++  (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(1)$ *)+  val maximum : t -> X.t++  (* [remove h] removes the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(log(n))$ *)+  val remove : t -> unit++  (* [pop_maximum h] removes the maximum element of [h] and returns it;+     raises [EmptyHeap] when [h] is empty; complexity $O(log(n))$ *)+  val pop_maximum : t -> X.t++  (* usual iterators and combinators; elements are presented in+     arbitrary order *)+  val iter : (X.t -> unit) -> t -> unit++  val fold : (X.t -> 'a -> 'a) -> t -> 'a -> 'a++end++(*S Functional implementation. *)++module type FunctionalSig = sig++  (* heap elements *)+  type elt++  (* Type of functional heaps *)+  type t++  (* The empty heap *)+  val empty : t++  (* [add x h] returns a new heap containing the elements of [h], plus [x];+     complexity $O(log(n))$ *)+  val add : elt -> t -> t++  (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap]+     when [h] is empty; complexity $O(1)$ *)+  val maximum : t -> elt++  (* [remove h] returns a new heap containing the elements of [h], except+     the maximum of [h]; raises [EmptyHeap] when [h] is empty; +     complexity $O(log(n))$ *) +  val remove : t -> t++  (* usual iterators and combinators; elements are presented in+     arbitrary order *)+  val iter : (elt -> unit) -> t -> unit++  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a++end++module Functional(X: Ordered) : FunctionalSig with type elt = X.t
+ external/ocamlgraph/lib/unionfind.ml view
@@ -0,0 +1,117 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++module type HashedOrderedType = sig+  type t+  val equal : t -> t -> bool+  val hash : t -> int +  val compare : t -> t -> int +end++module type S = sig+  type elt+  type t+    +  val init : elt list -> t+  val find : elt -> t -> elt+  val union : elt -> elt -> t -> unit+end++module Make(X:HashedOrderedType) = struct++  type elt = X.t++  module H = Hashtbl.Make(X)+  +  type cell = {+    mutable c : int;+    data : elt;+    mutable father : cell+  }+  +  type t = cell H.t (* a forest *)++  let init l = +    let h = H.create 997 in+    List.iter +      (fun x ->+         let rec cell = { c = 0; data = x; father = cell } in +	 H.add h x cell) +      l;+    h++  let rec find_aux cell = +    if cell.father == cell then +      cell+    else +      let r = find_aux cell.father in +      cell.father <- r; +      r++  let find x h = (find_aux (H.find h x)).data++  let union x y h = +    let rx = find_aux (H.find h x) in+    let ry = find_aux (H.find h y) in+    if rx != ry then begin+      if rx.c > ry.c then+        ry.father <- rx+      else if rx.c < ry.c then+        rx.father <- ry+      else begin+        rx.c <- rx.c + 1;+        ry.father <- rx+      end+    end+end++(*** test ***)+(***++module M = Make (struct +        type t = int let +        hash = Hashtbl.hash +        let compare = compare +        let equal = (=) +    end)++open Printf++let saisir s  = +        printf "%s = " s; flush stdout;+        let x = read_int () in+        x++let h = M.init [0;1;2;3;4;5;6;7;8;9] +let () = if not !Sys.interactive then +    while true do +        printf "1) find\n2) union\n";+        match read_int () with+            1 -> begin+                let x = saisir "x" in+                printf "%d\n" (M.find x h) +            end+          | 2 -> begin+                let x, y = saisir "x", saisir "y" in+                M.union x y h+            end+          | _ -> ()+    done++***)
+ external/ocamlgraph/lib/unionfind.mli view
@@ -0,0 +1,49 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++++(* Unionfind structure over hash-ordered types.++   This module implements a unionfind data structure, given a total ordering+   function and a hash function over the elements. ++*)+++module type HashedOrderedType = sig+  (* The type of the elements*)+  type t+  val equal : t -> t -> bool+  val hash : t -> int +  val compare : t -> t -> int +end++(* Input signature of the functor Unionfind.Make *)++module type S = sig+  type elt+  type t+    +  val init : elt list -> t+  val find : elt -> t -> elt+  val union : elt -> elt -> t -> unit+end++module Make (X : HashedOrderedType) : S with type elt = X.t++
+ external/ocamlgraph/src/blocks.ml view
@@ -0,0 +1,650 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: per_imp.ml,v 1.32 2006-02-03 09:27:29 filliatr Exp $ *)++(** Common implementation to persistent and imperative graphs. *)++open Sig+open Util++let cpt_vertex = ref min_int+  (* global counter for abstract vertex *)++(* ************************************************************************* *)+(** {2 Association table builder} *)+(* ************************************************************************* *)++(** Common signature to an imperative/persistent association table *)+module type HM = sig+  type 'a return+  type 'a t+  type key+  val create : int -> 'a t+  val create_from : 'a t -> 'a t+  val empty : 'a return+  val is_empty : 'a t -> bool+  val add : key -> 'a -> 'a t -> 'a t+  val remove : key -> 'a t -> 'a t+  val mem : key -> 'a t -> bool+  val find : key -> 'a t -> 'a+  val find_and_raise : key -> 'a t -> string -> 'a+    (** [find_and_raise k t s] is equivalent to [find k t] but+       raises [Invalid_argument s] when [find k t] raises [Not_found] *)++  val iter : (key -> 'a -> unit) -> 'a t -> unit+  val map : (key -> 'a -> key * 'a) -> 'a t -> 'a t+  val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b+  val copy : 'a t -> 'a t+end++module type TBL_BUILDER = functor(X: COMPARABLE) -> HM with type key = X.t++(** [HM] implementation using hashtbl. *)+module Make_Hashtbl(X: COMPARABLE) = struct++  include Hashtbl.Make(X)++  type 'a return = unit+  let empty = ()+    (* never call and not visible for the user thank's to signature +       constraints *)++  let create_from h = create (length h)++  let is_empty h = (length h = 0)++  let find_and_raise k h s = try find h k with Not_found -> invalid_arg s++  let map f h = +    let h' = create_from h  in+    iter (fun k v -> let k, v = f k v in add h' k v) h;+    h'++  let add k v h = replace h k v; h+  let remove k h = remove h k; h+  let mem k h = mem h k+  let find k h = find h k++end++(** [HM] implementation using map *)+module Make_Map(X: COMPARABLE) = struct+  include Map.Make(X)+  type 'a return = 'a t+  let is_empty m = (m = empty)+  let create _ = assert false+    (* never call and not visible for the user thank's to +       signature constraints *)+  let create_from _ = empty+  let copy m = m+  let map f m = fold (fun k v m -> let k, v = f k v in add k v m) m empty+  let find_and_raise k h s = try find k h with Not_found -> invalid_arg s+end++(* ************************************************************************* *)+(** {2 Blocks builder} *)+(* ************************************************************************* *)++(** Common implementation to all (directed) graph implementations. *)+module Minimal(S: Set.S)(HM: HM) = struct++  type vertex = HM.key++  let is_directed = true+  let empty = HM.empty+  let create = HM.create+  let is_empty = HM.is_empty++  let nb_vertex g = HM.fold (fun _ _ -> succ) g 0+  let nb_edges g = HM.fold (fun _ s n -> n + S.cardinal s) g 0+  let out_degree g v = +    S.cardinal (try HM.find v g with Not_found -> invalid_arg "out_degree")++  let mem_vertex g v = HM.mem v g++  let unsafe_add_vertex g v = HM.add v S.empty g+  let unsafe_add_edge g v1 v2 = HM.add v1 (S.add v2 (HM.find v1 g)) g++  let add_vertex g v = if HM.mem v g then g else unsafe_add_vertex g v++  let iter_vertex f = HM.iter (fun v _ -> f v)+  let fold_vertex f = HM.fold (fun v _ -> f v)+    +end++(** All the predecessor operations from the iterators on the edges *)+module Pred(S: sig+	      module PV: COMPARABLE+	      module PE: EDGE with type vertex = PV.t+	      type t+	      val mem_vertex : PV.t -> t -> bool+	      val iter_edges : (PV.t -> PV.t -> unit) -> t -> unit+	      val fold_edges : (PV.t -> PV.t -> 'a -> 'a) -> t -> 'a -> 'a+	      val iter_edges_e : (PE.t -> unit) -> t -> unit+	      val fold_edges_e : (PE.t -> 'a -> 'a) -> t -> 'a -> 'a+	    end) =+struct++  open S++  let iter_pred f g v = +    if not (mem_vertex v g) then invalid_arg "iter_pred";+    iter_edges (fun v1 v2 -> if PV.equal v v2 then f v1) g++  let fold_pred f g v = +    if not (mem_vertex v g) then invalid_arg "fold_pred";+    fold_edges (fun v1 v2 a -> if PV.equal v v2 then f v1 a else a) g++  let pred g v = fold_pred (fun v l -> v :: l) g v []++  let in_degree g v = +    if not (mem_vertex v g) then invalid_arg "in_degree";+    fold_pred (fun v n -> n + 1) g v 0++  let iter_pred_e f g v =+    if not (mem_vertex v g) then invalid_arg "iter_pred_e";+    iter_edges_e (fun e -> if PV.equal v (PE.dst e) then f e) g++  let fold_pred_e f g v =+    if not (mem_vertex v g) then invalid_arg "fold_pred_e";+    fold_edges_e (fun e a -> if PV.equal v (PE.dst e) then f e a else a) g+      +  let pred_e g v = fold_pred_e (fun v l -> v :: l) g v []++end++(** Common implementation to all the unlabeled (directed) graphs. *)+module Unlabeled(V: COMPARABLE)(HM: HM with type key = V.t) = struct+  +  module S = Set.Make(V)++  module E = struct+    type vertex = V.t+    include OTProduct(V)(V)+    let src = fst+    let dst = snd+    type label = unit+    let label _ = ()+    let create v1 () v2 = v1, v2+  end++  type edge = E.t++  let mem_edge g v1 v2 = +    try+      S.mem v2 (HM.find v1 g)+    with Not_found ->+      false++  let mem_edge_e g (v1, v2) = mem_edge g v1 v2++  let find_edge g v1 v2 = if mem_edge g v1 v2 then v1, v2 else raise Not_found++  let unsafe_remove_edge g v1 v2 = HM.add v1 (S.remove v2 (HM.find v1 g)) g+  let unsafe_remove_edge_e g (v1, v2) = unsafe_remove_edge g v1 v2++  let remove_edge g v1 v2 = +    if not (HM.mem v2 g) then invalid_arg "remove_edge";+    HM.add v1 (S.remove v2 (HM.find_and_raise v1 g "remove_edge")) g++  let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  let iter_succ f g v = S.iter f (HM.find_and_raise v g "iter_succ")+  let fold_succ f g v = S.fold f (HM.find_and_raise v g "fold_succ")++  let iter_succ_e f g v = iter_succ (fun v2 -> f (v, v2)) g v+  let fold_succ_e f g v = fold_succ (fun v2 -> f (v, v2)) g v++  let succ g v = S.elements (HM.find_and_raise v g "succ")+  let succ_e g v = fold_succ_e (fun e l -> e :: l) g v []++  let map_vertex f = +    HM.map (fun v s -> f v, S.fold (fun v s -> S.add (f v) s) s S.empty)++  module I = struct+    type t = S.t HM.t+    module PV = V+    module PE = E+    let iter_edges f = HM.iter (fun v -> S.iter (f v))+    let fold_edges f = HM.fold (fun v -> S.fold (f v))+    let iter_edges_e f = iter_edges (fun v1 v2 -> f (v1, v2))+    let fold_edges_e f = fold_edges (fun v1 v2 a -> f (v1, v2) a)+  end+  include I++  include Pred(struct include I let mem_vertex = HM.mem end)++end++(** Common implementation to all the labeled (directed) graphs. *)+module Labeled(V: COMPARABLE)(E: ORDERED_TYPE)(HM: HM with type key = V.t) = +struct++  module VE = OTProduct(V)(E)++  module S = Set.Make(VE)++  module E = struct+    type vertex = V.t+    type label = E.t+    type t = vertex * label * vertex+    let src (v, _, _) = v+    let dst (_, _, v) = v+    let label (_, l, _) = l+    let create v1 l v2 = v1, l, v2+    module C = OTProduct(V)(VE)+    let compare (x1, x2, x3) (y1, y2, y3) = +      C.compare (x1, (x3, x2)) (y1, (y3, y2))+  end++  type edge = E.t++  let mem_edge g v1 v2 = +    try+      S.exists (fun (v2', _) -> V.equal v2 v2') (HM.find v1 g)+    with Not_found ->+      false++  let mem_edge_e g (v1, l, v2) =+    try+      let ve = v2, l in+      S.exists (fun ve' -> VE.compare ve ve' == 0) (HM.find v1 g)+    with Not_found ->+      false++  exception Found of edge+  let find_edge g v1 v2 =+    try+      S.iter +	(fun (v2', l) -> if V.equal v2 v2' then raise (Found (v1, l, v2')))+	(HM.find v1 g);+      raise Not_found+    with Found e ->+      e++  let unsafe_remove_edge g v1 v2 = +    HM.add v1 (S.filter +		 (fun (v2', _) -> not (V.equal v2 v2')) (HM.find v1 g)) g++  let unsafe_remove_edge_e g (v1, l, v2) = +    HM.add v1 (S.remove (v2, l) (HM.find v1 g)) g++  let remove_edge g v1 v2 =+    if not (HM.mem v2 g) then invalid_arg "remove_edge";+    HM.add v1 (S.filter +		 (fun (v2', _) -> not (V.equal v2 v2'))+		 (HM.find_and_raise v1 g "remove_edge")) g++  let remove_edge_e g (v1, l, v2) = +    if not (HM.mem v2 g) then invalid_arg "remove_edge_e";+    HM.add v1 (S.remove (v2, l) (HM.find_and_raise v1 g "remove_edge_e")) g++  let iter_succ f g v = +    S.iter (fun (w, _) -> f w) (HM.find_and_raise v g "iter_succ")+  let fold_succ f g v = +    S.fold (fun (w, _) -> f w) (HM.find_and_raise v g "fold_succ")++  let iter_succ_e f g v = +    S.iter (fun (w, l) -> f (v, l, w)) (HM.find_and_raise v g "iter_succ_e")+  let fold_succ_e f g v = +    S.fold (fun (w, l) -> f (v, l, w)) (HM.find_and_raise v g "fold_succ_e")++  let succ g v = fold_succ (fun w l -> w :: l) g v []+  let succ_e g v = fold_succ_e (fun e l -> e :: l) g v []++  let map_vertex f = +    HM.map (fun v s -> +	      f v, S.fold (fun (v, l) s -> S.add (f v, l) s) s S.empty)++  module I = struct+    type t = S.t HM.t+    module PV = V+    module PE = E++    let iter_edges f = HM.iter (fun v -> S.iter (fun (w, _) -> f v w))+    let fold_edges f = HM.fold (fun v -> S.fold (fun (w, _) -> f v w))+    let iter_edges_e f = +      HM.iter (fun v -> S.iter (fun (w, l) -> f (v, l, w)))+    let fold_edges_e f = +      HM.fold (fun v -> S.fold (fun (w, l) -> f (v, l, w)))+  end+  include I++  include Pred(struct include I let mem_vertex = HM.mem end)++end++(** The vertex module and the vertex table for the concrete graphs. *)+module ConcreteVertex(F : TBL_BUILDER)(V: COMPARABLE) = struct++  module V = struct+    include V+    type label = t+    let label v = v+    let create v = v+  end++  module HM = F(V)++end++(* Support for explicitly maintaining edge set of+   predecessors.  Crucial for algorithms that do a lot of backwards+   traversal. *)++module BidirectionalMinimal(S:Set.S)(HM:HM with type key = S.elt) = +struct++  type vertex = HM.key++  let is_directed = true+  let empty = HM.empty+  let create = HM.create+  let is_empty = HM.is_empty++  let nb_vertex g = HM.fold (fun _ _ -> succ) g 0+  let nb_edges g = HM.fold (fun _ (_,s) n -> n + S.cardinal s) g 0+  let out_degree g v = +    S.cardinal (snd (try HM.find v g with Not_found -> invalid_arg "out_degree"))++  let mem_vertex g v = HM.mem v g++  let unsafe_add_vertex g v = HM.add v (S.empty,S.empty) g+  let unsafe_add_edge g v1 v2 = +    let (in_set,out_set) = HM.find v1 g+    in +      ignore ( HM.add v1 (in_set,S.add v2 out_set) g ) ;+      let (in_set,out_set) = HM.find v2 g+      in+	HM.add v2 (S.add v1 in_set,out_set) g++  let iter_vertex f = HM.iter (fun v _ -> f v)+  let fold_vertex f = HM.fold (fun v _ -> f v)+end++module BidirectionalUnlabeled(V:COMPARABLE)(HM:HM with type key = V.t) =+struct++  module S = Set.Make(V)++  (* Edge definition *)++  module E = struct+    type vertex = V.t+    include OTProduct(V)(V)+    let src = fst+    let dst = snd+    type label = unit+    let label _ = ()+    let create v1 () v2 = v1, v2+  end++  type edge = E.t++  let mem_edge g v1 v2 =+    try S.mem v2 (snd (HM.find v1 g))+    with Not_found -> false++  let mem_edge_e g (v1,v2) = mem_edge g v1 v2++  let find_edge g v1 v2 = if mem_edge g v1 v2 then v1, v2 else raise Not_found++  let unsafe_remove_edge g v1 v2 =+    let (in_set,out_set) = HM.find v1 g in +    ignore ( HM.add v1 (in_set,( S.remove v2 out_set )) g ) ;+    let (in_set,out_set) = HM.find v2 g in+    HM.add v2 (S.remove v1 in_set,out_set) g++  let unsafe_remove_edge_e g (v1,v2) = unsafe_remove_edge g v1 v2++  let remove_edge g v1 v2 = +    if not (HM.mem v2 g) then invalid_arg "remove_edge";+    unsafe_remove_edge g v1 v2+    (* HM.add v1 (S.remove v2 (HM.find_and_raise v1 g "remove_edge")) g *)++  let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  let iter_succ f g v = S.iter f (snd (HM.find_and_raise v g "iter_succ"))+  let fold_succ f g v = S.fold f (snd (HM.find_and_raise v g "fold_succ"))++  let iter_succ_e f g v = iter_succ (fun v2 -> f (v, v2)) g v+  let fold_succ_e f g v = fold_succ (fun v2 -> f (v, v2)) g v++  let succ g v = S.elements (snd (HM.find_and_raise v g "succ"))+  let succ_e g v = fold_succ_e (fun e l -> e :: l) g v []+ +  let map_vertex f = +    HM.map (fun v (s1,s2) -> +	      f v, +	      ( S.fold (fun v s -> S.add (f v) s) s1 S.empty,+		S.fold (fun v s -> S.add (f v) s) s2 S.empty ) +	   )++  module I = struct+    (* we keep sets for both incoming and outgoing edges *)+    type t = (S.t * S.t) HM.t  +    module PV = V+    module PE = E+    let iter_edges f = HM.iter (fun v (_,outset) -> S.iter (f v) outset )+    let fold_edges f = HM.fold (fun v (_,outset) -> S.fold (f v) outset )+    let iter_edges_e f = iter_edges (fun v1 v2 -> f (v1, v2))+    let fold_edges_e f = fold_edges (fun v1 v2 a -> f (v1, v2) a)+  end+  include I++  let iter_pred f g v = S.iter f (fst (HM.find_and_raise v g "iter_pred"))+  let fold_pred f g v = S.fold f (fst (HM.find_and_raise v g "fold_pred"))++  let pred g v = S.elements (fst (HM.find_and_raise v g "pred"))++  let in_degree g v = +    S.cardinal +      (fst (try HM.find v g with Not_found -> invalid_arg "in_degree"))++  let iter_pred_e f g v = iter_pred (fun v2 -> f (v2,v)) g v+  let fold_pred_e f g v = fold_pred (fun v2 -> f (v2,v)) g v++  let pred_e g v = fold_pred_e (fun e l -> e :: l) g v []   +end++module Make_Abstract+  (G: sig+     module HM: HM+     module S: Set.S+     include G with type t = S.t HM.t and type V.t = HM.key+     val remove_edge: t -> vertex -> vertex -> t+     val remove_edge_e: t -> edge -> t+     val unsafe_add_vertex: t -> vertex -> t+     val unsafe_add_edge: t -> vertex -> S.elt -> t+     val unsafe_remove_edge: t -> vertex -> vertex -> t+     val unsafe_remove_edge_e: t -> edge -> t+     val empty: S.t HM.return+     val create: int -> t+   end) = +struct++  module I = struct+    type t = { edges : G.t; mutable size : int }+	(* BE CAREFUL: [size] is only mutable in the imperative version.+	   As there is no extensible records in current ocaml version,+	   and for genericity purpose, [size] is mutable in both the+	   imperative and persistent implementation.+	   Do not modify size in the persistent implementation! *)++    type vertex = G.vertex+    type edge = G.edge++    module PV = G.V+    module PE = G.E++    let iter_edges f g = G.iter_edges f g.edges+    let fold_edges f g = G.fold_edges f g.edges+    let iter_edges_e f g = G.iter_edges_e f g.edges+    let fold_edges_e f g = G.fold_edges_e f g.edges+    let mem_vertex v g = G.mem_vertex g.edges v+  end+  include I++  include Pred(I)++  (* optimisations *)++  let is_empty g = g.size = 0+  let nb_vertex g = g.size++  (* redefinitions *)+  module V = G.V+  module E = G.E+  module HM = G.HM+  module S = G.S++  let unsafe_add_edge = G.unsafe_add_edge+  let unsafe_remove_edge = G.unsafe_remove_edge+  let unsafe_remove_edge_e = G.unsafe_remove_edge_e+  let is_directed = G.is_directed++  let remove_edge g = G.remove_edge g.edges+  let remove_edge_e g = G.remove_edge_e g.edges++  let out_degree g = G.out_degree g.edges+  let in_degree g = G.in_degree g.edges++  let nb_edges g = G.nb_edges g.edges+  let succ g = G.succ g.edges+  let mem_vertex g = G.mem_vertex g.edges+  let mem_edge g = G.mem_edge g.edges+  let mem_edge_e g = G.mem_edge_e g.edges+  let find_edge g = G.find_edge g.edges++  let iter_vertex f g = G.iter_vertex f g.edges+  let fold_vertex f g = G.fold_vertex f g.edges+  let iter_succ f g = G.iter_succ f g.edges+  let fold_succ f g = G.fold_succ f g.edges+  let succ_e g = G.succ_e g.edges+  let iter_succ_e f g = G.iter_succ_e f g.edges+  let fold_succ_e f g = G.fold_succ_e f g.edges+  let map_vertex f g = { g with edges = G.map_vertex f g.edges }++end++(** Build persistent (resp. imperative) graphs from a persistent (resp. +    imperative) association table *)+module Make(F : TBL_BUILDER) = struct++  module Digraph = struct++    module Concrete(V: COMPARABLE) = struct+      include ConcreteVertex(F)(V)+      include Unlabeled(V)(HM)+      include Minimal(S)(HM)++      let add_edge g v1 v2 = +	let g = add_vertex g v1 in+	let g = add_vertex g v2 in+	unsafe_add_edge g v1 v2++      let add_edge_e g (v1, v2) = add_edge g v1 v2++      let remove_vertex g v =+	if HM.mem v g then+	  let g = HM.remove v g in+	  HM.fold +	    (fun k s g -> HM.add k (S.remove v s) g) +	    g +	    (HM.create_from g)+	else+	  g++    end++    module ConcreteBidirectional(V: COMPARABLE) = struct+      include ConcreteVertex(F)(V)+      include BidirectionalUnlabeled(V)(HM)+      include BidirectionalMinimal(S)(HM)+    end++    module ConcreteLabeled(V: COMPARABLE)(E: ORDERED_TYPE_DFT) = struct+      include ConcreteVertex(F)(V)+      include Labeled(V)(E)(HM)+      include Minimal(S)(HM)+    end++    module Abstract(V: VERTEX) = struct+      module G = struct+	module V = V+	module HM = F(V)+	include Unlabeled(V)(HM) +	include Minimal(S)(HM)+      end+      include Make_Abstract(G)+    end++    module AbstractLabeled(V: VERTEX)(E: ORDERED_TYPE_DFT) = struct+      module G = struct+	module V = V+	module HM = F(V)+	include Labeled(V)(E)(HM) +	include Minimal(S)(HM)+      end+      include Make_Abstract(G)+    end++  end++end++(** Implementation of undirected graphs from implementation of directed+    graphs. *)+module Graph(G: Sig.G) = struct++  include G++  let is_directed = false++  (* Redefine iterators and [nb_edges]. *)++  let iter_edges f =+    iter_edges (fun v1 v2 -> if V.compare v1 v2 >= 0 then f v1 v2)++  let fold_edges f =+    fold_edges +      (fun v1 v2 acc -> if V.compare v1 v2 >= 0 then f v1 v2 acc else acc)++  let iter_edges_e f =+    iter_edges_e+      (fun e -> if V.compare (E.src e) (E.dst e) >= 0 then f e)++  let fold_edges_e f =+    fold_edges_e+      (fun e acc -> +	 if V.compare (E.src e) (E.dst e) >= 0 then f e acc else acc)++  let nb_edges g = fold_edges_e (fun _ -> (+) 1) g 0++  (* Redefine operations on predecessors:+     predecessors are successors in an undirected graph. *)++  let pred = succ+  let in_degree = out_degree+  let iter_pred = iter_succ+  let fold_pred = fold_succ+  let pred_e = succ_e+  let iter_pred_e = iter_succ_e+  let fold_pred_e = fold_succ_e++end
+ external/ocamlgraph/src/builder.ml view
@@ -0,0 +1,49 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: builder.ml,v 1.12 2004-02-20 14:37:40 signoles Exp $ *)++open Sig++module type S = sig+  module G : Sig.G+  val empty : unit -> G.t+  val copy : G.t -> G.t+  val add_vertex : G.t -> G.V.t -> G.t+  val add_edge : G.t -> G.V.t -> G.V.t -> G.t+  val add_edge_e : G.t -> G.E.t -> G.t+end++module type INT = S with type G.V.label = int++module P(G : Sig.P) = struct+  module G = G+  let empty () = G.empty+  let copy g = g+  let add_vertex = G.add_vertex+  let add_edge = G.add_edge+  let add_edge_e = G.add_edge_e+end++module I(G : Sig.I) = struct+  module G = G+  let empty () = G.create ~size:997 ()+  let copy = G.copy+  let add_vertex g v = G.add_vertex g v; g+  let add_edge g v1 v2 = G.add_edge g v1 v2; g+  let add_edge_e g e = G.add_edge_e g e; g+end
+ external/ocamlgraph/src/builder.mli view
@@ -0,0 +1,47 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: builder.mli,v 1.13 2004-02-20 14:37:40 signoles Exp $ *)++(** Graph builders *)++open Sig++(** {1 Common interface for graph builders}.++   Note: the following functions always return graphs but this is meaningless+   for imperative implementations (the graph is modified in-place).  +   This is just to provide a common interface. *)++module type S = sig+  module G : Sig.G+  val empty : unit -> G.t+  val copy : G.t -> G.t+  val add_vertex : G.t -> G.V.t -> G.t+  val add_edge : G.t -> G.V.t -> G.V.t -> G.t+  val add_edge_e : G.t -> G.E.t -> G.t+end++module type INT = S with type G.V.label = int++(** {1 Builders for the various graph implementations} *)++module P(G : Sig.P) : S with module G = G+  (** Persistent Graphs Builders *)++module I(G : Sig.I) : S with module G = G+  (** Imperative Graphs Builders *)
+ external/ocamlgraph/src/classic.ml view
@@ -0,0 +1,85 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: classic.ml,v 1.9 2004-02-02 08:11:14 filliatr Exp $ *)++module type S = sig+  type graph +  val divisors : int -> graph+  val de_bruijn : int -> graph+  val vertex_only : int -> graph+  val full : ?self:bool -> int -> graph+end++module Generic(B : Builder.INT) = struct++  type graph = B.G.t++  let divisors n =+    if n < 2 then invalid_arg "divisors";+    let v = Array.init (n + 1) (fun i -> B.G.V.create i) in+    let rec loop g i =+      let sqrt_i = truncate (sqrt (float i)) in+      let rec loop_i g d =+	if d > sqrt_i then +	  g +	else if i mod d == 0 then+	  loop_i (B.add_edge (B.add_edge g v.(i / d) v.(i)) v.(d) v.(i)) (d+1)+	else+	  loop_i g (succ d)+      in+      if i > n then g else loop (loop_i (B.add_vertex g v.(i)) 2) (i+1)+    in+    loop (B.empty ()) 2+	+  let fold_for i0 i1 f =+    let rec loop i v = if i > i1 then v else loop (i + 1) (f v i) in+    loop i0++  let de_bruijn n =+    if n < 1 || n > Sys.word_size - 1 then invalid_arg "de_bruijn";+    let v = Array.init (1 lsl n) (fun i -> B.G.V.create i) in+    let all_1 = 1 lsl n - 1 in (* 11...1 *)+    let g = fold_for 0 all_1 (fun g i -> B.add_vertex g v.(i)) (B.empty ()) in+    let rec loop g i =+      if i > all_1 then+	g+      else +	let si = (i lsl 1) land all_1 in+	let g = B.add_edge g v.(i) v.(si) in+	let g = B.add_edge g v.(i) v.(si lor 1) in+	loop g (i + 1)+    in+    loop g 0++  let vertex_only n =+    fold_for 1 n (fun g i -> B.add_vertex g (B.G.V.create i)) (B.empty ())++  let full ?(self=true) n =+    let v = Array.init (n + 1) (fun i -> B.G.V.create i) in+    fold_for 1 n+      (fun g i ->+	 fold_for 1 n+	   (fun g j -> if self || i <> j then B.add_edge g v.(i) v.(j) else g)+	   g)+      (fold_for 1 n (fun g i -> B.add_vertex g v.(i)) (B.empty ()))++end++module P (G : Sig.P with type V.label = int) = Generic(Builder.P(G))++module I (G : Sig.I with type V.label = int) = Generic(Builder.I(G))
+ external/ocamlgraph/src/classic.mli view
@@ -0,0 +1,54 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: classic.mli,v 1.12 2005-02-25 13:54:33 signoles Exp $ *)++(** Some classic graphs *)++module type S = sig++  type graph ++  val divisors : int -> graph+    (** [divisors n] builds the graph of divisors. +      Vertices are integers from [2] to [n]. [i] is connected to [j] if+      and only if [i] divides [j]. +      @raise Invalid_argument is [n < 2]. *)++  val de_bruijn : int -> graph+    (** [de_bruijn n] builds the de Bruijn graph of order [n].+      Vertices are bit sequences of length [n] (encoded as their+      interpretation as binary integers). The sequence [xw] is connected+      to the sequence [wy] for any bits [x] and [y] and any bit sequence +      [w] of length [n-1]. +      @raise Invalid_argument is [n < 1] or [n > Sys.word_size-1]. *)++  val vertex_only : int -> graph+    (** [vertex_only n] builds a graph with [n] vertices and no edge. *)++  val full : ?self:bool -> int -> graph+    (** [full n] builds a graph with [n] vertices and all possible edges.+      The optional argument [self] indicates if loop edges should be added+      (default value is [true]). *)++end++module P (G : Sig.P with type V.label = int) : S with type graph = G.t+  (** Classic Persistent Graphs *)++module I (G : Sig.I with type V.label = int) : S with type graph = G.t+  (** Classic Imperative Graphs *)
+ external/ocamlgraph/src/cliquetree.ml view
@@ -0,0 +1,343 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(**+  Clique tree of a graph.+  +  @author Matthieu Sozeau+*)++(*i $Id: cliquetree.ml,v 1.6 2005-11-02 13:43:35 filliatr Exp $ i*)++module CliqueTree(Gr : Sig.G) = struct++  (* Original vertex set (of Gr) *)+  module OVSet = Set.Make(Gr.V) +    +  (* Vertex signature *)+  module rec CliqueV : +  sig +    type t+    val compare : t -> t -> int  +    val hash : t -> int+    val equal : t -> t -> bool+    val label : t -> t+    val create : Gr.V.t -> t+    val vertex : t -> Gr.V.t+    val number : t -> int+    val set_number : t -> int -> unit+    val clique : t -> int+    val set_clique : t -> int -> unit+    val mark : t -> int+    val incr_mark : t -> unit+    val m : t -> CVS.t+    val set_m : t -> CVS.t -> unit+    val last : t -> t+    val set_last : t -> t -> unit+  end =+  struct+    type t = {+      mutable mark: int;+      orig: Gr.V.t;+      mutable m: CVS.t;+      mutable last: t option;+      mutable number: int;+      mutable clique: int;+    }++    let compare x y = Gr.V.compare x.orig y.orig+    let hash x = Gr.V.hash x.orig+    let equal x y = Gr.V.equal x.orig y.orig++    type label = t+    let label x = x++    let create o = { +      mark = 0; +      orig = o; +      m = CVS.empty;+      last = None;+      number = 0;+      clique = -1;+    }++    let vertex x = x.orig++    let clique x = x.clique+    let set_clique x v = x.clique <- v++    let number x = x.number+    let set_number x v = x.number <- v++    let mark x = x.mark+    let incr_mark x = +      (*Printf.printf "Increasing mark of %s to %i\n%!"+	(Gr.v_to_string x.orig) (succ x.mark);*)+      x.mark <- succ x.mark++    let m x = x.m+    let set_m x v = x.m <- v+		      +    let last x = +      match x.last with+	  Some v -> v+	| None -> failwith "last not set"+	    +    let set_last x v = x.last <- Some v++  end+    (* Clique tree vertex set *)+  and CVS : Set.S with type elt = CliqueV.t = Set.Make(CliqueV)+		    +  (* The final clique tree vertex type:+     - set of original vertexes ordered by mark.+     - clique number.+  *)+  module CliqueTreeV = +    Util.DataV+      (struct type t = CliqueV.t list * CVS.t end)+      (struct+	 type t = int+	 type label = int+	 let compare x y = Pervasives.compare x y+	 let hash = Hashtbl.hash+	 let equal x y = x = y+	 let label x = x+	 let create lbl = lbl+       end)  +    +  module CliqueTreeE = struct+    type t = int * CVS.t+	+    let compare (x, _) (y, _) = Pervasives.compare x y++    let default = (0, CVS.empty)+		    +    let create n s = (n, s)+		       +    let vertices = snd++    let width g tri (_, x) = +      let vertices = List.map CliqueV.vertex (CVS.elements x) in+      let w =+	List.fold_left+	  (fun w v ->+	     List.fold_left+	     (fun w v' ->+		if v <> v' then+		  if not (Gr.mem_edge g v v') && Gr.mem_edge tri v v'+		  then succ w+		  else w+		else w)+	     w vertices)+	  0 vertices+      in +      assert(w mod 2 = 0);+      w / 2+  end+    +  (* The returned tree *)+  module CliqueTree =+    Persistent.Digraph.ConcreteLabeled(CliqueTreeV)(CliqueTreeE)+      +  (* Intermediate graph *)+  module G = Persistent.Graph.Concrete(CliqueV)+    +  (* Convenient types *)+  module EdgeSet = Set.Make(G.E)+  module H = Hashtbl.Make(CliqueV)++  (* Used to choose some vertex in the intermediate graph *)+  module Choose = Oper.Choose(G)++  (* Creates the intermediate graph from the original *)+  module Copy = Gmap.Vertex(Gr)(struct include G include Builder.P(G) end)++  open CliqueV++  let vertices_list x =+    let l = CVS.elements x in+    List.sort+      (fun x y -> +	 (*let markx = mark x and marky = mark y in*)+	 - Pervasives.compare (number x) (number y))+      l++  let mcs_clique g =+    (* initializations *)+    let n = Gr.nb_vertex g in+    let g' = Copy.map CliqueV.create g in+    let unnumbered = ref (G.fold_vertex CVS.add g' CVS.empty) in+    let pmark = ref (-1) in+    let order = ref [] in+    let cliques = Array.make n ([], CVS.empty) in+    let ties = ref [] in+    let j = ref 0 in+      (* loop, taking each unnumbered vertex in turn *)+      for i = n downto 1 do+	(* Find greatest unnumbered vertex+	   if CVS.is_empty !unnumbered then+	   Printf.printf "No more unnumbered vertices\n%!"+	   else+	   Printf.printf "%i unnumbered vertices remaining\n%!" +	   (CVS.cardinal !unnumbered);+	*)+ 	let x, mark = +	  let choosed = CVS.choose !unnumbered in+ 	    CVS.fold+ 	      (fun x ((maxx, maxv) as max) ->+ 		 let v = mark x in+ 		 if v > maxv then (x, v) else max)+ 	      !unnumbered (choosed, mark choosed)+  	in+	  (* peo construction *)+	  order := x :: !order;+	  (* now numbered *)+	  unnumbered := CVS.remove x !unnumbered;+	  if mark <= !pmark then begin+	    (* Create a new clique (lemma 8) *)+	    incr j;+	    (* m x is the neighborhoud of x in the previous clique *)+	    cliques.(!j) <- ([x], CVS.add x (m x));+	    (* Use reverse map of cliques to find what clique +	       we're connected to. m x is the width of the ties *)+	    let clast = clique (last x) in+	    ties := (clast, m x, !j) :: !ties;+	  end else begin+	    let l, c = cliques.(!j) in+	    cliques.(!j) <- (x::l, CVS.add x c);+	  end;+	  G.iter_succ+	    (fun y ->+	       if number y == 0 then begin+		 incr_mark y;+		 set_m y (CVS.add x (m y));+	       end;+	       set_last y x)+	    g' x;+	  pmark := mark;+	  set_number x i;+	  set_clique x !j;+      done;+      let cliques = +	Array.mapi+	  (fun i (l, c) -> CliqueTreeV.create (List.rev l, c) i)+	  (Array.sub cliques 0 (succ !j))+      in+      let tree = +	Array.fold_left CliqueTree.add_vertex CliqueTree.empty cliques+      in+      let tree, _ = +	List.fold_left+	  (fun (g, n) (i, verts, j) ->	     +	     let label = CliqueTreeE.create n verts in+	     let edge = CliqueTree.E.create cliques.(i) label cliques.(j) in+	     (CliqueTree.add_edge_e g edge, succ n))+	  (tree, 1) !ties+      in+      List.map CliqueV.vertex !order, tree, cliques.(0)++   let sons g x = CliqueTree.fold_succ (fun x y -> x :: y) g x []++   exception NotClique++   let rec drop_while p l =+     match l with+       | x :: tl -> +	   if p x then drop_while p tl+	   else l+       | [] -> []++   let test_simpliciality_first l sons =+     let takeOne l = match !l with+       | x :: xs -> l := xs; Some x+       | [] -> None+     in+     let vertices = ref l in+     let sons = ref sons in+     try+       while !vertices <> [] && not (List.for_all (fun c -> !c = []) !sons) do+	 (match takeOne vertices with+	      Some v -> +		let mark = CliqueV.mark v in+		List.iter+		  (fun s -> +		     match !s with+		       | y :: tl -> +			   let ymark = CliqueV.mark y in+			   if ymark > mark then+			     ()+			   else if ymark = mark then+			     s := drop_while +			       (fun y -> CliqueV.mark y = mark) tl+			   else raise NotClique+		       | [] -> ())+		  !sons+	      | None -> assert false);+       done;+       !vertices <> []+     with NotClique -> false++   let test_simpliciality_first' l sons =+     List.for_all+       (fun son ->+	  match !son with+	    | [] -> false+	    | xi :: tl ->+		let other = m xi in+		CVS.subset other l)+       sons++   let test_simpliciality_next vertices sons =+     match vertices with+       | x :: tl ->+	   begin+	     try+	       ignore(+		 List.fold_left+			(fun vm v' ->+			   let vm' = CliqueV.m v' in+			   if CVS.equal vm' vm then+			     CVS.add v' vm'+			   else raise NotClique)+			(CVS.add x (m x)) tl);+	       true+	     with NotClique -> false+	   end+       | _ -> true++   let is_chordal g = +     let order, tree, root = mcs_clique g in+     let rec aux c = +       let csons = sons tree c in+       let s = List.map CliqueTreeV.data csons in+       let l = CliqueTreeV.data c in+       let sons () = List.map (fun (x,y) -> ref x) s in+       let first = test_simpliciality_first' (snd l) (sons ()) in+       let next = test_simpliciality_next (fst l) (sons ()) in+       first && next && (List.for_all aux csons)+     in +     aux root+	  +   let maxwidth g tri tree = +     CliqueTree.fold_edges_e+       (fun e res -> +	  let w = CliqueTreeE.width g tri (CliqueTree.E.label e) in	   +	  max res w)+       tree 0      	 ++end
+ external/ocamlgraph/src/cliquetree.mli view
@@ -0,0 +1,90 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(**+  Construction of the clique tree of a graph and recognition+  of chordal graphs.+  +  Based on the article:+  Chordal graphs and their clique graph+  by P. Galinier, M. Habib and C. Paul.+  +  @author Matthieu Sozeau+*)++(*i $Id: cliquetree.mli,v 1.4 2004-10-19 15:22:47 signoles Exp $ i*)++module CliqueTree(G : Sig.G) : sig++  (** Original graph vertex *)+  module CliqueV :+  sig+    type t+    val compare : t -> t -> int+    val hash : t -> int+    val equal : t -> t -> bool+    val label : t -> t+    val create : G.V.t -> t+    val vertex : t -> G.V.t+  end++  (** Set of original vertices *)+  module CVS : Set.S with type elt = CliqueV.t+		       +  (** Clique tree vertex type *)+  module CliqueTreeV : sig+    (** Trace of the algorithm as a list of markers Clique vertices *)+    type data = CliqueV.t list * CVS.t+    type label+    type t++    val compare : t -> t -> int+    val hash : t -> int+    val equal : t -> t -> bool+	    +    val create : data -> label -> t+    val label : t -> label+    val data : t -> data+  end+	+  module CliqueTreeE : sig+    type t = int * CVS.t+    val compare : t -> t -> int+    val default : t+    val create : int -> CVS.t -> t+	    +    (** Vertices in the clique tree edge +      (intersection of the two clique extremities). *)+    val vertices : t -> CVS.t+  end+	+  (** The clique tree graph type *)+  module CliqueTree : Sig.G with type V.t = CliqueTreeV.t+			    and type E.label = CliqueTreeE.t+      +  (** [mcs_clique g] return an perfect elimination order of [g] +    (if it is chordal), the clique tree of [g] and its root.  *)+  val mcs_clique : G.t -> G.V.t list * CliqueTree.t * CliqueTree.V.t++  (** [is_chordal g] uses the clique tree construction to test if a graph is +    chordal or not. *)+  val is_chordal : G.t -> bool++  (** [maxwidth g tri tree] returns the maxwidth characteristic of the+    triangulation [tri] of graph [g] given the clique tree [tree] of [tri]. *)+  val maxwidth : G.t -> G.t -> CliqueTree.t -> int+end
+ external/ocamlgraph/src/components.ml view
@@ -0,0 +1,90 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: components.ml,v 1.9 2004-10-22 14:42:06 signoles Exp $ *)++open Util++module type G = sig+  type t+  module V : Sig.COMPARABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+end++module Make(G: G) = struct++  module H = Hashtbl.Make(G.V)+  module S = Set.Make(G.V)++  let scc g =+    let root = H.create 997 in+    let hashcomp = H.create 997 in+    let stack = ref [] in+    let numdfs = ref 0 in+    let numcomp = ref 0 in+    let rec pop x c = function+      | (y, w) :: l when y > x -> +	  H.add hashcomp w !numcomp; +	  pop x (S.add w c) l+      | l -> c,l+    in+    let rec visit v = +      if not (H.mem root v) then+	begin+	  let n = incr numdfs; !numdfs in+	  H.add root v n; +	  G.iter_succ +	    (fun w -> +	       visit w;+	       if not (H.mem hashcomp w) then +		 H.replace root v (min (H.find root v) (H.find root w)))+	    g v;+	  if H.find root v = n then +	    (H.add hashcomp v !numcomp;+	     let comp,s = pop n (S.add v S.empty) !stack in +	     stack:= s;+	     incr numcomp)+	  else stack := (n,v)::!stack;+	end+    in +    G.iter_vertex visit g;+    (!numcomp,(fun v -> H.find hashcomp v))++  let scc_array g =+    let n,f = scc g in+    let t = Array.make n [] in+    G.iter_vertex +      (fun v -> let i = f v in t.(i) <- v::t.(i)) g;+    t++  let scc_list g =+    let _,scc = scc g in+    let tbl = Hashtbl.create 97 in+    G.iter_vertex +      (fun v -> +	 let n = scc v in+	 try+	   let l = Hashtbl.find tbl n in+	   l := v :: !l+	 with Not_found ->+	   Hashtbl.add tbl n (ref [ v ]))+      g;+    Hashtbl.fold (fun _ v l -> !v :: l) tbl []+++end
+ external/ocamlgraph/src/components.mli view
@@ -0,0 +1,53 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: components.mli,v 1.12 2004-10-22 14:42:06 signoles Exp $ *)++(** Strongly connected components *)++open Util++(** Minimal graph signature for [scc] *)+module type G = sig+  type t+  module V : Sig.COMPARABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+end++module Make (G: G) : sig++  val scc : G.t -> int*(G.V.t -> int)+    (** [scc g] computes the strongly connected components of [g].+	The result is a pair [(n,f)] where [n] is the number of+	components. Components are numbered from [0] to [n-1], and+	[f] is a function mapping each vertex to its component+	number. In particular, [f u = f v] if and only if [u] and+	[v] are in the same component. Another property of the+	numbering is that components are numbered in a topological+	order: if there is an arc from [u] to [v], then [f u >= f u] *)++  val scc_array : G.t -> G.V.t list array+    (** [scc_array] computes the strongly connected components of [g].+	Components are stored in the resulting array, indexed with a+	numbering with the same properties as for [scc] above. *)++  val scc_list : G.t -> G.V.t list list+    (** [scc_list] computes the strongly connected components of [g].+	The result is a partition of the set of the vertices of [g]. *)++end
+ external/ocamlgraph/src/delaunay.ml view
@@ -0,0 +1,344 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: delaunay.ml,v 1.12 2005-11-02 13:43:35 filliatr Exp $ *)++(** Code follows Don Knuth's algorithm+    from ``Axioms and hulls'' (LNCS 606, Springer-Verlag, 1992), pp. 73-77 *)++open Printf++module type CCC = sig+  type point+  val ccw : point -> point -> point -> bool+  val in_circle : point -> point -> point -> point -> bool+end++module type Triangulation = sig+  module S : CCC+  type triangulation+  val triangulate : S.point array -> triangulation+  val iter : (S.point -> S.point -> unit) -> triangulation -> unit+  val fold : (S.point -> S.point -> 'a -> 'a) -> triangulation -> 'a -> 'a+end++module Make (S : CCC) = struct++  module S = S++  type point = Point of int | Infinity++  type arc = { mutable vert : point;+	       mutable next : arc;+	       mutable inst : node ref;+	       mate : int }+  and node = +    | Branch of int * int * node ref * node ref+    | Terminal of arc++  type triangulation = { +    points : S.point array; +    arcs : arc array;+    last_used_arc : int +  }++  let rec dummy_arc = +    { vert = Infinity; next = dummy_arc; +      inst = ref (Terminal dummy_arc); mate = -1 }++  let make_arc n i =+    { vert = Infinity; next = dummy_arc; +      inst = ref (Terminal dummy_arc); mate = 6 * n - 7 - i }++  let finite = function Point p -> p | Infinity -> assert false++  (* [flip] will be used in both steps T4 and T5 *)+  let flip c d e t'' p n n' =+    let e' = e.next in+    let c' = c.next in+    let c'' = c'.next in+    e.next <- c;+    c.next <- c'';+    c''.next <- e;+    c''.inst <- n; c.inst <- n; e.inst <- n;+    c.vert <- Point p;+    d.next <- e';+    e'.next <- c'; +    c'.next <- d;+    c'.inst <- n'; e'.inst <- n'; d.inst <- n';+    d.vert <- Point t''++  let triangulate points =+    let ccw p q r = S.ccw points.(p) points.(q) points.(r) in+    let in_circle p q r s = +      S.in_circle points.(p) points.(q) points.(r) points.(s)+    in+    let n = Array.length points in+    if n < 2 then invalid_arg "triangulate";+    let arcs = Array.init (6 * n - 6) (make_arc n) in+    let mate i = 6 * n - 7 - i in++  (*i DEBUG+  let rec dump d l = +    eprintf "%s" (String.make (2*d) ' ');+    match !l with+      | Terminal a ->+	  eprintf "T %d\n" (mate a.mate)+      | Branch (u, v, l, r) ->+	  eprintf "N %d %d\n" u v;+	  dump (d+1) l;+	  dump (d+1) r+  in+  i*)++    (* initialization: +       create a trivial triangulation for the first 2 vertices *)+    let u = 0 in+    let v = 1 in+    let a1 = arcs.(0) in+    let a2 = arcs.(1) in+    let a3 = arcs.(2) in+    let b1 = arcs.(mate 0) in+    let b2 = arcs.(mate 1) in+    let b3 = arcs.(mate 2) in+    let l1 = ref (Terminal a2) in+    let l2 = ref (Terminal b3) in+    a1.vert <- Point v;  a1.next <- a2; a1.inst <- l1;+    a2.vert <- Infinity; a2.next <- a3; a2.inst <- l1;+    a3.vert <- Point u;  a3.next <- a1; a3.inst <- l1;+    b1.vert <- Point u;  b1.next <- b3; b1.inst <- l2;+    b2.vert <- Point v;  b2.next <- b1; b2.inst <- l2;+    b3.vert <- Infinity; b3.next <- b2; b3.inst <- l2;+    let l0 = ref (Branch (u, v, l1, l2)) in+    let j = ref 2 in (* last used arc *)++    (* then for each new vertex [p] *)+    for p = 2 to n - 1 do+      (* Step T1 *)+      let rec step_T1 l p = match !l with+	| Terminal al -> +	    l, al+	| Branch (pl, ql, al, bl) -> +	    step_T1 (if ccw pl ql p then al else bl) p+      in+      let l, al = step_T1 l0 p in++      (* Step T2 *)+      let a = al in+      let b = a.next in+      let c = b.next in+      let q = a.vert in+      let r = b.vert in+      let s = c.vert in+      j := !j + 3;+      let aj = arcs.(!j) in+      let aj_1 = arcs.(!j - 1) in+      let aj_2 = arcs.(!j - 2) in+      let bj = arcs.(aj.mate) in+      let bj_1 = arcs.(aj_1.mate) in+      let bj_2 = arcs.(aj_2.mate) in+      let l' = ref (Terminal a) in+      let l'' = ref (Terminal aj) in+      let l''' = ref (Terminal c) in+      aj.vert   <- q;         aj.next <- b;      aj.inst <- l'';+      aj_1.vert <- r;       aj_1.next <- c;    aj_1.inst <- l''';+      aj_2.vert <- s;       aj_2.next <- a;    aj_2.inst <- l';+      bj.vert   <- Point p;   bj.next <- aj_2;   bj.inst <- l';+      bj_1.vert <- Point p; bj_1.next <- aj;   bj_1.inst <- l'';+      bj_2.vert <- Point p; bj_2.next <- aj_1; bj_2.inst <- l''';+      a.next <- bj;   a.inst <- l'; +      b.next <- bj_1; b.inst <- l'';+      c.next <- bj_2; c.inst <- l''';+      let r = finite r in+      let s = finite s in++      (* steps T3 or T4 depending on [q] *)+      let r = match q with+	| Point q -> (* Step T3 *)+	    let n = ref (Branch (q, p, l', l'')) in+	    let n' = ref (Branch (s, p, l''', l')) in+	    l := Branch (r, p, n, n');+	    r+	| Infinity -> (* Step T4 *)+	    let n = ref (Branch (s, p, l''', l')) in+	    l := Branch (r, p, l'', n);+	    let rec loop m a d s t =+	      if t <> r && ccw p s t then begin+		let n = ref (Terminal d) in+		match !m with+		  | Branch (mu, mv, ml, is_l') -> +		      assert (is_l' == l');+		      m := Branch (mu, mv, ml, d.inst);+		      d.inst := Branch (t, p, n, l');+		      let m = d.inst in+		      flip a arcs.(a.mate) d t p n l';+		      let a = arcs.(a.mate).next in+		      let d = arcs.(a.mate).next in+		      let s = t in+		      let t = finite d.vert in+		      l' := Terminal a;+		      loop m a d s t+		  | Terminal _ -> +		      assert false+	      end else begin+		(* at exit of while loop *)+		let n = ref (Terminal d.next) in+		d.inst := Branch (s, p, n, l');+		d.inst <- n; d.next.inst <- n; d.next.next.inst <- n;+		s+	      end+	    in+	    let d = arcs.(a.mate).next in+	    loop n a d s (finite d.vert)+      in++      (* Step T5 *)+      let rec loop c =+	let d = arcs.(c.mate) in+	let e = d.next in+	let t = finite d.vert in+	let t' = finite c.vert in+	let t'' = e.vert in+	if t'' <> Infinity && in_circle (finite t'') t' t p then begin+	  let t'' = finite t'' in+	  let n = ref (Terminal e) in+	  let n' = ref (Terminal d) in+	  c.inst := Branch (t'', p, n, n');+	  d.inst := Branch (t'', p, n, n');+	  flip c d e t'' p n n';+	  loop e+	end else if t' <> r then+	  loop arcs.(c.next.mate).next+	else+	  () (* break *)+      in+      loop c++    done;+    { points = points; arcs = arcs; last_used_arc = !j }++  let iter f t =+    let points = t.points in+    let n = Array.length t.arcs in+    for i = 0 to t.last_used_arc do+      match t.arcs.(i).vert, t.arcs.(n - 1 - i).vert with+	| Point u, Point v -> f points.(u) points.(v)+	| _ -> ()+    done++  let fold f t a =+    let points = t.points in+    let n = Array.length t.arcs in+    let rec loop i a =+      if i <= t.last_used_arc then+	match t.arcs.(i).vert, t.arcs.(n - 1 - i).vert with+	  | Point u, Point v -> loop (succ i) (f points.(u) points.(v) a)+	  | _ -> loop (succ i) a+      else+	a+    in+    loop 0 a++end++(** Points with floating point coordinates *)++module FloatPoints = struct++  type point = float * float++  let ( + ) = ( +. )+  let ( - ) = ( -. )+  let ( * ) = ( *. )++  let det = function+    | [| [| a00; a01 |];+	 [| a10; a11 |] |] -> +	a00 * a11 - a01 * a10+    | [| [| a00; a01; a02 |];+	 [| a10; a11; a12 |];+	 [| a20; a21; a22 |] |] -> +	a00*a11*a22 - a00*a12*a21 - a10*a01*a22 + +	a10*a02*a21 + a20*a01*a12 - a20*a02*a11+    | [| [| a00; a01; a02; a03 |];+	 [| a10; a11; a12; a13 |];+	 [| a20; a21; a22; a23 |];+	 [| a30; a31; a32; a33 |] |] -> +	a00*a11*a22*a33 - a00*a11*a23*a32 - a00*a21*a12*a33 + +	a00*a21*a13*a32 + a00*a31*a12*a23 - a00*a31*a13*a22 - +	a10*a01*a22*a33 + a10*a01*a23*a32 + a10*a21*a02*a33 - +	a10*a21*a03*a32 - a10*a31*a02*a23 + a10*a31*a03*a22 + +	a20*a01*a12*a33 - a20*a01*a13*a32 - a20*a11*a02*a33 + +	a20*a11*a03*a32 + a20*a31*a02*a13 - a20*a31*a03*a12 - +	a30*a01*a12*a23 + a30*a01*a13*a22 + a30*a11*a02*a23 - +	a30*a11*a03*a22 - a30*a21*a02*a13 + a30*a21*a03*a12+    | _ -> assert false++  let ccw (xu,yu) (xv,yv) (xw,yw) = +    det [| [| xu; yu; 1.0 |];+	   [| xv; yv; 1.0 |];+	   [| xw; yw; 1.0 |] |] > 0.0++  (*i DEBUG+  let ccw (xu,yu) (xv,yv) (xw,yw) = +    eprintf "ccw((%.0f,%.0f),(%.0f,%.0f),(%.0f,%.0f)) -> " +      xu yu xv yv xw yw;+    let r = ccw (xu,yu) (xv,yv) (xw,yw) in+    eprintf "%b\n" r; flush stderr;+    r+  i*)++  let in_circle (xt,yt) (xu,yu) (xv,yv) (xw,yw) = +    det [| [| xt; yt; (xt * xt + yt * yt); 1.0 |];+	   [| xu; yu; (xu * xu + yu * yu); 1.0 |];+	   [| xv; yv; (xv * xv + yv * yv); 1.0 |];+	   [| xw; yw; (xw * xw + yw * yw); 1.0 |]; |] > 0.0++  (*i DEBUG+  let in_circle (xt,yt) (xu,yu) (xv,yv) (xw,yw) = +    eprintf "in_circle((%.0f,%.0f),(%.0f,%.0f),(%.0f,%.0f),(%.0f,%.0f)) -> " +      xt yt xu yu xv yv xw yw;+    let r = in_circle (xt,yt) (xu,yu) (xv,yv) (xw,yw) in+    eprintf "%b\n" r; flush stderr;+    r+  i*)++end++module Float = Make(FloatPoints)++(** Points with integer coordinates.+    We approximate using module [FloatPoints] but this could be made exact+    following Knuth's code in Axioms and Hulls *)++module IntPoints = struct++  type point = int * int++  let ccw (xu,yu) (xv,yv) (xw,yw) = +    FloatPoints.ccw +      (float xu, float yu) (float xv, float yv) (float xw, float yw)++  let in_circle (xt,yt) (xu,yu) (xv,yv) (xw,yw) = +    FloatPoints.in_circle+      (float xt, float yt)+      (float xu, float yu) (float xv, float yv) (float xw, float yw)++end++module Int = Make(IntPoints)+
+ external/ocamlgraph/src/delaunay.mli view
@@ -0,0 +1,76 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: delaunay.mli,v 1.8 2004-02-20 14:37:40 signoles Exp $ *)++(** Delaunay triangulation *)++(** Delaunay triangulation is available for any CCC system in the sense+    of Knuth's ``Axioms and Hulls'' *)+module type CCC = sig++  type point++  val ccw : point -> point -> point -> bool+    (** The counterclockwise relation [ccw p q r] states that the +      circle through points [(p,q,r)] is traversed counterclockwise +      when we encounter the points in cyclic order [p,q,r,p,...] **)++  val in_circle : point -> point -> point -> point -> bool+    (** The relation [in_circle p q r s] states that [s] lies +      inside the circle [(p,q,r)] if [ccw p q r] is true, or outside that +      circle if [ccw p q r] is false. *)++end++(** The result of triangulation is an abstract value of type [triangulation].+  Then one can iterate over all edges of the triangulation. *)+module type Triangulation = sig++  module S : CCC++  type triangulation++  val triangulate : S.point array -> triangulation+    (** [triangulate a] computes the Delaunay triangulation of a set of +      points, given as an array [a]. If [N] is the number of points+      (that is [Array.length a]), then the running time is $O(N \log N)$+      on the average and $O(N^2)$ on the worst-case. The space used is +      always $O(N)$. *)++  val iter : (S.point -> S.point -> unit) -> triangulation -> unit+    (** [iter f t] iterates over all edges of the triangulation [t]. +      [f u v] is called once for each undirected edge [(u,v)]. *)++  val fold : (S.point -> S.point -> 'a -> 'a) -> triangulation -> 'a -> 'a++end++(** Generic Delaunay triangulation *)+module Make(S : CCC) : Triangulation with module S = S++(** Points with integer coordinates *)+module IntPoints : CCC with type point = int * int++(** Delaunay triangulation with integer coordinates *)+module Int : Triangulation with module S = IntPoints++(** Points with floating point coordinates *)+module FloatPoints : CCC with type point = float * float++(** Delaunay triangulation with floating point coordinates *)+module Float : Triangulation with module S = FloatPoints
+ external/ocamlgraph/src/dot.ml view
@@ -0,0 +1,78 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++(** Parser for DOT file format *)++open Dot_ast++module Parse +  (B : Builder.S)+  (L : sig +     val node : node_id -> attr list -> B.G.V.label+       (** how to build the node label out of the set of attributes *)+     val edge : attr list -> B.G.E.label +       (** how to build the edge label out of the set of attributes *)+   end) =+struct++  let create_graph dot =+    let nodes = Hashtbl.create 97 in+    let node g id l =+      try+	g, Hashtbl.find nodes id+      with Not_found ->+	let n = B.G.V.create (L.node id l) in+	Hashtbl.add nodes id n;+	B.add_vertex g n, n+    in+    List.fold_left+      (fun g s -> match s with+	| Node_stmt (id, al) ->+	    let g,_ = node g id al in g+	| Edge_stmt (NodeId id, nl, al) ->+	    let el = L.edge al in+	    let g,vn = node g id [] in+	    List.fold_left+	      (fun g m -> match m with+		| NodeId idm -> +		    let g,vm = node g idm [] in+		    let e = B.G.E.create vn el vm in+		    B.add_edge_e g e+		| NodeSub _ -> +		    g)+	      g nl+	| _ ->+	    g)+      (B.empty ()) +      dot.stmts++  let parse f =+    let c = open_in f in+    let lb = Lexing.from_channel c in+    let dot = +      try+	Dot_parser.file Dot_lexer.token lb +      with Parsing.Parse_error ->+	let n = Lexing.lexeme_start lb in+	failwith (Printf.sprintf "Dot.parse: parse error character %d" n)+    in+    close_in c;+    create_graph dot++end
+ external/ocamlgraph/src/dot.mli view
@@ -0,0 +1,34 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(** Parser for DOT file format *)++open Dot_ast++module Parse +  (B : Builder.S)+  (L : sig +     val node : node_id -> attr list -> B.G.V.label+       (** how to build the node label out of the set of attributes *)+     val edge : attr list -> B.G.E.label +       (** how to build the edge label out of the set of attributes *)+   end) :+sig+  +  val parse : string -> B.G.t++end
+ external/ocamlgraph/src/dot_ast.mli view
@@ -0,0 +1,57 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++type id = +  | Ident of string+  | Number of string+  | String of string+  | Html of string++type attr = (id * id option) list++type compass_pt = N | Ne | E | Se | S | Sw | W | Nw++type port = +  | PortId of id * compass_pt option+  | PortC of compass_pt++type node_id = id * port option++type subgraph = +  | SubgraphId of id+  | SubgraphDef of id option * stmt list++and node =+  | NodeId of node_id+  | NodeSub of subgraph++and stmt = +  | Node_stmt of node_id * attr list+  | Edge_stmt of node * node list * attr list+  | Attr_graph of attr list+  | Attr_node of attr list+  | Attr_edge of attr list+  | Equal of id * id+  | Subgraph of subgraph++type file =+  { strict : bool;+    digraph : bool;+    id : id option;+    stmts : stmt list }
+ external/ocamlgraph/src/dot_lexer.ml view
@@ -0,0 +1,386 @@+# 20 "src/dot_lexer.mll"+ +  open Lexing+  open Dot_ast+  open Dot_parser++  let string_buf = Buffer.create 1024++  let keyword =+    let h = Hashtbl.create 17 in+    List.iter +      (fun (s,k) -> Hashtbl.add h s k)+      [+	"strict", STRICT;+	"graph", GRAPH;+	"digraph", DIGRAPH;+	"subgraph", SUBGRAPH;+	"node", NODE;+	"edge", EDGE;+      ];+    fun s -> let s = String.lowercase s in Hashtbl.find h s+++# 25 "src/dot_lexer.ml"+let __ocaml_lex_tables = {+  Lexing.lex_base = +   "\000\000\238\255\239\255\240\255\241\255\078\000\088\000\098\000\+    \176\000\245\255\246\255\247\255\248\255\249\255\250\255\251\255\+    \252\255\114\000\001\000\005\000\254\255\002\000\253\255\191\000\+    \244\255\211\000\221\000\157\000\252\255\253\255\002\000\255\255\+    \254\255\032\000\252\255\253\255\254\255\255\255\054\000\253\255\+    \254\255\015\000\255\255";+  Lexing.lex_backtrk = +   "\255\255\255\255\255\255\255\255\255\255\013\000\017\000\012\000\+    \017\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\017\000\017\000\000\000\255\255\255\255\255\255\255\255\+    \255\255\013\000\013\000\255\255\255\255\255\255\002\000\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\001\000\255\255";+  Lexing.lex_default = +   "\001\000\000\000\000\000\000\000\000\000\255\255\255\255\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\255\255\021\000\255\255\000\000\021\000\000\000\255\255\+    \000\000\255\255\255\255\029\000\000\000\000\000\255\255\000\000\+    \000\000\035\000\000\000\000\000\000\000\000\000\040\000\000\000\+    \000\000\255\255\000\000";+  Lexing.lex_trans = +   "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\019\000\019\000\020\000\020\000\019\000\019\000\019\000\+    \000\000\000\000\019\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \019\000\000\000\004\000\018\000\032\000\019\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\015\000\008\000\006\000\017\000\+    \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\+    \005\000\005\000\016\000\014\000\003\000\013\000\042\000\000\000\+    \000\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\010\000\036\000\009\000\037\000\007\000\+    \041\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\012\000\026\000\011\000\005\000\005\000\+    \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\+    \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\+    \025\000\025\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\022\000\000\000\000\000\000\000\+    \000\000\021\000\000\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\000\000\000\000\031\000\+    \000\000\007\000\000\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\024\000\023\000\000\000\+    \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\+    \005\000\005\000\000\000\000\000\000\000\000\000\024\000\025\000\+    \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\+    \025\000\030\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \002\000\255\255\255\255\025\000\025\000\025\000\025\000\025\000\+    \025\000\025\000\025\000\025\000\025\000\026\000\026\000\026\000\+    \026\000\026\000\026\000\026\000\026\000\026\000\026\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \034\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\039\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\028\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000";+  Lexing.lex_check = +   "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\000\000\000\000\018\000\021\000\000\000\019\000\019\000\+    \255\255\255\255\019\000\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \000\000\255\255\000\000\000\000\030\000\019\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\041\000\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\033\000\000\000\033\000\000\000\+    \038\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\005\000\000\000\005\000\005\000\+    \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\017\000\255\255\255\255\255\255\+    \255\255\017\000\255\255\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\255\255\255\255\027\000\+    \255\255\007\000\255\255\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\008\000\008\000\255\255\+    \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\+    \008\000\008\000\255\255\255\255\255\255\255\255\008\000\023\000\+    \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\+    \023\000\027\000\255\255\255\255\255\255\255\255\255\255\255\255\+    \000\000\018\000\021\000\025\000\025\000\025\000\025\000\025\000\+    \025\000\025\000\025\000\025\000\025\000\026\000\026\000\026\000\+    \026\000\026\000\026\000\026\000\026\000\026\000\026\000\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \033\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\038\000\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\027\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255";+  Lexing.lex_base_code = +   "";+  Lexing.lex_backtrk_code = +   "";+  Lexing.lex_default_code = +   "";+  Lexing.lex_trans_code = +   "";+  Lexing.lex_check_code = +   "";+  Lexing.lex_code = +   "";+}++let rec token lexbuf =+    __ocaml_lex_token_rec lexbuf 0+and __ocaml_lex_token_rec lexbuf __ocaml_lex_state =+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 52 "src/dot_lexer.mll"+      ( token lexbuf )+# 191 "src/dot_lexer.ml"++  | 1 ->+# 54 "src/dot_lexer.mll"+      ( token lexbuf )+# 196 "src/dot_lexer.ml"++  | 2 ->+# 56 "src/dot_lexer.mll"+      ( comment lexbuf; token lexbuf )+# 201 "src/dot_lexer.ml"++  | 3 ->+# 58 "src/dot_lexer.mll"+      ( COLON )+# 206 "src/dot_lexer.ml"++  | 4 ->+# 60 "src/dot_lexer.mll"+      ( COMMA )+# 211 "src/dot_lexer.ml"++  | 5 ->+# 62 "src/dot_lexer.mll"+      ( SEMICOLON )+# 216 "src/dot_lexer.ml"++  | 6 ->+# 64 "src/dot_lexer.mll"+      ( EQUAL )+# 221 "src/dot_lexer.ml"++  | 7 ->+# 66 "src/dot_lexer.mll"+      ( LBRA )+# 226 "src/dot_lexer.ml"++  | 8 ->+# 68 "src/dot_lexer.mll"+      ( RBRA )+# 231 "src/dot_lexer.ml"++  | 9 ->+# 70 "src/dot_lexer.mll"+      ( LSQ )+# 236 "src/dot_lexer.ml"++  | 10 ->+# 72 "src/dot_lexer.mll"+      ( RSQ )+# 241 "src/dot_lexer.ml"++  | 11 ->+# 74 "src/dot_lexer.mll"+      ( EDGEOP )+# 246 "src/dot_lexer.ml"++  | 12 ->+let+# 75 "src/dot_lexer.mll"+             s+# 252 "src/dot_lexer.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in+# 76 "src/dot_lexer.mll"+      ( try keyword s with Not_found -> ID (Ident s) )+# 256 "src/dot_lexer.ml"++  | 13 ->+let+# 77 "src/dot_lexer.mll"+              s+# 262 "src/dot_lexer.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in+# 78 "src/dot_lexer.mll"+      ( ID (Number s) )+# 266 "src/dot_lexer.ml"++  | 14 ->+# 80 "src/dot_lexer.mll"+      ( Buffer.clear string_buf; +	let s = string lexbuf in+	ID (String s) )+# 273 "src/dot_lexer.ml"++  | 15 ->+# 84 "src/dot_lexer.mll"+      ( Buffer.clear string_buf; +	html lexbuf; +	ID (Html (Buffer.contents string_buf)) )+# 280 "src/dot_lexer.ml"++  | 16 ->+# 88 "src/dot_lexer.mll"+      ( EOF )+# 285 "src/dot_lexer.ml"++  | 17 ->+let+# 89 "src/dot_lexer.mll"+         c+# 291 "src/dot_lexer.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 90 "src/dot_lexer.mll"+      ( failwith ("Dot_lexer: invalid character " ^ String.make 1 c) )+# 295 "src/dot_lexer.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_token_rec lexbuf __ocaml_lex_state++and string lexbuf =+    __ocaml_lex_string_rec lexbuf 27+and __ocaml_lex_string_rec lexbuf __ocaml_lex_state =+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 94 "src/dot_lexer.mll"+      ( Buffer.contents string_buf )+# 306 "src/dot_lexer.ml"++  | 1 ->+# 96 "src/dot_lexer.mll"+      ( Buffer.add_char string_buf '"';+	string lexbuf )+# 312 "src/dot_lexer.ml"++  | 2 ->+let+# 98 "src/dot_lexer.mll"+         c+# 318 "src/dot_lexer.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 99 "src/dot_lexer.mll"+      ( Buffer.add_char string_buf c;+	string lexbuf )+# 323 "src/dot_lexer.ml"++  | 3 ->+# 102 "src/dot_lexer.mll"+      ( failwith ("Dot_lexer: unterminated string literal") )+# 328 "src/dot_lexer.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec lexbuf __ocaml_lex_state++and html lexbuf =+    __ocaml_lex_html_rec lexbuf 33+and __ocaml_lex_html_rec lexbuf __ocaml_lex_state =+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 106 "src/dot_lexer.mll"+      ( () )+# 339 "src/dot_lexer.ml"++  | 1 ->+# 108 "src/dot_lexer.mll"+      ( Buffer.add_char string_buf '<'; html lexbuf;+	Buffer.add_char string_buf '>'; html lexbuf )+# 345 "src/dot_lexer.ml"++  | 2 ->+let+# 110 "src/dot_lexer.mll"+         c+# 351 "src/dot_lexer.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 111 "src/dot_lexer.mll"+      ( Buffer.add_char string_buf c;+	html lexbuf )+# 356 "src/dot_lexer.ml"++  | 3 ->+# 114 "src/dot_lexer.mll"+      ( failwith ("Dot_lexer: unterminated html literal") )+# 361 "src/dot_lexer.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_html_rec lexbuf __ocaml_lex_state++and comment lexbuf =+    __ocaml_lex_comment_rec lexbuf 38+and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state =+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 118 "src/dot_lexer.mll"+      ( () )+# 372 "src/dot_lexer.ml"++  | 1 ->+# 120 "src/dot_lexer.mll"+      ( comment lexbuf )+# 377 "src/dot_lexer.ml"++  | 2 ->+# 122 "src/dot_lexer.mll"+      ( failwith "Dot_lexer: unterminated comment" )+# 382 "src/dot_lexer.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf __ocaml_lex_state++;;+
+ external/ocamlgraph/src/dot_lexer.mll view
@@ -0,0 +1,122 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++{+  open Lexing+  open Dot_ast+  open Dot_parser++  let string_buf = Buffer.create 1024++  let keyword =+    let h = Hashtbl.create 17 in+    List.iter +      (fun (s,k) -> Hashtbl.add h s k)+      [+	"strict", STRICT;+	"graph", GRAPH;+	"digraph", DIGRAPH;+	"subgraph", SUBGRAPH;+	"node", NODE;+	"edge", EDGE;+      ];+    fun s -> let s = String.lowercase s in Hashtbl.find h s++}++let alpha = ['a'-'z' 'A'-'Z' '_']+let digit = ['0'-'9']+let ident = alpha (alpha | digit)*+let number = '-'? ('.'['0'-'9']+ | ['0'-'9']+('.'['0'-'9']*)? )++let space = [' ' '\t' '\r' '\n']+++rule token = parse+  | space+      { token lexbuf }+  | ('#' | "//") [^ '\n']* '\n'+      { token lexbuf }+  | "/*"+      { comment lexbuf; token lexbuf }+  | ":" +      { COLON }+  | "," +      { COMMA }+  | ";" +      { SEMICOLON }+  | "=" +      { EQUAL }+  | "{" +      { LBRA }+  | "}" +      { RBRA }+  | "[" +      { LSQ }+  | "]" +      { RSQ }+  | "--" | "->"+      { EDGEOP }+  | ident as s+      { try keyword s with Not_found -> ID (Ident s) }+  | number as s+      { ID (Number s) }+  | "\""+      { Buffer.clear string_buf; +	let s = string lexbuf in+	ID (String s) }+  | "<"+      { Buffer.clear string_buf; +	html lexbuf; +	ID (Html (Buffer.contents string_buf)) }+  | eof+      { EOF }+  | _ as c+      { failwith ("Dot_lexer: invalid character " ^ String.make 1 c) }++and string = parse+  | "\"" +      { Buffer.contents string_buf }+  | "\\" "\""+      { Buffer.add_char string_buf '"';+	string lexbuf }+  | _ as c+      { Buffer.add_char string_buf c;+	string lexbuf }+  | eof+      { failwith ("Dot_lexer: unterminated string literal") }++and html = parse+  | ">"+      { () }+  | "<"+      { Buffer.add_char string_buf '<'; html lexbuf;+	Buffer.add_char string_buf '>'; html lexbuf }+  | _ as c+      { Buffer.add_char string_buf c;+	html lexbuf }+  | eof+      { failwith ("Dot_lexer: unterminated html literal") }++and comment = parse+  | "*/"+      { () }+  | _ +      { comment lexbuf }+  | eof+      { failwith "Dot_lexer: unterminated comment" }
+ external/ocamlgraph/src/dot_parser.ml view
@@ -0,0 +1,551 @@+type token =+  | ID of (Dot_ast.id)+  | COLON+  | COMMA+  | EQUAL+  | SEMICOLON+  | EDGEOP+  | STRICT+  | GRAPH+  | DIGRAPH+  | LBRA+  | RBRA+  | LSQ+  | RSQ+  | NODE+  | EDGE+  | SUBGRAPH+  | EOF++open Parsing;;+# 23 "src/dot_parser.mly"+  open Dot_ast+  open Parsing++  let compass_pt = function+    | Ident "n" -> N+    | Ident "ne" -> Ne+    | Ident "e" -> E+    | Ident "se" -> Se+    | Ident "s" -> S+    | Ident "sw" -> Sw+    | Ident "w" -> W+    | Ident "nw" -> Nw+    | _ -> invalid_arg "compass_pt"++# 37 "src/dot_parser.ml"+let yytransl_const = [|+  258 (* COLON *);+  259 (* COMMA *);+  260 (* EQUAL *);+  261 (* SEMICOLON *);+  262 (* EDGEOP *);+  263 (* STRICT *);+  264 (* GRAPH *);+  265 (* DIGRAPH *);+  266 (* LBRA *);+  267 (* RBRA *);+  268 (* LSQ *);+  269 (* RSQ *);+  270 (* NODE *);+  271 (* EDGE *);+  272 (* SUBGRAPH *);+    0 (* EOF *);+    0|]++let yytransl_block = [|+  257 (* ID *);+    0|]++let yylhs = "\255\255\+\001\000\002\000\002\000\003\000\003\000\005\000\005\000\006\000\+\006\000\008\000\008\000\007\000\007\000\007\000\007\000\007\000\+\009\000\010\000\011\000\011\000\011\000\016\000\018\000\018\000\+\015\000\015\000\013\000\019\000\019\000\020\000\020\000\014\000\+\014\000\017\000\017\000\004\000\004\000\021\000\021\000\022\000\+\022\000\023\000\023\000\012\000\012\000\012\000\012\000\000\000"++let yylen = "\002\000\+\007\000\000\000\001\000\001\000\001\000\000\000\001\000\002\000\+\003\000\000\000\001\000\001\000\001\000\001\000\003\000\001\000\+\002\000\003\000\002\000\002\000\002\000\003\000\000\000\003\000\+\001\000\001\000\002\000\000\000\001\000\002\000\004\000\000\000\+\001\000\003\000\004\000\000\000\001\000\002\000\003\000\001\000\+\003\000\000\000\001\000\002\000\005\000\004\000\003\000\002\000"++let yydefred = "\000\000\+\000\000\000\000\003\000\048\000\000\000\004\000\005\000\000\000\+\037\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+\000\000\000\000\007\000\000\000\012\000\013\000\014\000\000\000\+\000\000\000\000\000\000\000\000\027\000\029\000\000\000\019\000\+\000\000\020\000\021\000\000\000\000\000\000\000\011\000\000\000\+\017\000\033\000\000\000\000\000\000\000\015\000\000\000\000\000\+\000\000\047\000\000\000\000\000\001\000\009\000\000\000\026\000\+\025\000\000\000\018\000\000\000\000\000\000\000\043\000\000\000\+\000\000\046\000\000\000\022\000\031\000\041\000\035\000\039\000\+\045\000\000\000\024\000"++let yydgoto = "\002\000\+\004\000\005\000\008\000\010\000\018\000\019\000\020\000\040\000\+\021\000\022\000\023\000\024\000\025\000\041\000\026\000\044\000\+\042\000\068\000\029\000\030\000\048\000\049\000\064\000"++let yysindex = "\009\000\+\024\255\000\000\000\000\000\000\000\255\000\000\000\000\031\255\+\000\000\029\255\131\255\011\255\033\255\131\255\033\255\033\255\+\051\255\040\255\000\000\048\255\000\000\000\000\000\000\000\000\+\033\255\050\255\057\255\067\255\000\000\000\000\069\255\000\000\+\062\255\000\000\000\000\070\255\131\255\091\000\000\000\131\255\+\000\000\000\000\018\255\033\255\090\255\000\000\099\255\081\255\+\101\255\000\000\131\255\095\255\000\000\000\000\107\255\000\000\+\000\000\110\255\000\000\114\255\117\255\033\255\000\000\069\255\+\111\255\000\000\018\255\000\000\000\000\000\000\000\000\000\000\+\000\000\110\255\000\000"++let yyrindex = "\000\000\+\074\255\000\000\000\000\000\000\000\000\000\000\000\000\116\255\+\000\000\000\000\118\255\006\255\000\000\118\255\000\000\000\000\+\000\000\000\000\000\000\120\255\000\000\000\000\000\000\049\255\+\061\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+\000\000\000\000\000\000\073\255\118\255\000\000\000\000\122\255\+\000\000\000\000\000\000\097\255\032\255\000\000\023\255\000\000\+\022\255\000\000\118\255\000\000\000\000\000\000\006\255\000\000\+\000\000\085\255\000\000\000\000\000\000\109\255\000\000\124\255\+\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+\000\000\085\255\000\000"++let yygindex = "\000\000\+\000\000\000\000\000\000\000\000\246\255\087\000\000\000\000\000\+\000\000\000\000\000\000\214\255\218\255\094\000\219\255\000\000\+\243\255\066\000\000\000\000\000\078\000\000\000\000\000"++let yytablesize = 147+let yytable = "\032\000\+\056\000\034\000\035\000\033\000\057\000\058\000\028\000\006\000\+\007\000\001\000\028\000\028\000\027\000\028\000\028\000\028\000\+\028\000\028\000\055\000\028\000\028\000\028\000\042\000\040\000\+\056\000\040\000\052\000\014\000\057\000\074\000\003\000\009\000\+\030\000\017\000\042\000\040\000\030\000\030\000\011\000\030\000\+\065\000\030\000\030\000\030\000\031\000\030\000\030\000\030\000\+\071\000\016\000\038\000\036\000\039\000\016\000\026\000\043\000\+\016\000\045\000\016\000\016\000\037\000\032\000\016\000\016\000\+\016\000\032\000\025\000\046\000\032\000\047\000\032\000\032\000\+\050\000\044\000\032\000\032\000\032\000\044\000\044\000\051\000\+\044\000\002\000\002\000\044\000\044\000\023\000\044\000\044\000\+\044\000\023\000\053\000\060\000\023\000\062\000\023\000\023\000\+\023\000\032\000\023\000\023\000\023\000\032\000\061\000\063\000\+\032\000\066\000\032\000\032\000\027\000\034\000\032\000\032\000\+\032\000\034\000\069\000\067\000\034\000\070\000\034\000\034\000\+\010\000\073\000\034\000\034\000\034\000\036\000\054\000\010\000\+\006\000\010\000\010\000\012\000\008\000\010\000\010\000\010\000\+\038\000\059\000\013\000\075\000\014\000\072\000\000\000\000\000\+\015\000\016\000\017\000"++let yycheck = "\013\000\+\043\000\015\000\016\000\014\000\043\000\043\000\001\001\008\001\+\009\001\001\000\005\001\006\001\002\001\008\001\004\001\010\001\+\011\001\012\001\001\001\014\001\015\001\016\001\001\001\001\001\+\067\000\003\001\037\000\010\001\067\000\067\000\007\001\001\001\+\001\001\016\001\013\001\013\001\005\001\006\001\010\001\008\001\+\051\000\010\001\011\001\012\001\012\001\014\001\015\001\016\001\+\062\000\001\001\011\001\001\001\005\001\005\001\006\001\006\001\+\008\001\001\001\010\001\011\001\010\001\001\001\014\001\015\001\+\016\001\005\001\006\001\001\001\008\001\001\001\010\001\011\001\+\011\001\001\001\014\001\015\001\016\001\005\001\006\001\010\001\+\008\001\008\001\009\001\011\001\012\001\001\001\014\001\015\001\+\016\001\005\001\000\000\002\001\008\001\013\001\010\001\011\001\+\012\001\001\001\014\001\015\001\016\001\005\001\004\001\003\001\+\008\001\011\001\010\001\011\001\002\001\001\001\014\001\015\001\+\016\001\005\001\001\001\006\001\008\001\001\001\010\001\011\001\+\001\001\011\001\014\001\015\001\016\001\010\001\040\000\008\001\+\011\001\010\001\011\001\001\001\011\001\014\001\015\001\016\001\+\013\001\044\000\008\001\074\000\010\001\064\000\255\255\255\255\+\014\001\015\001\016\001"++let yynames_const = "\+  COLON\000\+  COMMA\000\+  EQUAL\000\+  SEMICOLON\000\+  EDGEOP\000\+  STRICT\000\+  GRAPH\000\+  DIGRAPH\000\+  LBRA\000\+  RBRA\000\+  LSQ\000\+  RSQ\000\+  NODE\000\+  EDGE\000\+  SUBGRAPH\000\+  EOF\000\+  "++let yynames_block = "\+  ID\000\+  "++let yyact = [|+  (fun _ -> failwith "parser")+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 6 : 'strict_opt) in+    let _2 = (Parsing.peek_val __caml_parser_env 5 : 'graph_or_digraph) in+    let _3 = (Parsing.peek_val __caml_parser_env 4 : 'id_opt) in+    let _5 = (Parsing.peek_val __caml_parser_env 2 : 'stmt_list) in+    Obj.repr(+# 49 "src/dot_parser.mly"+    ( { strict = _1; digraph = _2; id = _3; stmts = _5 } )+# 199 "src/dot_parser.ml"+               : Dot_ast.file))+; (fun __caml_parser_env ->+    Obj.repr(+# 53 "src/dot_parser.mly"+                ( false )+# 205 "src/dot_parser.ml"+               : 'strict_opt))+; (fun __caml_parser_env ->+    Obj.repr(+# 54 "src/dot_parser.mly"+                ( true )+# 211 "src/dot_parser.ml"+               : 'strict_opt))+; (fun __caml_parser_env ->+    Obj.repr(+# 58 "src/dot_parser.mly"+          ( false )+# 217 "src/dot_parser.ml"+               : 'graph_or_digraph))+; (fun __caml_parser_env ->+    Obj.repr(+# 59 "src/dot_parser.mly"+          ( true )+# 223 "src/dot_parser.ml"+               : 'graph_or_digraph))+; (fun __caml_parser_env ->+    Obj.repr(+# 63 "src/dot_parser.mly"+                ( [] )+# 229 "src/dot_parser.ml"+               : 'stmt_list))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'list1_stmt) in+    Obj.repr(+# 64 "src/dot_parser.mly"+                ( _1 )+# 236 "src/dot_parser.ml"+               : 'stmt_list))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 1 : 'stmt) in+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'semicolon_opt) in+    Obj.repr(+# 68 "src/dot_parser.mly"+                     ( [_1] )+# 244 "src/dot_parser.ml"+               : 'list1_stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 2 : 'stmt) in+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'semicolon_opt) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : 'list1_stmt) in+    Obj.repr(+# 69 "src/dot_parser.mly"+                                ( _1 :: _3 )+# 253 "src/dot_parser.ml"+               : 'list1_stmt))+; (fun __caml_parser_env ->+    Obj.repr(+# 73 "src/dot_parser.mly"+                ( () )+# 259 "src/dot_parser.ml"+               : 'semicolon_opt))+; (fun __caml_parser_env ->+    Obj.repr(+# 74 "src/dot_parser.mly"+                ( () )+# 265 "src/dot_parser.ml"+               : 'semicolon_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'node_stmt) in+    Obj.repr(+# 78 "src/dot_parser.mly"+            ( _1 )+# 272 "src/dot_parser.ml"+               : 'stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'edge_stmt) in+    Obj.repr(+# 79 "src/dot_parser.mly"+            ( _1 )+# 279 "src/dot_parser.ml"+               : 'stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'attr_stmt) in+    Obj.repr(+# 80 "src/dot_parser.mly"+            ( _1 )+# 286 "src/dot_parser.ml"+               : 'stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 2 : Dot_ast.id) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 81 "src/dot_parser.mly"+              ( Equal (_1, _3) )+# 294 "src/dot_parser.ml"+               : 'stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'subgraph) in+    Obj.repr(+# 82 "src/dot_parser.mly"+            ( Subgraph _1 )+# 301 "src/dot_parser.ml"+               : 'stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 1 : 'node_id) in+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list_opt) in+    Obj.repr(+# 86 "src/dot_parser.mly"+                        ( Node_stmt (_1, _2) )+# 309 "src/dot_parser.ml"+               : 'node_stmt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 2 : 'node) in+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'edge_rhs) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list_opt) in+    Obj.repr(+# 90 "src/dot_parser.mly"+                              ( Edge_stmt (_1, _2, _3) )+# 318 "src/dot_parser.ml"+               : 'edge_stmt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list) in+    Obj.repr(+# 94 "src/dot_parser.mly"+                  ( Attr_graph _2 )+# 325 "src/dot_parser.ml"+               : 'attr_stmt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list) in+    Obj.repr(+# 95 "src/dot_parser.mly"+                  ( Attr_node _2 )+# 332 "src/dot_parser.ml"+               : 'attr_stmt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list) in+    Obj.repr(+# 96 "src/dot_parser.mly"+                  ( Attr_edge _2 )+# 339 "src/dot_parser.ml"+               : 'attr_stmt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'node) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : 'edge_rhs_opt) in+    Obj.repr(+# 100 "src/dot_parser.mly"+                           ( _2 :: _3 )+# 347 "src/dot_parser.ml"+               : 'edge_rhs))+; (fun __caml_parser_env ->+    Obj.repr(+# 104 "src/dot_parser.mly"+                ( [] )+# 353 "src/dot_parser.ml"+               : 'edge_rhs_opt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'node) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : 'edge_rhs_opt) in+    Obj.repr(+# 105 "src/dot_parser.mly"+                           ( _2 :: _3 )+# 361 "src/dot_parser.ml"+               : 'edge_rhs_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'node_id) in+    Obj.repr(+# 109 "src/dot_parser.mly"+           ( NodeId _1 )+# 368 "src/dot_parser.ml"+               : 'node))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'subgraph) in+    Obj.repr(+# 110 "src/dot_parser.mly"+           ( NodeSub _1 )+# 375 "src/dot_parser.ml"+               : 'node))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 1 : Dot_ast.id) in+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'port_opt) in+    Obj.repr(+# 114 "src/dot_parser.mly"+              ( _1, _2 )+# 383 "src/dot_parser.ml"+               : 'node_id))+; (fun __caml_parser_env ->+    Obj.repr(+# 118 "src/dot_parser.mly"+                ( None )+# 389 "src/dot_parser.ml"+               : 'port_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'port) in+    Obj.repr(+# 119 "src/dot_parser.mly"+                ( Some _1 )+# 396 "src/dot_parser.ml"+               : 'port_opt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 123 "src/dot_parser.mly"+           ( try PortC (compass_pt _2)+             with Invalid_argument _ -> PortId (_2, None) )+# 404 "src/dot_parser.ml"+               : 'port))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 2 : Dot_ast.id) in+    let _4 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 126 "src/dot_parser.mly"+      ( let cp = +  	  try compass_pt _4 with Invalid_argument _ -> raise Parse_error +	in+	PortId (_2, Some cp) )+# 415 "src/dot_parser.ml"+               : 'port))+; (fun __caml_parser_env ->+    Obj.repr(+# 133 "src/dot_parser.mly"+                ( [] )+# 421 "src/dot_parser.ml"+               : 'attr_list_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list) in+    Obj.repr(+# 134 "src/dot_parser.mly"+               ( _1 )+# 428 "src/dot_parser.ml"+               : 'attr_list_opt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'a_list) in+    Obj.repr(+# 138 "src/dot_parser.mly"+                 ( [_2] )+# 435 "src/dot_parser.ml"+               : 'attr_list))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 2 : 'a_list) in+    let _4 = (Parsing.peek_val __caml_parser_env 0 : 'attr_list) in+    Obj.repr(+# 139 "src/dot_parser.mly"+                           ( _2 :: _4 )+# 443 "src/dot_parser.ml"+               : 'attr_list))+; (fun __caml_parser_env ->+    Obj.repr(+# 143 "src/dot_parser.mly"+                ( None )+# 449 "src/dot_parser.ml"+               : 'id_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 144 "src/dot_parser.mly"+                ( Some _1 )+# 456 "src/dot_parser.ml"+               : 'id_opt))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 1 : 'equality) in+    let _2 = (Parsing.peek_val __caml_parser_env 0 : 'comma_opt) in+    Obj.repr(+# 148 "src/dot_parser.mly"+                     ( [_1] )+# 464 "src/dot_parser.ml"+               : 'a_list))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 2 : 'equality) in+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'comma_opt) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : 'a_list) in+    Obj.repr(+# 149 "src/dot_parser.mly"+                            ( _1 :: _3 )+# 473 "src/dot_parser.ml"+               : 'a_list))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 153 "src/dot_parser.mly"+     ( _1, None )+# 480 "src/dot_parser.ml"+               : 'equality))+; (fun __caml_parser_env ->+    let _1 = (Parsing.peek_val __caml_parser_env 2 : Dot_ast.id) in+    let _3 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 154 "src/dot_parser.mly"+              ( _1, Some _3 )+# 488 "src/dot_parser.ml"+               : 'equality))+; (fun __caml_parser_env ->+    Obj.repr(+# 158 "src/dot_parser.mly"+                ( () )+# 494 "src/dot_parser.ml"+               : 'comma_opt))+; (fun __caml_parser_env ->+    Obj.repr(+# 159 "src/dot_parser.mly"+                ( () )+# 500 "src/dot_parser.ml"+               : 'comma_opt))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 0 : Dot_ast.id) in+    Obj.repr(+# 164 "src/dot_parser.mly"+              ( SubgraphId _2 )+# 507 "src/dot_parser.ml"+               : 'subgraph))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 3 : Dot_ast.id) in+    let _4 = (Parsing.peek_val __caml_parser_env 1 : 'stmt_list) in+    Obj.repr(+# 165 "src/dot_parser.mly"+                                  ( SubgraphDef (Some _2, _4) )+# 515 "src/dot_parser.ml"+               : 'subgraph))+; (fun __caml_parser_env ->+    let _3 = (Parsing.peek_val __caml_parser_env 1 : 'stmt_list) in+    Obj.repr(+# 166 "src/dot_parser.mly"+                               ( SubgraphDef (None, _3) )+# 522 "src/dot_parser.ml"+               : 'subgraph))+; (fun __caml_parser_env ->+    let _2 = (Parsing.peek_val __caml_parser_env 1 : 'stmt_list) in+    Obj.repr(+# 167 "src/dot_parser.mly"+                      ( SubgraphDef (None, _2) )+# 529 "src/dot_parser.ml"+               : 'subgraph))+(* Entry file *)+; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))+|]+let yytables =+  { Parsing.actions=yyact;+    Parsing.transl_const=yytransl_const;+    Parsing.transl_block=yytransl_block;+    Parsing.lhs=yylhs;+    Parsing.len=yylen;+    Parsing.defred=yydefred;+    Parsing.dgoto=yydgoto;+    Parsing.sindex=yysindex;+    Parsing.rindex=yyrindex;+    Parsing.gindex=yygindex;+    Parsing.tablesize=yytablesize;+    Parsing.table=yytable;+    Parsing.check=yycheck;+    Parsing.error_function=parse_error;+    Parsing.names_const=yynames_const;+    Parsing.names_block=yynames_block }+let file (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =+   (Parsing.yyparse yytables 1 lexfun lexbuf : Dot_ast.file)
+ external/ocamlgraph/src/dot_parser.mli view
@@ -0,0 +1,21 @@+type token =+  | ID of (Dot_ast.id)+  | COLON+  | COMMA+  | EQUAL+  | SEMICOLON+  | EDGEOP+  | STRICT+  | GRAPH+  | DIGRAPH+  | LBRA+  | RBRA+  | LSQ+  | RSQ+  | NODE+  | EDGE+  | SUBGRAPH+  | EOF++val file :+  (Lexing.lexbuf  -> token) -> Lexing.lexbuf -> Dot_ast.file
+ external/ocamlgraph/src/dot_parser.mly view
@@ -0,0 +1,168 @@+/**************************************************************************/+/*                                                                        */+/*  Ocamlgraph: a generic graph library for OCaml                         */+/*  Copyright (C) 2004-2007                                               */+/*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        */+/*                                                                        */+/*  This software is free software; you can redistribute it and/or        */+/*  modify it under the terms of the GNU Library General Public           */+/*  License version 2, with the special exception on linking              */+/*  described in file LICENSE.                                            */+/*                                                                        */+/*  This software is distributed in the hope that it will be useful,      */+/*  but WITHOUT ANY WARRANTY; without even the implied warranty of        */+/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  */+/*                                                                        */+/**************************************************************************/++/* $Id:$ */++/* DOT parser, following http://www.graphviz.org/doc/info/lang.html */++%{+  open Dot_ast+  open Parsing++  let compass_pt = function+    | Ident "n" -> N+    | Ident "ne" -> Ne+    | Ident "e" -> E+    | Ident "se" -> Se+    | Ident "s" -> S+    | Ident "sw" -> Sw+    | Ident "w" -> W+    | Ident "nw" -> Nw+    | _ -> invalid_arg "compass_pt"++%} ++%token <Dot_ast.id> ID+%token COLON COMMA EQUAL SEMICOLON EDGEOP+%token STRICT GRAPH DIGRAPH LBRA RBRA LSQ RSQ NODE EDGE SUBGRAPH EOF++%type <Dot_ast.file> file+%start file+%%++file: +| strict_opt graph_or_digraph id_opt LBRA stmt_list RBRA EOF+    { { strict = $1; digraph = $2; id = $3; stmts = $5 } }+;++strict_opt:+| /* epsilon */ { false }+| STRICT        { true }+;++graph_or_digraph:+| GRAPH   { false }+| DIGRAPH { true }+;++stmt_list:+| /* epsilon */ { [] }+| list1_stmt    { $1 }+;++list1_stmt:+| stmt semicolon_opt { [$1] }+| stmt semicolon_opt list1_stmt { $1 :: $3 }+;++semicolon_opt:+| /* epsilon */ { () }+| SEMICOLON     { () }+;++stmt:+| node_stmt { $1 }+| edge_stmt { $1 }+| attr_stmt { $1 }+| ID EQUAL ID { Equal ($1, $3) }+| subgraph  { Subgraph $1 }+;++node_stmt:+| node_id attr_list_opt { Node_stmt ($1, $2) }+;++edge_stmt:+| node edge_rhs attr_list_opt { Edge_stmt ($1, $2, $3) }+;++attr_stmt:+| GRAPH attr_list { Attr_graph $2 }+| NODE  attr_list { Attr_node $2 }+| EDGE  attr_list { Attr_edge $2 }+;++edge_rhs:+| EDGEOP node edge_rhs_opt { $2 :: $3 }+;++edge_rhs_opt:+| /* epsilon */ { [] }+| EDGEOP node edge_rhs_opt { $2 :: $3 }+;++node:+| node_id  { NodeId $1 }+| subgraph { NodeSub $1 }+; ++node_id:+| ID port_opt { $1, $2 }+;++port_opt:+| /* epsilon */ { None }+| port          { Some $1 }+;++port:+| COLON ID { try PortC (compass_pt $2)+             with Invalid_argument _ -> PortId ($2, None) }+| COLON ID COLON ID +      { let cp = +  	  try compass_pt $4 with Invalid_argument _ -> raise Parse_error +	in+	PortId ($2, Some cp) }+;++attr_list_opt:+| /* epsilon */ { [] }+| attr_list    { $1 }+;++attr_list:+| LSQ a_list RSQ { [$2] }+| LSQ a_list RSQ attr_list { $2 :: $4 }+;++id_opt:+| /* epsilon */ { None }+| ID            { Some $1 }+;++a_list:+| equality comma_opt { [$1] }+| equality comma_opt a_list { $1 :: $3 }+;++equality:+| ID { $1, None }+| ID EQUAL ID { $1, Some $3 }+;++comma_opt:+| /* epsilon */ { () }+| COMMA         { () }+;++/* one shift/reduce conflict here, which is ok */+subgraph:+| SUBGRAPH ID { SubgraphId $2 }+| SUBGRAPH ID LBRA stmt_list RBRA { SubgraphDef (Some $2, $4) }+| SUBGRAPH LBRA stmt_list RBRA { SubgraphDef (None, $3) }+| LBRA stmt_list RBRA { SubgraphDef (None, $2) }+;
+ external/ocamlgraph/src/flow.ml view
@@ -0,0 +1,329 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++module type FLOW = sig+  type label+  type t+  val max_capacity : label -> t+  val min_capacity : label -> t+  val flow : label -> t+  val add : t -> t -> t+  val sub : t -> t -> t+  val zero : t+  val compare : t -> t -> int+end++module type G_GOLDBERG = sig+  type t+  module V : Sig.COMPARABLE+  module E : Sig.EDGE with type vertex = V.t+  val nb_vertex : t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_edges_e : (E.t -> unit) -> t -> unit+  val fold_succ_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val fold_pred_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++module Goldberg(G: G_GOLDBERG)(F: FLOW with type label = G.E.label) = +struct+  +  module V = Hashtbl.Make(G.V)+  module E = Hashtbl.Make(Util.HTProduct(G.V)(G.V)) +  module Se = Set.Make(G.E)+  module Sv = Set.Make(G.V)++  let excedents = V.create 997+  let hauteur = V.create 997+  let flot = E.create 997++  let fold_booleen f = List.fold_left (fun r x->(f x) or r) false++  let capacite_restante g e = +    F.sub (F.max_capacity (G.E.label e)) (E.find flot (G.E.src e, G.E.dst e))++  let reste_excedent x = F.compare (V.find excedents x) F.zero > 0 +      +  let flux_et_reflux g x = +    let s = +      G.fold_succ_e +	(fun e s->+	   if F.compare +	     (capacite_restante g e) (F.min_capacity (G.E.label e))+	     > 0 +	   then e::s else s) +	g x [] +    in +    G.fold_pred_e +      (fun e s -> +	 if F.compare +	   (E.find flot (G.E.src e, G.E.dst e)) (F.min_capacity (G.E.label e))+	   > 0 +	 then (G.E.create (G.E.dst e) (G.E.label e) (G.E.src e))::s else s)+      g x s++  let pousser g e l =+    let x, y = G.E.src e, G.E.dst e in+    let ex = V.find excedents x in+    let cxy = capacite_restante g e in+    if F.compare ex F.zero > 0 &&+      F.compare cxy (F.min_capacity (G.E.label e)) > 0 &&+      V.find hauteur x = (V.find hauteur y + 1)+    then+      let d = if F.compare ex cxy < 0 then ex else cxy in+      let fxy = E.find flot (x,y) in+      let ex = V.find excedents x in+      let ey = V.find excedents y in+      E.replace flot (x,y) (F.add fxy d);+      E.replace flot (y,x) (F.sub F.zero (F.add fxy d));+      V.replace excedents x (F.sub ex d);+      V.replace excedents y (F.add ey d);+      if reste_excedent x then l:=Sv.add x !l;+      if reste_excedent y then l:=Sv.add y !l;+      true+    else +      (if F.compare ex F.zero > 0 then l:=Sv.add x !l; +       false)++  let elever g p x = +    let u = flux_et_reflux g x in+    reste_excedent x+    && not (G.V.equal x p) +    && +    List.for_all +      (fun e -> (V.find hauteur (G.E.src e)) <= (V.find hauteur (G.E.dst e))) u+    && +    (let min = +       List.fold_left (fun m e -> min (V.find hauteur (G.E.dst e)) m) max_int u+     in+     V.replace hauteur x (1+min); +     true)++  let init_preflot g s p = +    G.iter_vertex (fun x -> V.add excedents x F.zero; V.add hauteur x 0) g;+    G.iter_edges_e +      (fun e -> +	 let x,y = G.E.src e, G.E.dst e in +	 E.add flot (x,y) (F.flow (G.E.label e)); +	 E.add flot (y,x) (F.sub F.zero (F.flow (G.E.label e))))+      g;+    V.add hauteur s (G.nb_vertex g);+    G.fold_succ_e +      (fun e l -> +	 let y = G.E.dst e in+	 let c = F.max_capacity (G.E.label e) in +	 E.add flot (s,y) c;+	 E.add flot (y,s) (F.sub F.zero c);+	 V.add excedents y c;+	 y::l)+      g s []+      +  let maxflow g s p = +    let push_and_pull l x = +      G.fold_succ_e (fun e r->pousser g e l or r) g x false+      or G.fold_pred_e (fun e r->pousser g e l or r) g x false+    in+    let todo = ref (init_preflot g s p) in+    while +      (fold_booleen (elever g p) !todo) or +      (let l = ref Sv.empty in +       let r = fold_booleen (push_and_pull l) !todo in+       todo:=Sv.elements !l; r)+    do () done;+    let flot_max = +      G.fold_pred_e (fun e f -> F.add (E.find flot (G.E.src e,p)) f) g p F.zero+    in+    let flot_init = +      G.fold_pred_e (fun e f -> F.add (F.flow (G.E.label e)) f) g p F.zero+    in+    let f e = +      let x,y = G.E.src e, G.E.dst e in +      try E.find flot (x,y) +      with Not_found -> F.flow (G.E.label e)+    in+    f, F.sub flot_max flot_init+end++(*****************************************************************************)++module type G_FORD_FULKERSON = sig+  type t+  module V : Sig.HASHABLE+  module E : sig+    type t+    type label+    val src : t -> V.t+    val dst : t -> V.t+    val label : t -> label+  end+  val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit+  val iter_pred_e : (E.t -> unit) -> t -> V.t -> unit+end++module Ford_Fulkerson+  (G: G_FORD_FULKERSON)+  (F: FLOW with type label = G.E.label) =+struct++  (* redefinition of F *)+  module F = struct+    include F++    type u =+      | Flow of F.t+      | Infinity++    let min x y = match x, y with+      | Flow _, Infinity -> x+      | Flow fx, Flow fy when F.compare fx fy < 0 -> x+      | (Infinity, _) | (Flow _, Flow _) -> y+  end++  module Mark = struct+    module H = Hashtbl.Make(G.V)+    type mark = Plus | Minus++    let marked = H.create 997+    let unvisited = Queue.create ()++    let clear () = H.clear marked++    let mem = H.mem marked++    let set s e tag = +      assert (not (mem s));+      H.add marked s (e, tag);+      Queue.add s unvisited++    let get s : G.E.t * mark =+      let e, tag = H.find marked s in+      (match e with None -> assert false | Some e -> e), tag++    exception Empty = Queue.Empty+    let next () = Queue.pop unvisited+  end++  module Result = struct+    module H = +      Hashtbl.Make+	(struct+	   open G+	   type t = E.t+	   module U = Util.HTProduct(V)(V)+	   let equal e1 e2 = U.equal (E.src e1, E.dst e1) (E.src e2, E.dst e2)+	   let hash e = U.hash (E.src e, E.dst e)+	 end)++    let create () = H.create 997++    let find = H.find++    let flow r e = +      try+	find r e+      with Not_found ->+	let f = F.flow (G.E.label e) in+	H.add r e f;+	f++    let change op r e f =+      try+	H.replace r e (op (find r e) f);+      with Not_found ->+	assert false++    let grow = change F.add+    let reduce = change F.sub+  end++  let is_full r e =+    F.compare (F.max_capacity (G.E.label e)) (Result.flow r e) = 0++  let is_empty r e =+    F.compare (F.min_capacity (G.E.label e)) (Result.flow r e) = 0++  let set_flow r s t a =+    let rec loop t =+      if not (G.V.equal s t) then+	let e, tag = Mark.get t in+	match tag with +	  | Mark.Plus -> Result.grow r e a; loop (G.E.src e)+	  | Mark.Minus -> Result.reduce r e a; loop (G.E.dst e)+    in+    loop t++  let grow_flow r s t a =+    let rec loop u b =+      if G.V.equal s u then begin+	match b with+	  | F.Infinity -> (* source = destination *)+	      assert (G.V.equal s t); +	      a+	  | F.Flow f ->+	      set_flow r s t f;+	      F.add a f+      end else+	let e, tag = Mark.get u in+	let l = G.E.label e in+	match tag with+	  | Mark.Plus -> +	      loop +	        (G.E.src e) +	        (F.min b (F.Flow (F.sub (F.max_capacity l) (Result.flow r e))))+	  | Mark.Minus -> +	      loop +	        (G.E.dst e) +	        (F.min b (F.Flow (F.sub (Result.flow r e) (F.min_capacity l))))+    in+    loop t F.Infinity++  let maxflow g s t =+    let r = Result.create () in+    let succ s = +      G.iter_succ_e+	(fun e ->+	   assert (G.V.equal s (G.E.src e));+	   let t = G.E.dst e in+	   if not (Mark.mem t || is_full r e) then +	     Mark.set t (Some e) Mark.Plus)+	g s+    in+    let pred s = +      G.iter_pred_e+	(fun e ->+	   assert (G.V.equal s (G.E.dst e));+	   let t = G.E.src e in+	   if not (Mark.mem t || is_empty r e) then+	     Mark.set t (Some e) Mark.Minus)+	g s+    in+    let internal_loop a =+      try+	while true do let s = Mark.next () in succ s; pred s done;+	assert false+      with Mark.Empty ->+	if Mark.mem t then grow_flow r s t a else a+    in+    let rec external_loop a =+      Mark.clear ();+      Mark.set s None Mark.Plus;+      let a' = internal_loop a in+      if a = a' then a else external_loop a'+    in+    let a = external_loop F.zero in+    (fun e -> try Result.find r e with Not_found -> F.flow (G.E.label e)), a++end
+ external/ocamlgraph/src/flow.mli view
@@ -0,0 +1,107 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(** Algorithms on flows ++    The following flow algorithms only apply to networks, that are+    directed graphs together with a source (a 0 in-degree vertex) and a +    terminal (a 0 out-degree vertex). *)++(** {1 Maximum flow algorithms} *)++(** Signature for edges' flow *)+module type FLOW = sig+  type label+  type t++  (** maximum and minimum capacities for a label on an edge *)++  val max_capacity : label -> t+  val min_capacity : label -> t++  (** current flow for a label on an edge *)++  val flow : label -> t++  (** [+] and [-] on flows. *)++  val add : t -> t -> t+  val sub : t -> t -> t++  (** neutral element for [add] and [sub]. *)++  val zero : t++  (** a total ordering over flows *)++  val compare : t -> t -> int++end++(**  {2 Goldberg maximal flow algorithm} *)++(** Minimal digraph signature for Goldberg *)+module type G_GOLDBERG = sig+  type t+  module V : Sig.COMPARABLE+  module E : Sig.EDGE with type vertex = V.t+  val nb_vertex : t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_edges_e : (E.t -> unit) -> t -> unit+  val fold_succ_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val fold_pred_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++module Goldberg(G: G_GOLDBERG)(F: FLOW with type label = G.E.label) : +sig+      +  val maxflow : G.t -> G.V.t -> G.V.t -> (G.E.t -> F.t) * F.t+    (** [maxflow g v1 v2] searchs the maximal flow from source [v1] to+      terminal [v2] using the Goldberg algorithm. It returns the new+      flows on each edges and the growth of the flow. *)++end++(**  {2 Ford-Fulkerson maximal flow algorithm} *)++(** Minimal digraph signature for Ford-Fulkerson *)+module type G_FORD_FULKERSON = sig+  type t+  module V : Sig.HASHABLE+  module E : sig+    type t+    type label+    val src : t -> V.t+    val dst : t -> V.t+    val label : t -> label+  end+  val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit+  val iter_pred_e : (E.t -> unit) -> t -> V.t -> unit+end++module Ford_Fulkerson+  (G: G_FORD_FULKERSON)+  (F: FLOW with type label = G.E.label) :+sig++  val maxflow : G.t -> G.V.t -> G.V.t -> (G.E.t -> F.t) * F.t+      (** [maxflow g v1 v2] searchs the maximal flow from source [v1]+	to terminal [v2] using the Ford-Fulkerson algorithm. It+	returns the new flows on each edges and the growth of the+	flow. *)++end
+ external/ocamlgraph/src/gcoloring.ml view
@@ -0,0 +1,123 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++exception NoColoring++module type GM = sig+  type t+  val nb_vertex : t -> int+  module V : Sig.COMPARABLE+  val out_degree : t -> V.t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  module Mark : sig+    val get : V.t -> int+    val set : V.t -> int -> unit+  end+end++(** Graph coloring with marking. +    Only applies to imperative graphs with marks. *)+module Mark(G : GM) = struct++  module Bfs = Traverse.Bfs(G)+  +  let coloring g k =+    (* first step: we eliminate vertices with less than [k] successors *)+    let stack = Stack.create () in+    let nb_to_color = ref (G.nb_vertex g) in+    let count = ref 1 in+    while !count > 0 do +      count := 0;+      let erase v = incr count; G.Mark.set v (k+1); Stack.push v stack in+      G.iter_vertex +	(fun v -> if G.Mark.get v = 0 && G.out_degree g v < k then erase v) +	g;+      (*Format.printf "eliminating %d nodes@." !count;*)+      nb_to_color := !nb_to_color - !count+    done;+    (* second step: we k-color the remaining of the graph *)+    (* [try_color v i] tries to assign color [i] to vertex [v] *)+    let try_color v i =+      G.Mark.set v i;+      G.iter_succ (fun w -> if G.Mark.get w = i then raise NoColoring) g v+    in+    let uncolor v = G.Mark.set v 0 in+    if !nb_to_color > 0 then begin+      let rec iterate iter =+	let v = Bfs.get iter in+	let m = G.Mark.get v in+	if m > 0 then+	  iterate (Bfs.step iter)+	else begin+	  for i = 1 to k do+	    try try_color v i; iterate (Bfs.step iter)+	    with NoColoring -> ()+	  done;+	  uncolor v;+	  raise NoColoring+	end+      in+      try iterate (Bfs.start g) with Exit -> ()+    end;+    (* third step: we color the eliminated vertices, in reverse order *)+    Stack.iter+      (fun v -> +	 try +	   for i = 1 to k do +	     try try_color v i; raise Exit with NoColoring -> ()+	   done;+	   raise NoColoring (* it may still fail on a self edge v->v *)+	 with Exit -> ())+      stack++end++(** Graph coloring for graphs without marks: we use an external hashtbl *)++module type G = sig+  type t+  val nb_vertex : t -> int+  module V : Sig.COMPARABLE+  val out_degree : t -> V.t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++module Make(G: G) = struct++  module H = Hashtbl.Make(G.V)++  let coloring g k =+    let h = H.create 97 in+    let module M = +      Mark(struct+	     include G+	     module Mark = struct+	       let get v = try H.find h v with Not_found -> 0+	       let set v n = H.replace h v n+	     end+	   end )+    in+    M.coloring g k;+    h++end
+ external/ocamlgraph/src/gcoloring.mli view
@@ -0,0 +1,79 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(** k-coloring of undirected graphs.++    A k-coloring of a graph g is a mapping c from nodes to \{1,...,k\} such+    that c(u)<>c(v) for any edge u-v in g. *)++exception NoColoring++(** Graph coloring for graph with integer marks. *)++module type GM = sig+  type t+  val nb_vertex : t -> int+  module V : Sig.COMPARABLE+  val out_degree : t -> V.t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  module Mark : sig+    val get : V.t -> int+    val set : V.t -> int -> unit+  end+end++module Mark(G : GM) : sig++  val coloring : G.t -> int -> unit+    (** [coloring g k] colors the nodes of graph [g] using k colors,+	assigning the marks integer values between 1 and k.+        raises [NoColoring] when there is no possible coloring.++        The graph marks may be partially set before starting; the meaning of+        initial values is as follows:+	- 0: a node to be colored+	- any value between 1 and k: a color already assigned+	- any value greater than k: a node to be ignored *)++end++(** Graph coloring for graphs without marks *)++module type G = sig+  type t+  val nb_vertex : t -> int+  module V : Sig.COMPARABLE+  val out_degree : t -> V.t -> int+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++module Make(G: G) : sig++  module H : Hashtbl.S with type key = G.V.t+    (** hash tables used to store the coloring *)++  val coloring : G.t -> int -> int H.t+    (** [coloring g k] colors the graph [g] with [k] colors and returns the+        coloring as a hash table mapping nodes to their colors. *)++end
+ external/ocamlgraph/src/gmap.ml view
@@ -0,0 +1,68 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: gmap.ml,v 1.1 2004-10-20 09:59:56 signoles Exp $ *)++module Vertex+  (G_Init : sig+     type t+     module V : Sig.HASHABLE+     val fold_vertex : (V.t -> 'a -> 'a) -> t -> 'a -> 'a+   end)+  (G_Dest : sig+     type t+     type vertex+     val empty : unit -> t+     val add_vertex : t -> vertex -> t+   end) =+struct+  +  module H = Hashtbl.Make(G_Init.V)+    +  let vertices = H.create 97++  let convert_vertex f x =+    try +      H.find vertices x+    with Not_found ->+      let x' = f x in+      H.add vertices x x';+      x'++  let map f g =+    H.clear vertices;+    G_Init.fold_vertex+      (fun x g -> G_Dest.add_vertex g (convert_vertex f x)) +      g (G_Dest.empty ())++end++module Edge+  (G_Init : sig+     type t+     module E : Sig.HASHABLE+     val fold_edges_e : (E.t -> 'a -> 'a) -> t -> 'a -> 'a+   end)+  (G_Dest : sig+     type t+     type edge+     val empty : unit -> t+     val add_edge_e : t -> edge -> t+   end) =+  Vertex+    (struct include G_Init module V = E let fold_vertex = fold_edges_e end)+    (struct include G_Dest type vertex = edge let add_vertex = add_edge_e end)
+ external/ocamlgraph/src/gmap.mli view
@@ -0,0 +1,60 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: gmap.mli,v 1.1 2004-10-20 09:59:56 signoles Exp $ *)++(** Graph mapping *)++module Vertex+  (G_Init : sig+     type t+     module V : Sig.HASHABLE+     val fold_vertex : (V.t -> 'a -> 'a) -> t -> 'a -> 'a+   end)+  (G_Dest : sig+     type t+     type vertex+     val empty : unit -> t+     val add_vertex : t -> vertex -> t+   end) :+sig++  val map : (G_Init.V.t -> G_Dest.vertex) -> G_Init.t -> G_Dest.t+    (** [map f g] applies [f] to each vertex of [g] and so builds a new graph+      based on [g] *)++end++module Edge+  (G_Init : sig+     type t+     module E : Sig.HASHABLE+     val fold_edges_e : (E.t -> 'a -> 'a) -> t -> 'a -> 'a+   end)+  (G_Dest : sig+     type t+     type edge+     val empty : unit -> t+     val add_edge_e : t -> edge -> t+   end) :+sig++  val map : (G_Init.E.t -> G_Dest.edge) -> G_Init.t -> G_Dest.t+    (** [map f g] applies [f] to each edge of [g] and so builds a new graph+      based on [g] *)++end
+ external/ocamlgraph/src/gml.ml view
@@ -0,0 +1,670 @@+# 20 "src/gml.mll"+  ++  open Lexing++  type value = +    | Int of int +    | Float of float+    | String of string+    | List of value_list++  and value_list = (string * value) list+++# 16 "src/gml.ml"+let __ocaml_lex_tables = {+  Lexing.lex_base = +   "\000\000\252\255\253\255\114\000\002\000\007\000\228\000\086\001\+    \252\255\253\255\200\001\009\000\014\000\058\002\002\000\251\255\+    \252\255\001\000\080\000\102\000\194\000\216\000\052\001\071\001\+    \253\255\006\000";+  Lexing.lex_backtrk = +   "\255\255\255\255\255\255\003\000\000\000\001\000\255\255\255\255\+    \255\255\255\255\003\000\000\000\001\000\255\255\255\255\255\255\+    \255\255\004\000\001\000\000\000\004\000\255\255\001\000\255\255\+    \255\255\255\255";+  Lexing.lex_default = +   "\001\000\000\000\000\000\255\255\255\255\255\255\255\255\008\000\+    \000\000\000\000\255\255\255\255\255\255\255\255\015\000\000\000\+    \000\000\025\000\255\255\255\255\255\255\255\255\255\255\255\255\+    \000\000\025\000";+  Lexing.lex_trans = +   "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\004\000\004\000\004\000\004\000\004\000\000\000\004\000\+    \005\000\005\000\011\000\011\000\005\000\000\000\011\000\012\000\+    \012\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\+    \004\000\000\000\004\000\024\000\017\000\000\000\000\000\005\000\+    \024\000\011\000\000\000\000\000\000\000\020\000\012\000\020\000\+    \018\000\000\000\019\000\019\000\019\000\019\000\019\000\019\000\+    \019\000\019\000\019\000\019\000\000\000\000\000\000\000\000\000\+    \000\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\000\000\000\000\016\000\000\000\000\000\+    \000\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\005\000\005\000\000\000\000\000\005\000\+    \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\+    \018\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\005\000\000\000\018\000\021\000\019\000\019\000\+    \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\+    \000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\005\000\005\000\000\000\+    \018\000\005\000\019\000\019\000\019\000\019\000\019\000\019\000\+    \019\000\019\000\019\000\019\000\000\000\000\000\000\000\000\000\+    \002\000\255\255\255\255\023\000\005\000\023\000\255\255\000\000\+    \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\+    \022\000\022\000\000\000\000\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\011\000\+    \011\000\000\000\000\000\011\000\022\000\022\000\022\000\022\000\+    \022\000\022\000\022\000\022\000\022\000\022\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\011\000\022\000\+    \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\+    \022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\000\000\000\000\009\000\000\000\000\000\000\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\012\000\012\000\000\000\000\000\012\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\012\000\012\000\000\000\000\000\012\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\255\255\000\000\+    \000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000";+  Lexing.lex_check = +   "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\000\000\000\000\004\000\004\000\000\000\255\255\004\000\+    \005\000\005\000\011\000\011\000\005\000\255\255\011\000\012\000\+    \012\000\255\255\255\255\012\000\255\255\255\255\255\255\255\255\+    \000\000\255\255\004\000\017\000\014\000\255\255\255\255\005\000\+    \025\000\011\000\255\255\255\255\255\255\014\000\012\000\014\000\+    \014\000\255\255\014\000\014\000\014\000\014\000\014\000\014\000\+    \014\000\014\000\014\000\014\000\255\255\255\255\255\255\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\255\255\255\255\014\000\255\255\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\003\000\003\000\255\255\255\255\003\000\+    \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\+    \018\000\018\000\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\003\000\255\255\019\000\018\000\019\000\019\000\+    \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\+    \255\255\255\255\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\255\255\255\255\255\255\+    \255\255\255\255\255\255\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\006\000\006\000\255\255\+    \020\000\006\000\020\000\020\000\020\000\020\000\020\000\020\000\+    \020\000\020\000\020\000\020\000\255\255\255\255\255\255\255\255\+    \000\000\017\000\014\000\021\000\006\000\021\000\025\000\255\255\+    \021\000\021\000\021\000\021\000\021\000\021\000\021\000\021\000\+    \021\000\021\000\255\255\255\255\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\255\255\+    \255\255\255\255\255\255\255\255\255\255\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\007\000\+    \007\000\255\255\255\255\007\000\022\000\022\000\022\000\022\000\+    \022\000\022\000\022\000\022\000\022\000\022\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\007\000\023\000\+    \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\+    \023\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\255\255\255\255\007\000\255\255\255\255\255\255\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\010\000\010\000\255\255\255\255\010\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \010\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\255\255\255\255\255\255\255\255\255\255\+    \255\255\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\013\000\013\000\255\255\255\255\013\000\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\007\000\255\255\+    \255\255\255\255\013\000\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\255\255\255\255\255\255\+    \255\255\255\255\255\255\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255";+  Lexing.lex_base_code = +   "\000\000\000\000\000\000\075\000\000\000\000\000\150\000\208\000\+    \000\000\000\000\027\001\000\000\000\000\102\001\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000";+  Lexing.lex_backtrk_code = +   "\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000";+  Lexing.lex_default_code = +   "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000";+  Lexing.lex_trans_code = +   "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\+    \001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000";+  Lexing.lex_check_code = +   "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\+    \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\+    \000\000\000\000\000\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\+    \003\000\003\000\003\000\003\000\003\000\003\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\255\255\255\255\255\255\255\255\255\255\255\255\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\+    \006\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\255\255\255\255\255\255\255\255\255\255\+    \255\255\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\+    \007\000\007\000\007\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\255\255\255\255\+    \255\255\255\255\255\255\255\255\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\+    \010\000\010\000\010\000\010\000\010\000\010\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\255\255\255\255\255\255\255\255\255\255\255\255\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\+    \013\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255";+  Lexing.lex_code = +   "\255\001\255\255\000\001\255";+}++let rec file lexbuf =+  lexbuf.Lexing.lex_mem <- Array.create 2 (-1) ;   __ocaml_lex_file_rec lexbuf 0+and __ocaml_lex_file_rec lexbuf __ocaml_lex_state =+  match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 45 "src/gml.mll"+      ( file lexbuf )+# 425 "src/gml.ml"++  | 1 ->+let+# 46 "src/gml.mll"+              key+# 431 "src/gml.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_mem.(0) in+# 47 "src/gml.mll"+      ( let v = value lexbuf in+	(key, v) :: file lexbuf )+# 436 "src/gml.ml"++  | 2 ->+# 50 "src/gml.mll"+      ( [] )+# 441 "src/gml.ml"++  | 3 ->+let+# 51 "src/gml.mll"+         c+# 447 "src/gml.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 52 "src/gml.mll"+      ( failwith ("Gml: invalid character " ^ String.make 1 c) )+# 451 "src/gml.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_file_rec lexbuf __ocaml_lex_state++and value_list lexbuf =+  lexbuf.Lexing.lex_mem <- Array.create 2 (-1) ;   __ocaml_lex_value_list_rec lexbuf 7+and __ocaml_lex_value_list_rec lexbuf __ocaml_lex_state =+  match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+# 56 "src/gml.mll"+      ( value_list lexbuf )+# 462 "src/gml.ml"++  | 1 ->+let+# 57 "src/gml.mll"+              key+# 468 "src/gml.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_mem.(0) in+# 58 "src/gml.mll"+      ( let v = value lexbuf in+	(key, v) :: value_list lexbuf )+# 473 "src/gml.ml"++  | 2 ->+# 61 "src/gml.mll"+      ( [] )+# 478 "src/gml.ml"++  | 3 ->+let+# 62 "src/gml.mll"+         c+# 484 "src/gml.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 63 "src/gml.mll"+      ( failwith ("Gml: invalid character " ^ String.make 1 c) )+# 488 "src/gml.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_value_list_rec lexbuf __ocaml_lex_state++and value lexbuf =+    __ocaml_lex_value_rec lexbuf 14+and __ocaml_lex_value_rec lexbuf __ocaml_lex_state =+  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with+      | 0 ->+let+# 66 "src/gml.mll"+               i+# 500 "src/gml.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in+# 67 "src/gml.mll"+      ( Int (int_of_string i) )+# 504 "src/gml.ml"++  | 1 ->+let+# 68 "src/gml.mll"+            r+# 510 "src/gml.ml"+= Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos lexbuf.Lexing.lex_curr_pos in+# 69 "src/gml.mll"+      ( Float (float_of_string r) )+# 514 "src/gml.ml"++  | 2 ->+let+# 70 "src/gml.mll"+                      s+# 520 "src/gml.ml"+= Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 1) (lexbuf.Lexing.lex_curr_pos + -1) in+# 71 "src/gml.mll"+      ( String s )+# 524 "src/gml.ml"++  | 3 ->+# 73 "src/gml.mll"+      ( let l = value_list lexbuf in List l )+# 529 "src/gml.ml"++  | 4 ->+let+# 74 "src/gml.mll"+         c+# 535 "src/gml.ml"+= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in+# 75 "src/gml.mll"+      ( failwith ("Gml: invalid character " ^ String.make 1 c) )+# 539 "src/gml.ml"++  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_value_rec lexbuf __ocaml_lex_state++;;++# 77 "src/gml.mll"+ ++  let parse f =+    let c = open_in f in+    let lb = from_channel c in+    let v = file lb in+    close_in c;+    v++  module Parse+    (B : Builder.S)+    (L : sig val node : value_list -> B.G.V.label+	     val edge : value_list -> B.G.E.label end) = +  struct++    let create_graph l =+      let nodes = Hashtbl.create 97 in+      let g = B.empty () in+      (* 1st pass: create the nodes *)+      let g =+	List.fold_left +	  (fun g v -> match v with+	     | "node", List l ->+		 let n = B.G.V.create (L.node l) in+		 begin +		   try +		     let id = List.assoc "id" l in Hashtbl.add nodes id n+		   with Not_found -> +		     ()+		 end;+		 B.add_vertex g n+	     | _ -> +		 g)+	  g l+      in+      (* 2nd pass: add the edges *)+      List.fold_left+	(fun g v -> match v with+	   | "edge", List l ->+	       begin try+		 let source = List.assoc "source" l in+		 let target = List.assoc "target" l in+		 let nsource = Hashtbl.find nodes source in+		 let ntarget = Hashtbl.find nodes target in+		 let e = B.G.E.create nsource (L.edge l) ntarget in+		 B.add_edge_e g e+	       with Not_found ->+		 g+	       end+	   | _ ->+	       g)+	g l+	+    let parse f =+      match parse f with+	| ["graph", List l] -> create_graph l+	| _ -> invalid_arg "Gml.Parse.parse: not a graph file"+      +  end++  module Print+    (G : sig+       module V : sig+	 type t+	 val hash : t -> int+	 val equal : t -> t -> bool+	 type label+	 val label : t -> label+       end+       module E : sig+	 type t+	 type label+	 val src : t -> V.t+	 val dst : t -> V.t+	 val label : t -> label+       end+       type t+       val iter_vertex : (V.t -> unit) -> t -> unit+       val iter_edges_e : (E.t -> unit) -> t -> unit+     end)+    (L : sig+       val node : G.V.label -> value_list+       val edge : G.E.label -> value_list+     end) =+  struct++    open Format++    module H = Hashtbl.Make(G.V)++    let print fmt g =+      let nodes = H.create 97 in+      let cpt = ref 0 in+      let id n = +	try H.find nodes n+	with Not_found -> incr cpt; let id = !cpt in H.add nodes n id; id+      in+      fprintf fmt "@[graph [@\n";+      let rec value fmt = function+	| Int n -> fprintf fmt "%d" n+	| Float f -> fprintf fmt "%f" f+	| String s -> fprintf fmt "\"%s\"" s+	| List l -> fprintf fmt "[@\n  @[%a@]@\n]" value_list l+      and value_list fmt = function+	| [] -> ()+	| [s,v] -> fprintf fmt "%s %a" s value v+	| (s,v) :: l -> fprintf fmt "%s %a@\n" s value v; value_list fmt l+      in+      G.iter_vertex+	(fun v -> +	   fprintf fmt "  @[node [@\n  id %d@\n  @[%a@]@\n]@]@\n" +	     (id v) value_list (L.node (G.V.label v)))+	g;+      G.iter_edges_e+	(fun e ->+	   fprintf fmt +	     "  @[edge [@\n  source %d@\n  target %d@\n  @[%a@]@\n]@]@\n"+	     (id (G.E.src e)) (id (G.E.dst e)) +	     value_list (L.edge (G.E.label e)))+	g;+      fprintf fmt "]@\n"++  end+++# 671 "src/gml.ml"
+ external/ocamlgraph/src/gml.mli view
@@ -0,0 +1,76 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: gml.mli,v 1.3 2005-07-06 13:20:31 conchon Exp $ *)++(** Parser for GML file format *)++type value = +  | Int of int +  | Float of float+  | String of string+  | List of value_list+      +and value_list = (string * value) list++module Parse +  (B : Builder.S)+  (L : sig +     val node : value_list -> B.G.V.label+       (** how to build the node label out of the set of GML attributes;+for example {v node [ id 12 label "foo" ] v} +will call this function with [["id", Int 12; "label", String "foo"]] *)+     val edge : value_list -> B.G.E.label +       (** how to build the edge label out of the set of GML attributes *)+   end) :+sig+  +  val parse : string -> B.G.t++end++module Print+  (G : sig+     module V : sig+       type t+       val hash : t -> int+       val equal : t -> t -> bool+       type label+       val label : t -> label+     end+     module E : sig+       type t+       type label+       val src : t -> V.t+       val dst : t -> V.t+       val label : t -> label+     end+     type t+     val iter_vertex : (V.t -> unit) -> t -> unit+     val iter_edges_e : (E.t -> unit) -> t -> unit+   end)+  (L : sig+     val node : G.V.label -> value_list+     val edge : G.E.label -> value_list+   end) :+sig++  val print : Format.formatter -> G.t -> unit++end++
+ external/ocamlgraph/src/gml.mll view
@@ -0,0 +1,202 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: gml.mll,v 1.3 2005-07-06 13:20:31 conchon Exp $ *)++{ ++  open Lexing++  type value = +    | Int of int +    | Float of float+    | String of string+    | List of value_list++  and value_list = (string * value) list++}++let space = [' ' '\t' '\r' '\n']++let ident = ['a'-'z' 'A'-'Z'] ['a'-'z' 'A'-'Z' '0'-'9']*+let digit = ['0'-'9']+let sign = '-' | '+' +let integer = sign? digit++let mantissa = 'E' sign? digit++let real = sign? digit* '.' digit* mantissa?+let in_string = [^ '"']*++rule file = parse+  | space +      { file lexbuf }+  | (ident as key) space +      { let v = value lexbuf in+	(key, v) :: file lexbuf }+  | eof +      { [] }+  | _ as c+      { failwith ("Gml: invalid character " ^ String.make 1 c) }++and value_list = parse+  | space +      { value_list lexbuf }+  | (ident as key) space +      { let v = value lexbuf in+	(key, v) :: value_list lexbuf }+  | ']' +      { [] }+  | _ as c+      { failwith ("Gml: invalid character " ^ String.make 1 c) }++and value = parse+  | integer as i+      { Int (int_of_string i) }+  | real as r+      { Float (float_of_string r) }+  | '"' (in_string as s) '"'+      { String s }+  | '['+      { let l = value_list lexbuf in List l }+  | _ as c+      { failwith ("Gml: invalid character " ^ String.make 1 c) }++{++  let parse f =+    let c = open_in f in+    let lb = from_channel c in+    let v = file lb in+    close_in c;+    v++  module Parse+    (B : Builder.S)+    (L : sig val node : value_list -> B.G.V.label+	     val edge : value_list -> B.G.E.label end) = +  struct++    let create_graph l =+      let nodes = Hashtbl.create 97 in+      let g = B.empty () in+      (* 1st pass: create the nodes *)+      let g =+	List.fold_left +	  (fun g v -> match v with+	     | "node", List l ->+		 let n = B.G.V.create (L.node l) in+		 begin +		   try +		     let id = List.assoc "id" l in Hashtbl.add nodes id n+		   with Not_found -> +		     ()+		 end;+		 B.add_vertex g n+	     | _ -> +		 g)+	  g l+      in+      (* 2nd pass: add the edges *)+      List.fold_left+	(fun g v -> match v with+	   | "edge", List l ->+	       begin try+		 let source = List.assoc "source" l in+		 let target = List.assoc "target" l in+		 let nsource = Hashtbl.find nodes source in+		 let ntarget = Hashtbl.find nodes target in+		 let e = B.G.E.create nsource (L.edge l) ntarget in+		 B.add_edge_e g e+	       with Not_found ->+		 g+	       end+	   | _ ->+	       g)+	g l+	+    let parse f =+      match parse f with+	| ["graph", List l] -> create_graph l+	| _ -> invalid_arg "Gml.Parse.parse: not a graph file"+      +  end++  module Print+    (G : sig+       module V : sig+	 type t+	 val hash : t -> int+	 val equal : t -> t -> bool+	 type label+	 val label : t -> label+       end+       module E : sig+	 type t+	 type label+	 val src : t -> V.t+	 val dst : t -> V.t+	 val label : t -> label+       end+       type t+       val iter_vertex : (V.t -> unit) -> t -> unit+       val iter_edges_e : (E.t -> unit) -> t -> unit+     end)+    (L : sig+       val node : G.V.label -> value_list+       val edge : G.E.label -> value_list+     end) =+  struct++    open Format++    module H = Hashtbl.Make(G.V)++    let print fmt g =+      let nodes = H.create 97 in+      let cpt = ref 0 in+      let id n = +	try H.find nodes n+	with Not_found -> incr cpt; let id = !cpt in H.add nodes n id; id+      in+      fprintf fmt "@[graph [@\n";+      let rec value fmt = function+	| Int n -> fprintf fmt "%d" n+	| Float f -> fprintf fmt "%f" f+	| String s -> fprintf fmt "\"%s\"" s+	| List l -> fprintf fmt "[@\n  @[%a@]@\n]" value_list l+      and value_list fmt = function+	| [] -> ()+	| [s,v] -> fprintf fmt "%s %a" s value v+	| (s,v) :: l -> fprintf fmt "%s %a@\n" s value v; value_list fmt l+      in+      G.iter_vertex+	(fun v -> +	   fprintf fmt "  @[node [@\n  id %d@\n  @[%a@]@\n]@]@\n" +	     (id v) value_list (L.node (G.V.label v)))+	g;+      G.iter_edges_e+	(fun e ->+	   fprintf fmt +	     "  @[edge [@\n  source %d@\n  target %d@\n  @[%a@]@\n]@]@\n"+	     (id (G.E.src e)) (id (G.E.dst e)) +	     value_list (L.edge (G.E.label e)))+	g;+      fprintf fmt "]@\n"++  end++}+
+ external/ocamlgraph/src/gpath.ml view
@@ -0,0 +1,132 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: path.ml,v 1.6 2005-07-18 07:10:35 filliatr Exp $ *)++module type WEIGHT = sig+  type label+  type t+  val weight : label -> t+  val zero : t+  val add : t -> t -> t+  val compare : t -> t -> int+end++module type G = sig+  type t +  module V : Sig.COMPARABLE +  module E : sig +    type t +    type label +    val label : t -> label +    val dst : t -> V.t +  end +  val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit+end++module Dijkstra+  (G: G)+  (W: WEIGHT with type label = G.E.label) =+struct++  open G.E++  module H =  Hashtbl.Make(G.V)++  module Elt = struct+    type t = W.t * G.V.t * G.E.t list++    (* weights are compared first, and minimal weights come first in the+       queue *)	       +    let compare (w1,v1,_) (w2,v2,_) =+      let cw = W.compare w2 w1 in+      if cw != 0 then cw else G.V.compare v1 v2+  end++  module PQ = Heap.Imperative(Elt)++  let shortest_path g v1 v2 =+    let visited = H.create 97 in+    let q = PQ.create 17 in+    let rec loop () = +      if PQ.is_empty q then raise Not_found;+      let (w,v,p) = PQ.pop_maximum q in+      if G.V.compare v v2 = 0 then +	List.rev p, w+      else begin+	if not (H.mem visited v) then begin+	  H.add visited v ();+	  G.iter_succ_e+	    (fun e -> PQ.add q (W.add w (W.weight (label e)), dst e, e :: p))+	    g v+	end;+	loop ()+      end+    in+    PQ.add q (W.zero, v1, []);+    loop ()++end++++module Check +  (G : +    sig+      type t+      module V : Sig.COMPARABLE+      val iter_succ : (V.t -> unit) -> t -> V.t -> unit+    end) = +struct++  module HV = Hashtbl.Make(G.V)+  module HVV = Hashtbl.Make(Util.HTProduct(G.V)(G.V))++  (* the cache contains the path tests already computed *)+  type path_checker = { cache : bool HVV.t; graph : G.t }++  let create g = { cache = HVV.create 97; graph = g }++  let check_path pc v1 v2 =+    try +      HVV.find pc.cache (v1, v2)+    with Not_found -> +      (* the path is not in cache; we check it with Dijkstra *)+      let visited = HV.create 97 in+      let q = Queue.create () in+      let rec loop () =+	if Queue.is_empty q then begin+	  HVV.add pc.cache (v1, v2) false;+	  false+	end else begin+	  let v = Queue.pop q in+	  HVV.add pc.cache (v1, v) true;+	  if G.V.compare v v2 = 0 then +	    true+	  else begin+	    if not (HV.mem visited v) then begin+	      HV.add visited v ();+	      G.iter_succ (fun v' -> Queue.add v' q) pc.graph v+	    end;+	    loop ()+	  end+	end+      in+      Queue.add v1 q;+      loop ()++end
+ external/ocamlgraph/src/gpath.mli view
@@ -0,0 +1,96 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: path.mli,v 1.9 2005-07-18 07:10:35 filliatr Exp $ *)++(** Paths *)++(** Minimal graph signature for Dijkstra's algorithm *)+module type G = sig+  type t +  module V : Sig.COMPARABLE +  module E : sig +    type t +    type label +    val label : t -> label +    val dst : t -> V.t +  end +  val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit+end++(** Signature for edges' weights *)+module type WEIGHT = sig+  type label+  type t+  val weight : label -> t+  val zero : t+  val add : t -> t -> t+  val compare : t -> t -> int+end++module Dijkstra+  (G: G)+  (W: WEIGHT with type label = G.E.label) : +sig++  val shortest_path : G.t -> G.V.t -> G.V.t -> G.E.t list * W.t+    (** [shortest_path g v1 v2] computes the shortest path from vertex [v1]+      to vertex [v2] in graph [g]. The path is returned as the list of +      followed edges, together with the total length of the path. +      raise [Not_found] if the path from [v1] to [v2] does not exist. ++      Complexity: at most O((V+E)log(V)) *)++end+++(** Check for a path *)++module Check+  (G : +    sig+      type t+      module V : Sig.COMPARABLE+      val iter_succ : (V.t -> unit) -> t -> V.t -> unit+    end) : +sig++  type path_checker+    (** the abstract data type of a path checker; this is a mutable data +	structure *)++  val create : G.t -> path_checker+    (** [create g] builds a new path checker for the graph [g];+        if the graph is mutable, it must not be mutated while this path +        checker is in use (through the function [check_path] below). *)++  val check_path : path_checker -> G.V.t -> G.V.t -> bool+    (** [check_path pc v1 v2] checks whether there is a path from [v1] to+	[v2] in the graph associated to the path checker [pc].++        Complexity: The path checker contains a cache of all results computed+	so far. This cache is implemented with a hash table so access in this +	cache is usually O(1). When the result is not in the cache, Dijkstra's+	algorithm is run to check for the path, and all intermediate results+	are cached.++	Note: if checks are to be done for almost all pairs of vertices, it+	may be more efficient to compute the transitive closure of the graph+	(see module [Oper]).+	*)++end
+ external/ocamlgraph/src/graphviz.ml view
@@ -0,0 +1,779 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: graphviz.ml,v 1.4 2006-05-09 10:19:37 conchon Exp $ *)++(** Interface with {i GraphViz}++    This module provides a basic interface with dot and neato,+    two programs of the GraphViz toolbox.+    These tools are available at the following URLs:+      http://www.graphviz.org/+      http://www.research.att.com/sw/tools/graphviz/++ *)++open Format++(***************************************************************************)+(** {2 Common stuff} *)++(** Because the neato and dot engines present a lot of common points -+    in particular in the graph description language, large parts of+    the code is shared.  First, the [!CommonAttributes] module defines+    attributes of graphs, nodes and edges that are understood by the+    two engines.  Second, given a module (of type [!ENGINE])+    describing an engine the [!MakeEngine] functor provides suitable+    interface function for it. *)++(*-------------------------------------------------------------------------*)+(** {3 Common attributes} *)++type color = int++let fprint_color ppf color =+  fprintf ppf "\"#%06X\"" color++let fprint_string ppf s = fprintf ppf "\"%s\"" s+(*  let s' = String.escaped s in+  if s' = s && s <> ""+  then fprintf ppf "%s" s+  else fprintf ppf "\"%s\"" s'*)++let fprint_string_user ppf s =+(*  let s = String.escaped s in*)+    fprintf ppf "\"%s\"" s++type arrow_style =+  [ `None | `Normal | `Inv | `Dot | `Odot | `Invdot | `Invodot ] ++let fprint_arrow_style ppf = function+    `None -> fprintf ppf "none"+  | `Normal -> fprintf ppf "normal"+  | `Inv -> fprintf ppf "inv"+  | `Dot -> fprintf ppf "dot"+  | `Odot -> fprintf ppf "odot"+  | `Invdot -> fprintf ppf "invdot"+  | `Invodot -> fprintf ppf "invodot"++let fprint_dir ppf = function+    `TopToBottom -> fprintf ppf "TB"+  | `LeftToRight -> fprintf ppf "LR"++(** The [ATTRIBUTES] module type defines the interface for the engines. *)+module type ATTRIBUTES = sig++  type graph  (** Attributes of graphs. *)++  type vertex (** Attributes of vertices. *)++  type edge   (** Attributes of edges. *)++  (** Attributes of (optional) boxes around vertices. *) +  type subgraph = {+    sg_name : string;            (** Box name. *)+    sg_attributes : vertex list; (** Box attributes. *)+  }++end++(** The [CommonAttributes] module defines attributes for graphs, nodes and+    edges that are available in the two engines, dot and neato. *)+module CommonAttributes = struct++  (** Attributes of graphs. *)+  type graph =+    [ `Center of bool+        (** Centers the drawing on the page.  Default value is [false]. *)+    | `Fontcolor of color+        (** Sets the font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the font family name.  Default value is ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the type size (in points).  Default value is [14]. *)+    | `Label of string+        (** Caption for graph drawing. *)+    | `Orientation of [ `Portrait | `Landscape ]+        (** Sets the page orientation.  Default value is [`Portrait]. *)+    | `Page of float * float+        (** Sets the PostScript pagination unit, e.g [8.5, 11.0]. *)+    | `Pagedir of [ `TopToBottom | `LeftToRight ]+        (** Traversal order of pages.  Default value is [`TopToBottom]. *)+    | `Size of float * float+        (** Sets the bounding box of drawing (in inches). *)+    | `OrderingOut+        (** Constrains  order of out-edges in a subgraph according to+          their file sequence *)+    ] ++  (** Attributes of nodes. *)+  type vertex =+    [ `Color of color+        (** Sets the color of the border of the node. Default value is [black]+         *)+    | `Fontcolor of color+        (** Sets the label font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the label font family name.  Default value is+            ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the label type size (in points).  Default value is [14]. *)+    | `Height of float+        (** Sets the minimum height.  Default value is [0.5]. *)+    | `Label of string+        (** Sets the label printed in the node. The string may include escaped+            newlines [\n], [\l], or [\r] for center, left, and right justified+	    lines.+            Record labels may contain recursive box lists delimited by { | }. +	*)+    | `Orientation of float+        (** Node rotation angle, in degrees.  Default value is [0.0]. *)+    | `Peripheries of int+        (** Sets  the  number  of periphery lines drawn around the polygon. *)+    | `Regular of bool+        (** If [true], then the polygon is made regular, i.e. symmetric about+	    the x and y axis, otherwise  the polygon   takes   on   the  aspect+	    ratio of the label.  Default value is [false]. *)+    | `Shape of+        [`Ellipse | `Box | `Circle | `Doublecircle | `Diamond+        | `Plaintext | `Record | `Polygon of int * float]+        (** Sets the shape of the node.  Default value is [`Ellipse].+            [`Polygon (i, f)] draws a polygon with [n] sides and a skewing+            of [f]. *)+    | `Style of [ `Filled | `Solid | `Dashed | `Dotted | `Bold | `Invis ]+        (** Sets the layout style of the node.  Several styles may be combined+            simultaneously. *)+    | `Width of float+        (** Sets the minimum width.  Default value is [0.75]. *)+    ]     ++  (** Attributes of edges. *)+  type edge =+    [ `Color of color+        (** Sets the edge stroke color.  Default value is [black]. *)+    | `Decorate of bool+        (** If [true], draws a line connecting labels with their edges. *)+    | `Dir of [ `Forward | `Back | `Both | `None ] +        (** Sets arrow direction.  Default value is [`Forward]. *)+    | `Fontcolor of color+        (** Sets the label font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the label font family name.  Default value is+	    ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the label type size (in points).  Default value is [14]. *)+    | `Label of string+        (** Sets the label to be attached to the edge.  The string may include+	    escaped newlines [\n], [\l], or [\r] for centered, left, or right+	    justified lines. *)+    | `Labelfontcolor of color+        (** Sets the font color for head and tail labels.  Default value is+            [black]. *)+    | `Labelfontname of string+        (** Sets the font family name for head and tail labels.  Default+            value is ["Times-Roman"]. *)+    | `Labelfontsize of int+        (** Sets the font size for head and tail labels (in points). +            Default value is [14]. *)+    | `Style of [ `Solid | `Dashed | `Dotted | `Bold | `Invis ]+        (** Sets the layout style of the edge.  Several styles may be combined+            simultaneously. *)+    ]     ++  (** Pretty-print. *)++  let fprint_orientation ppf = function+      `Portrait -> fprintf ppf "portrait"+    | `Landscape -> fprintf ppf "landscape"++  let fprint_graph ppf = function+      `Center b -> fprintf ppf "center=%i" (if b then 1 else 0)+    | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a+    | `Fontname s -> fprintf ppf "fontname=%a" fprint_string s+    | `Fontsize i -> fprintf ppf "fontsize=%i" i+    | `Label s -> fprintf ppf "label=%a" fprint_string_user s+    | `Orientation a -> fprintf ppf "orientation=%a" fprint_orientation a+    | `Page (x, y) -> fprintf ppf "page=\"%f,%f\"" x y+    | `Pagedir a -> fprintf ppf "pagedir=%a" fprint_dir a+    | `Size (x, y) -> fprintf ppf "size=\"%f,%f\"" x y+    | `OrderingOut -> fprintf ppf "ordering=out"++  let fprint_shape ppf = function+    | `Ellipse -> fprintf ppf "ellipse"+    | `Box -> fprintf ppf "box"+    | `Circle -> fprintf ppf "circle"+    | `Doublecircle -> fprintf ppf "doublecircle"+    | `Diamond -> fprintf ppf "diamond"+    | `Plaintext -> fprintf ppf "plaintext"+    | `Record -> fprintf ppf "record"+    | `Polygon (i, f) -> fprintf ppf "polygon, sides=%i, skew=%f" i f++  let fprint_node_style ppf = function+      `Filled -> fprintf ppf "filled"+    | `Solid -> fprintf ppf "solid"+    | `Dashed -> fprintf ppf "dashed"+    | `Dotted -> fprintf ppf "dotted"+    | `Bold -> fprintf ppf "bold"+    | `Invis -> fprintf ppf "invis"++  let fprint_vertex ppf = function+      `Color a -> fprintf ppf "color=%a" fprint_color a+    | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a+    | `Fontname s -> fprintf ppf "fontname=%a"  fprint_string s+    | `Fontsize i -> fprintf ppf "fontsize=%i" i+    | `Height f -> fprintf ppf "height=%f" f+    | `Label s -> fprintf ppf "label=%a" fprint_string_user s+    | `Orientation f -> fprintf ppf "orientation=%f" f+    | `Peripheries i -> fprintf ppf "peripheries=%i" i+    | `Regular b -> fprintf ppf "regular=%b" b+    | `Shape a -> fprintf ppf "shape=%a" fprint_shape a+    | `Style a -> fprintf ppf "style=%a" fprint_node_style a+    | `Width f -> fprintf ppf "width=%f" f++  let fprint_edge_style = +    fprint_node_style++  let fprint_arrow_direction ppf = function+      `Forward -> fprintf ppf "forward"+    | `Back -> fprintf ppf "back"+    | `Both -> fprintf ppf "both"+    | `None -> fprintf ppf "none"++  let fprint_edge ppf = function+      `Color a -> fprintf ppf "color=%a" fprint_color a+    | `Decorate b -> fprintf ppf "decorate=%b" b+    | `Dir a -> fprintf ppf "dir=%a" fprint_arrow_direction a+    | `Fontcolor a -> fprintf ppf "fontcolor=%a" fprint_color a+    | `Fontname s -> fprintf ppf "fontname=%a" fprint_string s+    | `Fontsize i -> fprintf ppf "fontsize=%i" i+    | `Label s -> fprintf ppf "label=%a" fprint_string_user s+    | `Labelfontcolor a -> fprintf ppf "labelfontcolor=%a" fprint_color a+    | `Labelfontname s -> fprintf ppf "labelfontname=\"%s\"" s +	(* (String.escaped s) *)+    | `Labelfontsize i -> fprintf ppf "labelfontsize=%i" i+    | `Style a -> fprintf ppf "style=%a" fprint_edge_style a++end+++(*-------------------------------------------------------------------------*)+(** {3 The [MakeEngine] functor} *)++(** An engine is described by a module of the following signature. *)+module type ENGINE = sig++  module Attributes : sig+    include ATTRIBUTES +    val fprint_graph:formatter -> graph -> unit+    val fprint_vertex: formatter -> vertex -> unit+    val fprint_edge: formatter -> edge -> unit+  end++  (** The litteral name of the engine. *)      +  val name: string++  (** The keyword for graphs ("digraph" for dot, "graph" for neato) *)+  val opening: string++  (** The litteral for edge arrows ("->" for dot, "--" for neato) *)+  val edge_arrow: string++end++module type GRAPH = sig++end++module MakeEngine+  (EN: ENGINE)+  (X : sig+     type t+     module V : sig type t end+     module E : sig type t val src : t -> V.t val dst : t -> V.t end+       +     val iter_vertex : (V.t -> unit) -> t -> unit+     val iter_edges_e : (E.t -> unit) -> t -> unit++     val graph_attributes: t -> EN.Attributes.graph list++     val default_vertex_attributes: t -> EN.Attributes.vertex list+     val vertex_name : V.t -> string+     val vertex_attributes: V.t -> EN.Attributes.vertex list++     val default_edge_attributes: t -> EN.Attributes.edge list+     val edge_attributes: E.t -> EN.Attributes.edge list+     val get_subgraph : V.t -> EN.Attributes.subgraph option+   end) =+struct++  let command = ref EN.name+  let set_command cmd =+    command := cmd++  exception Error of string++  let handle_error f arg =+    try +      f arg+    with +	Error msg ->+	  Printf.eprintf "%s: %s failure\n   %s\n"+	  Sys.argv.(0) EN.name msg;+	  flush stderr;+	  exit 2++    (** [fprint_graph_attributes ppf list] pretty prints a list of +        graph attributes on the formatter [ppf].  Attributes are separated+        by a ";". *)+    let fprint_graph_attributes ppf list =+       List.iter (function att ->+	 fprintf ppf "%a;@ " EN.Attributes.fprint_graph att+       ) list++   (** [fprint_graph_attribute printer ppf list] pretty prints a list of +       attributes on the formatter [ppf], using the printer [printer] for+       each attribute.  The list appears between brackets and attributes+       are speparated by ",".  If the list is empty, nothing is printed. *)+    let fprint_attributes fprint_attribute ppf = function+	[] -> ()+      | hd :: tl ->+	  let rec fprint_attributes_rec ppf = function+	      [] -> ()+	    | hd' :: tl' ->+		fprintf ppf ",@ %a%a" +		  fprint_attribute hd'+		  fprint_attributes_rec tl'+	  in+	  fprintf ppf " [@[<hov>%a%a@]]"+	    fprint_attribute hd+	    fprint_attributes_rec tl++    (** [fprint_graph_attributes ppf list] pretty prints a list of +        node attributes using the format of [fprint_attributes]. *)+    let fprint_node_attributes ppf list = +      fprint_attributes EN.Attributes.fprint_vertex ppf list+	 +    (** [fprint_graph_attributes ppf list] pretty prints a list of +        edge attributes using the format of [fprint_attributes]. *)+    let fprint_edge_attributes ppf list =+      fprint_attributes EN.Attributes.fprint_edge ppf list++    (** [fprint_graph ppf graph] pretty prints the graph [graph] in+        the CGL language on the formatter [ppf]. *)+    let fprint_graph ppf graph =+      let subgraphs = Hashtbl.create 7 in ++      (* Printing nodes. *)++      let print_nodes ppf =++	let default_node_attributes = X.default_vertex_attributes graph in+	if default_node_attributes  <> [] then+	  fprintf ppf "node%a;@ " +	    fprint_node_attributes default_node_attributes;++	X.iter_vertex +          (function node ->+             begin match X.get_subgraph node with +             | None -> ()+             | Some sg -> +                 try +                   let (sg,nodes) = +		     Hashtbl.find subgraphs sg.EN.Attributes.sg_name +		   in+                   Hashtbl.replace subgraphs +		     sg.EN.Attributes.sg_name (sg,node::nodes)+                 with Not_found -> +                   Hashtbl.add subgraphs sg.EN.Attributes.sg_name (sg,[node]) +             end;+	     fprintf ppf "%s%a;@ " +	       (X.vertex_name node)+	       fprint_node_attributes (X.vertex_attributes node)) +          graph++      in++      (* Printing subgraphs *)++      let print_subgraphs ppf = ++        Hashtbl.iter+          (fun name (sg,nodes) -> +             fprintf ppf "@[<v 2>subgraph cluster_%s { %t%t };@]@\n"+               name+               +               (fun ppf -> +                  (List.iter +                     (fun n -> +			fprintf ppf "%a;@\n" EN.Attributes.fprint_vertex n)+                     sg.EN.Attributes.sg_attributes))++               (fun ppf -> +                  (List.iter +		     (fun n -> fprintf ppf "%s;" (X.vertex_name n))+                     nodes))+          )+          subgraphs +        +      in++      (* Printing edges *)++      let print_edges ppf =+	+	let default_edge_attributes = X.default_edge_attributes graph in+	if default_edge_attributes <> [] then+	  fprintf ppf "edge%a;@ " +	    fprint_edge_attributes default_edge_attributes;++	X.iter_edges_e (function edge ->+	                  fprintf ppf "%s %s %s%a;@ "+	                    (X.vertex_name (X.E.src edge))+	                    EN.edge_arrow+	                    (X.vertex_name (X.E.dst edge))+	                    fprint_edge_attributes (X.edge_attributes edge)+                       ) graph++      in++      fprintf ppf "@[<v>%s G {@ @[<v 2>  %a"+	EN.opening+	fprint_graph_attributes (X.graph_attributes graph);+      fprintf ppf "%t@ " print_nodes;+      fprintf ppf "%t@ " print_subgraphs;+      fprintf ppf "%t@ " print_edges;+      fprintf ppf "@]}@]"++    (** [output_graph oc graph] pretty prints the graph [graph] in the dot+	language on the channel [oc]. *)+    let output_graph oc graph =++      let ppf = formatter_of_out_channel oc in+      fprint_graph ppf graph;+      pp_print_flush ppf ()++  end++(***************************************************************************)+(** {2 Interface with the dot engine} *)++(** The [DotAttributes] module defines attributes for graphs, nodes and edges+    that are available in the dot engine. *)+module DotAttributes = struct++  (** Attributes of graphs.  They include all common graph attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: clusterank, color,+      compound, labeljust, labelloc, ordering, rank, remincross, rotate,+      searchsize and style.+   *)+  type graph =+    [ CommonAttributes.graph+    | `Bgcolor of color+        (** Sets the background color and the inital fill color. *)+    | `Comment of string+        (** Comment string. *)+    | `Concentrate of bool+        (** If [true], enables edge concentrators.  Default value is [false]. *)+    | `Fontpath of string+        (** List of directories for fonts. *)+    | `Layers of string list+        (** List of layers. *)+    | `Margin of float+        (** Sets the page margin (included in the page size).  Default value is+            [0.5]. *)+    | `Mclimit of float+        (** Scale factor for mincross iterations.  Default value is [1.0]. *)+    | `Nodesep of float+        (** Sets the minimum separation between nodes, in inches.  Default+            value is [0.25]. *)+    | `Nslimit of int+        (** If set of [f], bounds network simplex iterations by [f *+            <number of nodes>] when ranking nodes. *)+    | `Nslimit1 of int+        (** If set of [f], bounds network simplex iterations by [f *+            <number of nodes>] when setting x-coordinates. *)+    | `Ranksep of float+        (** Sets the minimum separation between ranks. *)+    | `Quantum of float+        (** If not [0.0], node label dimensions will be rounded to integral+	    multiples of it.  Default value is [0.0]. *)+    | `Rankdir of [ `TopToBottom | `LeftToRight ]+        (** Direction of rank ordering.  Default value is [`TopToBottom]. *)+    | `Ratio of [ `Float of float | `Fill | `Compress| `Auto ]+        (** Sets the aspect ratio. *)+    | `Samplepoints of int+        (** Number of points used to represent ellipses and circles on output.+	    Default value is [8]. *)+    | `Url of string+        (** URL associated with graph (format-dependent). *)+    ] ++  (** Attributes of nodes.  They include all common node attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: bottomlabel, group,+      shapefile and toplabel.+   *)+  type vertex =+    [ CommonAttributes.vertex+    | `Comment of string+        (** Comment string. *)+    | `Distortion of float+        (* TEMPORARY *)+    | `Fillcolor of color+        (** Sets the fill color (used when `Style filled).  Default value+            is [lightgrey]. *)+    | `Fixedsize of bool+        (** If [true], forces the given dimensions to be the actual ones.+            Default value is [false]. *)+    | `Layer of string+        (** Overlay. *)+    | `Url of string+        (** The  default  url  for  image  map  files; in PostScript files,+            the base URL for all relative URLs, as recognized by Acrobat+	    Distiller 3.0 and up. *)+    | `Z of float+        (** z coordinate for VRML output. *)+    ] ++  (** Attributes of edges.  They include all common edge attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: lhead and ltail.+   *)+  type edge =+    [ CommonAttributes.edge+    | `Arrowhead of arrow_style+        (** Sets the style of the head arrow.  Default value is [`Normal]. *)+    | `Arrowsize of float+        (** Sets the scaling factor of arrowheads.  Default value is [1.0]. *)+    | `Arrowtail of arrow_style+        (** Sets the style of the tail arrow.  Default value is [`Normal]. *)+    | `Comment of string+        (** Comment string. *)+    | `Constraints of bool+        (** If [false], causes an edge to be ignored for rank assignment. +            Default value is [true]. *)+    | `Headlabel of string+        (** Sets the label attached to the head arrow. *)+    | `Headport of [ `N | `NE | `E | `SE | `S | `SW | `W | `NW ]+        (* TEMPORARY *)+    | `Headurl of string+        (** Url attached to head label if output format is ismap. *)+    | `Labelangle of float+        (** Angle in degrees which head or tail label is rotated off edge. +            Default value is [-25.0]. *)+    | `Labeldistance of float+        (** Scaling factor for distance of head or tail label from node. +            Default value is [1.0]. *)+    | `Labelfloat of bool+        (** If [true], lessen constraints on edge label placement. +            Default value is [false]. *)+    | `Layer of string+        (** Overlay. *)+    | `Minlen of int+        (** Minimum rank distance between head an tail.  Default value is [1]. *)+    | `Samehead of string+        (** Tag for head node; edge heads with the same tag are merged onto the+	    same port. *)+    | `Sametail of string+        (** Tag for tail node; edge tails with the same tag are merged onto the+	    same port. *)+    | `Taillabel of string+        (** Sets the label attached to the tail arrow. *)+    | `Tailport of [ `N | `NE | `E | `SE | `S | `SW | `W | `NW ]+        (* TEMPORARY *)+    | `Tailurl of string+        (** Url attached to tail label if output format is ismap. *)+    | `Weight of int+        (** Sets the integer cost of stretching the edge.  Default value is+            [1]. *)+    ] ++    type subgraph = {+      sg_name : string;+      sg_attributes : vertex list;+    }++    (** {4 Pretty-print of attributes} *)++    let rec fprint_string_list ppf = function+      [] -> ()+      | [hd] -> fprintf ppf "%s" hd+      | hd :: tl -> fprintf ppf "%s,%a" hd fprint_string_list tl++    let fprint_ratio ppf = function+	`Float f -> fprintf ppf "%f" f+      | `Fill -> fprintf ppf "fill"+      | `Compress -> fprintf ppf "compress"+      | `Auto -> fprintf ppf "auto"++    let fprint_graph ppf = function+	#CommonAttributes.graph as att -> CommonAttributes.fprint_graph ppf att+      | `Bgcolor a -> fprintf ppf "bgcolor=%a" fprint_color a+      | `Comment s -> fprintf ppf "comment=%a" fprint_string s+      | `Concentrate b -> fprintf ppf "concentrate=%b" b+      | `Fontpath s -> fprintf ppf "fontpath=%a" fprint_string s+      | `Layers s -> fprintf ppf "layers=%a" fprint_string_list s+      | `Margin f -> fprintf ppf "margin=%f" f+      | `Mclimit f -> fprintf ppf "mclimit=%f" f+      | `Nodesep f -> fprintf ppf "nodesep=%f" f+      | `Nslimit i -> fprintf ppf "nslimit=%i" i+      | `Nslimit1 i -> fprintf ppf "nslimit1=%i" i+      | `Ranksep f -> fprintf ppf "ranksep=%f" f+      | `Quantum f -> fprintf ppf "quantum=%f" f+      | `Rankdir a -> fprintf ppf "rankdir=%a" fprint_dir a+      | `Ratio a -> fprintf ppf "ratio=%a" fprint_ratio a+      | `Samplepoints i -> fprintf ppf "samplepoints=%i" i+      | `Url s -> fprintf ppf "URL=\"%s\"" s (*(String.escaped s)*)++    let fprint_vertex ppf = function+	#CommonAttributes.vertex as att -> +	  CommonAttributes.fprint_vertex ppf att+      | `Comment s -> fprintf ppf "comment=%a" fprint_string s+      | `Distortion f -> fprintf ppf "distortion=%f" f+      | `Fillcolor a -> fprintf ppf "fillcolor=%a" fprint_color a+      | `Fixedsize b -> fprintf ppf "fixedsize=%b" b+      | `Layer s -> fprintf ppf "layer=%a" fprint_string s+      | `Url s -> fprintf ppf "URL=\"%s\"" s (*(String.escaped s)*)+      | `Z f -> fprintf ppf "z=%f" f++    let fprint_port ppf = function+	`N -> fprintf ppf "n"+      | `NE -> fprintf ppf "ne"+      | `E -> fprintf ppf "e"+      | `SE -> fprintf ppf "se"+      | `S -> fprintf ppf "s"+      | `SW -> fprintf ppf "sw"+      | `W -> fprintf ppf "w"+      | `NW -> fprintf ppf "nw"++    let fprint_edge ppf = function+	#CommonAttributes.edge as att -> CommonAttributes.fprint_edge ppf att+      | `Arrowhead a -> fprintf ppf "arrowhead=%a" fprint_arrow_style a+      | `Arrowsize f -> fprintf ppf "arrowsize=%f" f+      | `Arrowtail a -> fprintf ppf "arrowtail=%a" fprint_arrow_style a+      | `Comment s -> fprintf ppf "comment=%a" fprint_string s+      | `Constraints b -> fprintf ppf "constraints=%b" b+      | `Headlabel s -> fprintf ppf "headlabel=%a" fprint_string s+      | `Headport a -> fprintf ppf "headport=%a" fprint_port a+      | `Headurl s -> fprintf ppf "headURL=%a" fprint_string s+      | `Labelangle f -> fprintf ppf "labelangle=%f" f+      | `Labeldistance f -> fprintf ppf "labeldistance=%f" f+      | `Labelfloat b -> fprintf ppf "labelfloat=%b" b+      | `Layer s -> fprintf ppf "layer=%a" fprint_string s+      | `Minlen i -> fprintf ppf "minlen=%i" i+      | `Samehead s -> fprintf ppf "samehead=%a" fprint_string s+      | `Sametail s -> fprintf ppf "sametail=%a" fprint_string s+      | `Taillabel s -> fprintf ppf "taillabel=%a" fprint_string s+      | `Tailport a -> fprintf ppf "tailport=%a" fprint_port a+      | `Tailurl s -> fprintf ppf "tailURL=%a" fprint_string s+      | `Weight i -> fprintf ppf "weight=%i" i++end++module Dot = +  MakeEngine (struct+		module Attributes = DotAttributes+		let name = "dot"+		let opening = "digraph"+		let edge_arrow = "->"+	      end)++(***************************************************************************)+(** {2 Interface with the neato engine} *)++(** The [NeatoAttributes] module defines attributes for graphs, nodes and edges+    that are available in the neato engine. *)+module NeatoAttributes = struct++  (** Attributes of graphs.  They include all common graph attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled. *)+  type graph =+    [ CommonAttributes.graph+    | `Margin of float * float+        (** Sets the page margin (included in the page size).  Default value is+            [0.5, 0.5]. *)+    | `Start of int+        (** Seed for random number generator. *)+    | `Overlap of bool+	(** Default value is [true]. *)+    | `Spline of bool+	(** [true] makes edge splines if nodes don't overlap.+	    Default value is [false]. *)+    | `Sep of float+	(** Edge spline separation factor from nodes.  Default value +	    is [0.0]. *)+    ] ++  (** Attributes of nodes.  They include all common node attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled. *)+  type vertex =+    [ CommonAttributes.vertex+    | `Pos of float * float+        (** Initial coordinates of the node. *)+    ] ++  (** Attributes of edges.  They include all common edge attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled. *)+  type edge =+    [ CommonAttributes.edge+    | `Id of string+        (** Optional value to distinguish multiple edges. *)+    | `Len of float+        (** Preferred length of edge.  Default value is [1.0]. *)+    | `Weight of float+        (** Strength of edge spring.  Default value is [1.0]. *)+    ] ++    type subgraph = {+      sg_name : string;+      sg_attributes : vertex list;+    }++  (** {4 Pretty-print of attributes} *)++    let fprint_graph ppf = function+	#CommonAttributes.graph as att -> CommonAttributes.fprint_graph ppf att+      | `Margin (f1, f2) -> fprintf ppf "margin=\"%f,%f\"" f1 f2+      | `Start i -> fprintf ppf "start=%i" i+      | `Overlap b -> fprintf ppf "overlap=%b" b+      | `Spline b -> fprintf ppf "spline=%b" b+      | `Sep f -> fprintf ppf "sep=%f" f++    let fprint_vertex ppf = function+	#CommonAttributes.vertex as att -> +	  CommonAttributes.fprint_vertex ppf att+      | `Pos (f1, f2) -> fprintf ppf "pos=\"%f,%f\"" f1 f2++    let fprint_edge ppf = function+	#CommonAttributes.edge as att -> CommonAttributes.fprint_edge ppf att+      | `Id s -> fprintf ppf "id=%a" fprint_string s+      | `Len f -> fprintf ppf "len=%f" f+      | `Weight f -> fprintf ppf "weight=%f" f++end++module Neato = +  MakeEngine (struct+		module Attributes = NeatoAttributes+		let name = "neato"+		let opening = "graph"+		let edge_arrow = "--"+	      end)
+ external/ocamlgraph/src/graphviz.mli view
@@ -0,0 +1,469 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: graphviz.mli,v 1.4 2005-01-18 09:17:49 filliatr Exp $ *)++(** Interface with {i GraphViz}++    This module provides a basic interface with dot and neato,+    two programs of the GraphViz toolbox.+    These tools are available at the following URLs:++    {v http://www.graphviz.org/ v}++    {v http://www.research.att.com/sw/tools/graphviz/ v}++ *)++open Format++(***************************************************************************)+(** {2 Common stuff} *)++(** Because the neato and dot engines present a lot of common points -+    in particular in the graph description language, large parts of+    the code is shared.  The [CommonAttributes] module defines+    attributes of graphs, vertices and edges that are understood by the+    two engines.  Then module [DotAttributes] and [NeatoAttributes]+    define attributes specific to dot and neato respectively. *)++(*-------------------------------------------------------------------------*)+(** {3 Common types and signatures} *)++type color = int++type arrow_style =+  [ `None | `Normal | `Inv | `Dot | `Odot | `Invdot | `Invodot ] ++(** The [ATTRIBUTES] module type defines the interface for the engines. *)+module type ATTRIBUTES = sig++  type graph  (** Attributes of graphs. *)++  type vertex (** Attributes of vertices. *)++  type edge   (** Attributes of edges. *)++  (** Attributes of (optional) boxes around vertices. *) +  type subgraph = {+    sg_name : string;            (** Box name. *)+    sg_attributes : vertex list; (** Box attributes. *)+  }++end++(*-------------------------------------------------------------------------*)+(** {3 Common attributes} *)++(** The [CommonAttributes] module defines attributes for graphs, vertices and+    edges that are available in the two engines, dot and neato. *)+module CommonAttributes : sig++  (** Attributes of graphs. *)+  type graph =+    [ `Center of bool+        (** Centers the drawing on the page.  Default value is [false]. *)+    | `Fontcolor of color+        (** Sets the font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the font family name.  Default value is ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the type size (in points).  Default value is [14]. *)+    | `Label of string+        (** Caption for graph drawing. *)+    | `Orientation of [ `Portrait | `Landscape ]+        (** Sets the page orientation.  Default value is [`Portrait]. *)+    | `Page of float * float+        (** Sets the PostScript pagination unit, e.g [8.5, 11.0]. *)+    | `Pagedir of [ `TopToBottom | `LeftToRight ]+        (** Traversal order of pages.  Default value is [`TopToBottom]. *)+    | `Size of float * float+        (** Sets the bounding box of drawing (in inches). *)+    | `OrderingOut+        (** Constrains  order of out-edges in a subgraph according to+          their file sequence *)+    ] ++  (** Attributes of vertices.+   *)+  type vertex =+    [ `Color of color+        (** Sets the color of the border of the vertex. +	  Default value is [black] *)+    | `Fontcolor of color+        (** Sets the label font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the label font family name.  Default value is+            ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the label type size (in points).  Default value is [14].+         *)+    | `Height of float+        (** Sets the minimum height.  Default value is [0.5]. *)+    | `Label of string+        (** Sets the label printed in the vertex. +	    The string may include escaped+            newlines [\n], [\l], or [\r] for center, left, and right justified+	    lines.+            Record labels may contain recursive box lists delimited by { | }. +	*)+    | `Orientation of float+        (** Vertex rotation angle, in degrees.  Default value is [0.0]. *)+    | `Peripheries of int+        (** Sets  the  number  of periphery lines drawn around the polygon. *)+    | `Regular of bool+        (** If [true], then the polygon is made regular, i.e. symmetric about+	    the x and y axis, otherwise  the polygon   takes   on   the  aspect+	    ratio of the label.  Default value is [false]. *)+    | `Shape of+        [`Ellipse | `Box | `Circle | `Doublecircle | `Diamond+        | `Plaintext | `Record | `Polygon of int * float]+        (** Sets the shape of the vertex.  Default value is [`Ellipse].+            [`Polygon (i, f)] draws a polygon with [n] sides and a skewing+            of [f]. *)+    | `Style of [ `Filled | `Solid | `Dashed | `Dotted | `Bold | `Invis ]+        (** Sets the layout style of the vertex.  +	    Several styles may be combined simultaneously. *)+    | `Width of float+        (** Sets the minimum width.  Default value is [0.75]. *)+    ]     ++  (** Attributes of edges.+   *)+  type edge =+    [ `Color of color+        (** Sets the edge stroke color.  Default value is [black]. *)+    | `Decorate of bool+        (** If [true], draws a line connecting labels with their edges. *)+    | `Dir of [ `Forward | `Back | `Both | `None ] +        (** Sets arrow direction.  Default value is [`Forward]. *)+    | `Fontcolor of color+        (** Sets the label font color.  Default value is [black]. *)+    | `Fontname of string+        (** Sets the label font family name.  Default value is+	    ["Times-Roman"]. *)+    | `Fontsize of int+        (** Sets the label type size (in points).  Default value is [14]. *)+    | `Label of string+        (** Sets the label to be attached to the edge.  The string may include+	    escaped newlines [\n], [\l], or [\r] for centered, left, or right+	    justified lines. *)+    | `Labelfontcolor of color+        (** Sets the font color for head and tail labels.  Default value is+            [black]. *)+    | `Labelfontname of string+        (** Sets the font family name for head and tail labels.  Default+            value is ["Times-Roman"]. *)+    | `Labelfontsize of int+        (** Sets the font size for head and tail labels (in points). +            Default value is [14]. *)+    | `Style of [ `Solid | `Dashed | `Dotted | `Bold | `Invis ]+        (** Sets the layout style of the edge.  Several styles may be combined+            simultaneously. *)+    ]     ++end++(***************************************************************************)+(** {2 Interface with the dot engine} *)++(** [DotAttributes] extends [CommonAttributes] and implements [ATTRIBUTES]. *)+module DotAttributes : sig++  (** Attributes of graphs.  They include all common graph attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: clusterank, color,+      compound, labeljust, labelloc, ordering, rank, remincross, rotate,+      searchsize and style.+   *)+  type graph =+    [ CommonAttributes.graph+    | `Bgcolor of color+        (** Sets the background color and the inital fill color. *)+    | `Comment of string+        (** Comment string. *)+    | `Concentrate of bool+        (** If [true], enables edge concentrators.  Default value is [false]. *)+    | `Fontpath of string+        (** List of directories for fonts. *)+    | `Layers of string list+        (** List of layers. *)+    | `Margin of float+        (** Sets the page margin (included in the page size).  Default value is+            [0.5]. *)+    | `Mclimit of float+        (** Scale factor for mincross iterations.  Default value is [1.0]. *)+    | `Nodesep of float+        (** Sets the minimum separation between nodes, in inches.  Default+            value is [0.25]. *)+    | `Nslimit of int+        (** If set of [f], bounds network simplex iterations by [f *+            <number of nodes>] when ranking nodes. *)+    | `Nslimit1 of int+        (** If set of [f], bounds network simplex iterations by [f *+            <number of nodes>] when setting x-coordinates. *)+    | `Ranksep of float+        (** Sets the minimum separation between ranks. *)+    | `Quantum of float+        (** If not [0.0], node label dimensions will be rounded to integral+	    multiples of it.  Default value is [0.0]. *)+    | `Rankdir of [ `TopToBottom | `LeftToRight ]+        (** Direction of rank ordering.  Default value is [`TopToBottom]. *)+    | `Ratio of [ `Float of float | `Fill | `Compress| `Auto ]+        (** Sets the aspect ratio. *)+    | `Samplepoints of int+        (** Number of points used to represent ellipses and circles on output.+	    Default value is [8]. *)+    | `Url of string+        (** URL associated with graph (format-dependent). *)+    ] ++  (** Attributes of nodes.  They include all common node attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: bottomlabel, group,+      shapefile and toplabel.+   *)+  type vertex =+    [ CommonAttributes.vertex+    | `Comment of string+        (** Comment string. *)+    | `Distortion of float+        (* TEMPORARY *)+    | `Fillcolor of color+        (** Sets the fill color (used when `Style filled).  Default value+            is [lightgrey]. *)+    | `Fixedsize of bool+        (** If [true], forces the given dimensions to be the actual ones.+            Default value is [false]. *)+    | `Layer of string+        (** Overlay. *)+    | `Url of string+        (** The  default  url  for  image  map  files; in PostScript files,+            the base URL for all relative URLs, as recognized by Acrobat+	    Distiller 3.0 and up. *)+    | `Z of float+        (** z coordinate for VRML output. *)+    ] ++  (** Attributes of edges.  They include all common edge attributes and+      several specific ones.  All attributes described in the "dot User's+      Manual, February 4, 2002" are handled, excepted: lhead and ltail.+   *)+  type edge =+    [ CommonAttributes.edge+    | `Arrowhead of arrow_style+        (** Sets the style of the head arrow.  Default value is [`Normal]. *)+    | `Arrowsize of float+        (** Sets the scaling factor of arrowheads.  Default value is [1.0]. *)+    | `Arrowtail of arrow_style+        (** Sets the style of the tail arrow.  Default value is [`Normal]. *)+    | `Comment of string+        (** Comment string. *)+    | `Constraints of bool+        (** If [false], causes an edge to be ignored for rank assignment. +            Default value is [true]. *)+    | `Headlabel of string+        (** Sets the label attached to the head arrow. *)+    | `Headport of [ `N | `NE | `E | `SE | `S | `SW | `W | `NW ]+        (* TEMPORARY *)+    | `Headurl of string+        (** Url attached to head label if output format is ismap. *)+    | `Labelangle of float+        (** Angle in degrees which head or tail label is rotated off edge. +            Default value is [-25.0]. *)+    | `Labeldistance of float+        (** Scaling factor for distance of head or tail label from node. +            Default value is [1.0]. *)+    | `Labelfloat of bool+        (** If [true], lessen constraints on edge label placement. +            Default value is [false]. *)+    | `Layer of string+        (** Overlay. *)+    | `Minlen of int+        (** Minimum rank distance between head an tail.  +	    Default value is [1]. *)+    | `Samehead of string+        (** Tag for head node; edge heads with the same tag are merged onto the+	    same port. *)+    | `Sametail of string+        (** Tag for tail node; edge tails with the same tag are merged onto the+	    same port. *)+    | `Taillabel of string+        (** Sets the label attached to the tail arrow. *)+    | `Tailport of [ `N | `NE | `E | `SE | `S | `SW | `W | `NW ]+        (* TEMPORARY *)+    | `Tailurl of string+        (** Url attached to tail label if output format is ismap. *)+    | `Weight of int+        (** Sets the integer cost of stretching the edge.  Default value is+            [1]. *)+    ] ++    type subgraph = {+      sg_name : string;+      sg_attributes : vertex list;+    }++end++module Dot+  (X : sig++     (** Graph implementation. *)++     type t+     module V : sig type t end+     module E : sig type t val src : t -> V.t val dst : t -> V.t end+       +     val iter_vertex : (V.t -> unit) -> t -> unit+     val iter_edges_e : (E.t -> unit) -> t -> unit+       +     (** Graph, vertex and edge attributes. *)++     val graph_attributes: t -> DotAttributes.graph list+       +     val default_vertex_attributes: t -> DotAttributes.vertex list+     val vertex_name : V.t -> string+     val vertex_attributes: V.t -> DotAttributes.vertex list++     val get_subgraph : V.t -> DotAttributes.subgraph option+       (** The box (if exists) which the vertex belongs to. Boxes with same+	   names are not distinguished and so they should have the same+	   attributes. *)+       +     val default_edge_attributes: t -> DotAttributes.edge list+     val edge_attributes: E.t -> DotAttributes.edge list+       +   end) :+sig++  (** [fprint_graph ppf graph] pretty prints the graph [graph] in+    the CGL language on the formatter [ppf]. *)+  val fprint_graph: formatter -> X.t -> unit++  (** [output_graph oc graph] pretty prints the graph [graph] in the dot+    language on the channel [oc]. *)+  val output_graph: out_channel -> X.t -> unit++end++(***************************************************************************)+(** {2 The neato engine} *)++module NeatoAttributes : sig++  (** Attributes of graphs.  They include all common graph attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled.+   *)+  type graph =+    [ CommonAttributes.graph+    | `Margin of float * float+        (** Sets the page margin (included in the page size).  Default value is+            [0.5, 0.5]. *)+    | `Start of int+        (** Seed for random number generator. *)+    | `Overlap of bool+	(** Default value is [true]. *)+    | `Spline of bool+	(** [true] makes edge splines if nodes don't overlap.+	    Default value is [false]. *)+    | `Sep of float+	(** Edge spline separation factor from nodes.  Default value +	    is [0.0]. *)+    ] ++  (** Attributes of nodes.  They include all common node attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled.+   *)+  type vertex =+    [ CommonAttributes.vertex+    | `Pos of float * float+        (** Initial coordinates of the vertex. *)+    ] ++  (** Attributes of edges.  They include all common edge attributes and+      several specific ones.  All attributes described in the "Neato User's+      manual, April 10, 2002" are handled.+   *)+  type edge =+    [ CommonAttributes.edge+    | `Id of string+        (** Optional value to distinguish multiple edges. *)+    | `Len of float+        (** Preferred length of edge.  Default value is [1.0]. *)+    | `Weight of float+        (** Strength of edge spring.  Default value is [1.0]. *)+    ] ++  type subgraph = {+    sg_name : string;+    sg_attributes : vertex list;+  }++end++module Neato+  (X : sig++     (** Graph implementation. *)++     type t+     module V : sig type t end+     module E : sig type t val src : t -> V.t val dst : t -> V.t end+       +     val iter_vertex : (V.t -> unit) -> t -> unit+     val iter_edges_e : (E.t -> unit) -> t -> unit+       +     (** Graph, vertex and edge attributes. *)++     val graph_attributes: t -> NeatoAttributes.graph list+       +     val default_vertex_attributes: t -> NeatoAttributes.vertex list+     val vertex_name : V.t -> string+     val vertex_attributes: V.t -> NeatoAttributes.vertex list++     val get_subgraph : V.t -> NeatoAttributes.subgraph option+       (** The box (if exists) which the vertex belongs to. Boxes with same+	   names are not distinguished and so they should have the same+	   attributes. *)+       +     val default_edge_attributes: t -> NeatoAttributes.edge list+     val edge_attributes: E.t -> NeatoAttributes.edge list+       +   end) :+sig++  (** Several functions provided by this module run the external program+      {i neato}.  By default, this command is supposed to be in the default+      path and is invoked by {i neato}.  The function+      [set_command] allows to set an alternative path at run time. *)+  val set_command: string -> unit++  exception Error of string+  val handle_error: ('a -> 'b) -> 'a -> 'b++  (** [fprint_graph ppf graph] pretty prints the graph [graph] in+    the CGL language on the formatter [ppf]. *)+  val fprint_graph: formatter -> X.t -> unit++  (** [output_graph oc graph] pretty prints the graph [graph] in the dot+    language on the channel [oc]. *)+  val output_graph: out_channel -> X.t -> unit++end
+ external/ocamlgraph/src/imperative.ml view
@@ -0,0 +1,618 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: imperative.ml,v 1.27 2006-05-12 14:07:16 filliatr Exp $ *)++open Sig+open Blocks++module type S = sig++  (** Imperative Unlabeled Graphs *)+  module Concrete (V: COMPARABLE) : +    Sig.I with type V.t = V.t and type V.label = V.t and type E.t = V.t * V.t++  (** Abstract Imperative Unlabeled Graphs *)+  module Abstract(V: sig type t end) : +    Sig.IM with type V.label = V.t and type E.label = unit++  (** Imperative Labeled Graphs *)+  module ConcreteLabeled (V: COMPARABLE)(E: ORDERED_TYPE_DFT) :+    Sig.I with type V.t = V.t and type V.label = V.t +	    and type E.t = V.t * E.t * V.t and type E.label = E.t++  (** Abstract Imperative Labeled Graphs *)+  module AbstractLabeled (V: sig type t end)(E: ORDERED_TYPE_DFT) :+    Sig.IM with type V.label = V.t and type E.label = E.t++end++module I = Make(Make_Hashtbl)++type 'a abstract_vertex = { tag : int; label : 'a; mutable mark : int }++(* Implement the module [Mark]. *)+module Make_Mark+  (X: sig +     type graph+     type label +     val iter_vertex : (label abstract_vertex -> unit) -> graph -> unit+   end) = +struct+  type vertex = X.label abstract_vertex+  type graph = X.graph+  let get v = v.mark+  let set v m = v.mark <- m+  let clear g = X.iter_vertex (fun v -> set v 0) g+end++(* Vertex for the abstract imperative graphs. *)+module AbstractVertex(V: sig type t end) = struct++  type label = V.t+  type t = label abstract_vertex++  let compare x y = compare x.tag y.tag +  let hash x = Hashtbl.hash x.tag+  let equal x y = x.tag = y.tag+  let label x = x.label++  let create l = +    assert (!cpt_vertex < max_int);+    incr cpt_vertex;+    { tag = !cpt_vertex; label = l; mark = 0 }++end++module Digraph = struct++  module Concrete (V: COMPARABLE) = struct++    include I.Digraph.Concrete(V)++    let create ?(size=997) () = create size++    let add_vertex g v = ignore (add_vertex g v)+    let remove_vertex g v = ignore (remove_vertex g v)+    let remove_edge g v1 v2 = ignore (remove_edge g v1 v2)+    let remove_edge_e g e = ignore (remove_edge_e g e)++    let add_edge g v1 v2 = +      add_vertex g v1;+      add_vertex g v2;+      ignore (unsafe_add_edge g v1 v2)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let copy = HM.copy++  end++  module ConcreteBidirectional (V: COMPARABLE) = struct++    include I.Digraph.ConcreteBidirectional(V)++    let create ?(size=997) () = create size++    let add_vertex g v = +      if not (HM.mem v g) then ignore (unsafe_add_vertex g v)++    let add_edge g v1 v2 = +      add_vertex g v1;+      add_vertex g v2;+      ignore (unsafe_add_edge g v1 v2)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_vertex g v =+      if HM.mem v g then begin+	iter_pred_e (fun e -> ignore (remove_edge_e g e)) g v;+	iter_succ_e (fun e -> ignore (remove_edge_e g e)) g v;+	ignore (HM.remove v g)+      end++    let copy = HM.copy++    let remove_edge g v1 v2 = ignore (remove_edge g v1 v2)+    let remove_edge_e g e = ignore (remove_edge_e g e)++  end++  module ConcreteLabeled(V: COMPARABLE)(E: ORDERED_TYPE_DFT) = struct++    let default = E.default++    include I.Digraph.ConcreteLabeled(V)(E)++    let create ?(size=997) () = create size++    let add_vertex g v = ignore (add_vertex g v)+    let remove_edge g v1 v2 = ignore (remove_edge g v1 v2)+    let remove_edge_e g e = ignore (remove_edge_e g e)++    let add_edge_e g (v1, l, v2) = +      add_vertex g v1;+      add_vertex g v2;+      ignore (unsafe_add_edge g v1 (v2, l))++    let add_edge g v1 v2 = add_edge_e g (v1, default, v2)++    let remove_vertex g v =+      if HM.mem v g then+	let remove s =+	  S.fold +	    (fun (v2, _ as e) s -> if not (V.equal v v2) then S.add e s else s)+	    s S.empty+	in+	ignore (HM.remove v g);+	HM.iter (fun k s -> ignore (HM.add k (remove s) g)) g++    let copy = HM.copy++  end++  module Abstract(V: sig type t end) = struct+    +    include I.Digraph.Abstract(AbstractVertex(V))++    let create ?(size=997) () = { edges = G.create size; size = 0 }++    let add_vertex g v = +      if not (HM.mem v g.edges) then begin+	g.size <- Pervasives.succ g.size;+	ignore (G.unsafe_add_vertex g.edges v)+      end++    let add_edge g v1 v2 = +      add_vertex g v1;+      add_vertex g v2;+      ignore (unsafe_add_edge g.edges v1 v2)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_vertex g v = +      if HM.mem v g.edges then+	let e = g.edges in+	ignore (HM.remove v e);+	HM.iter (fun k s -> ignore (HM.add k (S.remove v s) e)) e;+	g.size <- Pervasives.pred g.size++    module Mark = Make_Mark(struct +			      type graph = t +			      type label = V.label +			      let iter_vertex = iter_vertex +			    end)++    let copy g =+      let h = HM.create 997 in+      let vertex v = +	try+	  HM.find v h+	with Not_found ->+	  let v' = V.create (V.label v) in+	  ignore (HM.add v v' h);+	  v'+      in+      map_vertex vertex g++    let remove_edge g v1 v2 = ignore (remove_edge g v1 v2)+    let remove_edge_e g e = ignore (remove_edge_e g e)++  end++  module AbstractLabeled(V: sig type t end)(Edge: ORDERED_TYPE_DFT) = struct+    +    include I.Digraph.AbstractLabeled(AbstractVertex(V))(Edge)++    let create ?(size=997) () = { edges = G.create size; size = 0 }++    let add_vertex g v = +      if not (HM.mem v g.edges) then begin+	g.size <- Pervasives.succ g.size;+	ignore (G.unsafe_add_vertex g.edges v)+      end++    let add_edge_e g (v1, l, v2) =+      add_vertex g v1;+      add_vertex g v2;+      ignore (unsafe_add_edge g.edges v1 (v2, l))++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_vertex g v =+      if HM.mem v g.edges then+	let remove s =+	  S.fold +	    (fun (v2, _ as e) s -> if not (V.equal v v2) then S.add e s else s)+	    s S.empty+	in+	let e = g.edges in+	ignore (HM.remove v e);+	HM.iter (fun k s -> ignore (HM.add k (remove s) e)) e;+	g.size <- Pervasives.pred g.size++    module Mark = Make_Mark(struct +			      type graph = t +			      type label = V.label +			      let iter_vertex = iter_vertex +			    end)++    let copy g =+      let h = HM.create 997 in+      let vertex v = +	try+	  HM.find v h+	with Not_found ->+	  let v' = V.create (V.label v) in+	  ignore (HM.add v v' h);+	  v'+      in+      map_vertex vertex g++    let remove_edge g v1 v2 = ignore (remove_edge g v1 v2)+    let remove_edge_e g e = ignore (remove_edge_e g e)++  end++end++module Graph = struct++  module Concrete(V: COMPARABLE) = struct++    module G = Digraph.Concrete(V) ++    include Graph(G)++    (* Export some definitions of [G] *)++    let create = G.create+    let copy = G.copy+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge g v1 v2 = +      G.add_edge g v1 v2;+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      ignore (G.unsafe_add_edge g v2 v1)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_edge g v1 v2 =+      G.remove_edge g v1 v2;+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      ignore (G.unsafe_remove_edge g v2 v1)++    let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  end++  module ConcreteLabeled (V: COMPARABLE)(E: ORDERED_TYPE_DFT) = struct++    module G = Digraph.ConcreteLabeled(V)(E)++    include Graph(G)++    (* Export some definitions of [G] *)++    let create = G.create+    let copy = G.copy+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge_e g (v1, l, v2 as e) =+      G.add_edge_e g e;+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      ignore (G.unsafe_add_edge g v2 (v1, l))++    let add_edge g v1 v2 = add_edge_e g (v1, G.default, v2)++    let remove_edge g v1 v2 =+      G.remove_edge g v1 v2;+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      ignore (G.unsafe_remove_edge g v2 v1)++    let remove_edge_e g (v1, l, v2 as e) =+      G.remove_edge_e g e;+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      ignore (G.unsafe_remove_edge_e g (v2, l, v1))++  end++  module Abstract(V: sig type t end) = struct++    module G = Digraph.Abstract(V)++    include Graph(G)++    (* Export some definitions of [G] *)++    module Mark = G.Mark+    let create = G.create+    let copy = G.copy+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge g v1 v2 = +      G.add_edge g v1 v2;+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      ignore (G.unsafe_add_edge g.G.edges v2 v1)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_edge g v1 v2 =+      G.remove_edge g v1 v2;+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      ignore (G.unsafe_remove_edge g.G.edges v2 v1)++    let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  end++  module AbstractLabeled (V: sig type t end)(Edge: ORDERED_TYPE_DFT) = struct++    module G = Digraph.AbstractLabeled(V)(Edge)++    include Graph(G)++    (* Export some definitions of [G] *)++    module Mark = G.Mark+    let create = G.create+    let copy = G.copy+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge_e g (v1, l, v2 as e) = +      G.add_edge_e g e;+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      ignore (G.unsafe_add_edge g.G.edges v2 (v1, l))++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_edge g v1 v2 =+      G.remove_edge g v1 v2;+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      ignore (G.unsafe_remove_edge g.G.edges v2 v1)++    let remove_edge_e g (v1, l, v2 as e) =+      ignore (G.remove_edge_e g e);+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      ignore (G.unsafe_remove_edge_e g.G.edges (v2, l, v1))++  end++end++module Matrix = struct++  module type S = sig+    include Sig.I with type V.t = int and type V.label = int+		  and type E.t = int * int+    val make : int -> t+  end++  module Digraph = struct++    module V = struct+      type t = int+      type label = int+      let compare = Pervasives.compare+      let hash = Hashtbl.hash+      let equal = (==)+      let create i = i+      let label i = i+    end++    module E = struct+      type t = V.t * V.t+      type vertex = V.t+      let compare = Pervasives.compare+      type label = unit+      let create v1 _ v2 = (v1, v2)+      let src = fst+      let dst = snd+      let label _ = ()+    end++    type t = Bitv.t array+    type vertex = V.t+    type edge = E.t++    let create ?size () = +      failwith "do not use Matrix.create; please use Matrix.make instead"+		      +    let make n =+      if n < 0 then invalid_arg "Matrix.make";+      Array.init n (fun _ -> Bitv.create n false)++    let is_directed = true+			+    let nb_vertex = Array.length+    let is_empty g = nb_vertex g = 0+    let nb_edges =+      Array.fold_left (Bitv.fold_left (fun n b -> if b then n+1 else n)) 0+	+    let mem_vertex g v = 0 <= v && v < nb_vertex g+    let mem_edge g i j = Bitv.get g.(i) j+    let mem_edge_e g (i,j) = Bitv.get g.(i) j+    let find_edge g i j = if mem_edge g i j then i, j else raise Not_found+			       +    (* constructors *)+    let add_edge g i j = Bitv.set g.(i) j true+    let add_edge_e g (i,j) = Bitv.set g.(i) j true+			       +    let remove_edge g i j = Bitv.set g.(i) j false+    let remove_edge_e g (i,j) = Bitv.set g.(i) j false++    let unsafe_add_edge g i j = +      Bitv.unsafe_set (Array.unsafe_get g i) j true+    let unsafe_remove_edge g i j = +      Bitv.unsafe_set (Array.unsafe_get g i) j false+				  +    let remove_vertex g _ = ()+    let add_vertex g _ = ()+			   +    let copy g = Array.init (nb_vertex g) (fun i -> Bitv.copy g.(i))+		   +    (* iter/fold on all vertices/edges of a graph *)+    let iter_vertex f g = +      for i = 0 to nb_vertex g - 1 do f i done+      +    let iter_edges f g =+      for i = 0 to nb_vertex g - 1 do +	Bitv.iteri (fun j b -> if b then f i j) g.(i)+      done+      +    let fold_vertex f g a = +      let n = nb_vertex g in +      let rec fold i a = if i = n then a else fold (i+1) (f i a) in fold 0 a+								      +    let fold_edges f g a =+      fold_vertex+	(fun i a -> +	   Bitv.foldi_right (fun j b a -> if b then f i j a else a) g.(i) a)+	g a+	+    (* successors and predecessors of a vertex *)+    let succ g i = +      Bitv.foldi_left (fun l j b -> if b then j::l else l) [] g.(i)+	+    let pred g i = +      fold_vertex+	(fun j a -> if Bitv.unsafe_get g.(j) i then j :: a else a)+	g []+	+    (* iter/fold on all successor/predecessor of a vertex. *)+    let iter_succ f g i =+      let si = g.(i) in+      for j = 0 to nb_vertex g - 1 do if Bitv.unsafe_get si j then f j done+      (* optimization w.r.t. +	 [Bitv.iteri (fun j b -> if b then f j) g.(i)]+      *)++    let iter_pred f g i =+      for j = 0 to nb_vertex g - 1 do if Bitv.unsafe_get g.(j) i then f j done+      +    let fold_succ f g i a =+      Bitv.foldi_right (fun j b a -> if b then f j a else a) g.(i) a+	+    let fold_pred f g i a =+      fold_vertex+	(fun j a -> if Bitv.unsafe_get g.(j) i then f j a else a)+	g a+	+    (* degree *)+    let out_degree g i = fold_succ (fun _ n -> n + 1) g i 0+			   +    let in_degree g i = fold_pred (fun _ n -> n + 1) g i 0+			  +    (* map iterator on vertex *)+    let map_vertex f g =+      let n = nb_vertex g in+      let g' = make n in+      iter_edges+	(fun i j -> +	   let fi = f i in+	   let fj = f j in+	   if fi < 0 || fi >= n || fj < 0 || fj >= n then +	     invalid_arg "map_vertex";+	   Bitv.unsafe_set g'.(fi) fj true)+	g;+      g'++    (* labeled edges going from/to a vertex *)+    (* successors and predecessors of a vertex *)+    let succ_e g i = +      Bitv.foldi_left (fun l j b -> if b then (i,j)::l else l) [] g.(i)++    let pred_e g i = +      fold_vertex+	(fun j a -> if Bitv.unsafe_get g.(j) i then (j,i) :: a else a)+	g []+	+    (* iter/fold on all labeled edges of a graph *)+    let iter_edges_e f g =+      for i = 0 to nb_vertex g - 1 do +	Bitv.iteri (fun j b -> if b then f (i,j)) g.(i)+      done++    let fold_edges_e f g a =+      fold_vertex+	(fun i a -> +	   Bitv.foldi_right (fun j b a -> if b then f (i,j) a else a) g.(i) a)+	g a++    (* iter/fold on all edges going from/to a vertex *)+    let iter_succ_e f g i =+      let si = g.(i) in+      for j = 0 to nb_vertex g - 1 do if Bitv.unsafe_get si j then f (i,j) done+      +    let iter_pred_e f g i =+      for j = 0 to nb_vertex g - 1 do +	if Bitv.unsafe_get g.(j) i then f (j,i) +      done++    let fold_succ_e f g i a =+      Bitv.foldi_right (fun j b a -> if b then f (i,j) a else a) g.(i) a++    let fold_pred_e f g i a =+      fold_vertex+	(fun j a -> if Bitv.unsafe_get g.(j) i then f (j,i) a else a)+	g a++  end++  module Graph = struct++    module G = Digraph ++    include Blocks.Graph(G)		 +    (* Export some definitions of [G] *)++    let create = G.create+    let make = G.make+    let copy = G.copy+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge g v1 v2 = +      G.add_edge g v1 v2;+      ignore (G.unsafe_add_edge g v2 v1)++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_edge g v1 v2 =+      G.remove_edge g v1 v2;+      ignore (G.unsafe_remove_edge g v2 v1)++    let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  end++end+
+ external/ocamlgraph/src/imperative.mli view
@@ -0,0 +1,87 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: imperative.mli,v 1.18 2006-05-12 14:07:16 filliatr Exp $ *)++(** Imperative Implementations *)++open Sig++(** Signature of imperative graphs *)+module type S = sig++  (** Imperative Unlabeled Graphs *)+  module Concrete (V: COMPARABLE) : +    Sig.I with type V.t = V.t and type V.label = V.t and type E.t = V.t * V.t++  (** Abstract Imperative Unlabeled Graphs *)+  module Abstract(V: ANY_TYPE) : +    Sig.IM with type V.label = V.t and type E.label = unit++  (** Imperative Labeled Graphs *)+  module ConcreteLabeled (V: COMPARABLE)(E: ORDERED_TYPE_DFT) :+    Sig.I with type V.t = V.t and type V.label = V.t +	    and type E.t = V.t * E.t * V.t and type E.label = E.t++  (** Abstract Imperative Labeled Graphs *)+  module AbstractLabeled (V: ANY_TYPE)(E: ORDERED_TYPE_DFT) :+    Sig.IM with type V.label = V.t and type E.label = E.t++end++(** Imperative Directed Graphs *)++module Digraph : sig +  include S   ++  (** Imperative Unlabeled, bidirectional graph (gives predecessors in+      constant time) *)+  module ConcreteBidirectional (V: COMPARABLE) : +    Sig.I with type V.t = V.t and type V.label = V.t and type E.t = V.t * V.t +end++(** Imperative Undirected Graphs *)+module Graph : S++(** Imperative graphs implemented as adjacency matrices *)+module Matrix : sig++  module type S = sig++    (** Vertices are integers in [0..n-1]. +        A vertex label is the vertex itself. +        Edges are unlabeled. *)++    include Sig.I with type V.t = int and type V.label = int+		  and type E.t = int * int++    (** Creation. graphs are not resizeable: size is given at creation time.+        Thus [make] must be used instead of [create] *)+    val make : int -> t++    (** Note: [add_vertex] and [remove_vertex] have no effect *)++  end++  module Digraph : S+    (** Imperative Directed Graphs implemented with adjacency matrices *)++  module Graph : S+    (** Imperative Undirected Graphs implemented with adjacency matrices *)++end+
+ external/ocamlgraph/src/kruskal.ml view
@@ -0,0 +1,74 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: kruskal.ml,v 1.5 2005-06-30 10:48:55 filliatr Exp $ *)++open Util++module type UNIONFIND = sig+  type elt+  type t+    +  val init : elt list -> t+  val find : elt -> t -> elt+  val union : elt -> elt -> t -> unit+end++module type G = sig+  type t +  module V : Sig.COMPARABLE +  module E : sig +    type t +    type label +    val label : t -> label +    val dst : t -> V.t +    val src : t -> V.t+  end +  val fold_vertex : (V.t -> 'a -> 'a) -> t -> 'a -> 'a+  val iter_edges_e : (E.t -> unit) -> t ->  unit+end++module Generic+  (G: G)+  (W : Sig.ORDERED_TYPE with type t=G.E.label)+  (UF: UNIONFIND with type elt=G.V.t) =+struct+    +  let spanningtree g =   +    let vertices = G.fold_vertex (fun v a -> v :: a) g [] in+    let uf = UF.init vertices in+    let edges = +      let l = ref [] in+      G.iter_edges_e (fun e -> l:=e::!l) g;+      List.sort (fun e e'-> W.compare (G.E.label e) (G.E.label e')) !l+    in+    let s = ref [] in+    let cover e =+      let u,v = G.E.src e , G.E.dst e in+      if G.V.compare (UF.find u uf) (UF.find v uf) <> 0 then+	(UF.union u v uf; s:=e::!s)+    in+    List.iter cover edges;!s++end++module Make+  (G: G)+  (W : Sig.ORDERED_TYPE with type t=G.E.label)+  = +  Generic(G)(W)(Unionfind.Make(G.V))+
+ external/ocamlgraph/src/kruskal.mli view
@@ -0,0 +1,65 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: kruskal.mli,v 1.5 2005-06-30 10:48:55 filliatr Exp $ *)++(** Kruskal's algorithm *)++(** Minimal graph signature for Kruskal *)+module type G = sig+  type t +  module V : Sig.COMPARABLE +  module E : sig +    type t +    type label +    val label : t -> label +    val dst : t -> V.t +    val src : t -> V.t+  end +  val fold_vertex : (V.t -> 'a -> 'a) -> t -> 'a -> 'a+  val iter_edges_e : (E.t -> unit) -> t ->  unit+end++module Make+  (G: G)+  (W: Sig.ORDERED_TYPE with type t = G.E.label) :+sig+    +  val spanningtree : G.t -> G.E.t list++end  ++(** Generic version where union-find implementation is provided *)++module type UNIONFIND = sig+  type elt+  type t+    +  val init : elt list -> t+  val find : elt -> t -> elt+  val union : elt -> elt -> t -> unit+end++module Generic+  (G: G)+  (W: Sig.ORDERED_TYPE with type t=G.E.label)+  (UF: UNIONFIND with type elt=G.V.t) : +sig+    +  val spanningtree : G.t -> G.E.t list++end
+ external/ocamlgraph/src/mcs_m.ml view
@@ -0,0 +1,203 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(**+  Maximal Cardinality Search (MCS-M).+  +  Based on the article:+  Maximal Cardinality Search for Computing Minimal Triangulations of Graphs.+  by A. Berry, Jean R. S. Blair, Pinar Heggernes & Barry W. Peyton.+  +  @author Matthieu Sozeau <mattam\@mattam.org>+  @author Pierre-Loic Garoche <ploc\@garoche.net>+  +  $Id: mcs_m.ml,v 1.5 2005-11-02 13:43:35 filliatr Exp $+*)+       +module MaximalCardinalitySearch = struct++  module WeightedV(V : Sig.COMPARABLE) = struct+    include Util.DataV(struct type t = int end)(V)+    let weight = data+    let set_weight = set_data+  end++  module P(Gr : Sig.P) = struct+    type edgelist = (Gr.V.t * Gr.V.t) list++    module NewV = WeightedV(Gr.V)+    module G = Persistent.Graph.Concrete(NewV)+    module EdgeSet = Set.Make(G.E)+    module VerticesSet = Set.Make(NewV)+    module Choose = Oper.Choose(G)+    module H = Hashtbl.Make(NewV)+      +    exception Found+      +    let check_path g u v =+      let h = H.create 97 in+      let maxw = NewV.weight u in+      let rec aux x : bool = +	if H.mem h x then+	  false+	else +	  if x = v then true+	  else+	    if NewV.weight x < maxw || x = u then+	      begin+		H.add h x ();+		G.fold_succ +		  (fun x found -> +		     if not found then aux x+		     else found)+		  g x false+	      end+	    else (H.add h x (); false)+      in aux u+	   +    module Copy = Gmap.Vertex(Gr)(struct include G include Builder.P(G) end)++    let fold f d =+      let rec aux = function+	  (true, a) -> aux (f a)+	| (false, a) -> a+      in aux d+	   +    let mcsm g =+      let g' = Copy.map (NewV.create 0) g in+      let (_, _, ord, triang) =+	fold +	  (fun ((i, g', a, f) as x)->+	     if i = 0 then (false, x)+	     else+	       let v =+		 G.fold_vertex+		   (fun x max -> +		      if NewV.weight x > NewV.weight max then x else max)+		   g' (ref 0, snd (Choose.choose_vertex g'))+	       in+	       let s =+		 G.fold_vertex+		   (fun x s ->+		      if x = v then s+		      else +			if check_path g' x v then+			  VerticesSet.add x s+			else s)+		   g' VerticesSet.empty+	       in+	       let f' = +		 VerticesSet.fold+		   (fun x f ->+		      NewV.set_weight x (succ (NewV.weight x));+		      if not (G.mem_edge g' x v) then+			EdgeSet.add (x,v) f+		      else f)+		   s f+	       in+	       let g' = G.remove_vertex g' v in+	       let a' = (i, NewV.label v) :: a in+		 (true, (i - 1, g', a', f')))+	  (true, (Gr.nb_vertex g, g', [], EdgeSet.empty))+      in+      (List.rev ord, +       EdgeSet.fold +	 (fun (x, y) e -> (NewV.label x, NewV.label y) :: e)+	 triang [])+	  +    let triangulate g =+      let (_, triang) = mcsm g in+      List.fold_left (fun g (x, y) -> Gr.add_edge g x y) g triang+  end++  module I(Gr : Sig.I) = struct+    type edgelist = (Gr.V.t * Gr.V.t) list	  ++    module NewV = WeightedV(Gr.V)+    module G = Imperative.Graph.Concrete(NewV)+    module EdgeSet = Set.Make(G.E)+    module VerticesSet = Set.Make(NewV)+    module Choose = Oper.Choose(G)+    module H = Hashtbl.Make(NewV)+      +    exception Found+      +    let check_path g u v =+      let h = H.create 97 in+      let maxw = NewV.weight u in+      let rec aux x : bool = +	if H.mem h x then+	  false+	else +	  if x = v then true+	  else+	    if NewV.weight x < maxw || x = u then begin+	      H.add h x ();+	      G.fold_succ +		(fun x found -> +		   if not found then aux x+		   else found)+		g x false+	    end else (H.add h x (); false)+      in aux u+	   +    module Copy = Gmap.Vertex(Gr)(struct include G include Builder.I(G) end)+      +    let mcsm g =+      let f = ref EdgeSet.empty+      and a = ref []+      and g' = Copy.map (NewV.create 0) g in+      for i = Gr.nb_vertex g downto 1 do+	let v =+	  G.fold_vertex+	    (fun x max -> +	       if NewV.weight x > NewV.weight max then x else max)+	    g' (ref 0, snd (Choose.choose_vertex g'))+	in+	let s =+	  G.fold_vertex+	    (fun x s ->+	       if x = v then s+	       else +		 if check_path g' x v then+		   VerticesSet.add x s+		 else s)+	    g' VerticesSet.empty+	in+	let f' = +	  VerticesSet.fold+	    (fun x f ->+	       NewV.set_weight x (succ (NewV.weight x));+	       if not (G.mem_edge g' x v) then+		 EdgeSet.add (x,v) f+	       else f)+	    s !f+	in+	f := f';+	G.remove_vertex g' v;+	a := (i, NewV.label v) :: !a;+      done;+      (List.rev !a, +       EdgeSet.fold +	 (fun (x, y) e -> (NewV.label x, NewV.label y) :: e)+	 !f [])+	  +    let triangulate g =+      let (_, triang) = mcsm g in+      List.iter (fun (x, y) -> Gr.add_edge g x y) triang+  end+end
+ external/ocamlgraph/src/mcs_m.mli view
@@ -0,0 +1,53 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(**+  Maximal Cardinality Search (MCS-M) algorithm+  +  Based on the article:+  Maximal Cardinality Search for Computing Minimal Triangulations of Graphs.+  by A. Berry, Jean R. S. Blair, Pinar Heggernes & Barry W. Peyton.+  +  @author Matthieu Sozeau+  @author Pierre-Loic Garoche+  +  $Id: mcs_m.mli,v 1.2 2004-10-19 15:21:44 signoles Exp $+*)++module MaximalCardinalitySearch : sig+  module P(G : Sig.P) : sig+    type edgelist = (G.V.t * G.V.t) list	  +	+    (** [mcsm g] returns a tuple [(o, e)] where [o] is a perfect elimination+      order of [g'] where [g'] is the triangulation [e] applied to [g]. *)+    val mcsm : G.t -> (int * G.V.t) list * edgelist++    (** [triangulate g] computes a triangulation of [g]+      using the MCS-M algorithm *)+    val triangulate : G.t -> G.t+  end+  module I(Gr : Sig.I) : sig+    type edgelist = (Gr.V.t * Gr.V.t) list	  +          +    (** [mcsm g] return a tuple [(o, e)] where o is a perfect elimination order+      of [g'] where [g'] is the triangulation [e] applied to [g]. *) +    val mcsm : Gr.t -> (int * Gr.V.t) list * edgelist+          +    (** [triangulate g] triangulates [g] using the MCS-M algorithm *)+    val triangulate : Gr.t -> unit+  end+end
+ external/ocamlgraph/src/md.ml view
@@ -0,0 +1,163 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: md.ml,v 1.6 2004-10-22 14:42:06 signoles Exp $ *)++(** Minimum Degree.+  +  Based on the article:+  The Minimum Degree Heuristic and the Minimal Triangulation Process+  by A. Berry, Pinar Heggernes & Geneviève Simonet.+  +  @author Matthieu Sozeau+  @author Pierre-Loic Garoche *)+  +module P(G : Sig.P) = struct++  module VertexSet = Set.Make(G.V)+  module CT = Cliquetree.CliqueTree(G)++  module Choose = Oper.Choose(G)+(*  module NG = Neighborhood.Graph(G)*)++  type edgeset = (G.V.t * G.V.t) list+      +  let md g =+    let gref = ref g in+    let gtri = ref g in+    let n = G.nb_vertex g in+    let tri = ref [] in+    let ord = ref [] in+    let i = ref 0 in+    while not (CT.is_chordal !gtri) && !i < n do+      let v = +	let x = +	  G.fold_vertex +	    (fun v' x ->+	       let deg' = G.out_degree !gref v' in+	       match x with+		   Some (v,deg) when deg' > deg -> x+		 | _ -> Some (v', deg'))+	    !gref None+	in match x with +	    Some (v,_) -> v+	  | None -> failwith "Expecting some vertex"+      in+      let ng = G.succ !gref v in+      let g', tri' =+	List.fold_left+	  (fun (g, tri) v ->+	     let tri' =+	       List.fold_left+		 (fun tri v' ->+		    if v <> v' && not (G.mem_edge g v v') then+		      (v, v') :: tri+		    else tri)+		 tri ng+	     in+	     let g' = +	       List.fold_left+		 (fun g v' ->+		    if v <> v' then+		      G.add_edge g v v'+		    else g)+		 g ng+	     in +	     (g', tri'))+	  (!gref, []) ng +      in+      ord := v :: !ord;+      gtri := List.fold_left +	(fun g (x,y) -> G.add_edge g x y) +	!gtri tri';+      gref := G.remove_vertex g' v;+      tri := tri' @ !tri;+      incr i;+    done;+    (!gtri, !tri, !ord)+	  +  let triangulate g = +    let gtri, _, _ = md g in +    gtri++end++module I(G : Sig.I) = struct++  module VertexSet = Set.Make(G.V)   +  module CT = Cliquetree.CliqueTree(G)++  module Choose = Oper.Choose(G)+(*  module NG = Neighborhood.Graph(G)*)+            +  type edgeset = (G.V.t * G.V.t) list+      +  module Copy = Gmap.Vertex(G)(struct include G include Builder.I(G) end)++  let md g =+    let gtri = Copy.map (fun x -> x) g in+    let gcur = Copy.map (fun x -> x) g in+    let n = G.nb_vertex g in+    let tri = ref [] in+    let ord = ref [] in+    let i = ref 0 in+    while not (CT.is_chordal gtri) && !i < n do+      let v = +	let x = +	  G.fold_vertex +	    (fun v' x ->+	       let deg' = G.out_degree gcur v' in+	       match x with+		   Some (v,deg) when deg' > deg -> x+		 | _ -> Some (v', deg'))+	    gcur None+	in match x with +	    Some (v,_) -> v+	  | None -> failwith "Expecting some vertex"+      in+      let ng = G.succ gcur v in+      let tri' =+	List.fold_left+	  (fun tri v ->+	     List.fold_left+	     (fun tri v' ->+		let tri' =+		  if v <> v' && not (G.mem_edge g v v') then+		    (v, v') :: tri+		  else +		    tri+		in+		List.iter (fun v' -> if v <> v' then G.add_edge gcur v v') ng;+		tri')+	     tri ng)+	  [] ng+      in+      ord := v :: !ord;+      List.iter+	(fun (x,y) -> G.add_edge gtri x y) +	tri';+      G.remove_vertex gcur v;+      tri := tri' @ !tri;+      incr i;+    done;+    (gtri, !tri, !ord)+	  +  let triangulate g = +    let gtri, _, _ = md g in +    gtri++end
+ external/ocamlgraph/src/md.mli view
@@ -0,0 +1,57 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: md.mli,v 1.2 2004-06-28 13:48:25 signoles Exp $ *)++(** Minimum Degree algorithm+  +  Based on the article:+  The Minimum Degree Heuristic and the Minimal Triangulation Process+  by A. Berry, Pinar Heggernes & Geneviève Simonet.+  +  @author Matthieu Sozeau+  @author Pierre-Loic Garoche *)++module P(G : Sig.P) : sig++  type edgeset = (G.V.t * G.V.t) list++  val md : G.t -> G.t * edgeset * G.V.t list+    (** [md g] return a tuple [(g', e, o)] where [g'] is +      a triangulated graph, [e] is the triangulation of [g] and+      [o] is a perfect elimination order of [g'] *)++  val triangulate : G.t -> G.t+    (** [triangulate g] return the graph [g'] produced by applying +      miminum degree to [g]. *)++end++module I(G : Sig.I) : sig+  +  type edgeset = (G.V.t * G.V.t) list+	+  val md : G.t -> G.t * edgeset * G.V.t list+    (** [md g] return a tuple [(g', e, o)] where [g'] is +      a triangulated graph, [e] is the triangulation of [g] and+      [o] is a perfect elimination order of [g'] *)++  val triangulate : G.t -> G.t+    (** [triangulate g] return the graph [g'] produced by applying +      miminum degree to [g]. *)++end
+ external/ocamlgraph/src/minsep.ml view
@@ -0,0 +1,131 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*i $Id: minsep.ml,v 1.7 2004-10-25 15:46:16 signoles Exp $ i*)++module type G = sig+  type t+  module V : Sig.COMPARABLE+  val succ: t -> V.t -> V.t list+  val iter_succ: (V.t -> unit) -> t -> V.t -> unit+  val fold_succ: (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val iter_vertex: (V.t -> unit) -> t -> unit+  val fold_vertex: (V.t -> 'a -> 'a) -> t -> 'a -> 'a+end++module type MINSEP = sig+  module G : G+  module Vertex_Set : Set.S with type elt = G.V.t+  module VSetset : Set.S with type elt = Vertex_Set.t+  val allminsep : G.t -> Vertex_Set.t list+  val list_of_allminsep : G.t -> G.V.t list list+  val set_of_allminsep : G.t -> VSetset.t+end++module Make+  (G : sig +     include G+     val cc: t -> V.t list -> V.t list list +       (** compute the set of connected components of G(V \ l) *)+   end) =+struct++  module N = Oper.Neighbourhood(G)+  module Vertex_Set = N.Vertex_Set+  module VSetset = Set.Make(Vertex_Set)++  let initialisation g =+    let cc = G.cc g in+    let neighbourhood = N.list_from_vertex g in+    let neighbourhoods = N.set_from_vertices g in+    G.fold_vertex+      (fun v s -> +	 List.fold_left +	   (fun s l -> neighbourhoods l :: s)+	   s (cc (v :: neighbourhood v)))+      g []++  let generation g =+    let neighbourhood = N.list_from_vertex g in+    let neighbourhoods = N.set_from_vertices g in+    let cc = G.cc g in+    let rec gen_aux seen bigs = function+      | [] -> bigs+      | s :: tl ->+	  let l = Vertex_Set.elements s in+	  let seen = VSetset.add s seen in+	  let bigs, tl =+	    Vertex_Set.fold +	      (fun v c ->+		 let add_neighbourhoods (bigs, tl) l = +		   let s = neighbourhoods l in+		   s :: bigs, if VSetset.mem s seen then tl else s :: tl+		 in+		 List.fold_left +		   add_neighbourhoods+		   (bigs, tl) (cc (l @ neighbourhood v)))+	      s (bigs, tl)+	  in+	  gen_aux seen bigs tl+    in+    fun bigs -> gen_aux VSetset.empty bigs bigs++  let allminsep g = generation g (initialisation g)++  let set_of_allminsep g = +    List.fold_left +      (fun bigs s -> VSetset.add s bigs) VSetset.empty (allminsep g)++  let list_of_allminsep g = List.map Vertex_Set.elements (allminsep g)++end++module P(G : sig include G val remove_vertex : t -> V.t -> t end) = struct+  module G = G+  include Make(struct+		 include G+		 let cc =+		   let module CC = Components.Make(G) in+		   fun g l ->+		     let g = List.fold_left remove_vertex g l in+		     CC.scc_list g+	       end)+end++module I(G : sig +	   include G +	   module Mark : Sig.MARK with type graph = t and type vertex = V.t +	 end) =  +struct+  module G = G+  include Make(struct+		 include G+		 let cc = +		   let module CC = +		     Components.Make+		       (struct +			  include G +			  let iter_vertex f = +			    iter_vertex (fun v -> if Mark.get v=0 then f v)+			end) +		   in+		   fun g l ->+		     G.Mark.clear g;+		     List.iter (fun v -> G.Mark.set v 1) l;+		     CC.scc_list g+	       end)+end
+ external/ocamlgraph/src/minsep.mli view
@@ -0,0 +1,70 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*i $Id: minsep.mli,v 1.4 2004-10-22 16:31:03 conchon Exp $ i*)++(**+  Minimal separators of a graph+  +  Based on the article:+  Generating all the minimal separators of a graph.+  by A. Berry, J.-P. Bordat and O.Cogis+  http://www.isima.fr/berry/generating.html+  +  A set [S] of vertices is a minimal separator if it exists 2 distinct+  connected components [C] and [D] in [G \ S] such that each vertex of [S] has+  a successor in [C] and [D]. *)++(** Minimal signature for computing the minimal separators *)+module type G = sig+  type t+  module V : Sig.COMPARABLE+  val succ: t -> V.t -> V.t list+  val iter_succ: (V.t -> unit) -> t -> V.t -> unit+  val fold_succ: (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val iter_vertex: (V.t -> unit) -> t -> unit+  val fold_vertex: (V.t -> 'a -> 'a) -> t -> 'a -> 'a+end++module type MINSEP = sig+  module G : G+    (** Implementation of a graph *)+  module Vertex_Set : Set.S with type elt = G.V.t+    (** Implementation of a set of vertex *)+  module VSetset : Set.S with type elt = Vertex_Set.t+    (** Implementation of a set of [Vertex_Set] *)++  val allminsep : G.t -> Vertex_Set.t list+    (** [allminsep g] computes the list of all minimal separators of g. *)+  val list_of_allminsep : G.t -> G.V.t list list+    (** Less efficient that [allminsep] *)+  val set_of_allminsep : G.t -> VSetset.t+    (** Less efficient that [allminsep] *)+end++(** Implementation for a persistent graph *)+module P(G : sig include G val remove_vertex : t -> V.t -> t end) : +  MINSEP with module G = G++(** Implementation for an imperative graph.+  Less efficient that the implementation for a persistent graph *)+module I(G : sig +	   include G +	   module Mark : Sig.MARK with type graph = t and type vertex = V.t+	 end) : +  MINSEP with module G = G+
+ external/ocamlgraph/src/oper.ml view
@@ -0,0 +1,171 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: oper.ml,v 1.13 2005-06-30 10:48:55 filliatr Exp $ *)++(* Basic operations over graphs *)++module type S = sig+  type g+  val transitive_closure : ?reflexive:bool -> g -> g+  val add_transitive_closure : ?reflexive:bool -> g -> g+  val mirror : g -> g+  val complement : g -> g+  val intersect : g -> g -> g+  val union : g -> g -> g+end++module Make(B : Builder.S) = struct++  open B++  (* Roy-Warshall's algorithm *)++  type g = G.t++  let add_transitive_closure ?(reflexive=false) g0 =+    let phi v g =+      let g = if reflexive then B.add_edge g v v else g in+      G.fold_succ+	(fun sv g -> G.fold_pred (fun pv g -> B.add_edge g pv sv) g v g) +	g v g+    in+    G.fold_vertex phi g0 g0++  let transitive_closure ?(reflexive=false) g0 = +    add_transitive_closure ~reflexive (B.copy g0)++  module H = Hashtbl.Make(G.V)++  let mirror g =+    if G.is_directed then begin+      let g' = B.empty () in+        G.fold_edges_e+	  (fun e g' -> +	     let v1 = (G.E.src e) in+	     let v2 = (G.E.dst e) in+	     B.add_edge_e g' (G.E.create v2 (G.E.label e) v1))+	  g g'+    end else+      B.copy g++  let complement g =+    G.fold_vertex+      (fun v g' ->+	 G.fold_vertex+	   (fun w g' ->+	      if G.mem_edge g v w then g'+	      else B.add_edge g' v w)+	 g g')+      g (B.empty ())++  let intersect g1 g2 = +    G.fold_vertex+      (fun v g ->+	 try+	   let succ = G.succ_e g2 v in+	   G.fold_succ_e +	     (fun e g -> +		if List.mem e succ +		then B.add_edge_e g e +		else B.add_vertex g (G.E.dst e))+	     g1 v (B.add_vertex g v)+	 with Invalid_argument _ -> +	   (* $v \notin g2$ *)+	   g)+      g1 (B.empty ())++  let union g1 g2 =+    let add g1 g2 = +      (* add the graph [g1] in [g2] *)+      G.fold_vertex +	(fun v g -> +	   G.fold_succ_e (fun e g -> B.add_edge_e g e) g1 v (B.add_vertex g v))+	g1 g2+    in+    add g1 (B.copy g2)++end++module P(G : Sig.P) = Make(Builder.P(G))+module I(G : Sig.I) = Make(Builder.I(G))++module Choose(G : sig+		type t +		type vertex +		type edge +		val iter_vertex : (vertex -> unit) -> t -> unit+		val iter_edges_e : (edge -> unit) -> t -> unit+	      end) =+struct++  exception Found_Vertex of G.vertex+  let choose_vertex g = +    try+      G.iter_vertex (fun v -> raise (Found_Vertex v)) g;+      invalid_arg "choose_vertex"+    with Found_Vertex v ->+      v++  exception Found_Edge of G.edge+  let choose_edge g =+    try+      G.iter_edges_e (fun v -> raise (Found_Edge v)) g;+      invalid_arg "choose_vertex"+    with Found_Edge v ->+      v++end++module Neighbourhood(G : sig +		      type t +		      module V : Sig.COMPARABLE+		      val fold_succ: (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+		      val succ: t -> V.t -> V.t list+		    end) =+struct++  module Vertex_Set = Set.Make(G.V)++  let set_from_vertex g v =+    G.fold_succ +      (fun v' s -> if G.V.equal v v' then s else Vertex_Set.add v' s) +      g v Vertex_Set.empty ++  let list_from_vertex g v =+    let rec aux = function+      | [] -> []+      | v' :: l ->+	  if G.V.equal v v' then begin+	    assert (not (List.exists (G.V.equal v) l));+	    l+	  end else+	    v' :: aux l+    in+    aux (G.succ g v)++  let set_from_vertices g l =+    let fold_left f = List.fold_left f Vertex_Set.empty l in+    let env_init = fold_left (fun s v -> Vertex_Set.add v s) in+    let add x s = +      if Vertex_Set.mem x env_init then s else Vertex_Set.add x s +    in+    fold_left (fun s v -> G.fold_succ add g v s)++  let list_from_vertices g l = Vertex_Set.elements (set_from_vertices g l)++end
+ external/ocamlgraph/src/oper.mli view
@@ -0,0 +1,124 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: oper.mli,v 1.15 2005-01-18 16:40:14 signoles Exp $ *)++(** Basic operations over graphs *)++(** {1 Basic operations over graphs} *)++module type S = sig++  type g++  val transitive_closure : ?reflexive:bool -> g -> g+    (** [transitive_closure ?reflexive g] returns the transitive closure +      of [g] (as a new graph). Loops (i.e. edges from a vertex to itself) +      are added only if [reflexive] is [true] (default is [false]). *)++  val add_transitive_closure : ?reflexive:bool -> g -> g+    (** [add_transitive_closure ?reflexive g] replaces [g] by its+      transitive closure. Meaningless for persistent implementations+      (then acts as [transitive_closure]). *)++  val mirror : g -> g+    (** [mirror g] returns a new graph which is the mirror image of [g]:+      each edge from [u] to [v] has been replaced by an edge from [v] to [u].+      For undirected graphs, it simply returns a copy of [g]. *)++  val complement : g -> g+    (** [complement g] returns a new graph which is the complement of [g]:+      each edge present in [g] is not present in the resulting graph and+      vice-versa. Edges of the returned graph are unlabeled. *)++  val intersect : g -> g -> g+    (** [intersect g1 g2] returns a new graph which is the intersection of [g1]+      and [g2]: each vertex and edge present in [g1] *and* [g2] is present +      in the resulting graph. *)++  val union : g -> g -> g+    (** [union g1 g2] returns a new graph which is the union of [g1] and [g2]:+      each vertex and edge present in [g1] *or* [g2] is present in the +      resulting graph. *)+      +end++module Make(B : Builder.S) : S with type g = B.G.t+  (** Basic operations over graphs *)++module P(G : Sig.P) : S with type g = G.t+  (** Basic operations over persistent graphs *)++module I(G : Sig.I) : S with type g = G.t+  (** Basic operations over imperative graphs *)++(** {1 Choose} *)++(** Choose an element in a graph *)+module Choose(G : sig +		type t +		type vertex +		type edge +		val iter_vertex : (vertex -> unit) -> t -> unit+		val iter_edges_e : (edge -> unit) -> t -> unit+	      end) :+sig++  val choose_vertex : G.t -> G.vertex+    (** [choose_vertex g] returns a vertex from the graph.+      @raise Invalid_argument if the graph is empty. *)++  val choose_edge : G.t -> G.edge+    (** [choose_edge g] returns an edge from the graph.+      @raise Invalid_argument if the graph has no edge. *)++end++(** {1 Neighbourhood } *)++(** Neighbourhood of vertex / vertices *)+module Neighbourhood(G : sig +		      type t +		      module V : Sig.COMPARABLE+		      val fold_succ: (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+		      val succ: t -> V.t -> V.t list+		    end) :+sig++  module Vertex_Set : Set.S with type elt = G.V.t++  (** The neighbourhood of a vertex [v] is +    \{ v' | (succ g v) and (v <> v') \} *)++  val list_from_vertex : G.t -> G.V.t -> G.V.t list+    (** Neighbourhood of a vertex as a list. *)++  val set_from_vertex : G.t -> G.V.t -> Vertex_Set.t+    (** Neighbourhood of a vertex as a set. +      Less efficient that [list_from_vertex]. *)++  (** The neighbourhood of a set [S] of vertices is [U \ S] where+    [U] is the union of neighbourhoods of each vertex of [S]. *)++  val list_from_vertices : G.t -> G.V.t list -> G.V.t list+    (** Neighbourhood of a list of vertices as a list. *)++  val set_from_vertices : G.t -> G.V.t list -> Vertex_Set.t+    (** Neighbourhood of a list of vertices as a set. +      More efficient that [list_from_vertices]. *)++end
+ external/ocamlgraph/src/pack.ml view
@@ -0,0 +1,180 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: pack.ml,v 1.13 2006-05-12 14:07:16 filliatr Exp $ *)++module Generic(G : Sig.IM with type V.label = int and type E.label = int) = +struct++  include G++  exception Found of V.t+  let find_vertex g i =+    try +      iter_vertex (fun v -> if V.label v = i then raise (Found v)) g;+      raise Not_found+    with Found v -> +      v++  module Builder = Builder.I(G)++  module Dfs = Traverse.Dfs(G)+  module Bfs = Traverse.Bfs(G)+  module Marking = Traverse.Mark(G)++  module Classic = Classic.I(G)++  module Rand = Rand.I(G)++  module Components = Components.Make(G)++  module W = struct +    type label = int+    type t = int+    let weight x = x+    let zero = 0+    let add = (+)+    let compare = compare+  end++  include Gpath.Dijkstra(G)(W)++  module F = struct+    type label = int+    type t = int+    let max_capacity x = x+    let min_capacity _ = 0+    let flow _ = 0+    let add = (+)+    let sub = (-)+    let compare = compare+    let max = max_int+    let min = 0+    let zero = 0+  end++  module FF = Flow.Ford_Fulkerson(G)(F)+  let ford_fulkerson g = +    if not G.is_directed then +      invalid_arg "ford_fulkerson: not a directed graph";+    FF.maxflow g++  module Goldberg = Flow.Goldberg(G)(F)+  let goldberg g = +    if not G.is_directed then invalid_arg "goldberg: not a directed graph";+    Goldberg.maxflow g++  include Oper.Make(Builder)++  module PathCheck = Gpath.Check(G)++  module Topological = Topological.Make(G)++  module Int = struct+    type t = int+    let compare = Pervasives.compare+  end++  include Kruskal.Make(G)(Int)++  module Display = struct+    include G+    let vertex_name v = string_of_int (V.label v)+    let graph_attributes _ = []+    let default_vertex_attributes _ = []+    let vertex_attributes _ = []+    let default_edge_attributes _ = []+    let edge_attributes _ = []+    let get_subgraph _ = None+  end+  module Dot_ = Graphviz.Dot(Display)+  module Neato = Graphviz.Neato(Display)++  let dot_output g f = +    let oc = open_out f in+    if is_directed then Dot_.output_graph oc g else Neato.output_graph oc g;+    close_out oc++  let display_with_gv g =+    let tmp = Filename.temp_file "graph" ".dot" in+    dot_output g tmp;+    ignore (Sys.command ("dot -Tps " ^ tmp ^ " | gv -"));+    Sys.remove tmp++  module GmlParser = +    Gml.Parse+      (Builder)+      (struct +	 let node l = +	   try match List.assoc "id" l with Gml.Int n -> n | _ -> -1+	   with Not_found -> -1+	 let edge _ =+	   0+       end)++  let parse_gml_file = GmlParser.parse++  module DotParser =+    Dot.Parse+      (Builder)+      (struct+ 	 let nodes = Hashtbl.create 97+	 let new_node = ref 0+	 let node (id,_) _ = +	   try +	     Hashtbl.find nodes id+	   with Not_found -> +	     incr new_node;+	     Hashtbl.add nodes id !new_node;+	     !new_node+	 let edge _ =+	   0+      end)++  let parse_dot_file = DotParser.parse++  open Format++  module GmlPrinter =+    Gml.Print+      (G)+      (struct+	 let node n = ["label", Gml.Int n]+	 let edge n = ["label", Gml.Int n]+       end)++  let print_gml_file g f =+    let c = open_out f in+    let fmt = formatter_of_out_channel c in+    fprintf fmt "%a@." GmlPrinter.print g;+    close_out c++end++module I = struct+  type t = int +  let compare = compare +  let hash = Hashtbl.hash +  let equal = (=)+  let default = 0+end++module Digraph = Generic(Imperative.Digraph.AbstractLabeled(I)(I))++module Graph = Generic(Imperative.Graph.AbstractLabeled(I)(I))++
+ external/ocamlgraph/src/pack.mli view
@@ -0,0 +1,28 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: pack.mli,v 1.1 2004-02-04 11:52:02 filliatr Exp $ *)++(** Immediate access to the library. *)++module Digraph : Sig_pack.S+  (** Directed graphs *)++module Graph : Sig_pack.S+  (** Undirected graphs *)++
+ external/ocamlgraph/src/persistent.ml view
@@ -0,0 +1,297 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: persistent.ml,v 1.18 2005-01-17 15:22:03 signoles Exp $ *)++open Sig+open Util+open Blocks++module type S = sig++  (** Persistent Unlabeled Graphs *)+  module Concrete (V: COMPARABLE) : +    Sig.P with type V.t = V.t and type V.label = V.t and type E.t = V.t * V.t++  (** Abstract Persistent Unlabeled Graphs *)+  module Abstract(V: sig type t end) : Sig.P with type V.label = V.t++  (** Persistent Labeled Graphs *)+  module ConcreteLabeled (V: COMPARABLE)(E: ORDERED_TYPE_DFT) :+    Sig.P with type V.t = V.t and type V.label = V.t+	    and type E.t = V.t * E.t * V.t and type E.label = E.t++  (** Abstract Persistent Labeled Graphs *)+  module AbstractLabeled (V: sig type t end)(E: ORDERED_TYPE_DFT) :+    Sig.P with type V.label = V.t and type E.label = E.t++end++module P = Make(Make_Map)++type 'a abstract_vertex = { tag : int; label : 'a }++(* Vertex for the abstract persistent graphs. *)+module AbstractVertex(V: sig type t end) = struct++  type label = V.t+  type t = label abstract_vertex++  let compare x y = compare x.tag y.tag +  let hash x = Hashtbl.hash x.tag+  let equal x y = x.tag = y.tag+  let label x = x.label++  let create l = +    assert (!cpt_vertex < max_int);+    incr cpt_vertex;+    { tag = !cpt_vertex; label = l }+    +end++module Digraph = struct++  module Concrete = P.Digraph.Concrete++  module ConcreteLabeled(V: COMPARABLE)(Edge: ORDERED_TYPE_DFT) = struct++    include P.Digraph.ConcreteLabeled(V)(Edge)++    let add_edge_e g (v1, l, v2) = +      let g = add_vertex g v1 in+      let g = add_vertex g v2 in+      unsafe_add_edge g v1 (v2, l)++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_vertex g v =+      if HM.mem v g then+	let remove v s =+	  S.fold +	    (fun (v2, _ as e) s -> if not (V.equal v v2) then S.add e s else s)+	    s S.empty+	in+	let g = HM.remove v g in+	HM.fold (fun k s g -> HM.add k (remove v s) g) g HM.empty+      else+	g++  end++  module Abstract(V: sig type t end) = struct++    include P.Digraph.Abstract(AbstractVertex(V))++    let empty = { edges = G.empty; size = 0 }++    let add_vertex g v = +      if mem_vertex g v then +	g +      else+	{ edges = G.unsafe_add_vertex g.edges v; +	  size = Pervasives.succ g.size }++    let add_edge g v1 v2 = +      let g = add_vertex g v1 in+      let g = add_vertex g v2 in+      { g with edges = G.unsafe_add_edge g.edges v1 v2 }++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_vertex g v = +      if HM.mem v g.edges then+	let e = HM.remove v g.edges in+	let e = HM.fold (fun k s g -> HM.add k (S.remove v s) g) e HM.empty in+	{ edges = e; size = Pervasives.pred g.size }+      else+	g++    let remove_edge g v1 v2 = { g with edges = remove_edge g v1 v2 }+    let remove_edge_e g e = { g with edges = remove_edge_e g e }++  end++  module AbstractLabeled(V: sig type t end)(Edge: ORDERED_TYPE_DFT) = struct++    include P.Digraph.AbstractLabeled(AbstractVertex(V))(Edge)++    let empty = { edges = G.empty; size = 0 }++    let add_vertex g v = +      if mem_vertex g v then +	g +      else+	{ edges = G.unsafe_add_vertex g.edges v; +	  size = Pervasives.succ g.size }++    let add_edge_e g (v1, l, v2) = +      let g = add_vertex g v1 in+      let g = add_vertex g v2 in+      { g with edges = G.unsafe_add_edge g.edges v1 (v2, l) }++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_vertex g v =+      if HM.mem v g.edges then+	let remove v s =+	  S.fold +	    (fun (v2, _ as e) s -> if not (V.equal v v2) then S.add e s else s)+	    s S.empty+	in+	let edges = HM.remove v g.edges in+	{ edges = +	    HM.fold (fun k s g -> HM.add k (remove v s) g) edges HM.empty;+	  size = Pervasives.pred g.size }+      else+	g++    let remove_edge g v1 v2 = { g with edges = remove_edge g v1 v2 }+    let remove_edge_e g e = { g with edges = remove_edge_e g e }++  end++end++module Graph = struct++  module Concrete(V: COMPARABLE) = struct++    module G = Digraph.Concrete(V) ++    include Graph(G)++    (* Export some definitions of [G] *)++    let empty = G.empty+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge g v1 v2 = +      let g = G.add_edge g v1 v2 in+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      G.unsafe_add_edge g v2 v1++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_edge g v1 v2 =+      let g = G.remove_edge g v1 v2 in+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      G.unsafe_remove_edge g v2 v1++    let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  end++  module ConcreteLabeled(V: COMPARABLE)(Edge: ORDERED_TYPE_DFT) = struct++    module G = Digraph.ConcreteLabeled(V)(Edge)++    include Graph(G)++    (* Export some definitions of [G] *)++    let empty = G.empty+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge_e g (v1, l, v2 as e) = +      let g = G.add_edge_e g e in+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      G.unsafe_add_edge g v2 (v1, l)++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_edge g v1 v2 =+      let g = G.remove_edge g v1 v2 in+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      G.unsafe_remove_edge g v2 v1++    let remove_edge_e g (v1, l, v2 as e) =+      let g = G.remove_edge_e g e in+      assert (G.HM.mem v1 g && G.HM.mem v2 g);+      G.unsafe_remove_edge_e g (v2, l, v1)++  end++  module Abstract(V: sig type t end) = struct++    module G = Digraph.Abstract(V)++    include Graph(G)++    (* Export some definitions of [G] *)++    let empty = G.empty+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge g v1 v2 = +      let g = G.add_edge g v1 v2 in+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      { g with G.edges = G.unsafe_add_edge g.G.edges v2 v1 }++    let add_edge_e g (v1, v2) = add_edge g v1 v2++    let remove_edge g v1 v2 =+      let g = G.remove_edge g v1 v2 in+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      { g with G.edges = G.unsafe_remove_edge g.G.edges v2 v1 }++    let remove_edge_e g (v1, v2) = remove_edge g v1 v2++  end++  module AbstractLabeled (V: sig type t end)(Edge: ORDERED_TYPE_DFT) = struct++    module G = Digraph.AbstractLabeled(V)(Edge)++    include Graph(G)++    (* Export some definitions of [G] *)++    let empty = G.empty+    let add_vertex = G.add_vertex+    let remove_vertex = G.remove_vertex++    (* Redefine the [add_edge] and [remove_edge] operations *)++    let add_edge_e g (v1, l, v2 as e) = +      let g = G.add_edge_e g e in+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      { g with G.edges = G.unsafe_add_edge g.G.edges v2 (v1, l) }++    let add_edge g v1 v2 = add_edge_e g (v1, Edge.default, v2)++    let remove_edge g v1 v2 =+      let g = G.remove_edge g v1 v2 in+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      { g with G.edges = G.unsafe_remove_edge g.G.edges v2 v1 }++    let remove_edge_e g (v1, l, v2 as e) =+      let g = G.remove_edge_e g e in+      assert (G.HM.mem v1 g.G.edges && G.HM.mem v2 g.G.edges);+      { g with G.edges = G.unsafe_remove_edge_e g.G.edges (v2, l, v1) }++  end++end
+ external/ocamlgraph/src/persistent.mli view
@@ -0,0 +1,50 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: persistent.mli,v 1.13 2006-05-12 14:07:16 filliatr Exp $ *)++(** Persistent Implementations *)++open Sig++(** Signature of persistent graphs *)+module type S = sig++  (** Persistent Unlabeled Graphs *)+  module Concrete (V: COMPARABLE) : +    Sig.P with type V.t = V.t and type V.label = V.t and type E.t = V.t * V.t++  (** Abstract Persistent Unlabeled Graphs *)+  module Abstract(V: ANY_TYPE) : Sig.P with type V.label = V.t++  (** Persistent Labeled Graphs *)+  module ConcreteLabeled (V: COMPARABLE)(E: ORDERED_TYPE_DFT) :+    Sig.P with type V.t = V.t and type V.label = V.t+	    and type E.t = V.t * E.t * V.t and type E.label = E.t++  (** Abstract Persistent Labeled Graphs *)+  module AbstractLabeled (V: ANY_TYPE)(E: ORDERED_TYPE_DFT) :+    Sig.P with type V.label = V.t and type E.label = E.t++end++(** Persistent Directed Graphs *)+module Digraph : S++(** Persistent Undirected Graphs *)+module Graph : S+
+ external/ocamlgraph/src/rand.ml view
@@ -0,0 +1,207 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: rand.ml,v 1.18 2005-03-31 13:32:51 filliatr Exp $ *)++module type S = sig+  type graph +  type vertex+  type edge_label+  val graph : ?loops:bool -> v:int -> e:int -> unit -> graph+  val labeled : +    (vertex -> vertex -> edge_label) -> +    ?loops:bool -> v:int -> e:int -> unit -> graph+  (* DEBUG *)+  val random_few_edges : loops:bool -> v:int -> e:int -> graph+  val random_many_edges : loops:bool -> v:int -> e:int -> graph+end++module Make(B : Builder.INT) = struct++  open B+  type graph = G.t+  type vertex = G.V.t+  type edge_label = G.E.label++  open Int64++  let max_edges ~loops ~v ~e =+    if v <= 0 || e < 0 then invalid_arg "random";+    let v64 = of_int v in+    let max_e = mul v64 (pred v64) in+    let max_e = if G.is_directed then max_e else div max_e (of_int 2) in+    let max_e = if loops then add max_e v64 else max_e in+    if of_int e > max_e then invalid_arg "random: too many edges";+    max_e++  let fold_for i0 i1 f =+    let rec loop i v = if i > i1 then v else loop (i + 1) (f v i) in+    loop i0++  (* naive implementation: we randomly chose edges up to [e] different edges *)+  let random_few_edges add_edge ~loops ~v ~e =+    let _ = max_edges ~loops ~v ~e in+    let a = Array.init v G.V.create in+    let g = Array.fold_left add_vertex (empty ()) a in+    let rec random_edge g =+      let i = Random.int v in+      let j = Random.int v in+      if (i = j && not loops) || G.mem_edge g a.(i) a.(j) then +	random_edge g+      else+	add_edge g a.(i) a.(j)+    in+    fold_for 1 e (fun g _ -> random_edge g) g++  (* other implementation in O(v * v); faster when [e] is large *)+  let random_many_edges add_edge ~loops ~v ~e =+    let v64 = of_int v in+    let max_e = max_edges ~loops ~v ~e in+    let a = Array.init v G.V.create in+    let g = Array.fold_left add_vertex (empty ()) a in+    let rec add_edges i j max nb g =+      assert +	(max >= 0L &&+         max_e = +	   add max (add (mul (of_int i) v64) +           (of_int +  	    (j - +	    (match G.is_directed, loops with+	       | true, true -> 0+	       | true, false -> if j > i then i + 1 else i+	       | false, true -> i * (i - 1) / 2 + if j > i then i else j+	       | false, false -> i*(i+1)/2 + if j > i then i+1 else j)))));+      if nb = 0 then+	g+      else+	let add_edges = +	  let i, j = if j = v - 1 then i + 1, 0 else i, j + 1 in+	  add_edges i j +	in+	if (i = j && not loops) || (not G.is_directed && i > j) then +	  add_edges max nb g+	else+	  let add_edges = add_edges (pred max) in+	  if Random.int64 max < of_int nb then+	    add_edges (nb - 1) (add_edge g a.(i) a.(j))+	  else+	    add_edges nb g+    in+    add_edges 0 0 max_e e g++  let random ~loops ~v ~e = +    let r = float e /. (float v *. float v) in+    (if r < 0.4 then random_few_edges else random_many_edges) ~loops ~v ~e++  let graph ?(loops=false) ~v ~e () = random B.add_edge ~loops ~v ~e++  let labeled f ?(loops=false) ~v ~e () = +    random +      (fun g v1 v2 -> B.add_edge_e g (G.E.create v1 (f v1 v2) v2)) +      ~loops ~v ~e++  (* DEBUG *)+  let random_few_edges = random_few_edges B.add_edge+  let random_many_edges = random_many_edges B.add_edge++end++module P (G : Sig.P with type V.label = int) = Make(Builder.P(G))++module I (G : Sig.I with type V.label = int) = Make(Builder.I(G))+++(** Random planar graphs *)++module Planar = struct++  module type S = sig+    type graph +    val graph : +      ?loops:bool -> xrange:int*int -> yrange:int*int ->+	prob:float -> int -> graph+  end++  module Make+    (B : Builder.S with type G.V.label = int * int and type G.E.label = int) =+  struct++    type graph = B.G.t+    open B.G++    module Point = struct+      type point = V.t+      let ccw v1 v2 v3 = +	Delaunay.IntPoints.ccw (V.label v1) (V.label v2) (V.label v3)+      let in_circle v1 v2 v3 v4 =+	Delaunay.IntPoints.in_circle +	  (V.label v1) (V.label v2) (V.label v3) (V.label v4)+      let distance v1 v2 =+	let x1,y1 = V.label v1 in+	let x2,y2 = V.label v2 in+	let sqr x = let x = float x in x *. x in+	truncate (sqrt (sqr (x1 - x2) +. sqr (y1 - y2)))+    end++    module Triangulation = Delaunay.Make(Point)++    let graph ?(loops=false) ~xrange:(xmin,xmax) ~yrange:(ymin,ymax) ~prob v =+      if not (0.0 <= prob && prob <= 1.0) then invalid_arg "Planar.graph";+      if v < 2 then invalid_arg "Planar.graph";+      (* [v] random points and their Delaunay triangulation *)+      let random_point () =+	xmin + Random.int (1 + xmax - xmin),+	ymin + Random.int (1 + ymax - ymin)+      in+      let vertices = Array.init v (fun _ -> V.create (random_point ())) in+      let t = Triangulation.triangulate vertices in+      (* a graph with [v] vertices and random loops if any *)+      let g = Array.fold_left B.add_vertex (B.empty ()) vertices in+      let g = +	if loops then +	  Array.fold_left +	    (fun g v -> +	       if Random.float 1.0 < prob then +		 g+	       else+		 let e = E.create v 0 v in B.add_edge_e g e)+	    g vertices+	else +	  g+      in+      (* we keep some edges from the triangulation according to [prob] *)+      let add_edge v1 v2 g =+	if Random.float 1.0 < prob then +	  g+	else+	  let e = E.create v1 (Point.distance v1 v2) v2 in B.add_edge_e g e+      in+      Triangulation.fold+	(fun v1 v2 g -> +	   let g = add_edge v1 v2 g in+	   if is_directed then add_edge v2 v1 g else g)+	t g++  end++  module P (G : Sig.P with type V.label = int * int and type E.label = int) = +    Make(Builder.P(G))++  module I (G : Sig.I with type V.label = int * int and type E.label = int) = +    Make(Builder.I(G))++end
+ external/ocamlgraph/src/rand.mli view
@@ -0,0 +1,111 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: rand.mli,v 1.12 2005-03-31 13:32:51 filliatr Exp $ *)++(** Random graph generation *)++(** {1 Random graphs} *)++module type S = sig++  type graph +  type vertex+  type edge_label++  val graph : ?loops:bool -> v:int -> e:int -> unit -> graph+    (** [graph v e] generates a random graph with exactly [v] vertices +      and [e] edges. Vertices are labeled with [0] ... [v-1].+      The boolean [loops] indicates whether loops are allowed; +      default value is no loop ([false]). +      @raise Invalid_argument if [e] exceeds the maximal number of edges. *)++  val labeled : +    (vertex -> vertex -> edge_label) -> +    ?loops:bool -> v:int -> e:int -> unit -> graph+    (** [labeled f] is similar to [graph] except that edges are labeled+      using function [f].+      @raise Invalid_argument if there are too many edges. *)++  (** The two functions above actually make a choice between two+     different implementations according to the ratio e/(v*v).+     When this ratio is small, [random_few_edges] is selected; +     otherwise [random_many_edges] is selected. *)++  val random_few_edges : loops:bool -> v:int -> e:int -> graph+  val random_many_edges : loops:bool -> v:int -> e:int -> graph++end++module Make(B: Builder.INT) :+  S with type graph = B.G.t +    and type vertex = B.G.V.t +    and type edge_label = B.G.E.label+      (** Random graphs *)++module P (G : Sig.P with type V.label = int) : +  S with type graph = G.t +    and type vertex = G.V.t +    and type edge_label = G.E.label+      (** Random persistent graphs *)++module I (G : Sig.I with type V.label = int) : +  S with type graph = G.t+    and type vertex = G.V.t     +    and type edge_label = G.E.label+      (** Random imperative graphs *)++(** {1 Random planar graphs} *)++module Planar : sig++  module type S = sig++    type graph ++    val graph : +      ?loops:bool -> xrange:int*int -> yrange:int*int ->+	prob:float -> int -> graph+      (** [graph xrange yrange prob v] +        generates a random planar graph with exactly [v] vertices.+        Vertices are labeled with integer coordinates, randomly distributed+        according to [xrange] and [yrange].+        Edges are built as follows: the full Delaunay triangulation is+        constructed and then each edge is discarded with probabiblity [prob]+        (which should lie in [0..1]). In particular [prob = 0.0] gives the +        full triangulation.+        Edges are labeled with the (rounded) Euclidean distance between+        the two vertices.+        The boolean [loops] indicates whether loops are allowed; +        default value is no loop ([false]). *)++  end++  module Make+    (B : Builder.S with type G.V.label = int * int and type G.E.label = int) :+    S with type graph = B.G.t +	(** Random planar graphs *)++  module P (G : Sig.P with type V.label = int * int and type E.label = int) : +    S with type graph = G.t +	(** Random persistent planar graphs *)++  module I (G : Sig.I with type V.label = int * int and type E.label = int) : +    S with type graph = G.t+	(** Random imperative planar graphs *)+			      +end
+ external/ocamlgraph/src/sig.mli view
@@ -0,0 +1,309 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: sig.mli,v 1.21 2006-05-12 14:07:16 filliatr Exp $ *)++(** Signatures for graph implementations *)++(** {2 Signatures for graph implementations} *)++(** Interface for vertices *)++module type VERTEX = sig++  (** Vertices are [COMPARABLE] *)+  +  type t +  val compare : t -> t -> int +  val hash : t -> int +  val equal : t -> t -> bool+      +  (** Vertices are labeled. *)+      +  type label+  val create : label -> t+  val label : t -> label++end++(** Interface for edges *)++module type EDGE = sig++  (** Edges are [ORDERED]. *)++  type t+  val compare : t -> t -> int+      +  (** Edges are directed. *)++  type vertex+  val src : t -> vertex+  val dst : t -> vertex+      +  (** Edges are labeled. *)+      +  type label+  val create : vertex -> label -> vertex -> t+      (** [create v1 l v2] creates an edge from [v1] to [v2] with label [l] *)+  val label : t -> label++end++(** Common interface for all graph implementations *)++module type G = sig++  (** {2 Graph structure} *)++  (** Abstract type of graphs *)+  type t++  (** Vertices have type [V.t] and are labeled with type [V.label]+    (note that an implementation may identify the vertex with its+    label) *)+  module V : VERTEX++  type vertex = V.t++  (** Edges have type [E.t] and are labeled with type [E.label].+      [src] (resp. [dst]) returns the origin (resp. the destination) of a+      given edge. *)+  module E : EDGE with type vertex = vertex++  type edge = E.t++  (** Is this an implementation of directed graphs? *)+  val is_directed : bool++  (** {2 Size functions} *)++  val is_empty : t -> bool+  val nb_vertex : t -> int+  val nb_edges : t -> int++  (** Degree of a vertex *)++  val out_degree : t -> vertex -> int+    (** [out_degree g v] returns the out-degree of [v] in [g].+      @raise Invalid_argument if [v] is not in [g]. *)++  val in_degree : t -> vertex -> int+    (** [in_degree g v] returns the in-degree of [v] in [g].+      @raise Invalid_argument if [v] is not in [g]. *)++  (** {2 Membership functions} *)++  val mem_vertex : t -> vertex -> bool+  val mem_edge : t -> vertex -> vertex -> bool+  val mem_edge_e : t -> edge -> bool++  val find_edge : t -> vertex -> vertex -> edge+    (** [find_edge g v1 v2] returns the edge from [v1] to [v2] if it exists.+      The behaviour is unspecified if [g] has several edges from [v1] to [v2].+      @raise Not_found if no such edge exists. *)++  (** {2 Successors and predecessors} *)++  val succ : t -> vertex -> vertex list+    (** [succ g v] returns the successors of [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  val pred : t -> vertex -> vertex list+    (** [pred g v] returns the predecessors of [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  (** Labeled edges going from/to a vertex *)++  val succ_e : t -> vertex -> edge list+    (** [succ_e g v] returns the edges going from [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  val pred_e : t -> vertex -> edge list+    (** [pred_e g v] returns the edges going to [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  (** {2 Graph iterators} *)++  (** iter/fold on all vertices/edges of a graph *)++  val iter_vertex : (vertex -> unit) -> t -> unit+  val iter_edges : (vertex -> vertex -> unit) -> t -> unit+  val fold_vertex : (vertex -> 'a -> 'a) -> t  -> 'a -> 'a+  val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a++  (** map iterator on vertex *)+  val map_vertex : (vertex -> vertex) -> t -> t++  (** iter/fold on all labeled edges of a graph *)++  val iter_edges_e : (edge -> unit) -> t -> unit+  val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a++  (** {2 Vertex iterators} ++    Each iterator [iterator f v g] iters [f] to the successors/predecessors+    of [v] in the graph [g] and raises [Invalid_argument] if [v] is not in+    [g]. *)++  (** iter/fold on all successors/predecessors of a vertex. *)++  val iter_succ : (vertex -> unit) -> t -> vertex -> unit+  val iter_pred : (vertex -> unit) -> t -> vertex -> unit+  val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a+  val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a++  (** iter/fold on all edges going from/to a vertex. *)++  val iter_succ_e : (edge -> unit) -> t -> vertex -> unit+  val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a+  val iter_pred_e : (edge -> unit) -> t -> vertex -> unit+  val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a++end++(** Persistent (i.e. immutable) implementation *)++module type P = sig+  include G++  val empty : t+    (** The empty graph. *)++  val add_vertex : t -> vertex -> t+    (** [add_vertex g v] adds the vertex [v] from the graph [g].+      Just return [g] if [v] is already in [g]. *)++  val remove_vertex : t -> vertex -> t+    (** [remove g v] removes the vertex [v] from the graph [g] +      (and all the edges going from [v] in [g]).+      Just return [g] if [v] is not in [g]. *)++  val add_edge : t -> vertex -> vertex -> t+    (** [add_edge g v1 v2] adds an edge from the vertex [v1] to the vertex [v2]+      in the graph [g]. +      Add also [v1] (resp. [v2]) in [g] if [v1] (resp. [v2]) is not in [g]. +      Just return [g] if this edge is already in [g]. *) ++  val add_edge_e : t -> edge -> t+    (** [add_edge_e g e] adds the edge [e] in the graph [g].+      Add also [E.src e] (resp. [E.dst e]) in [g] if [E.src e] (resp. [E.dst+      e]) is not in [g]. +      Just return [g] if [e] is already in [g]. *)++  val remove_edge : t -> vertex -> vertex -> t+    (** [remove_edge g v1 v2] removes the edge going from [v1] to [v2] from the+      graph [g]. If the graph is labelled, all the edges going from [v1] to+      [v2] are removed from [g].+      Just return [g] if this edge is not in [g].+      @raise Invalid_argument if [v1] or [v2] are not in [g]. *)++  val remove_edge_e : t -> edge -> t+    (** [remove_edge_e g e] removes the edge [e] from the graph [g].+      Just return [g] if [e] is not in [g]. +      @raise Invalid_argument if [E.src e] or [E.dst e] are not in [g]. *)++end++(** Imperative (i.e. mutable) implementation *)++module type I = sig+  include G++  val create : ?size:int -> unit -> t+    (** [create ()] returns an empty graph. Optionally, a size can be+        given, which should be on the order of the expected number of+        vertices that will be in the graph (for hash tables-based+        implementations).  The graph grows as needed, so [size] is+        just an initial guess. *)++  val copy : t -> t+    (** [copy g] returns a copy of [g]. Vertices and edges (and eventually+	marks, see module [Mark]) are duplicated. *)++  val add_vertex : t -> vertex -> unit+    (** [add_vertex g v] adds the vertex [v] from the graph [g].+      Do nothing if [v] is already in [g]. *)++  val remove_vertex : t -> vertex -> unit+    (** [remove g v] removes the vertex [v] from the graph [g] +      (and all the edges going from [v] in [g]).+      Do nothing if [v] is not in [g]. *)++  val add_edge : t -> vertex -> vertex -> unit+    (** [add_edge g v1 v2] adds an edge from the vertex [v1] to the vertex [v2]+      in the graph [g]. +      Add also [v1] (resp. [v2]) in [g] if [v1] (resp. [v2]) is not in [g]. +      Do nothing if this edge is already in [g]. *) ++  val add_edge_e : t -> edge -> unit+    (** [add_edge_e g e] adds the edge [e] in the graph [g].+      Add also [E.src e] (resp. [E.dst e]) in [g] if [E.src e] (resp. [E.dst+      e]) is not in [g]. +      Do nothing if [e] is already in [g]. *)++  val remove_edge : t -> vertex -> vertex -> unit+    (** [remove_edge g v1 v2] removes the edge going from [v1] to [v2] from the+      graph [g]. If the graph is labelled, all the edges going from [v1] to+      [v2] are removed from [g].+      Do nothing if this edge is not in [g].+      @raise Invalid_argument if [v1] or [v2] are not in [g]. *)++  val remove_edge_e : t -> edge -> unit+    (** [remove_edge_e g e] removes the edge [e] from the graph [g].+      Do nothing if [e] is not in [g].+      @raise Invalid_argument if [E.src e] or [E.dst e] are not in [g]. *)++end++(** Imperative implementation with marks *)++module type MARK = sig+  type graph+  type vertex+  val clear : graph -> unit+      (** [clear g] sets all the marks to 0 for all the vertices of [g]. *)+  val get : vertex -> int+  val set : vertex -> int -> unit+end++module type IM = sig+  include I+  module Mark : MARK with type graph = t and type vertex = vertex+end++(** {2 Signature for ordered and hashable types} *)++module type ANY_TYPE = sig type t end++module type ORDERED_TYPE = sig type t val compare : t -> t -> int end++module type ORDERED_TYPE_DFT = sig include ORDERED_TYPE val default : t end++module type HASHABLE = sig+  type t +  val hash : t -> int +  val equal : t -> t -> bool+end++(** Comparable = Ordered + Hashable *)+module type COMPARABLE = sig +  type t +  val compare : t -> t -> int +  val hash : t -> int +  val equal : t -> t -> bool+end
+ external/ocamlgraph/src/sig_pack.mli view
@@ -0,0 +1,376 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: sig_pack.mli,v 1.23 2005-07-18 07:10:35 filliatr Exp $ *)++(** Immediate access to the library.+    Signature [S] gathers an imperative implementation and all algorithms into +    a single module. +    Vertices and edges are labeled with integers. *)++module type S = sig++  (** {2 Graph structure} *)++  (** abstract type of graphs *)+  type t++  (** Vertices *)+  module V : sig+    (** Vertices are [COMPARABLE] *)++    type t +    val compare : t -> t -> int +    val hash : t -> int +    val equal : t -> t -> bool++    (** vertices are labeled with integers *)++    type label = int+    val create : label -> t+    val label : t -> label+  end++  type vertex = V.t++  (** Edges *)+  module E : sig+    (** Edges are [ORDERED]. *)++    type t+    val compare : t -> t -> int++    (** Edges are directed. *)++    val src : t -> V.t+    val dst : t -> V.t++    (** Edges are labeled with integers. *)++    type label = int+    val create : V.t -> label -> V.t -> t+      (** [create v1 l v2] creates an edge from [v1] to [v2] with label [l] *)+    val label : t -> label++    type vertex = V.t+  end++  type edge = E.t++  (** is this an implementation of directed graphs? *)+  val is_directed : bool++  (** {2 Graph constructors and destructors} *)++  val create : ?size:int -> unit -> t+    (** Return an empty graph. Optionally, a size can be+        given, which should be on the order of the expected number of+        vertices that will be in the graph (for hash tables-based+        implementations).  The graph grows as needed, so [size] is+        just an initial guess. *)++  val copy : t -> t+    (** [copy g] returns a copy of [g]. Vertices and edges (and eventually+      marks, see module [Mark]) are duplicated. *)++  val add_vertex : t -> V.t -> unit+    (** [add_vertex g v] adds the vertex [v] from the graph [g].+      Do nothing if [v] is already in [g]. *)++  val remove_vertex : t -> V.t -> unit+    (** [remove g v] removes the vertex [v] from the graph [g] +      (and all the edges going from [v] in [g]).+      Do nothing if [v] is not in [g]. *)++  val add_edge : t -> V.t -> V.t -> unit+    (** [add_edge g v1 v2] adds an edge from the vertex [v1] to the vertex [v2]+      in the graph [g]. +      Add also [v1] (resp. [v2]) in [g] if [v1] (resp. [v2]) is not in [g]. +      Do nothing if this edge is already in [g]. *) ++  val add_edge_e : t -> E.t -> unit+    (** [add_edge_e g e] adds the edge [e] in the graph [g].+      Add also [E.src e] (resp. [E.dst e]) in [g] if [E.src e] (resp. [E.dst+      e]) is not in [g]. +      Do nothing if [e] is already in [g]. *)++  val remove_edge : t -> V.t -> V.t -> unit+    (** [remove_edge g v1 v2] removes the edge going from [v1] to [v2] from the+      graph [g].+      Do nothing if this edge is not in [g].+      @raise Invalid_argument if [v1] or [v2] are not in [g]. *)++  val remove_edge_e : t -> E.t -> unit+    (** [remove_edge_e g e] removes the edge [e] from the graph [g].+      Do nothing if [e] is not in [g].+      @raise Invalid_argument if [E.src e] or [E.dst e] are not in [g]. *)++  (** Vertices contains integers marks, which can be set or used by some +      algorithms (see for instance module [Marking] below) *)+  module Mark : sig+    type graph = t+    type vertex = V.t+    val clear : t -> unit+      (** [clear g] sets all marks to 0 from all the vertives of [g]. *)+    val get : V.t -> int+    val set : V.t -> int -> unit+  end++  (** {2 Size functions} *)++  val is_empty : t -> bool+  val nb_vertex : t -> int+  val nb_edges : t -> int++  (** Degree of a vertex *)++  val out_degree : t -> V.t -> int+    (** [out_degree g v] returns the out-degree of [v] in [g].+      @raise Invalid_argument if [v] is not in [g]. *)++  val in_degree : t -> V.t -> int+    (** [in_degree g v] returns the in-degree of [v] in [g].+      @raise Invalid_argument if [v] is not in [g]. *)++  (** {2 Membership functions} *)++  val mem_vertex : t -> V.t -> bool+  val mem_edge : t -> V.t -> V.t -> bool+  val mem_edge_e : t -> E.t -> bool+  val find_edge : t -> V.t -> V.t -> E.t++  (** {2 Successors and predecessors of a vertex} *)++  val succ : t -> V.t -> V.t list+    (** [succ g v] returns the successors of [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  val pred : t -> V.t -> V.t list+    (** [pred g v] returns the predecessors of [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  (** Labeled edges going from/to a vertex *)++  val succ_e : t -> V.t -> E.t list+    (** [succ_e g v] returns the edges going from [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  val pred_e : t -> V.t -> E.t list+    (** [pred_e g v] returns the edges going to [v] in [g].+        @raise Invalid_argument if [v] is not in [g]. *)++  (** {2 Graph iterators} *)++  (** iter/fold on all vertices/edges of a graph *)++  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_edges : (V.t -> V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val fold_edges : (V.t -> V.t -> 'a -> 'a) -> t -> 'a -> 'a++  (** map iterator on vertex *)+  val map_vertex : (V.t -> V.t) -> t -> t++  (** iter/fold on all labeled edges of a graph *)++  val iter_edges_e : (E.t -> unit) -> t -> unit+  val fold_edges_e : (E.t -> 'a -> 'a) -> t -> 'a -> 'a++  (** {2 Vertex iterators}++    Each iterator [iterator f v g] iters [f] to the successors/predecessors+    of [v] in the graph [g] and raises [Invalid_argument] if [v] is not in+    [g]. *)++  (** iter/fold on all successors/predecessors of a vertex. *)++  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val iter_pred : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val fold_pred : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a++  (** iter/fold on all edges going from/to a vertex. *)++  val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit+  val fold_succ_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+  val iter_pred_e : (E.t -> unit) -> t -> V.t -> unit+  val fold_pred_e : (E.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a++  (** {2 Basic operations} *)++  val find_vertex : t -> int -> V.t+    (** [vertex g i] returns a vertex of label [i] in [g]. The behaviour is+      unspecified if [g] has several vertices with label [i]. +      Note: this function is inefficient (linear in the number of vertices);+      you should better keep the vertices as long as you create them. *)++  val transitive_closure : ?reflexive:bool -> t -> t+    (** [transitive_closure ?reflexive g] returns the transitive closure +      of [g] (as a new graph). Loops (i.e. edges from a vertex to itself) +      are added only if [reflexive] is [true] (default is [false]). *)++  val add_transitive_closure : ?reflexive:bool -> t -> t+    (** [add_transitive_closure ?reflexive g] replaces [g] by its+      transitive closure. Meaningless for persistent implementations+      (then acts as [transitive_closure]). *)++  val mirror : t -> t+    (** [mirror g] returns a new graph which is the mirror image of [g]:+      each edge from [u] to [v] has been replaced by an edge from [v] to [u].+      For undirected graphs, it simply returns a copy of [g]. *)++  val complement : t -> t+    (** [complement g] builds a new graph which is the complement of [g]:+      each edge present in [g] is not present in the resulting graph and+      vice-versa. Edges of the returned graph are unlabeled. *)++  val intersect : t -> t -> t+    (** [intersect g1 g2] returns a new graph which is the intersection of [g1]+      and [g2]: each vertex and edge present in [g1] *and* [g2] is present +      in the resulting graph. *)++  val union : t -> t -> t+    (** [union g1 g2] returns a new graph which is the union of [g1] and [g2]:+      each vertex and edge present in [g1] *or* [g2] is present in the +      resulting graph. *)++  (** {2 Traversal} *)++  (** Depth-first search *)+  module Dfs : sig+    val iter : ?pre:(V.t -> unit) -> +               ?post:(V.t -> unit) -> t -> unit+      (** [iter pre post g] visits all nodes of [g] in depth-first search, +	  applying [pre] to each visited node before its successors,+	  and [post] after them. Each node is visited exactly once. *)+    val prefix : (V.t -> unit) -> t -> unit+      (** applies only a prefix function *)+    val postfix : (V.t -> unit) -> t -> unit+      (** applies only a postfix function *)++    (** Same thing, but for a single connected component *)++    val iter_component : +               ?pre:(V.t -> unit) -> +               ?post:(V.t -> unit) -> t -> V.t -> unit+    val prefix_component : (V.t -> unit) -> t -> V.t -> unit+    val postfix_component : (V.t -> unit) -> t -> V.t -> unit++    val has_cycle : t -> bool+  end++  (** Breadth-first search *)+  module Bfs : sig+    val iter : (V.t -> unit) -> t -> unit+    val iter_component : (V.t -> unit) -> t -> V.t -> unit+  end++  (** Graph traversal with marking *)+  module Marking : sig+    val dfs : t -> unit+    val has_cycle : t -> bool+  end++  (** {2 Graph generators} *)++  (** Classic graphs *)+  module Classic : sig+    val divisors : int -> t+      (** [divisors n] builds the graph of divisors. +	Vertices are integers from [2] to [n]. [i] is connected to [j] if+        and only if [i] divides [j]. +	@raise Invalid_argument is [n < 2]. *)++    val de_bruijn : int -> t+      (** [de_bruijn n] builds the de Bruijn graph of order [n].+	Vertices are bit sequences of length [n] (encoded as their+	interpretation as binary integers). The sequence [xw] is connected+	to the sequence [wy] for any bits [x] and [y] and any bit sequence +        [w] of length [n-1]. +	@raise Invalid_argument is [n < 1] or [n > Sys.word_size-1]. *)++    val vertex_only : int -> t+      (** [vertex_only n] builds a graph with [n] vertices and no edge. *)++    val full : ?self:bool -> int -> t+      (** [full n] builds a graph with [n] vertices and all possible edges.+	The optional argument [self] indicates if loop edges should be added+        (default value is [true]). *)+  end++  (** Random graphs *)+  module Rand : sig+    val graph : ?loops:bool -> v:int -> e:int -> unit -> t+      (** [random v e] generates a random with [v] vertices and [e] edges. *)++    val labeled : +      (V.t -> V.t -> E.label) -> +	?loops:bool -> v:int -> e:int -> unit -> t+	  (** [random_labeled f] is similar to [random] except that edges are +            labeled using function [f] *)+  end++  (** Strongly connected components *)+  module Components : sig+    val scc : t -> int*(V.t -> int)+	(** strongly connected components *)+    val scc_array : t -> V.t list array+    val scc_list : t -> V.t list list+  end++  (** {2 Classical algorithms} *)++  val shortest_path : t -> V.t -> V.t -> E.t list * int+    (** Dijkstra's shortest path algorithm. Weights are the labels. *)++  val ford_fulkerson : t -> V.t -> V.t -> (E.t -> int) * int+    (** Ford Fulkerson maximum flow algorithm *)++  val goldberg : t -> V.t -> V.t -> (E.t -> int) * int+    (** Goldberg maximum flow algorithm *)++  (** Path checking *)+  module PathCheck : sig+    type path_checker+    val create : t -> path_checker+    val check_path : path_checker -> V.t -> V.t -> bool+  end++  (** Topological order *)+  module Topological : sig+    val fold : (V.t -> 'a -> 'a) -> t -> 'a -> 'a+    val iter : (V.t -> unit) -> t -> unit+  end++  val spanningtree : t -> E.t list+    (** Kruskal algorithm *)++  (** {2 Input / Output} *)++  val dot_output : t -> string -> unit +    (** DOT output *)++  val display_with_gv : t -> unit+    (** Displays the given graph using the external tools "dot" and "gv"+        and returns when gv's window is closed *)++  val parse_gml_file : string -> t+  val parse_dot_file : string -> t++  val print_gml_file : t -> string -> unit++end
+ external/ocamlgraph/src/strat.ml view
@@ -0,0 +1,233 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++(* Signature for graphs *)+module type G = sig++  type t++  module V : Sig.ORDERED_TYPE++  type vertex = V.t++  val mem_vertex : t -> vertex -> bool++  val succ : t -> vertex -> vertex list++  val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a+  val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a+end+++(* Signature for graph add-ons: an initial vertex, final vertices+   and membership of vertices to either true or false,+   i.e. first or second player *)+module type PLAYER = sig++  type t+  type vertex++  val get_initial : t -> vertex+  val is_final : t -> vertex -> bool++  val turn : t -> vertex -> bool++end+++(* Signature for strategies : for a given state, the strategy tells+   which state to go to *)+module type STRAT = sig++  type t+  type vertex++  val empty : t+  val add : t -> vertex -> vertex -> t++  val next : t -> vertex -> vertex+    (* Raises Invalid_argument if vertex's image is not defined *)++end+++(* Implements strategy algorithms on graphs *)+module Algo (G : G) (P : PLAYER with type vertex = G.vertex)+  (S : STRAT with type vertex = G.vertex) :+sig++  (* coherent_player g p returns true iff+     the completion p is coherent w.r.t.+     the graph g *)+  val coherent_player : G.t -> P.t -> bool++  (* coherent_strat g s returns true iff+     the strategy s is coherent w.r.t.+     the graph g *)+  val coherent_strat : G.t -> S.t -> bool++  (* game g p a b returns true iff a wins in g+     given the completion p (i.e. the game+     goes through a final state). *)+  val game : G.t -> P.t -> S.t -> S.t -> bool++  (* strategy g p s returns true iff s wins in g+     given the completion p, whatever strategy+     plays the other player. *)+  val strategy : G.t -> P.t -> S.t -> bool++  (* strategyA g p returns true iff there+     exists a winning stragegy for the true+     player. In this case, the winning+     strategy is provided. *)+  val strategyA : G.t -> P.t -> (bool * S.t)+end = struct++    module SetV = Set.Make (G.V)+++    let rec eq l1 l2 = match l1, l2 with+	[], [] -> true+      | e1 :: l1', e2 :: l2' ->+	  (e1 = e2) && (eq l1' l2')+      | _ -> false++    let rec eq_mem i l1 l2 = match l1, l2 with+	[], [] -> (true, false)+      | e1 :: l1', e2 :: l2' ->+	  if e1 = e2 then+	    if e1 = i then (eq l1' l2', true)+	    else eq_mem i l1' l2'+	  else (false, false)+      | _ -> (false, false)++    let puit g v = match G.succ g v with+	[] -> true+      | _ -> false+++    let get_finals g p =+      let f a l =+	if P.is_final p a then a :: l+	else l+      in G.fold_vertex f g []+++    let coherent_player g p =+      G.mem_vertex g (P.get_initial p)+++    let coherent_strat g s =+      let f v b =+	try+	  let v' = S.next s v in+	    b && (G.mem_vertex g v')+	with Invalid_argument _ -> true+      in+	G.fold_vertex f g true+++    let game g p a b =++      let rec game_aux l pi =+	let continue x =+	  try+	    game_aux (SetV.add pi l) (S.next x pi)+	  with Invalid_argument _ -> false+	in+	  (P.is_final p pi) ||+	    (if SetV.mem pi l then false+	     else+	       if P.turn p pi then continue a+	       else continue b)++      in+	game_aux SetV.empty (P.get_initial p)+++    let rec attract1 g p s l =+      let f v l1 =+	if not (List.mem v l1) then+	  if P.turn p v then+	    try+	      if List.mem (S.next s v) l1 then v :: l1+	      else l1+	    with Invalid_argument _ -> l1+	  else+	    if puit g v then l1+	    else+	      if G.fold_succ (fun v' b -> b && (List.mem v' l1)) g v true+	      then v :: l1+	      else l1+	else l1+      in+	G.fold_vertex f g l+++    let rec strategy g p s =++      let rec strategy_aux l1 l2 =+	let (b1, b2) = eq_mem (P.get_initial p) l1 l2 in+	  if b1 then b2+	  else strategy_aux (attract1 g p s l1) l1++      in+      let finaux = get_finals g p in+	strategy_aux (attract1 g p s finaux) finaux+	  ++    let rec attract g p (l, l') =+      let f v (l1, l1') =+	if not (List.mem v l1) then+	  if P.turn p v then+	    let f' v' l2 =+	      (match l2 with+		   [] ->+		     if List.mem v' l1 then [v']+		     else []+		 | _ -> l2) in+	      (match G.fold_succ f' g v [] with+		   [] -> (l1, l1')+		 | v' :: _ -> (v :: l1, S.add l1' v v' ))+	  else+	    if puit g v then (l1, l1')+	    else+	      if G.fold_succ (fun v' b -> b && (List.mem v' l1)) g v true+	      then (v :: l1, l1')+	      else (l1, l1')+	else (l1, l1')+      in+	G.fold_vertex f g (l, l')+++    let rec strategyA g p =++      let rec strategyA_aux l1 l2 f =+	let (b1, b2) = eq_mem (P.get_initial p) l1 l2 in+	  if b1 then (b2, f)+	  else+	    let (new_l1, new_f) = attract g p (l1, f) in+	      strategyA_aux new_l1 l1 new_f++      in+      let finaux = get_finals g p in+      let (l, r) = attract g p (finaux, S.empty) in+	strategyA_aux l finaux r;;++  end
+ external/ocamlgraph/src/strat.mli view
@@ -0,0 +1,103 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id:$ *)++(** Strategies ++    Implementation of a winning strategy of a graph: the graph+    represents a two players game, each vertex belongs to either player+    (whose turn it is to play) and describes a configuration of the+    game. The algorithm computes the winning strategy of a player, if any; +    i.e. the moves to play (which vertex to go to) so that for all+    possible moves of the other player, the game goes through a final+    state. ++    @author Nicolas Ayache *)++(** Signature for graphs *)+module type G = sig+  type t+  module V : Sig.ORDERED_TYPE+  type vertex = V.t+  val mem_vertex : t -> vertex -> bool+  val succ : t -> vertex -> vertex list+  val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a+  val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a+end++(** Signature for graph add-ons: an initial vertex, final vertices+   and membership of vertices to either true or false,+   i.e. first or second player *)+module type PLAYER = sig++  type t+  type vertex++  val get_initial : t -> vertex+  val is_final : t -> vertex -> bool++  val turn : t -> vertex -> bool++end++(** Signature for strategies: for a given state, the strategy tells+   which state to go to *)+module type STRAT = sig++  type t+  type vertex++  val empty : t+  val add : t -> vertex -> vertex -> t++  val next : t -> vertex -> vertex+    (* Raises [Invalid_argument] if vertex's image is not defined *)++end++(** Implements strategy algorithms on graphs *)+module Algo (G : G) (P : PLAYER with type vertex = G.vertex)+  (S : STRAT with type vertex = G.vertex) :+sig++  (** [coherent_player g p] returns [true] iff+     the completion [p] is coherent w.r.t.+     the graph g *)+  val coherent_player : G.t -> P.t -> bool++  (** [coherent_strat g s] returns [true] iff+     the strategy [s] is coherent w.r.t.+     the graph [g] *)+  val coherent_strat : G.t -> S.t -> bool++  (** [game g p a b] returns [true] iff [a] wins in [g]+     given the completion [p] (i.e. the game+     goes through a final state). *)+  val game : G.t -> P.t -> S.t -> S.t -> bool++  (** [strategy g p s] returns [true] iff [s] wins in [g]+     given the completion [p], whatever strategy+     plays the other player. *)+  val strategy : G.t -> P.t -> S.t -> bool++  (** [strategyA g p] returns [true] iff there+      exists [a] winning stragegy for the true+      player. In this case, the winning+      strategy is provided. *)+  val strategyA : G.t -> P.t -> (bool * S.t)+end
+ external/ocamlgraph/src/topological.ml view
@@ -0,0 +1,57 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(*i $Id: topological.ml,v 1.5 2004-02-20 14:37:41 signoles Exp $ i*)++module type G = sig+  type t+  module V : Sig.HASHABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val in_degree : t -> V.t -> int+end++module Make(G: G) = struct++  module H = Hashtbl.Make(G.V)++  let fold f g acc =+    let degree = H.create 997 in+    let todo = Queue.create () in+    let rec walk acc = +      try+	let v = Queue.pop todo in+	let acc = f v acc in+	G.iter_succ +	  (fun x-> let d = H.find degree x in+	   if d=1 then Queue.push x todo+	   else H.replace degree x (d-1))+	  g v; +	walk acc+      with Queue.Empty -> acc+    in+    G.iter_vertex +      (fun v -> +	 let d = G.in_degree g v in +	 if d = 0 then Queue.push v todo+	 else H.add degree v d)+      g;+    walk acc++  let iter f g = fold (fun v () -> f v) g ()++end
+ external/ocamlgraph/src/topological.mli view
@@ -0,0 +1,48 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: topological.mli,v 1.7 2004-12-20 13:35:42 filliatr Exp $ *)++(** Topological order.++  This functor provides functions which allow iterating over a+  directed graph in topological order *)++(** Minimal graph signature to provide *)+module type G = sig+  type t+  module V : Sig.HASHABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val in_degree : t -> V.t -> int+end++module Make(G: G) : sig++  val fold : (G.V.t -> 'a -> 'a) -> G.t -> 'a -> 'a+    (** [fold action g seed] allows iterating over the graph [g] +      in topological order. [action node accu] is called repeatedly,+      where [node] is the node being visited, and [accu] is the result of +      the [action]'s previous invocation, if any, and [seed] otherwise. *)++  val iter : (G.V.t -> unit) -> G.t -> unit+    (** [iter action] calls [action node] repeatedly. Nodes are (again) +      presented to [action] in topological order. *)++end++
+ external/ocamlgraph/src/traverse.ml view
@@ -0,0 +1,284 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: traverse.ml,v 1.17 2004-11-04 13:10:28 filliatr Exp $ *)++(* Graph traversal *)++module type G = sig+  type t+  module V : Sig.COMPARABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++(* depth-first search *)+module Dfs(G : G) = struct+  module H = Hashtbl.Make(G.V)++  let iter ?(pre=fun _ -> ()) ?(post=fun _ -> ()) g = +    let h = H.create 65537 in+    let rec visit v =+      if not (H.mem h v) then begin+	H.add h v ();+	pre v;+	G.iter_succ visit g v;+	post v+      end+    in+    G.iter_vertex visit g++  let postfix post g = iter ~post g++  let iter_component ?(pre=fun _ -> ()) ?(post=fun _ -> ()) g v = +    let h = H.create 65537 in+    let rec visit v =+      H.add h v ();+      pre v;+      G.iter_succ (fun w -> if not (H.mem h w) then visit w) g v;+      post v+    in+    visit v++  let prefix_component pre g = iter_component ~pre g+  let postfix_component post g = iter_component ~post g++  (* invariant: not in [h] means not visited at all; [h v = true] means+     already visited in the current component; [h v = false] means+     already visited in another tree *)+  let has_cycle g =+    let h = H.create 65537 in+    let rec visit v =+      H.add h v true;+      G.iter_succ +	(fun w -> try if H.find h w then raise Exit with Not_found -> visit w) +	g v;+      H.replace h v false+    in+    try G.iter_vertex (fun v -> if not (H.mem h v) then visit v) g; false +    with Exit -> true++  module Tail = struct++    let iter f g = +      let h = H.create 65537 in+      let stack = Stack.create () in+      (* invariant: [h] contains exactly the vertices which have been pushed *)+      let push v = +	if not (H.mem h v) then begin H.add h v (); Stack.push v stack end+      in+      let loop () =+	while not (Stack.is_empty stack) do+	  let v = Stack.pop stack in+	  f v;+	  G.iter_succ push g v+	done+      in+      G.iter_vertex (fun v -> push v; loop ()) g++    let iter_component f g v0 = +      let h = H.create 65537 in+      let stack = Stack.create () in+      (* invariant: [h] contains exactly the vertices which have been pushed *)+      let push v = +	if not (H.mem h v) then begin H.add h v (); Stack.push v stack end+      in+      push v0;+      while not (Stack.is_empty stack) do+	let v = Stack.pop stack in+	f v;+	G.iter_succ push g v+      done++  end++  let prefix = Tail.iter+  let prefix_component = Tail.iter_component++  (* step-by-step iterator *)+  module S = Set.Make(G.V)++  (* state is [(s,st,g)] : [s] contains elements never been pushed in [st] *)+  type iterator = S.t * G.V.t list * G.t++  let start g =+    let s = G.fold_vertex S.add g S.empty in+    s, [], g++  let get (s,st,_) = match st with+    | [] -> if S.is_empty s then raise Exit else S.choose s+    | v :: _ -> v++  let step (s,st,g) =+    let push v (s,st as acc) = +      if S.mem v s then +	S.remove v s, v :: st+      else+	acc +    in+    let v,s',st' = match st with+      | [] ->+	  if S.is_empty s then raise Exit;+	  let v = S.choose s in+	  (v, S.remove v s, [])+      | v :: st' ->+	  (v, s, st')+    in+    let s'',st'' = G.fold_succ push g v (s',st') in+    (s'',st'',g)++end++(* breadth-first search *)+module Bfs(G : G) = struct+  module H = Hashtbl.Make(G.V)++  let iter f g = +    let h = H.create 65537 in+    let q = Queue.create () in+    (* invariant: [h] contains exactly the vertices which have been pushed *)+    let push v = +      if not (H.mem h v) then begin H.add h v (); Queue.add v q end +    in+    let loop () =+      while not (Queue.is_empty q) do+	let v = Queue.pop q in+	f v;+	G.iter_succ push g v+      done+    in+    G.iter_vertex (fun v -> push v; loop ()) g++  let iter_component f g v0 = +    let h = H.create 65537 in+    let q = Queue.create () in+    (* invariant: [h] contains exactly the vertices which have been pushed *)+    let push v = +      if not (H.mem h v) then begin H.add h v (); Queue.add v q end +    in+    push v0;+    while not (Queue.is_empty q) do+      let v = Queue.pop q in+      f v;+      G.iter_succ push g v+    done++  (* step-by-step iterator *)++  (* simple, yet O(1)-amortized, persistent queues *)+  module Q = struct+    type 'a t = 'a list * 'a list+    exception Empty+    let empty = [], []+    let is_empty = function [], [] -> true | _ -> false+    let push x (i,o) = (x :: i, o)+    let pop = function +      | i, y :: o -> y, (i,o) +      | [], [] -> raise Empty+      | i, [] -> match List.rev i with +	  | x :: o -> x, ([], o) +	  | [] -> assert false+    let peek q = fst (pop q)+  end++  module S = Set.Make(G.V)++  (* state is [(s,q,g)] : [s] contains elements never been pushed in [q] *)+  type iterator = S.t * G.V.t Q.t * G.t++  let start g =+    let s = G.fold_vertex S.add g S.empty in+    s, Q.empty, g++  let get (s,q,g) = +    if Q.is_empty q then+      if S.is_empty s then raise Exit else S.choose s+    else+      Q.peek q++  let step (s,q,g) =+    let push v (s,q as acc) = +      if S.mem v s then +	S.remove v s, Q.push v q+      else+	acc +    in+    let v,s',q' = +      if Q.is_empty q then begin+	if S.is_empty s then raise Exit;+	let v = S.choose s in+	v, S.remove v s, q+      end else+	let v,q' = Q.pop q in +	v, s, q'+    in+    let s'',q'' = G.fold_succ push g v (s',q') in+    (s'',q'',g)++end+++(* Graph traversal with marking. *)++module type GM = sig+  type t+  module V : sig type t end+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  module Mark : sig+    val clear : t -> unit+    val get : V.t -> int+    val set : V.t -> int -> unit+  end+end++module Mark(G : GM) = struct++  let dfs g =+    G.Mark.clear g;+    let n = ref 0 in+    let rec visit v =+      if G.Mark.get v = 0 then begin+	incr n;+	G.Mark.set v !n;+	G.iter_succ visit g v+      end+    in+    G.iter_vertex visit g++  (* invariant: [h v = 0] means not visited at all; [h v = 1] means+     already visited in the current component; [h v = 2] means+     already visited in another tree *)+  let has_cycle g =+    G.Mark.clear g;+    let rec visit v =+      G.Mark.set v 1;+      G.iter_succ +	(fun w -> +	   let m = G.Mark.get w in+	   if m = 1 then raise Exit;+	   if m = 0 then visit w) +	g v;+      G.Mark.set v 2+    in+    try G.iter_vertex (fun v -> if G.Mark.get v = 0 then visit v) g; false +    with Exit -> true++end+
+ external/ocamlgraph/src/traverse.mli view
@@ -0,0 +1,127 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: traverse.mli,v 1.14 2005-04-01 07:13:24 filliatr Exp $ *)++(** Graph traversal *)++(** {1 Dfs and Bfs} *)++(** Minimal graph signature for [Dfs] or [Bfs] *)+module type G = sig+  type t+  module V : Sig.COMPARABLE+  val iter_vertex : (V.t -> unit) -> t -> unit+  val fold_vertex : (V.t -> 'a -> 'a) -> t  -> 'a -> 'a+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a+end++(** Depth-first search *)+module Dfs(G : G) : sig+  (** {2 Classical big-step iterators} *)++  val iter : ?pre:(G.V.t -> unit) -> +             ?post:(G.V.t -> unit) -> G.t -> unit+      (** [iter pre post g] visits all nodes of [g] in depth-first search, +	 applying [pre] to each visited node before its successors,+	 and [post] after them. Each node is visited exactly once. +         Not tail-recursive. *)++  val prefix : (G.V.t -> unit) -> G.t -> unit+    (** applies only a prefix function; note that this function is more+      efficient than [iter] and is tail-recursive. *)++  val postfix : (G.V.t -> unit) -> G.t -> unit+    (** applies only a postfix function. Not tail-recursive. *)++  (** Same thing, but for a single connected component+      (only [prefix_component] is tail-recursive) *)++  val iter_component : ?pre:(G.V.t -> unit) -> +             ?post:(G.V.t -> unit) -> G.t -> G.V.t -> unit+  val prefix_component : (G.V.t -> unit) -> G.t -> G.V.t -> unit+  val postfix_component : (G.V.t -> unit) -> G.t -> G.V.t -> unit++  (** {2 Step-by-step iterator}++    This is a variant of the iterators above where you can move on+    step by step. The abstract type [iterator] represents the current+    state of the iteration. The [step] function returns the next state. +    In each state, function [get] returns the currently visited vertex.+    On the final state both [get] and [step] raises exception [Exit]. ++    Note: the iterator type is persistent (i.e. is not modified by the +    [step] function) and thus can be used in backtracking algorithms. *)++  type iterator+  val start : G.t -> iterator+  val step : iterator -> iterator+  val get : iterator -> G.V.t++  (** {2 Cycle detection} *)++  val has_cycle : G.t -> bool+    (** [has_cycle g] checks for a cycle in [g]. Linear in time and space. *)++end++(** Breadth-first search *)+module Bfs(G : G) : sig+  (** {2 Classical big-step iterators} *)++  val iter : (G.V.t -> unit) -> G.t -> unit+  val iter_component : (G.V.t -> unit) -> G.t -> G.V.t -> unit++  (** {2 Step-by-step iterator}+    See module [Dfs] *)++  type iterator+  val start : G.t -> iterator+  val step : iterator -> iterator+  val get : iterator -> G.V.t++end++(** {1 Traversal with marking} *)++(** Minimal graph signature for graph traversal with marking. *)+module type GM = sig+  type t+  module V : sig type t end+  val iter_vertex : (V.t -> unit) -> t -> unit+  val iter_succ : (V.t -> unit) -> t -> V.t -> unit+  module Mark : sig+    val clear : t -> unit+    val get : V.t -> int+    val set : V.t -> int -> unit+  end+end++(** Graph traversal with marking. +    Only applies to imperative graphs with marks. *)+module Mark(G : GM) : sig++  val dfs : G.t -> unit+    (** [dfs g] traverses [g] in depth-first search, marking all nodes. *)++  val has_cycle : G.t -> bool+    (** [has_cycle g] checks for a cycle in [g]. Modifies the marks.+      Linear time, constant space. *)++end+
+ external/ocamlgraph/src/util.ml view
@@ -0,0 +1,67 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: util.ml,v 1.14 2004-10-19 15:21:45 signoles Exp $ *)++open Sig++module OTProduct(X: ORDERED_TYPE)(Y: ORDERED_TYPE) = struct ++  type t = X.t * Y.t ++  let compare (x1, y1) (x2, y2) = +    let cv = X.compare x1 x2 in+    if cv != 0 then cv else Y.compare y1 y2++end++module HTProduct(X: HASHABLE)(Y: HASHABLE) = struct++  type t = X.t * Y.t++  let equal (x1, y1) (x2, y2) =+    X.equal x1 x2 && Y.equal y1 y2++  let hash (x, y) = +    Hashtbl.hash (X.hash x, Y.hash y)++end++module CMPProduct(X: COMPARABLE)(Y: COMPARABLE) = struct +  include HTProduct(X)(Y)+  include (OTProduct(X)(Y): sig val compare : t -> t -> int end)+end++module DataV(L : sig type t end)(V : Sig.COMPARABLE) = +struct+  type data = L.t+  type label = V.t+  type t = data ref * V.t+      +  let compare ((_, x) : t) ((_, x') : t) =+    V.compare x x'+      +  let hash ((_, x) : t) = V.hash x++  let equal ((_, x) : t) ((_, x') : t) = V.equal x x'+				   +  let create y lbl = (ref y, lbl)+  let label (_, z) = z+  let data (y, _) = !y+  let set_data (y, _) = (:=) y+end+
+ external/ocamlgraph/src/util.mli view
@@ -0,0 +1,47 @@+(**************************************************************************)+(*                                                                        *)+(*  Ocamlgraph: a generic graph library for OCaml                         *)+(*  Copyright (C) 2004-2007                                               *)+(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)+(*                                                                        *)+(*  This software is free software; you can redistribute it and/or        *)+(*  modify it under the terms of the GNU Library General Public           *)+(*  License version 2, with the special exception on linking              *)+(*  described in file LICENSE.                                            *)+(*                                                                        *)+(*  This software is distributed in the hope that it will be useful,      *)+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)+(*                                                                        *)+(**************************************************************************)++(* $Id: util.mli,v 1.12 2005-03-31 13:32:51 filliatr Exp $ *)++open Sig++module OTProduct(X: ORDERED_TYPE)(Y: ORDERED_TYPE) : +  ORDERED_TYPE with type t = X.t * Y.t++module HTProduct(X: HASHABLE)(Y: HASHABLE) :+  HASHABLE with type t = X.t * Y.t++module CMPProduct(X: COMPARABLE)(Y: COMPARABLE) : +  COMPARABLE with type t = X.t * Y.t++(** Create a vertex type with some data attached to it *)+module DataV +  (L : sig type t end)+  (V : Sig.COMPARABLE) :+sig+  type data = L.t+  and label = V.t+  and t = data ref * V.t+  val compare : t -> t -> int+  val hash : t -> int+  val equal : t -> t -> bool+  val create : data -> V.t -> t+  val label : t -> V.t+  val data : t -> data+  val set_data : t -> data -> unit+end+
+ external/ocamlgraph/src/version.ml view
@@ -0,0 +1,2 @@+let version = "0.99b"+let date = "Sun Sep 22 21:13:17 PDT 2013"
+ external/z3/include/z3.h view
@@ -0,0 +1,70 @@+/*+++Copyright (c) 2007 Microsoft Corporation++Module Name:++    msmt.h++Abstract:++    Z3 API.++Author:++    Nikolaj Bjorner (nbjorner)+    Leonardo de Moura (leonardo) 2007-06-8++Notes:+    +--*/++#ifndef _Z3__H_+#define _Z3__H_++#include <stdio.h>++#ifndef __in+#define __in+#endif++#ifndef __in_z+#define __in_z __in+#endif++#ifndef __out+#define __out+#endif++#ifndef __out_z+#define __out_z+#endif++#ifndef __ecount+#define __ecount(num_args)+#endif ++#ifndef __in_ecount+#define __in_ecount(num_args) __in __ecount(num_args)+#endif ++#ifndef __out_ecount+#define __out_ecount(num_args) __out __ecount(num_args)+#endif ++#ifndef __inout_ecount+#define __inout_ecount(num_args) __in __out __ecount(num_args)+#endif ++#ifndef __inout+#define __inout __in __out+#endif++#define Z3_API++#define DEFINE_TYPE(T) typedef struct _ ## T *T+#define DEFINE_VOID(T) typedef void* T++#include"z3_api.h"++#endif+
+ external/z3/include/z3_api.h view
@@ -0,0 +1,4824 @@+DEFINE_TYPE(Z3_config);+DEFINE_TYPE(Z3_context);+DEFINE_TYPE(Z3_sort);+DEFINE_TYPE(Z3_func_decl);+DEFINE_TYPE(Z3_ast);+DEFINE_TYPE(Z3_app);+DEFINE_TYPE(Z3_pattern);+DEFINE_TYPE(Z3_symbol);+DEFINE_TYPE(Z3_parameter);+DEFINE_TYPE(Z3_model);+DEFINE_TYPE(Z3_literals);+DEFINE_TYPE(Z3_constructor);+DEFINE_TYPE(Z3_constructor_list);+DEFINE_TYPE(Z3_theory);+DEFINE_VOID(Z3_theory_data);+++#ifndef __int64+#define __int64 long long+#endif++#ifndef __uint64+#define __uint64 unsigned long long+#endif++// Backwards compatibility+#define Z3_type_ast            Z3_sort+#define Z3_const_decl_ast      Z3_func_decl+#define Z3_const               Z3_app+#define Z3_pattern_ast         Z3_pattern+#define Z3_UNINTERPRETED_TYPE  Z3_UNINTERPRETED_SORT+#define Z3_BOOL_TYPE           Z3_BOOL_SORT+#define Z3_INT_TYPE            Z3_INT_SORT+#define Z3_REAL_TYPE           Z3_REAL_SORT+#define Z3_BV_TYPE             Z3_BV_SORT+#define Z3_ARRAY_TYPE          Z3_ARRAY_SORT+#define Z3_TUPLE_TYPE          Z3_DATATYPE_SORT+#define Z3_UNKNOWN_TYPE        Z3_UNKNOWN_SORT+#define Z3_CONST_DECL_AST      Z3_FUNC_DECL_AST    +#define Z3_TYPE_AST            Z3_SORT_AST          +#define Z3_SORT_ERROR          Z3_TYPE_ERROR+#define Z3_mk_uninterpreted_type Z3_mk_uninterpreted_sort+#define Z3_mk_bool_type        Z3_mk_bool_sort+#define Z3_mk_int_type         Z3_mk_int_sort+#define Z3_mk_real_type        Z3_mk_real_sort+#define Z3_mk_bv_type          Z3_mk_bv_sort+#define Z3_mk_array_type       Z3_mk_array_sort+#define Z3_mk_tuple_type       Z3_mk_tuple_sort+#define Z3_get_type            Z3_get_sort+#define Z3_get_pattern_ast           Z3_get_pattern+#define Z3_get_type_kind             Z3_get_sort_kind+#define Z3_get_type_name             Z3_get_sort_name+#define Z3_get_bv_type_size          Z3_get_bv_sort_size+#define Z3_get_array_type_domain     Z3_get_array_sort_domain+#define Z3_get_array_type_range      Z3_get_array_sort_range+#define Z3_get_tuple_type_num_fields Z3_get_tuple_sort_num_fields+#define Z3_get_tuple_type_field_decl Z3_get_tuple_sort_field_decl+#define Z3_get_tuple_type_mk_decl    Z3_get_tuple_sort_mk_decl+#define Z3_to_const_ast              Z3_to_app+#define Z3_get_numeral_value_string  Z3_get_numeral_string+#define Z3_get_const_ast_decl        Z3_get_app_decl+#define Z3_get_value                 Z3_eval_func_decl++/**+   \defgroup capi C API++*/+/*@{*/++/**+   \conly @name Types+   +   \conly Most of the types in the C API are opaque pointers.++   \conly - \c Z3_config: a configuration object used to initialize logical contexts.+   \conly - \c Z3_context: logical context. This is the main Z3 data-structure.+   \conly - \c Z3_symbol: a Lisp-link symbol. It is used to name types, constants, and functions.  A symbol can be created using+   \conly string or integers. +   \conly - \c Z3_ast: abstract syntax tree node. That is, the data-structure used in Z3 to represent terms, formulas and types.+   \conly - \c Z3_sort: a kind of AST used to represent types.+   \conly - \c Z3_app: a kind of AST used to represent constant and function declarations.+   \conly - \c Z3_pattern: a kind of AST used to represent pattern and multi-patterns used to guide quantifier instantiation.+   \conly - \c Z3_model: a model for the constraints asserted into the logical context.+*/++#ifndef CAMLIDL+/**+   \conly \brief Z3 Boolean type. It is just an alias for \c int.+*/+typedef int Z3_bool;+#else+/**+   \conly \brief Z3 Boolean type. It is just an alias for \c Boolean.+*/+#define Z3_bool boolean+#endif // CAMLIDL++#ifndef CAMLIDL+/**+   \conly \brief Z3 string type. It is just an alias for <tt>const char *</tt>.+*/+typedef const char * Z3_string;+typedef Z3_string * Z3_string_ptr;+#else+/**+   \conly \brief Z3 string type. It is just an alias for <tt>[string] const char *</tt>.+*/+#define Z3_string [string] const char *+/* hack to make the IDL compiler happy */+#define Z3_string_ptr const char * *+#endif // CAMLIDL+    +#ifndef CAMLIDL+/**+   \conly \brief True value. It is just an alias for \c 1.+*/+#define Z3_TRUE  1++/**+   \conly \brief False value. It is just an alias for \c 0.+*/+#define Z3_FALSE 0++#endif // CAMLIDL++/**+   \conly \brief Lifted Boolean type: \c false, \c undefined, \c true.+*/+typedef enum +{+    Z3_L_FALSE = -1,+    Z3_L_UNDEF,+    Z3_L_TRUE+} Z3_lbool;++/**+   \conly \brief In Z3, a symbol can be represented using integers and strings (See #Z3_get_symbol_kind).++   \conly \sa Z3_mk_int_symbol+   \conly \sa Z3_mk_string_symbol+*/+typedef enum +{+    Z3_INT_SYMBOL,+    Z3_STRING_SYMBOL +} Z3_symbol_kind;+++/**+   \conly \brief The different kinds of parameters that can be associated with function symbols.+   \conly \sa Z3_get_decl_num_parameters+   \conly \sa Z3_get_decl_parameter_kind++   \conly - Z3_PARAMETER_INT is used for integer parameters.+   \conly - Z3_PARAMETER_DOUBLE is used for double parameters.+   \conly - Z3_PARAMETER_RATIONAL is used for parameters that are rational numbers.+   \conly - Z3_PARAMETER_SORT is used for sort parameters.+   \conly - Z3_PARAMETER_AST is used for expression parameters.+   \conly - Z3_PARAMETER_FUNC_DECL is used for function declaration parameters.+*/+typedef enum +{+    Z3_PARAMETER_INT,+    Z3_PARAMETER_DOUBLE,+    Z3_PARAMETER_RATIONAL,+    Z3_PARAMETER_SYMBOL,+    Z3_PARAMETER_SORT,+    Z3_PARAMETER_AST,+    Z3_PARAMETER_FUNC_DECL,+} Z3_parameter_kind;++/**+   \conly \brief The different kinds of Z3 types (See #Z3_get_sort_kind).+*/+typedef enum +{+    Z3_UNINTERPRETED_SORT,+    Z3_BOOL_SORT,+    Z3_INT_SORT,+    Z3_REAL_SORT,+    Z3_BV_SORT,+    Z3_ARRAY_SORT,+    Z3_DATATYPE_SORT,+    Z3_RELATION_SORT,+    Z3_FINITE_DOMAIN_SORT,+    Z3_UNKNOWN_SORT = 1000+} Z3_sort_kind;++/**+   \conly \brief The different kinds of Z3 AST (abstract syntax trees). That is, terms, formulas and types.++   \conly - Z3_APP_AST:            constant and applications +   \conly - Z3_NUMERAL_AST:        numeral constants+   \conly - Z3_VAR_AST:            bound variables +   \conly - Z3_QUANTIFIER_AST:     quantifiers +   \conly - Z3_UNKNOWN_AST:        internal +*/+typedef enum +{+    Z3_NUMERAL_AST,+    Z3_APP_AST,         +    Z3_VAR_AST,          +    Z3_QUANTIFIER_AST,    +    Z3_UNKNOWN_AST = 1000 +} Z3_ast_kind;++/**+   \conly \brief The different kinds of interpreted function kinds.++   (*+   - Z3_OP_TRUE The constant true.++   - Z3_OP_FALSE The constant false.++   - Z3_OP_EQ The equality predicate.++   - Z3_OP_DISTINCT The n-ary distinct predicate (every argument is mutually distinct).++   - Z3_OP_ITE The ternary if-then-else term.++   - Z3_OP_AND n-ary conjunction.++   - Z3_OP_OR n-ary disjunction.++   - Z3_OP_IFF equivalence (binary).++   - Z3_OP_XOR Exclusive or.++   - Z3_OP_NOT Negation.++   - Z3_OP_IMPLIES Implication.++   - Z3_OP_OEQ Binary equivalence modulo namings. This binary predicate is used in proof terms.+        It captures equisatisfiability and equivalence modulo renamings.++   - Z3_OP_ANUM Arithmetic numeral.++   - Z3_OP_LE <=.++   - Z3_OP_GE >=.++   - Z3_OP_LT <.++   - Z3_OP_GT >.++   - Z3_OP_ADD Addition - Binary.++   - Z3_OP_SUB Binary subtraction.++   - Z3_OP_UMINUS Unary minus.++   - Z3_OP_MUL Multiplication - Binary.++   - Z3_OP_DIV Division - Binary.++   - Z3_OP_IDIV Integer division - Binary.++   - Z3_OP_REM Remainder - Binary.++   - Z3_OP_MOD Modulus - Binary.++   - Z3_OP_TO_REAL Coercion of integer to real - Unary.++   - Z3_OP_TO_INT Coercion of real to integer - Unary.++   - Z3_OP_IS_INT Check if real is also an integer - Unary.++   - Z3_OP_STORE Array store. It satisfies select(store(a,i,v),j) = if i = j then v else select(a,j).+        Array store takes at least 3 arguments. ++   - Z3_OP_SELECT Array select. ++   - Z3_OP_CONST_ARRAY The constant array. For example, select(const(v),i) = v holds for every v and i. The function is unary.++   - Z3_OP_ARRAY_DEFAULT Default value of arrays. For example default(const(v)) = v. The function is unary.++   - Z3_OP_ARRAY_MAP Array map operator.+         It satisfies map[f](a1,..,a_n)[i] = f(a1[i],...,a_n[i]) for every i.++   - Z3_OP_SET_UNION Set union between two Booelan arrays (two arrays whose range type is Boolean). The function is binary.++   - Z3_OP_SET_INTERSECT Set intersection between two Boolean arrays. The function is binary.++   - Z3_OP_SET_DIFFERENCE Set difference between two Boolean arrays. The function is binary.++   - Z3_OP_SET_COMPLEMENT Set complement of a Boolean array. The function is unary.++   - Z3_OP_SET_SUBSET Subset predicate between two Boolean arrays. The relation is binary.++   - Z3_OP_AS_ARRAY An array value that behaves as the function graph of the+                    function passed as parameter.++   - Z3_OP_BNUM Bit-vector numeral.++   - Z3_OP_BIT1 One bit bit-vector.++   - Z3_OP_BIT0 Zero bit bit-vector.++   - Z3_OP_BNEG Unary minus.++   - Z3_OP_BADD Binary addition.++   - Z3_OP_BSUB Binary subtraction.++   - Z3_OP_BMUL Binary multiplication.+    +   - Z3_OP_BSDIV Binary signed division.++   - Z3_OP_BUDIV Binary unsigned division.++   - Z3_OP_BSREM Binary signed remainder.++   - Z3_OP_BUREM Binary unsigned remainder.++   - Z3_OP_BSMOD Binary signed modulus.++   - Z3_OP_BSDIV0 Unary function. bsdiv(x,0) is congruent to bsdiv0(x).++   - Z3_OP_BUDIV0 Unary function. budiv(x,0) is congruent to budiv0(x).++   - Z3_OP_BSREM0 Unary function. bsrem(x,0) is congruent to bsrem0(x).++   - Z3_OP_BUREM0 Unary function. burem(x,0) is congruent to burem0(x).++   - Z3_OP_BSMOD0 Unary function. bsmod(x,0) is congruent to bsmod0(x).+    +   - Z3_OP_ULEQ Unsigned bit-vector <= - Binary relation.++   - Z3_OP_SLEQ Signed bit-vector  <= - Binary relation.++   - Z3_OP_UGEQ Unsigned bit-vector  >= - Binary relation.++   - Z3_OP_SGEQ Signed bit-vector  >= - Binary relation.++   - Z3_OP_ULT Unsigned bit-vector  < - Binary relation.++   - Z3_OP_SLT Signed bit-vector < - Binary relation.++   - Z3_OP_UGT Unsigned bit-vector > - Binary relation.++   - Z3_OP_SGT Signed bit-vector > - Binary relation.++   - Z3_OP_BAND Bit-wise and - Binary.++   - Z3_OP_BOR Bit-wise or - Binary.++   - Z3_OP_BNOT Bit-wise not - Unary.++   - Z3_OP_BXOR Bit-wise xor - Binary.++   - Z3_OP_BNAND Bit-wise nand - Binary.++   - Z3_OP_BNOR Bit-wise nor - Binary.++   - Z3_OP_BXNOR Bit-wise xnor - Binary.++   - Z3_OP_CONCAT Bit-vector concatenation - Binary.++   - Z3_OP_SIGN_EXT Bit-vector sign extension.++   - Z3_OP_ZERO_EXT Bit-vector zero extension.++   - Z3_OP_EXTRACT Bit-vector extraction.++   - Z3_OP_REPEAT Repeat bit-vector n times.++   - Z3_OP_BREDOR Bit-vector reduce or - Unary.++   - Z3_OP_BREDAND Bit-vector reduce and - Unary.++   - Z3_OP_BCOMP .++   - Z3_OP_BSHL Shift left.++   - Z3_OP_BLSHR Logical shift right.++   - Z3_OP_BASHR Arithmetical shift right.++   - Z3_OP_ROTATE_LEFT Left rotation.++   - Z3_OP_ROTATE_RIGHT Right rotation.++   - Z3_OP_EXT_ROTATE_LEFT (extended) Left rotation. Similar to Z3_OP_ROTATE_LEFT, but it is a binary operator instead of a parametric one.++   - Z3_OP_EXT_ROTATE_RIGHT (extended) Right rotation. Similar to Z3_OP_ROTATE_RIGHT, but it is a binary operator instead of a parametric one.++   - Z3_OP_INT2BV Coerce integer to bit-vector. NB. This function+       is not supported by the decision procedures. Only the most+       rudimentary simplification rules are applied to this function.++   - Z3_OP_BV2INT Coerce bit-vector to integer. NB. This function+       is not supported by the decision procedures. Only the most+       rudimentary simplification rules are applied to this function.++   - Z3_OP_CARRY Compute the carry bit in a full-adder. +       The meaning is given by the equivalence+       (carry l1 l2 l3) <=> (or (and l1 l2) (and l1 l3) (and l2 l3)))++   - Z3_OP_XOR3 Compute ternary XOR.+       The meaning is given by the equivalence+       (xor3 l1 l2 l3) <=> (xor (xor l1 l2) l3)++   - Z3_OP_PR_TRUE: Proof for the expression 'true'.++   - Z3_OP_PR_ASSERTED: Proof for a fact asserted by the user.+   +   - Z3_OP_PR_GOAL: Proof for a fact (tagged as goal) asserted by the user.++   - Z3_OP_PR_MODUS_PONENS: Given a proof for p and a proof for (implies p q), produces a proof for q.+       \nicebox{+          T1: p+          T2: (implies p q)+          [mp T1 T2]: q+          }+          The second antecedents may also be a proof for (iff p q).++   - Z3_OP_PR_REFLEXIVITY: A proof for (R t t), where R is a reflexive relation. This proof object has no antecedents.+        The only reflexive relations that are used are +        equivalence modulo namings, equality and equivalence.+        That is, R is either '~', '=' or 'iff'.++   - Z3_OP_PR_SYMMETRY: Given an symmetric relation R and a proof for (R t s), produces a proof for (R s t).+          \nicebox{+          T1: (R t s)+          [symmetry T1]: (R s t)+          }+          T1 is the antecedent of this proof object.++   - Z3_OP_PR_TRANSITIVITY: Given a transitive relation R, and proofs for (R t s) and (R s u), produces a proof+       for (R t u).+       \nicebox{+       T1: (R t s)+       T2: (R s u)+       [trans T1 T2]: (R t u)+       }++   - Z3_OP_PR_TRANSITIVITY_STAR: Condensed transitivity proof. This proof object is only used if the parameter PROOF_MODE is 1.+     It combines several symmetry and transitivity proofs. ++          Example:+          \nicebox{+          T1: (R a b)+          T2: (R c b)+          T3: (R c d)+          [trans* T1 T2 T3]: (R a d)+          }+          R must be a symmetric and transitive relation.++          Assuming that this proof object is a proof for (R s t), then+          a proof checker must check if it is possible to prove (R s t)+          using the antecedents, symmetry and transitivity.  That is, +          if there is a path from s to t, if we view every+          antecedent (R a b) as an edge between a and b.++   - Z3_OP_PR_MONOTONICITY: Monotonicity proof object.+          \nicebox{+          T1: (R t_1 s_1)+          ...+          Tn: (R t_n s_n)+          [monotonicity T1 ... Tn]: (R (f t_1 ... t_n) (f s_1 ... s_n))+          }+          Remark: if t_i == s_i, then the antecedent Ti is suppressed.+          That is, reflexivity proofs are supressed to save space.++   - Z3_OP_PR_QUANT_INTRO: Given a proof for (~ p q), produces a proof for (~ (forall (x) p) (forall (x) q)).++       T1: (~ p q)+       [quant-intro T1]: (~ (forall (x) p) (forall (x) q))+   +   - Z3_OP_PR_DISTRIBUTIVITY: Distributivity proof object. +          Given that f (= or) distributes over g (= and), produces a proof for++          (= (f a (g c d))+             (g (f a c) (f a d)))++          If f and g are associative, this proof also justifies the following equality:++          (= (f (g a b) (g c d))+             (g (f a c) (f a d) (f b c) (f b d)))++          where each f and g can have arbitrary number of arguments.++          This proof object has no antecedents.+          Remark. This rule is used by the CNF conversion pass and +          instantiated by f = or, and g = and.+    +   - Z3_OP_PR_AND_ELIM: Given a proof for (and l_1 ... l_n), produces a proof for l_i+        +       \nicebox{+       T1: (and l_1 ... l_n)+       [and-elim T1]: l_i+       }+   - Z3_OP_PR_NOT_OR_ELIM: Given a proof for (not (or l_1 ... l_n)), produces a proof for (not l_i).++       \nicebox{+       T1: (not (or l_1 ... l_n))+       [not-or-elim T1]: (not l_i)+       }++   - Z3_OP_PR_REWRITE: A proof for a local rewriting step (= t s).+          The head function symbol of t is interpreted.++          This proof object has no antecedents.+          The conclusion of a rewrite rule is either an equality (= t s), +          an equivalence (iff t s), or equi-satisfiability (~ t s).+          Remark: if f is bool, then = is iff.+          ++          Examples:+          \nicebox{+          (= (+ x 0) x)+          (= (+ x 1 2) (+ 3 x))+          (iff (or x false) x)+          }++   - Z3_OP_PR_REWRITE_STAR: A proof for rewriting an expression t into an expression s.+       This proof object is used if the parameter PROOF_MODE is 1.+       This proof object can have n antecedents.+       The antecedents are proofs for equalities used as substitution rules.+       The object is also used in a few cases if the parameter PROOF_MODE is 2.+       The cases are:+         - When applying contextual simplification (CONTEXT_SIMPLIFIER=true)+         - When converting bit-vectors to Booleans (BIT2BOOL=true)+         - When pulling ite expression up (PULL_CHEAP_ITE_TREES=true)++   - Z3_OP_PR_PULL_QUANT: A proof for (iff (f (forall (x) q(x)) r) (forall (x) (f (q x) r))). This proof object has no antecedents.++   - Z3_OP_PR_PULL_QUANT_STAR: A proof for (iff P Q) where Q is in prenex normal form.+       This proof object is only used if the parameter PROOF_MODE is 1.       +       This proof object has no antecedents.+  +   - Z3_OP_PR_PUSH_QUANT: A proof for:++       \nicebox{+          (iff (forall (x_1 ... x_m) (and p_1[x_1 ... x_m] ... p_n[x_1 ... x_m]))+               (and (forall (x_1 ... x_m) p_1[x_1 ... x_m])+                 ... +               (forall (x_1 ... x_m) p_n[x_1 ... x_m])))+               }+         This proof object has no antecedents.++   - Z3_OP_PR_ELIM_UNUSED_VARS:  +          A proof for (iff (forall (x_1 ... x_n y_1 ... y_m) p[x_1 ... x_n])+                           (forall (x_1 ... x_n) p[x_1 ... x_n])) ++          It is used to justify the elimination of unused variables.+          This proof object has no antecedents.++   - Z3_OP_PR_DER: A proof for destructive equality resolution:+          (iff (forall (x) (or (not (= x t)) P[x])) P[t])+          if x does not occur in t.++          This proof object has no antecedents.+          +          Several variables can be eliminated simultaneously.++   - Z3_OP_PR_QUANT_INST: A proof of (or (not (forall (x) (P x))) (P a))++   - Z3_OP_PR_HYPOTHESIS: Mark a hypothesis in a natural deduction style proof.++   - Z3_OP_PR_LEMMA: ++       \nicebox{+          T1: false+          [lemma T1]: (or (not l_1) ... (not l_n))+          }+          This proof object has one antecedent: a hypothetical proof for false.+          It converts the proof in a proof for (or (not l_1) ... (not l_n)),+          when T1 contains the hypotheses: l_1, ..., l_n.++   - Z3_OP_PR_UNIT_RESOLUTION: +       \nicebox{+          T1:      (or l_1 ... l_n l_1' ... l_m')+          T2:      (not l_1)+          ...+          T(n+1):  (not l_n)+          [unit-resolution T1 ... T(n+1)]: (or l_1' ... l_m')+          }++   - Z3_OP_PR_IFF_TRUE: +      \nicebox{+       T1: p+       [iff-true T1]: (iff p true)+       }++   - Z3_OP_PR_IFF_FALSE:+      \nicebox{+       T1: (not p)+       [iff-false T1]: (iff p false)+       }++   - Z3_OP_PR_COMMUTATIVITY:++          [comm]: (= (f a b) (f b a))+          +          f is a commutative operator.++          This proof object has no antecedents.+          Remark: if f is bool, then = is iff.+   +   - Z3_OP_PR_DEF_AXIOM: Proof object used to justify Tseitin's like axioms:+       +          \nicebox{+          (or (not (and p q)) p)+          (or (not (and p q)) q)+          (or (not (and p q r)) p)+          (or (not (and p q r)) q)+          (or (not (and p q r)) r)+          ...+          (or (and p q) (not p) (not q))+          (or (not (or p q)) p q)+          (or (or p q) (not p))+          (or (or p q) (not q))+          (or (not (iff p q)) (not p) q)+          (or (not (iff p q)) p (not q))+          (or (iff p q) (not p) (not q))+          (or (iff p q) p q)+          (or (not (ite a b c)) (not a) b)+          (or (not (ite a b c)) a c)+          (or (ite a b c) (not a) (not b))+          (or (ite a b c) a (not c))+          (or (not (not a)) (not a))+          (or (not a) a)+          }+          This proof object has no antecedents.+          Note: all axioms are propositional tautologies.+          Note also that 'and' and 'or' can take multiple arguments.+          You can recover the propositional tautologies by+          unfolding the Boolean connectives in the axioms a small+          bounded number of steps (=3).+    +   - Z3_OP_PR_DEF_INTRO: Introduces a name for a formula/term.+       Suppose e is an expression with free variables x, and def-intro+       introduces the name n(x). The possible cases are:++       When e is of Boolean type:+       [def-intro]: (and (or n (not e)) (or (not n) e))++       or:+       [def-intro]: (or (not n) e)+       when e only occurs positively.++       When e is of the form (ite cond th el):+       [def-intro]: (and (or (not cond) (= n th)) (or cond (= n el)))++       Otherwise:+       [def-intro]: (= n e)       ++   - Z3_OP_PR_APPLY_DEF: +       [apply-def T1]: F ~ n+       F is 'equivalent' to n, given that T1 is a proof that+       n is a name for F.+   +   - Z3_OP_PR_IFF_OEQ:+       T1: (iff p q)+       [iff~ T1]: (~ p q)+ +   - Z3_OP_PR_NNF_POS: Proof for a (positive) NNF step. Example:+       \nicebox{+          T1: (not s_1) ~ r_1+          T2: (not s_2) ~ r_2+          T3: s_1 ~ r_1'+          T4: s_2 ~ r_2'+          [nnf-pos T1 T2 T3 T4]: (~ (iff s_1 s_2)+                                    (and (or r_1 r_2') (or r_1' r_2)))+          }+       The negation normal form steps NNF_POS and NNF_NEG are used in the following cases:+       (a) When creating the NNF of a positive force quantifier.+        The quantifier is retained (unless the bound variables are eliminated).+        Example+        \nicebox{+           T1: q ~ q_new +           [nnf-pos T1]: (~ (forall (x T) q) (forall (x T) q_new))+        }+       (b) When recursively creating NNF over Boolean formulas, where the top-level+       connective is changed during NNF conversion. The relevant Boolean connectives+       for NNF_POS are 'implies', 'iff', 'xor', 'ite'.+       NNF_NEG furthermore handles the case where negation is pushed+       over Boolean connectives 'and' and 'or'.++    +   - Z3_OP_PR_NFF_NEG: Proof for a (negative) NNF step. Examples:+          \nicebox{+          T1: (not s_1) ~ r_1+          ...+          Tn: (not s_n) ~ r_n+         [nnf-neg T1 ... Tn]: (not (and s_1 ... s_n)) ~ (or r_1 ... r_n)+      and+          T1: (not s_1) ~ r_1+          ...+          Tn: (not s_n) ~ r_n+         [nnf-neg T1 ... Tn]: (not (or s_1 ... s_n)) ~ (and r_1 ... r_n)+      and+          T1: (not s_1) ~ r_1+          T2: (not s_2) ~ r_2+          T3: s_1 ~ r_1'+          T4: s_2 ~ r_2'+         [nnf-neg T1 T2 T3 T4]: (~ (not (iff s_1 s_2))+                                   (and (or r_1 r_2) (or r_1' r_2')))+       }+   - Z3_OP_PR_NNF_STAR: A proof for (~ P Q) where Q is in negation normal form.+       +       This proof object is only used if the parameter PROOF_MODE is 1.       +              +       This proof object may have n antecedents. Each antecedent is a PR_DEF_INTRO.++   - Z3_OP_PR_CNF_STAR: A proof for (~ P Q) where Q is in conjunctive normal form.+       This proof object is only used if the parameter PROOF_MODE is 1.       +       This proof object may have n antecedents. Each antecedent is a PR_DEF_INTRO.          ++   - Z3_OP_PR_SKOLEMIZE: Proof for:  +       +          \nicebox{+          [sk]: (~ (not (forall x (p x y))) (not (p (sk y) y)))+          [sk]: (~ (exists x (p x y)) (p (sk y) y))+          }++          This proof object has no antecedents.+   +   - Z3_OP_PR_MODUS_PONENS_OEQ: Modus ponens style rule for equi-satisfiability.+       \nicebox{+          T1: p+          T2: (~ p q)+          [mp~ T1 T2]: q+          }++    - Z3_OP_PR_TH_LEMMA: Generic proof for theory lemmas.++         The theory lemma function comes with one or more parameters.+         The first parameter indicates the name of the theory.+         For the theory of arithmetic, additional parameters provide hints for+         checking the theory lemma. +         The hints for arithmetic are:+         +         - farkas - followed by rational coefficients. Multiply the coefficients to the+           inequalities in the lemma, add the (negated) inequalities and obtain a contradiction.++         - triangle-eq - Indicates a lemma related to the equivalence:+         \nicebox{+            (iff (= t1 t2) (and (<= t1 t2) (<= t2 t1)))+         }++         - gcd-test - Indicates an integer linear arithmetic lemma that uses a gcd test.+++      - Z3_OP_RA_STORE: Insert a record into a relation.+        The function takes \c n+1 arguments, where the first argument is the relation and the remaining \c n elements +        correspond to the \c n columns of the relation.++      - Z3_OP_RA_EMPTY: Creates the empty relation. +        +      - Z3_OP_RA_IS_EMPTY: Tests if the relation is empty.++      - Z3_OP_RA_JOIN: Create the relational join.++      - Z3_OP_RA_UNION: Create the union or convex hull of two relations. +        The function takes two arguments.++      - Z3_OP_RA_WIDEN: Widen two relations.+        The function takes two arguments.++      - Z3_OP_RA_PROJECT: Project the columns (provided as numbers in the parameters).+        The function takes one argument.++      - Z3_OP_RA_FILTER: Filter (restrict) a relation with respect to a predicate.+        The first argument is a relation. +        The second argument is a predicate with free de-Brujin indices+        corresponding to the columns of the relation.+        So the first column in the relation has index 0.++      - Z3_OP_RA_NEGATION_FILTER: Intersect the first relation with respect to negation+        of the second relation (the function takes two arguments).+        Logically, the specification can be described by a function++           target = filter_by_negation(pos, neg, columns)++        where columns are pairs c1, d1, .., cN, dN of columns from pos and neg, such that+        target are elements in x in pos, such that there is no y in neg that agrees with+        x on the columns c1, d1, .., cN, dN.++    +      - Z3_OP_RA_RENAME: rename columns in the relation. +        The function takes one argument.+        The parameters contain the renaming as a cycle.+         +      - Z3_OP_RA_COMPLEMENT: Complement the relation.++      - Z3_OP_RA_SELECT: Check if a record is an element of the relation.+        The function takes \c n+1 arguments, where the first argument is a relation,+        and the remaining \c n arguments correspond to a record.++      - Z3_OP_RA_CLONE: Create a fresh copy (clone) of a relation. +        \conly The function is logically the identity, but+        \conly in the context of a register machine allows +        \conly for #Z3_OP_RA_UNION to perform destructive updates to the first argument.+        ++      - Z3_OP_FD_LT: A less than predicate over the finite domain Z3_FINITE_DOMAIN_SORT.++    *)++*/+typedef enum {+    Z3_OP_TRUE = 0x100,+    Z3_OP_FALSE,+    Z3_OP_EQ,+    Z3_OP_DISTINCT,+    Z3_OP_ITE,+    Z3_OP_AND,+    Z3_OP_OR,+    Z3_OP_IFF,+    Z3_OP_XOR,+    Z3_OP_NOT,+    Z3_OP_IMPLIES,+    Z3_OP_OEQ,+++    Z3_OP_ANUM = 0x200,+    Z3_OP_LE,+    Z3_OP_GE,+    Z3_OP_LT,+    Z3_OP_GT,+    Z3_OP_ADD,+    Z3_OP_SUB,+    Z3_OP_UMINUS,+    Z3_OP_MUL,+    Z3_OP_DIV,+    Z3_OP_IDIV,+    Z3_OP_REM,+    Z3_OP_MOD,+    Z3_OP_TO_REAL,+    Z3_OP_TO_INT,+    Z3_OP_IS_INT,++    Z3_OP_STORE = 0x300,+    Z3_OP_SELECT,+    Z3_OP_CONST_ARRAY,+    Z3_OP_ARRAY_MAP,+    Z3_OP_ARRAY_DEFAULT,+    Z3_OP_SET_UNION,+    Z3_OP_SET_INTERSECT,+    Z3_OP_SET_DIFFERENCE,+    Z3_OP_SET_COMPLEMENT,+    Z3_OP_SET_SUBSET,+    Z3_OP_AS_ARRAY,++    Z3_OP_BNUM = 0x400,+    Z3_OP_BIT1,+    Z3_OP_BIT0,+    Z3_OP_BNEG,+    Z3_OP_BADD,+    Z3_OP_BSUB,+    Z3_OP_BMUL,+    +    Z3_OP_BSDIV,+    Z3_OP_BUDIV,+    Z3_OP_BSREM,+    Z3_OP_BUREM,+    Z3_OP_BSMOD,++    // special functions to record the division by 0 cases+    // these are internal functions +    Z3_OP_BSDIV0, +    Z3_OP_BUDIV0,+    Z3_OP_BSREM0,+    Z3_OP_BUREM0,+    Z3_OP_BSMOD0,+    +    Z3_OP_ULEQ,+    Z3_OP_SLEQ,+    Z3_OP_UGEQ,+    Z3_OP_SGEQ,+    Z3_OP_ULT,+    Z3_OP_SLT,+    Z3_OP_UGT,+    Z3_OP_SGT,++    Z3_OP_BAND,+    Z3_OP_BOR,+    Z3_OP_BNOT,+    Z3_OP_BXOR,+    Z3_OP_BNAND,+    Z3_OP_BNOR,+    Z3_OP_BXNOR,++    Z3_OP_CONCAT,+    Z3_OP_SIGN_EXT,+    Z3_OP_ZERO_EXT,+    Z3_OP_EXTRACT,+    Z3_OP_REPEAT,++    Z3_OP_BREDOR,+    Z3_OP_BREDAND,+    Z3_OP_BCOMP,++    Z3_OP_BSHL,+    Z3_OP_BLSHR,+    Z3_OP_BASHR,+    Z3_OP_ROTATE_LEFT,+    Z3_OP_ROTATE_RIGHT,+    Z3_OP_EXT_ROTATE_LEFT,+    Z3_OP_EXT_ROTATE_RIGHT,++    Z3_OP_INT2BV,+    Z3_OP_BV2INT,+    Z3_OP_CARRY,+    Z3_OP_XOR3,++    Z3_OP_PR_UNDEF = 0x500, +    Z3_OP_PR_TRUE,+    Z3_OP_PR_ASSERTED, +    Z3_OP_PR_GOAL, +    Z3_OP_PR_MODUS_PONENS, +    Z3_OP_PR_REFLEXIVITY, +    Z3_OP_PR_SYMMETRY, +    Z3_OP_PR_TRANSITIVITY, +    Z3_OP_PR_TRANSITIVITY_STAR, +    Z3_OP_PR_MONOTONICITY, +    Z3_OP_PR_QUANT_INTRO,+    Z3_OP_PR_DISTRIBUTIVITY, +    Z3_OP_PR_AND_ELIM, +    Z3_OP_PR_NOT_OR_ELIM, +    Z3_OP_PR_REWRITE, +    Z3_OP_PR_REWRITE_STAR, +    Z3_OP_PR_PULL_QUANT, +    Z3_OP_PR_PULL_QUANT_STAR, +    Z3_OP_PR_PUSH_QUANT, +    Z3_OP_PR_ELIM_UNUSED_VARS, +    Z3_OP_PR_DER, +    Z3_OP_PR_QUANT_INST,+    Z3_OP_PR_HYPOTHESIS, +    Z3_OP_PR_LEMMA, +    Z3_OP_PR_UNIT_RESOLUTION, +    Z3_OP_PR_IFF_TRUE, +    Z3_OP_PR_IFF_FALSE, +    Z3_OP_PR_COMMUTATIVITY, +    Z3_OP_PR_DEF_AXIOM,+    Z3_OP_PR_DEF_INTRO, +    Z3_OP_PR_APPLY_DEF, +    Z3_OP_PR_IFF_OEQ, +    Z3_OP_PR_NNF_POS, +    Z3_OP_PR_NNF_NEG, +    Z3_OP_PR_NNF_STAR, +    Z3_OP_PR_CNF_STAR, +    Z3_OP_PR_SKOLEMIZE,+    Z3_OP_PR_MODUS_PONENS_OEQ, +    Z3_OP_PR_TH_LEMMA, ++    Z3_OP_RA_STORE = 0x600,+    Z3_OP_RA_EMPTY,+    Z3_OP_RA_IS_EMPTY,+    Z3_OP_RA_JOIN,+    Z3_OP_RA_UNION,+    Z3_OP_RA_WIDEN,+    Z3_OP_RA_PROJECT,+    Z3_OP_RA_FILTER,+    Z3_OP_RA_NEGATION_FILTER,+    Z3_OP_RA_RENAME,+    Z3_OP_RA_COMPLEMENT,+    Z3_OP_RA_SELECT,+    Z3_OP_RA_CLONE,+    Z3_OP_FD_LT,+++    Z3_OP_UNINTERPRETED+} Z3_decl_kind;++++/**+   \conly \brief The different kinds of search failure types.++   \conly - Z3_NO_FAILURE:         The last search was successful+   \conly - Z3_UNKNOWN:            Undocumented failure reason+   \conly - Z3_TIMEOUT:            Timeout+   \conly - Z3_MEMOUT_WATERMAK:    Search hit a memory high-watermak limit+   \conly - Z3_CANCELED:           External cancel flag was set+   \conly - Z3_NUM_CONFLICTS:      Maximum number of conflicts was reached+   \conly - Z3_THEORY:             Theory is incomplete+   \conly - Z3_QUANTIFIERS:        Logical context contains universal quantifiers+*/+typedef enum {+    Z3_NO_FAILURE,+    Z3_UNKNOWN,+    Z3_TIMEOUT,+    Z3_MEMOUT_WATERMARK,     +    Z3_CANCELED,      +    Z3_NUM_CONFLICTS, +    Z3_THEORY,        +    Z3_QUANTIFIERS    +} Z3_search_failure;++/**+   \conly \brief Z3 pretty printing modes (See #Z3_set_ast_print_mode).++   \conly - Z3_PRINT_SMTLIB_FULL:   Print AST nodes in SMTLIB verbose format.+   \conly - Z3_PRINT_LOW_LEVEL:     Print AST nodes using a low-level format.+   \conly - Z3_PRINT_SMTLIB_COMPLIANT: Print AST nodes in SMTLIB 1.x compliant format.+   \conly - Z3_PRINT_SMTLIB2_COMPLIANT: Print AST nodes in SMTLIB 2.x compliant format.+*/+typedef enum {+    Z3_PRINT_SMTLIB_FULL,+    Z3_PRINT_LOW_LEVEL,+    Z3_PRINT_SMTLIB_COMPLIANT,+    Z3_PRINT_SMTLIB2_COMPLIANT+} Z3_ast_print_mode;++#ifndef CAMLIDL++/**+   \conly \brief Z3 error codes (See #Z3_get_error_code). +   +   \conly - Z3_OK,            +   \conly - Z3_SORT_ERROR:    User tried to build an invalid (type incorrect) AST.+   \conly - Z3_IOB:           Index out of bounds +   \conly - Z3_INVALID_ARG:   Invalid argument was provided+   \conly - Z3_PARSER_ERROR:  An error occurred when parsing a string or file.+   \conly - Z3_NO_PARSER:     Parser output is not available, that is, user didn't invoke Z3_parse_smtlib_string or Z3_parse_smtlib_file.+   \conly - Z3_INVALID_PATTERN: Invalid pattern was used to build a quantifier.+   \conly - Z3_MEMOUT_FAIL:   A memory allocation failure was encountered.+   \conly - Z3_FILE_ACCESS_ERRROR: A file could not be accessed.+   \conly - Z3_INVALID_USAGE:   API call is invalid in the current state.+   \conly - Z3_INTERNAL_FATAL: An error internal to Z3 occurred. +   \conly - Z3_DEC_REF_ERROR: Trying decrement the reference counter of an AST that was deleted or the reference counter was not initialized with #Z3_inc_ref.+*/+typedef enum+{+    Z3_OK,            +    Z3_SORT_ERROR,    +    Z3_IOB,           +    Z3_INVALID_ARG,   +    Z3_PARSER_ERROR,  +    Z3_NO_PARSER,+    Z3_INVALID_PATTERN,+    Z3_MEMOUT_FAIL,+    Z3_FILE_ACCESS_ERROR,+    Z3_INTERNAL_FATAL,+    Z3_INVALID_USAGE,+    Z3_DEC_REF_ERROR+} Z3_error_code;++++/**+   \conly \brief Z3 custom error handler (See #Z3_set_error_handler). +*/+typedef void Z3_error_handler(Z3_error_code e);+++#endif // CAMLIDL++/*@}*/++#ifndef CAMLIDL+#ifdef __cplusplus+extern "C" {+#endif // __cplusplus+#else+[pointer_default(ref)] interface Z3 {+#endif // CAMLIDL+    +    /** +        @name Create configuration+    */+    /*@{*/++    /**+       \brief Create a configuration.++       Configurations are created in order to assign parameters prior to creating +       contexts for Z3 interaction. For example, if the users whishes to use model+       generation, then call:++       \ccode{Z3_set_param_value(cfg\, "MODEL"\, "true")}++       \mlonly \remark Consider using {!Z3.mk_context_x} instead of using+       explicit configuration objects. The function {!Z3.mk_context_x}+       receives an array of string pairs. This array represents the+       configuration options. \endmlonly++       \sa Z3_set_param_value+       \sa Z3_del_config+    */+    Z3_config Z3_API Z3_mk_config();++    /**+       \brief Delete the given configuration object.++       \sa Z3_mk_config+    */+    void Z3_API Z3_del_config(__in Z3_config c);+    +    /**+       \brief Set a configuration parameter.++       The list of all configuration parameters can be obtained using the Z3 executable:++       \verbatim+       z3.exe -ini?+       \endverbatim++       \sa Z3_mk_config+    */+    void Z3_API Z3_set_param_value(__in Z3_config c, __in_z Z3_string param_id, __in_z Z3_string param_value);+++    /*@}*/++    /**+       @name Create context+    */+    /*@{*/++    /**+       \brief Create a context using the given configuration. +    +       After a context is created, the configuration cannot be changed.+       All main interaction with Z3 happens in the context of a \c Z3_context.++       \mlonly \remark Consider using {!Z3.mk_context_x} instead of using+       explicit configuration objects. The function {!Z3.mk_context_x}+       receives an array of string pairs. This array represents the+       configuration options. \endmlonly++       \sa Z3_del_context+    */+    Z3_context Z3_API Z3_mk_context(__in Z3_config c);++    /**+       \brief Create a context using the given configuration.+       This function is similar to #Z3_mk_context. However,+       in the context returned by this function, the user+       is responsible for managing Z3_ast reference counters.+       Managing reference counters is a burden and error-prone,+       but allows the user to use the memory more efficiently. +       The user must invoke #Z3_inc_ref for any Z3_ast returned+       by Z3, and #Z3_dec_ref whenever the Z3_ast is not needed+       anymore. This idiom is similar to the one used in+       BDD (binary decision diagrams) packages such as CUDD.++       Remark: Z3_sort, Z3_func_decl, Z3_app, Z3_pattern are+       Z3_ast's.+ +       After a context is created, the configuration cannot be changed.+       All main interaction with Z3 happens in the context of a \c Z3_context.+    */+    Z3_context Z3_API Z3_mk_context_rc(__in Z3_config c);++    /**+       \brief Set the SMTLIB logic to be used in the given logical context.+       It is incorrect to invoke this function after invoking+       #Z3_check, #Z3_check_and_get_model, #Z3_check_assumptions and #Z3_push.+       Return \c Z3_TRUE if the logic was changed successfully, and \c Z3_FALSE otherwise.+    */+    Z3_bool Z3_API Z3_set_logic(__in Z3_context c, __in_z Z3_string logic);+    +    /**+       \brief Delete the given logical context.++       \sa Z3_mk_config+    */+    void Z3_API Z3_del_context(__in Z3_context c);+    +    /**+       \brief Increment the reference counter of the given AST.+       The context \c c should have been created using #Z3_mk_context_rc.+       This function is a NOOP if \c c was created using #Z3_mk_context.+    */+    void Z3_API Z3_inc_ref(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Decrement the reference counter of the given AST.+       The context \c c should have been created using #Z3_mk_context_rc.+       This function is a NOOP if \c c was created using #Z3_mk_context.+    */+    void Z3_API Z3_dec_ref(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Enable trace messages to a file++       When trace messages are enabled, Z3 will record the operations performed on a context in the given file file.+       Return \c Z3_TRUE if the file was opened successfully, and \c Z3_FALSE otherwise.++       \sa Z3_trace_off+    */+    Z3_bool Z3_API Z3_trace_to_file(__in Z3_context c, __in_z Z3_string trace_file);++    /**+       \brief Enable trace messages to a standard error.++       \sa Z3_trace_off+    */+    void Z3_API Z3_trace_to_stderr(__in Z3_context c);++    /**+       \brief Enable trace messages to a standard output.++       \sa Z3_trace_off+    */+    void Z3_API Z3_trace_to_stdout(__in Z3_context c);++    /**+       \brief Disable trace messages.++       \sa Z3_trace_to_file+       \sa Z3_trace_to_stdout+       \sa Z3_trace_to_stderr+    */+    void Z3_API Z3_trace_off(__in Z3_context c);++    /**+       \brief Enable/disable printing warning messages to the console.++       Warnings are printed after passing \c true, warning messages are+       suppressed after calling this method with \c false.       +    */+    void Z3_API Z3_toggle_warning_messages(__in Z3_bool enabled);++    /**+       \brief Update a mutable configuration parameter.++       The list of all configuration parameters can be obtained using the Z3 executable:++       \verbatim+       z3.exe -ini?+       \endverbatim++       Only a few configuration parameters are mutable once the context is created.+       The error handler is invoked when trying to modify an immutable parameter.++       \sa Z3_set_param_value+    */+    void Z3_API Z3_update_param_value(__in Z3_context c, __in_z Z3_string param_id, __in_z Z3_string param_value);++    /**+       \brief Get a configuration parameter.+      +       Returns false if the parameter value does not exist.++       \sa Z3_mk_config+       \sa Z3_set_param_value+    */++#ifndef CAMLIDL+    Z3_bool Z3_API Z3_get_param_value(__in Z3_context c, __in_z Z3_string param_id, __out_z Z3_string_ptr param_value);+#endif++    /*@}*/++    /**+       @name Symbols+    */+    /*@{*/+    /**+       \brief Create a Z3 symbol using an integer.++       Symbols are used to name several term and type constructors.++       NB. Not all integers can be passed to this function.+       The legal range of unsigned integers is 0 to 2^30-1.++       \sa Z3_mk_string_symbol+    */+    Z3_symbol Z3_API Z3_mk_int_symbol(__in Z3_context c, __in int i);++    /**+       \brief Create a Z3 symbol using a C string.++       Symbols are used to name several term and type constructors.++       \sa Z3_mk_int_symbol+    */+    Z3_symbol Z3_API Z3_mk_string_symbol(__in Z3_context c, __in_z Z3_string s);+    /*@}*/+    +    +    /**+       @name Sorts+    */+    /*@{*/+    +    /**+       \brief compare sorts.+    */+    Z3_bool Z3_API Z3_is_eq_sort(__in Z3_context c, __in Z3_sort s1, __in Z3_sort s2);++    /**+       \brief Create a free (uninterpreted) type using the given name (symbol).+       +       Two free types are considered the same iff the have the same name.+    */+    Z3_sort Z3_API Z3_mk_uninterpreted_sort(__in Z3_context c, __in Z3_symbol s);+    ++    /**+       \brief Create the Boolean type. ++       This type is used to create propositional variables and predicates.+    */+    Z3_sort Z3_API Z3_mk_bool_sort(__in Z3_context c);+    +    /**+       \brief Create an integer type.++       This type is not the int type found in programming languages.+       A machine integer can be represented using bit-vectors. The function+       #Z3_mk_bv_sort creates a bit-vector type.++       \sa Z3_mk_bv_sort+    */+    Z3_sort Z3_API Z3_mk_int_sort(__in Z3_context c);+    +    /**+       \brief Create a real type. ++       This type is not a floating point number.+       Z3 does not have support for floating point numbers yet.+    */+    Z3_sort Z3_API Z3_mk_real_sort(__in Z3_context c);++    /**+       \brief Create a bit-vector type of the given size.+    +       This type can also be seen as a machine integer.++       \remark The size of the bitvector type must be greater than zero.+    */+    Z3_sort Z3_API Z3_mk_bv_sort(__in Z3_context c, __in unsigned sz);++    /**+       \brief Create an array type. +       +       We usually represent the array type as: <tt>[domain -> range]</tt>.+       Arrays are usually used to model the heap/memory in software verification.++       \sa Z3_mk_select+       \sa Z3_mk_store+    */+    Z3_sort Z3_API Z3_mk_array_sort(__in Z3_context c, __in Z3_sort domain, __in Z3_sort range);++    /**+       \brief Create a tuple type.+       +       \mlonly [mk_tuple_sort c name field_names field_sorts] creates a tuple with a constructor named [name],+       a [n] fields, where [n] is the size of the arrays [field_names] and [field_sorts].+       \endmlonly++       \conly A tuple with \c n fields has a constructor and \c n projections.+       \conly This function will also declare the constructor and projection functions.++       \param c logical context+       \param mk_tuple_name name of the constructor function associated with the tuple type.+       \param num_fields number of fields in the tuple type.+       \param field_names name of the projection functions.+       \param field_sorts type of the tuple fields.+       \param mk_tuple_decl output parameter that will contain the constructor declaration.+       \param proj_decl output parameter that will contain the projection function declarations. This field must be a buffer of size \c num_fields allocated by the user.+    */+    Z3_sort Z3_API Z3_mk_tuple_sort(__in Z3_context c, +                                        __in Z3_symbol mk_tuple_name, +                                        __in unsigned num_fields, +                                        __in_ecount(num_fields) Z3_symbol   const field_names[],+                                        __in_ecount(num_fields) Z3_sort const field_sorts[],+                                        __out Z3_func_decl * mk_tuple_decl,+                                        __out_ecount(num_fields)  Z3_func_decl proj_decl[]);++    /**+       \brief Create a enumeration sort.+       +       \mlonly [mk_enumeration_sort c enums] creates an enumeration sort with enumeration names [enums], +               it also returns [n] predicates, where [n] is the number of [enums] corresponding+               to testing whether an element is one of the enumerants.+       \endmlonly++       \conly An enumeration sort with \c n elements.+       \conly This function will also declare the functions corresponding to the enumerations.++       \param c logical context+       \param name name of the enumeration sort.+       \param n number of elemenets in enumeration sort.+       \param enum_names names of the enumerated elements.+       \param enum_consts constants corresponding to the enumerated elements.+       \param enum_testers predicates testing if terms of the enumeration sort correspond to an enumeration.+    */+    Z3_sort Z3_API Z3_mk_enumeration_sort(__in Z3_context c, +                                          __in Z3_symbol name,+                                          __in unsigned n,+                                          __in_ecount(n)  Z3_symbol  const enum_names[],+                                          __out_ecount(n) Z3_func_decl enum_consts[],+                                          __out_ecount(n) Z3_func_decl enum_testers[]);++    /**+       \brief Create a list sort+       +       \mlonly [mk_list_sort c name elem_sort] creates a list sort of [name], over elements of sort [elem_sort].+       \endmlonly++       \conly A list sort over \c elem_sort +       \conly This function declares the corresponding constructors and testers for lists.++       \param c logical context+       \param name name of the list sort.+       \param elem_sort sort of list elements.+       \param nil_decl declaration for the empty list.+       \param is_nil_decl test for the empty list.+       \param cons_decl declaration for a cons cell.+       \param is_cons_decl cons cell test.+       \param head_decl list head.+       \param tail_decl list tail.+    */++    Z3_sort Z3_API Z3_mk_list_sort(__in Z3_context c,+                                   __in Z3_symbol name,+                                   __in Z3_sort   elem_sort,+                                   __out Z3_func_decl* nil_decl,+                                   __out Z3_func_decl* is_nil_decl,+                                   __out Z3_func_decl* cons_decl,+                                   __out Z3_func_decl* is_cons_decl,+                                   __out Z3_func_decl* head_decl,+                                   __out Z3_func_decl* tail_decl+                                   );++    /**+       \brief Create a constructor.+       +       \param c logical context.+       \param name constructor name.+       \param recognizer name of recognizer function.+       \param num_fields number of fields in constructor.+       \param field_names names of the constructor fields.+       \param sorts field sorts, 0 if the field sort refers to a recursive sort.+       \param sort_refs reference to datatype sort that is an argument to the constructor; if the corresponding+                        sort reference is 0, then the value in sort_refs should be an index referring to +                        one of the recursive datatypes that is declared.                        +    */++    Z3_constructor Z3_API Z3_mk_constructor(__in Z3_context c,+                                            __in Z3_symbol name,+                                            __in Z3_symbol recognizer,+                                            __in unsigned num_fields,+                                            __in_ecount(num_fields) Z3_symbol const field_names[],+                                            __in_ecount(num_fields) Z3_sort const sorts[],+                                            __in_ecount(num_fields) unsigned sort_refs[]+                                            );++    /**+       \brief Query constructor for declared funcions.+       +       \param c logical context.+       \param constr constructor container. The container must have been passed in to a #Z3_mk_datatype call.+       \param num_fields number of accessor fields in the constructor.+       \param constructor constructor function declaration.+       \param tester constructor test function declaration.+       \param accessors array of accessor function declarations.+    */++    void Z3_API Z3_query_constructor(__in Z3_context c,+                                     __in Z3_constructor constr,+                                     __in unsigned num_fields,+                                     __out Z3_func_decl* constructor,+                                     __out Z3_func_decl* tester,+                                     __out_ecount(num_fields) Z3_func_decl accessors[]);+    +    /**+       \brief Reclaim memory allocated to constructor.++       \param c logical context.+       \param constr constructor.+    */+       +    void Z3_API Z3_del_constructor(__in Z3_context c, __in Z3_constructor constr);++    /**+       \brief Create recursive datatype. Return the datatype sort.++       \param c logical context.+	   \param name name of datatype.+       \param num_constructors number of constructors passed in.+       \param constructors array of constructor containers.+    */++    Z3_sort Z3_API Z3_mk_datatype(__in Z3_context c,+                                  __in Z3_symbol name,+                                  __in unsigned num_constructors,+                                  __inout_ecount(num_constructors) Z3_constructor constructors[]);+++    /**+       \brief Create list of constructors.++       \param c logical context.+       \param num_constructors number of constructors in list.+       \param constructors list of constructors.+    */++    Z3_constructor_list Z3_API Z3_mk_constructor_list(__in Z3_context c,+                                                      __in unsigned num_constructors,+                                                      __in_ecount(num_constructors) Z3_constructor constructors[]);++    /**+       \brief reclaim memory allocated for constructor list.++       Each constructor inside the constructor list must be independently reclaimed using #Z3_del_constructor.++       \param c logical context.+       \param clist constructor list container.++    */++    void Z3_API Z3_del_constructor_list(__in Z3_context c, __in Z3_constructor_list clist);+                                        +    /**+       \brief Create mutually recursive datatypes.++       \param c logical context.+       \param num_sorts number of datatype sorts.+       \param sort_names names of datatype sorts.+       \param sorts array of datattype sorts.+       \param constructor_lists list of constructors, one list per sort.+    */++    void Z3_API Z3_mk_datatypes(__in Z3_context c,+                                __in unsigned num_sorts,+                                __in_ecount(num_sorts) Z3_symbol sort_names[],+                                __out_ecount(num_sorts) Z3_sort sorts[],+                                __inout_ecount(num_sorts) Z3_constructor_list constructor_lists[]);+    +    /*@}*/+++++    /**+       @name Injective functions+    */+    /*@{*/+    ++    /**+       \brief Create injective function declaration+    */+    Z3_func_decl Z3_API Z3_mk_injective_function(+        __in Z3_context c, +        __in Z3_symbol s, +        unsigned domain_size, __in_ecount(domain_size) Z3_sort const domain[],+        __in Z3_sort range+        );++    /*@}*/++    /**+       @name Constants and Applications+     */+    /*@{*/++    /**+       \brief compare terms.+    */+    Z3_bool Z3_API Z3_is_eq_ast(__in Z3_context c, __in Z3_ast t1, Z3_ast t2);+++    /**+       \brief compare terms.+    */+    Z3_bool Z3_API Z3_is_eq_func_decl(__in Z3_context c, __in Z3_func_decl f1, Z3_func_decl f2);+++    /**+       \brief Declare a constant or function.++       \mlonly [mk_func_decl c n d r] creates a function with name [n], domain [d], and range [r].+       The arity of the function is the size of the array [d]. \endmlonly++       \param c logical context.+       \param s name of the constant or function.+       \param domain_size number of arguments. It is 0 when declaring a constant.+       \param domain array containing the sort of each argument. The array must contain domain_size elements. It is 0 whe declaring a constant.+       \param range sort of the constant or the return sort of the function.++       After declaring a constant or function, the function+       #Z3_mk_app can be used to create a constant or function+       application.++       \sa Z3_mk_app+    */+    Z3_func_decl Z3_API Z3_mk_func_decl(__in Z3_context c, __in Z3_symbol s,+                                        __in unsigned domain_size, __in_ecount(domain_size) Z3_sort const domain[],+                                        __in Z3_sort range);++    +    /**+       \brief Create a constant or function application.++       \sa Z3_mk_func_decl+    */+    Z3_ast Z3_API Z3_mk_app(+        __in Z3_context c, +        __in Z3_func_decl d,+        __in unsigned num_args, +        __in_ecount(num_args) Z3_ast const args[]);++    /**+       \brief Declare and create a constant.+       +       \conly This function is a shorthand for:+       \conly \code+       \conly Z3_func_decl d = Z3_mk_func_decl(c, s, 0, 0, ty);+       \conly Z3_ast n            = Z3_mk_app(c, d, 0, 0);+       \conly \endcode+       +       \mlonly [mk_const c s t] is a shorthand for [mk_app c (mk_func_decl c s [||] t) [||]] \endmlonly++       \sa Z3_mk_func_decl+       \sa Z3_mk_app+    */+    Z3_ast Z3_API Z3_mk_const(__in Z3_context c, __in Z3_symbol s, __in Z3_sort ty);++    /**+       \brief Create a labeled formula.++       \param c logical context.+       \param s name of the label.+       \param is_pos label polarity.+       \param f formula being labeled.++       A label behaves as an identity function, so the truth value of the +       labeled formula is unchanged. Labels are used for identifying +       useful sub-formulas when generating counter-examples.+    */+    Z3_ast Z3_API Z3_mk_label(__in Z3_context c, __in Z3_symbol s, Z3_bool is_pos, Z3_ast f);++    /**+       \brief Declare a fresh constant or function.++       Z3 will generate an unique name for this function declaration.+       \conly If prefix is different from \c NULL, then the name generate by Z3 will start with \c prefix.+       +       \conly \remark If \c prefix is NULL, then it is assumed to be the empty string.++       \sa Z3_mk_func_decl+    */+    Z3_func_decl Z3_API Z3_mk_fresh_func_decl(__in Z3_context c, __in_z Z3_string prefix,+                                                   __in unsigned domain_size, __in_ecount(domain_size) Z3_sort const domain[],+                                                   __in Z3_sort range);+    +    /**+       \brief Declare and create a fresh constant.+       +       \conly This function is a shorthand for:+       \conly \code Z3_func_decl d = Z3_mk_fresh_func_decl(c, prefix, 0, 0, ty); Z3_ast n = Z3_mk_app(c, d, 0, 0); \endcode++       \mlonly [mk_fresh_const c p t] is a shorthand for [mk_app c (mk_fresh_func_decl c p [||] t) [||]]. \endmlonly++       \conly \remark If \c prefix is NULL, then it is assumed to be the empty string.+       +       \sa Z3_mk_func_decl+       \sa Z3_mk_app+    */+    Z3_ast Z3_API Z3_mk_fresh_const(__in Z3_context c, __in_z Z3_string prefix, __in Z3_sort ty);++    +    /** +        \brief Create an AST node representing \c true.+    */+    Z3_ast Z3_API Z3_mk_true(__in Z3_context c);++    /** +        \brief Create an AST node representing \c false.+    */+    Z3_ast Z3_API Z3_mk_false(__in Z3_context c);+    +    /** +        \brief \mlh mk_eq c l r \endmlh+        Create an AST node representing <tt>l = r</tt>.+        +        The nodes \c l and \c r must have the same type. +    */+    Z3_ast Z3_API Z3_mk_eq(__in Z3_context c, __in Z3_ast l, __in Z3_ast r);+    +    /**+       \conly \brief Create an AST node representing <tt>distinct(args[0], ..., args[num_args-1])</tt>.+       \mlonly \brief \[ [mk_distinct c [| t_1; ...; t_n |]] \] Create an AST+       node represeting a distinct construct. It is used for declaring+       the arguments t_i pairwise distinct. \endmlonly++       \conly The \c distinct construct is used for declaring the arguments pairwise distinct. +       \conly That is, <tt>Forall 0 <= i < j < num_args. not args[i] = args[j]</tt>.+       +       All arguments must have the same sort.++       \remark The number of arguments of a distinct construct must be greater than one.+    */+    Z3_ast Z3_API Z3_mk_distinct(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);++    /** +        \brief \mlh mk_not c a \endmlh +        Create an AST node representing <tt>not(a)</tt>.+        +        The node \c a must have Boolean sort.+    */+    Z3_ast Z3_API Z3_mk_not(__in Z3_context c, __in Z3_ast a);+    +    /**+       \brief \mlh mk_ite c t1 t2 t2 \endmlh +       Create an AST node representing an if-then-else: <tt>ite(t1, t2,+       t3)</tt>.++       The node \c t1 must have Boolean sort, \c t2 and \c t3 must have the same sort.+       The sort of the new node is equal to the sort of \c t2 and \c t3.+    */+    Z3_ast Z3_API Z3_mk_ite(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2, __in Z3_ast t3);++    /**+       \brief \mlh mk_iff c t1 t2 \endmlh+       Create an AST node representing <tt>t1 iff t2</tt>.++       The nodes \c t1 and \c t2 must have Boolean sort.+    */+    Z3_ast Z3_API Z3_mk_iff(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_implies c t1 t2 \endmlh+       Create an AST node representing <tt>t1 implies t2</tt>.++       The nodes \c t1 and \c t2 must have Boolean sort.+    */+    Z3_ast Z3_API Z3_mk_implies(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \brief \mlh mk_xor c t1 t2 \endmlh+       Create an AST node representing <tt>t1 xor t2</tt>.++       The nodes \c t1 and \c t2 must have Boolean sort.+    */+    Z3_ast Z3_API Z3_mk_xor(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \conly \brief Create an AST node representing <tt>args[0] and ... and args[num_args-1]</tt>.+       \mlonly \brief \[ [mk_and c [| t_1; ...; t_n |]] \] Create the conjunction: {e t_1 and ... and t_n}. \endmlonly++       \conly The array \c args must have \c num_args elements. +       All arguments must have Boolean sort.+       +       \remark The number of arguments must be greater than zero.+    */+    Z3_ast Z3_API Z3_mk_and(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);+    +    /**+       \conly \brief Create an AST node representing <tt>args[0] or ... or args[num_args-1]</tt>.+       \mlonly \brief \[ [mk_or c [| t_1; ...; t_n |]] \] Create the disjunction: {e t_1 or ... or t_n}. \endmlonly++       \conly The array \c args must have \c num_args elements. +       All arguments must have Boolean sort.++       \remark The number of arguments must be greater than zero.+    */+    Z3_ast Z3_API Z3_mk_or(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);+    +    /**+       \conly \brief Create an AST node representing <tt>args[0] + ... + args[num_args-1]</tt>.+       \mlonly \brief \[ [mk_add c [| t_1; ...; t_n |]] \] Create the term: {e t_1 + ... + t_n}. \endmlonly++       \conly The array \c args must have \c num_args elements. +       All arguments must have int or real sort.++       \remark The number of arguments must be greater than zero.+    */+    Z3_ast Z3_API Z3_mk_add(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);+    +    /**+       \conly \brief Create an AST node representing <tt>args[0] * ... * args[num_args-1]</tt>.+       \mlonly \brief \[ [mk_mul c [| t_1; ...; t_n |]] \] Create the term: {e t_1 * ... * t_n}. \endmlonly++       \conly The array \c args must have \c num_args elements. +       All arguments must have int or real sort.+       +       \remark Z3 has limited support for non-linear arithmetic.+       \remark The number of arguments must be greater than zero.+    */+    Z3_ast Z3_API Z3_mk_mul(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);+    +    /**+       \conly \brief Create an AST node representing <tt>args[0] - ... - args[num_args - 1]</tt>.+       \mlonly \brief \[ [mk_sub c [| t_1; ...; t_n |]] \] Create the term: {e t_1 - ... - t_n}. \endmlonly++       \conly The array \c args must have \c num_args elements. +       All arguments must have int or real sort.++       \remark The number of arguments must be greater than zero.+    */+    Z3_ast Z3_API Z3_mk_sub(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);++    /**+       \conly \brief Create an AST node representing <tt>-arg</tt>.+       \mlonly \brief \[ [mk_unary_minus c arg] \] Create the term: {e - arg}. \endmlonly++       The argument must have int or real type.++    */+    Z3_ast Z3_API Z3_mk_unary_minus(__in Z3_context c, __in Z3_ast arg);+++    /**+       \conly \brief Create an AST node representing <tt>arg1 div arg2</tt>.+       \mlonly \brief \[ [mk_div c t_1 t_2] \] Create the term: {e t_1 div t_2}. \endmlonly++       The arguments must either both have int type or both have real type.+       If the arguments have int type, then the result type is an int type, otherwise the+       the result type is real.++    */+    Z3_ast Z3_API Z3_mk_div(__in Z3_context c, __in Z3_ast arg1, __in Z3_ast arg2);+++    /**+       \conly \brief Create an AST node representing <tt>arg1 mod arg2</tt>.+       \mlonly \brief \[ [mk_mod c t_1 t_2] \] Create the term: {e t_1 mod t_2}. \endmlonly++       The arguments must have int type.++    */+    Z3_ast Z3_API Z3_mk_mod(__in Z3_context c, __in Z3_ast arg1, __in Z3_ast arg2);++    /**+       \conly \brief Create an AST node representing <tt>arg1 rem arg2</tt>.+       \mlonly \brief \[ [mk_rem c t_1 t_2] \] Create the term: {e t_1 rem t_2}. \endmlonly++       The arguments must have int type.++    */+    Z3_ast Z3_API Z3_mk_rem(__in Z3_context c, __in Z3_ast arg1, __in Z3_ast arg2);++    /** +        \brief \mlh mk_lt c t1 t2 \endmlh +        Create less than.++        The nodes \c t1 and \c t2 must have the same sort, and must be int or real.+    */+    Z3_ast Z3_API Z3_mk_lt(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_le c t1 t2 \endmlh+        Create less than or equal to.+        +        The nodes \c t1 and \c t2 must have the same sort, and must be int or real.+    */+    Z3_ast Z3_API Z3_mk_le(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_gt c t1 t2 \endmlh+        Create greater than.+        +        The nodes \c t1 and \c t2 must have the same sort, and must be int or real.+    */+    Z3_ast Z3_API Z3_mk_gt(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_ge c t1 t2 \endmlh+        Create greater than or equal to.+        +        The nodes \c t1 and \c t2 must have the same sort, and must be int or real.+    */+    Z3_ast Z3_API Z3_mk_ge(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_int2real c t1 \endmlh+        Coerce an integer to a real.++        There is also a converse operation exposed.+        It follows the semantics prescribed by the SMT-LIB standard.++        You can take the floor of a real by +        creating an auxiliary integer constant \c k and+        and asserting <tt> mk_int2real(k) <= t1 < mk_int2real(k)+1</tt>.+        +        The node \c t1 must have sort integer.++        \sa Z3_mk_real2int+        \sa Z3_mk_is_int+    */+    Z3_ast Z3_API Z3_mk_int2real(__in Z3_context c, __in Z3_ast t1);++    /** +        \brief \mlh mk_real2int c t1 \endmlh+        Coerce a real to an integer.++        The semantics of this function follows the SMT-LIB standard+        for the function to_int++        \sa Z3_mk_int2real+        \sa Z3_mk_is_int+    */+    Z3_ast Z3_API Z3_mk_real2int(__in Z3_context c, __in Z3_ast t1);++    /** +        \brief \mlh mk_is_int c t1 \endmlh+        Check if a real number is an integer.++        \sa Z3_mk_int2real+        \sa Z3_mk_real2int+    */+    Z3_ast Z3_API Z3_mk_is_int(__in Z3_context c, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvnot c t1 \endmlh+       Bitwise negation.++       The node \c t1 must have a bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvnot(__in Z3_context c, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvredand c t1 \endmlh+       Take conjunction of bits in vector, return vector of length 1.++       The node \c t1 must have a bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvredand(__in Z3_context c, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvredor c t1 \endmlh+       Take disjunction of bits in vector, return vector of length 1.++       The node \c t1 must have a bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvredor(__in Z3_context c, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvand c t1 t2 \endmlh+       Bitwise and.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvand(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvor c t1 t2 \endmlh+       Bitwise or.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvor(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvxor c t1 t2 \endmlh+       Bitwise exclusive-or.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvxor(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvnand c t1 t2 \endmlh+       Bitwise nand. ++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvnand(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvnor c t1 t2 \endmlh+       Bitwise nor. ++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvnor(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvxnor c t1 t2 \endmlh+       Bitwise xnor. +       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvxnor(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvneg c t1 \endmlh+       Standard two's complement unary minus. ++       The node \c t1 must have bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvneg(__in Z3_context c, __in Z3_ast t1);+    +    /** +        \brief \mlh mk_bvadd c t1 t2 \endmlh+        Standard two's complement addition.+        +        The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvadd(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_bvsub c t1 t2 \endmlh+        Standard two's complement subtraction.+        +        The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsub(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /** +        \brief \mlh mk_bvmul c t1 t2 \endmlh+        Standard two's complement multiplication.+        +        The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvmul(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_bvudiv c t1 t2 \endmlh+        Unsigned division. ++        It is defined as the \c floor of <tt>t1/t2</tt> if \c t2 is+        different from zero. If <tt>t2</tt> is zero, then the result+        is undefined.+        +        The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvudiv(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /** +        \brief \mlh mk_bvsdiv c t1 t2 \endmlh+        Two's complement signed division. ++        It is defined in the following way:++        - The \c floor of <tt>t1/t2</tt> if \c t2 is different from zero, and <tt>t1*t2 >= 0</tt>.++        - The \c ceiling of <tt>t1/t2</tt> if \c t2 is different from zero, and <tt>t1*t2 < 0</tt>.+        +        If <tt>t2</tt> is zero, then the result is undefined.+        +        The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsdiv(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvurem c t1 t2 \endmlh+       Unsigned remainder.++       It is defined as <tt>t1 - (t1 /u t2) * t2</tt>, where <tt>/u</tt> represents unsigned division.+       +       If <tt>t2</tt> is zero, then the result is undefined.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvurem(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsrem c t1 t2 \endmlh+       Two's complement signed remainder (sign follows dividend).++       It is defined as <tt>t1 - (t1 /s t2) * t2</tt>, where <tt>/s</tt> represents signed division.+       The most significant bit (sign) of the result is equal to the most significant bit of \c t1.++       If <tt>t2</tt> is zero, then the result is undefined.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.++       \sa Z3_mk_bvsmod+    */+    Z3_ast Z3_API Z3_mk_bvsrem(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsmod c t1 t2 \endmlh+       Two's complement signed remainder (sign follows divisor).+       +       If <tt>t2</tt> is zero, then the result is undefined.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.++       \sa Z3_mk_bvsrem+    */+    Z3_ast Z3_API Z3_mk_bvsmod(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvult c t1 t2 \endmlh+       Unsigned less than.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvult(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \brief \mlh mk_bvslt c t1 t2 \endmlh+       Two's complement signed less than.+       +       It abbreviates:+       \code+      (or (and (= (extract[|m-1|:|m-1|] t1) bit1)+               (= (extract[|m-1|:|m-1|] t2) bit0))+          (and (= (extract[|m-1|:|m-1|] t1) (extract[|m-1|:|m-1|] t2))+               (bvult t1 t2)))+       \endcode++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvslt(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvule c t1 t2 \endmlh+       Unsigned less than or equal to.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvule(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsle c t1 t2 \endmlh+       Two's complement signed less than or equal to.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsle(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvuge c t1 t2 \endmlh+       Unsigned greater than or equal to.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvuge(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsge c t1 t2 \endmlh+       Two's complement signed greater than or equal to.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsge(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvugt c t1 t2 \endmlh+       Unsigned greater than.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvugt(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsgt c t1 t2 \endmlh+       Two's complement signed greater than.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsgt(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_concat c t1 t2 \endmlh+       Concatenate the given bit-vectors.+       +       The nodes \c t1 and \c t2 must have (possibly different) bit-vector sorts++       The result is a bit-vector of size <tt>n1+n2</tt>, where \c n1 (\c n2) is the size+       of \c t1 (\c t2).+    */+    Z3_ast Z3_API Z3_mk_concat(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \brief \mlh mk_extract c high low t1 \endmlh+       Extract the bits \c high down to \c low from a bitvector of+       size \c m to yield a new bitvector of size \c n, where <tt>n =+       high - low + 1</tt>.++       The node \c t1 must have a bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_extract(__in Z3_context c, __in unsigned high, __in unsigned low, __in Z3_ast t1);++    /**+       \brief \mlh mk_sign_ext c i t1 \endmlh+       Sign-extend of the given bit-vector to the (signed) equivalent bitvector of+       size <tt>m+i</tt>, where \c m is the size of the given+       bit-vector.++       The node \c t1 must have a bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_sign_ext(__in Z3_context c, __in unsigned i, __in Z3_ast t1);++    /**+       \brief \mlh mk_zero_ext c i t1 \endmlh+       Extend the given bit-vector with zeros to the (unsigned) equivalent+       bitvector of size <tt>m+i</tt>, where \c m is the size of the+       given bit-vector.+       +       The node \c t1 must have a bit-vector sort. +    */+    Z3_ast Z3_API Z3_mk_zero_ext(__in Z3_context c, __in unsigned i, __in Z3_ast t1);++    /**+       \brief \mlh mk_repeat c i t1 \endmlh+       Repeat the given bit-vector up length <tt>i</tt>.+       +       The node \c t1 must have a bit-vector sort. +    */+    Z3_ast Z3_API Z3_mk_repeat(__in Z3_context c, __in unsigned i, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvshl c t1 t2 \endmlh+       Shift left.++       It is equivalent to multiplication by <tt>2^x</tt> where \c x is the value of the+       third argument.++       NB. The semantics of shift operations varies between environments. This +       definition does not necessarily capture directly the semantics of the +       programming language or assembly architecture you are modeling.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvshl(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvlshr c t1 t2 \endmlh+       Logical shift right.++       It is equivalent to unsigned division by <tt>2^x</tt> where \c x is the+       value of the third argument.++       NB. The semantics of shift operations varies between environments. This +       definition does not necessarily capture directly the semantics of the +       programming language or assembly architecture you are modeling.++       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvlshr(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvashr c t1 t2 \endmlh+       Arithmetic shift right.+       +       It is like logical shift right except that the most significant+       bits of the result always copy the most significant bit of the+       second argument.++       NB. The semantics of shift operations varies between environments. This +       definition does not necessarily capture directly the semantics of the +       programming language or assembly architecture you are modeling.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvashr(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \brief \mlh mk_rotate_left c i t1 \endmlh+       Rotate bits of \c t1 to the left \c i times.+       +       The node \c t1 must have a bit-vector sort. +    */+    Z3_ast Z3_API Z3_mk_rotate_left(__in Z3_context c, __in unsigned i, __in Z3_ast t1);+    +    /**+       \brief \mlh mk_rotate_right c i t1 \endmlh+       Rotate bits of \c t1 to the right \c i times.+       +       The node \c t1 must have a bit-vector sort. +    */+    Z3_ast Z3_API Z3_mk_rotate_right(__in Z3_context c, __in unsigned i, __in Z3_ast t1);++    /**+       \brief \mlh mk_ext_rotate_left c t1 t2 \endmlh+       Rotate bits of \c t1 to the left \c t2 times.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_ext_rotate_left(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_ext_rotate_right c t1 t2 \endmlh+       Rotate bits of \c t1 to the right \c t2 times.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_ext_rotate_right(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);+    +    /**+       \brief \mlh mk_int2bv c n t1 \endmlh+       Create an \c n bit bit-vector from the integer argument \c t1.++       NB. This function is essentially treated as uninterpreted. +       So you cannot expect Z3 to precisely reflect the semantics of this function+       when solving constraints with this function.+       +       The node \c t1 must have integer sort. +    */+    Z3_ast Z3_API Z3_mk_int2bv(__in Z3_context c, __in unsigned n, __in Z3_ast t1);++    /**+       \brief \mlh mk_bv2int c t1 is_signed \endmlh+       Create an integer from the bit-vector argument \c t1.+       If \c is_signed is false, then the bit-vector \c t1 is treated as unsigned. +       So the result is non-negative+       and in the range <tt>[0..2^N-1]</tt>, where N are the number of bits in \c t1.+       If \c is_signed is true, \c t1 is treated as a signed bit-vector.++       NB. This function is essentially treated as uninterpreted. +       So you cannot expect Z3 to precisely reflect the semantics of this function+       when solving constraints with this function.++       The node \c t1 must have a bit-vector sort. +    */+    Z3_ast Z3_API Z3_mk_bv2int(__in Z3_context c,__in Z3_ast t1, Z3_bool is_signed);++    /**+       \brief \mlh mk_bvadd_no_overflow c t1 t2 is_signed \endmlh+       Create a predicate that checks that the bit-wise addition+       of \c t1 and \c t2 does not overflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvadd_no_overflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2, Z3_bool is_signed);++    /**+       \brief \mlh mk_bvadd_no_underflow c t1 t2 \endmlh+       Create a predicate that checks that the bit-wise signed addition+       of \c t1 and \c t2 does not underflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvadd_no_underflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsub_no_overflow c t1 t2 \endmlh+       Create a predicate that checks that the bit-wise signed subtraction+       of \c t1 and \c t2 does not overflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsub_no_overflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvsub_no_underflow c t1 t2 is_signed \endmlh+       Create a predicate that checks that the bit-wise subtraction+       of \c t1 and \c t2 does not underflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsub_no_underflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2, Z3_bool is_signed);++    /**+       \brief \mlh mk_bvsdiv_no_overflow c t1 t2 \endmlh+       Create a predicate that checks that the bit-wise signed division +       of \c t1 and \c t2 does not overflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvsdiv_no_overflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_bvneg_no_overflow c t1 \endmlh+       Check that bit-wise negation does not overflow when +       \c t1 is interpreted as a signed bit-vector.+       +       The node \c t1 must have bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvneg_no_overflow(__in Z3_context c, __in Z3_ast t1);++    /**+       \brief \mlh mk_bvmul_no_overflow c t1 t2 is_signed \endmlh+       Create a predicate that checks that the bit-wise multiplication+       of \c t1 and \c t2 does not overflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvmul_no_overflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2, Z3_bool is_signed);++    /**+       \brief \mlh mk_bvmul_no_underflow c t1 t2 \endmlh+       Create a predicate that checks that the bit-wise signed multiplication+       of \c t1 and \c t2 does not underflow.+       +       The nodes \c t1 and \c t2 must have the same bit-vector sort.+    */+    Z3_ast Z3_API Z3_mk_bvmul_no_underflow(__in Z3_context c, __in Z3_ast t1, __in Z3_ast t2);++    /**+       \brief \mlh mk_select c a i \endmlh+       Array read.++       The node \c a must have an array sort <tt>[domain -> range]</tt>, and \c i must have the sort \c domain.+       The sort of the result is \c range.++       \sa Z3_mk_array_sort+       \sa Z3_mk_store+    */+    Z3_ast Z3_API Z3_mk_select(__in Z3_context c, __in Z3_ast a, __in Z3_ast i);+    +    /**+       \brief \mlh mk_store c a i v \endmlh+       Array update.+       +       The node \c a must have an array sort <tt>[domain -> range]</tt>, \c i must have sort \c domain,+       \c v must have sort range. The sort of the result is <tt>[domain -> range]</tt>.+       +       \sa Z3_mk_array_sort+       \sa Z3_mk_select+    */+    Z3_ast Z3_API Z3_mk_store(__in Z3_context c, __in Z3_ast a, __in Z3_ast i, __in Z3_ast v);++    /** +        \brief Create the constant array.++        \param c logical context.+        \param domain domain sort for the array.+        \param v value that the array maps to.+    */+    Z3_ast Z3_API Z3_mk_const_array(__in Z3_context c, __in Z3_sort domain, __in Z3_ast v);++    /**+       \brief \mlh mk_map f n args \endmlh+       map f on the the argument arrays.+       +       The \c n nodes \c args must be of array sorts <tt>[domain_i -> range_i]</tt>.+       The function declaration \c f must have type <tt> range_1 .. range_n -> range</tt>.+       \c v must have sort range. The sort of the result is <tt>[domain_i -> range]</tt>.+       +       \sa Z3_mk_array_sort+       \sa Z3_mk_store+       \sa Z3_mk_select+    */+    Z3_ast Z3_API Z3_mk_map(__in Z3_context c, __in Z3_func_decl f, unsigned n, __in Z3_ast const* args);++    /** +        \brief Access the array default value.+        Produces the default range value, for arrays that can be represented as +        finite maps with a default range value.++        \param c logical context.+        \param array array value whose default range value is accessed.++    */+    Z3_ast Z3_API Z3_mk_array_default(__in Z3_context c, __in Z3_ast array);+++    /*@}*/++    /**+       @name Sets+    */+    /*@{*/++    /**+       \brief Create Set type.+    */+    Z3_sort Z3_API Z3_mk_set_sort(__in Z3_context c, __in Z3_sort ty);++    /** +        \brief Create the empty set.+    */+    Z3_ast Z3_API Z3_mk_empty_set(__in Z3_context c, __in Z3_sort domain);++    /** +        \brief Create the full set.+    */+    Z3_ast Z3_API Z3_mk_full_set(__in Z3_context c, __in Z3_sort domain);++    /**+       \brief Add an element to a set.+       +       The first argument must be a set, the second an element.+    */+    Z3_ast Z3_API Z3_mk_set_add(__in Z3_context c, __in Z3_ast set, __in Z3_ast elem);++    /**+       \brief Remove an element to a set.+       +       The first argument must be a set, the second an element.+    */+    Z3_ast Z3_API Z3_mk_set_del(__in Z3_context c, __in Z3_ast set, __in Z3_ast elem);++    /**+       \brief Take the union of a list of sets.+    */+    Z3_ast Z3_API Z3_mk_set_union(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);++    /**+       \brief Take the intersection of a list of sets.+    */+    Z3_ast Z3_API Z3_mk_set_intersect(__in Z3_context c, __in unsigned num_args, __in_ecount(num_args) Z3_ast const args[]);++    /**+       \brief Take the set difference between two sets.+    */+    Z3_ast Z3_API Z3_mk_set_difference(__in Z3_context c, __in Z3_ast arg1, __in Z3_ast arg2);++    /**+       \brief Take the complement of a set.+    */+    Z3_ast Z3_API Z3_mk_set_complement(__in Z3_context c, __in Z3_ast arg);+++    /**+       \brief Check for set membership.+       +       The first argument should be an element type of the set.+    */+    Z3_ast Z3_API Z3_mk_set_member(__in Z3_context c, __in Z3_ast elem, __in Z3_ast set);++    /**+       \brief Check for subsetness of sets.+    */+    Z3_ast Z3_API Z3_mk_set_subset(__in Z3_context c, __in Z3_ast arg1, __in Z3_ast arg2);+    /*@}*/++    /**+       @name Numerals+    */+    /*@{*/++    /**+       \brief Create a numeral of a given sort. ++       \param c logical context.+       \param numeral A string representing the numeral value in decimal notation. If the given sort is a real, then the numeral can be a rational, that is, a string of the form <tt>[num]* / [num]*</tt>.+       \param ty The sort of the numeral. In the current implementation, the given sort can be an int, real, or bit-vectors of arbitrary size. +       +       \sa Z3_mk_int+       \sa Z3_mk_unsigned_int+    */+    Z3_ast Z3_API Z3_mk_numeral(__in Z3_context c, __in_z Z3_string numeral, __in Z3_sort ty);++    /**+       \brief Create a real from a fraction.++       \param c logical context.+       \param num numerator of rational.+       \param den denomerator of rational.++       \pre den != 0++       \sa Z3_mk_numeral+       \sa Z3_mk_int+       \sa Z3_mk_unsigned_int+    */+    Z3_ast Z3_API Z3_mk_real(__in Z3_context c, __in_z int num, __in_z int den);+    +    /**+       \brief Create a numeral of a given sort. +       +       This function can be use to create numerals that fit in a machine integer.+       It is slightly faster than #Z3_mk_numeral since it is not necessary to parse a string.++       \sa Z3_mk_numeral+    */+    Z3_ast Z3_API Z3_mk_int(__in Z3_context c, __in int v, __in Z3_sort ty);+    +    /**+       \brief Create a numeral of a given sort. +       +       This function can be use to create numerals that fit in a machine unsinged integer.+       It is slightly faster than #Z3_mk_numeral since it is not necessary to parse a string.++       \sa Z3_mk_numeral+    */+    Z3_ast Z3_API Z3_mk_unsigned_int(__in Z3_context c, __in unsigned v, __in Z3_sort ty);++#ifndef CAMLIDL+    /**+       \brief Create a numeral of a given sort. +       +       This function can be use to create numerals that fit in a machine __int64 integer.+       It is slightly faster than #Z3_mk_numeral since it is not necessary to parse a string.++       \sa Z3_mk_numeral+    */+    Z3_ast Z3_API Z3_mk_int64(__in Z3_context c, __in __int64 v, __in Z3_sort ty);+#endif // CAMLIDL++#ifndef CAMLIDL+    /**+       \brief Create a numeral of a given sort. +       +       This function can be use to create numerals that fit in a machine unsigned __int64 integer.+       It is slightly faster than #Z3_mk_numeral since it is not necessary to parse a string.++       \sa Z3_mk_numeral+    */+    Z3_ast Z3_API Z3_mk_unsigned_int64(__in Z3_context c, __in unsigned __int64 v, __in Z3_sort ty);+#endif // CAMLIDL++    /*@}*/++    /**+       @name Quantifiers+    */+    /*@{*/++    /**+       \brief Create a pattern for quantifier instantiation.++       Z3 uses pattern matching to instantiate quantifiers. If a+       pattern is not provided for a quantifier, then Z3 will+       automatically compute a set of patterns for it. However, for+       optimal performance, the user should provide the patterns.++       Patterns comprise a list of terms. The list should be+       non-empty.  If the list comprises of more than one term, it is+       a called a multi-pattern.+       +       In general, one can pass in a list of (multi-)patterns in the+       quantifier constructor.+++       \sa Z3_mk_forall+       \sa Z3_mk_exists+    */+    Z3_pattern Z3_API Z3_mk_pattern(+        __in Z3_context c,+        __in unsigned num_patterns, __in_ecount(num_patterns) Z3_ast const terms[]);++    /**+       \brief Create a bound variable.++       Bound variables are indexed by de-Bruijn indices. It is perhaps easiest to explain+       the meaning of de-Bruijn indices by indicating the compilation process from+       non-de-Bruijn formulas to de-Bruijn format.++       \verbatim +       abs(forall (x1) phi) = forall (x1) abs1(phi, x1, 0)+       abs(forall (x1, x2) phi) = abs(forall (x1) abs(forall (x2) phi))+       abs1(x, x, n) = b_n+       abs1(y, x, n) = y+       abs1(f(t1,...,tn), x, n) = f(abs1(t1,x,n), ..., abs1(tn,x,n))+       abs1(forall (x1) phi, x, n) = forall (x1) (abs1(phi, x, n+1))+       \endverbatim++       The last line is significant: the index of a bound variable is different depending+       on the scope in which it appears. The deeper x appears, the higher is its+       index.+       +       \param c logical context+       \param index de-Bruijn index+       \param ty sort of the bound variable++       \sa Z3_mk_forall+       \sa Z3_mk_exists+    */+    Z3_ast Z3_API Z3_mk_bound(__in Z3_context c, __in unsigned index, __in Z3_sort ty);+    +    /**+       \brief Create a forall formula.++       \mlonly [mk_forall c w p t n b] creates a forall formula, where+       [w] is the weight, [p] is an array of patterns, [t] is an array+       with the sorts of the bound variables, [n] is an array with the+       'names' of the bound variables, and [b] is the body of the+       quantifier. Quantifiers are associated with weights indicating+       the importance of using the quantifier during+       instantiation. \endmlonly+       +       \param c logical context.+       \param weight quantifiers are associated with weights indicating the importance of using the quantifier during instantiation. By default, pass the weight 0.+       \param num_patterns number of patterns.+       \param patterns array containing the patterns created using #Z3_mk_pattern.+       \param num_decls number of variables to be bound.+       \param sorts the sorts of the bound variables.+       \param decl_names names of the bound variables+       \param body the body of the quantifier.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_bound+       \sa Z3_mk_exists+    */+    Z3_ast Z3_API Z3_mk_forall(__in Z3_context c, __in unsigned weight,+                               __in unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const patterns[],+                               __in unsigned num_decls, __in_ecount(num_decls) Z3_sort const sorts[],+                               __in_ecount(num_decls) Z3_symbol const decl_names[],+                               __in Z3_ast body);++    /**+       \brief Create an exists formula. Similar to #Z3_mk_forall.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_bound+       \sa Z3_mk_forall+    */+    Z3_ast Z3_API Z3_mk_exists(__in Z3_context c, __in unsigned weight,+                               __in unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const patterns[],+                               __in unsigned num_decls, __in_ecount(num_decls) Z3_sort const sorts[],+                               __in_ecount(num_decls) Z3_symbol const decl_names[],+                               __in Z3_ast body);++    /**+       \brief Create a quantifier - universal or existential, with pattern hints.+       +       \param c logical context.+       \param is_forall flag to indicate if this is a universal or existential quantifier.+       \param weight quantifiers are associated with weights indicating the importance of using the quantifier during instantiation. By default, pass the weight 0.+       \param num_patterns number of patterns.+       \param patterns array containing the patterns created using #Z3_mk_pattern.+       \param num_decls number of variables to be bound.+       \param sorts array of sorts of the bound variables.+       \param decl_names names of the bound variables.+       \param body the body of the quantifier.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_bound+       \sa Z3_mk_forall+       \sa Z3_mk_exists+    */++    Z3_ast Z3_API Z3_mk_quantifier(+        __in Z3_context c, +        __in Z3_bool is_forall, +        __in unsigned weight, +        __in unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const* patterns, +        __in unsigned num_decls, __in_ecount(num_decls) Z3_sort const* sorts, +        __in_ecount(num_decls) Z3_symbol const* decl_names, +        __in Z3_ast body);+++    /**+       \brief Create a quantifier - universal or existential, with pattern hints, no patterns, and attributes+       +       \param c logical context.+       \param is_forall flag to indicate if this is a universal or existential quantifier.+       \param quantifier_id identifier to identify quantifier+       \param skolem_id identifier to identify skolem constants introduced by quantifier.+       \param weight quantifiers are associated with weights indicating the importance of using the quantifier during instantiation. By default, pass the weight 0.+       \param num_patterns number of patterns.+       \param patterns array containing the patterns created using #Z3_mk_pattern.+       \param num_no_patterns number of patterns.+       \param no_patterns array containing the patterns created using #Z3_mk_pattern.+       \param num_decls number of variables to be bound.+       \param sorts array of sorts of the bound variables.+       \param decl_names names of the bound variables.+       \param body the body of the quantifier.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_bound+       \sa Z3_mk_forall+       \sa Z3_mk_exists+    */++    Z3_ast Z3_API Z3_mk_quantifier_ex(+        __in Z3_context c, +        __in Z3_bool is_forall, +        __in unsigned weight, +        __in Z3_symbol quantifier_id,+        __in Z3_symbol skolem_id,+        __in unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const* patterns, +        __in unsigned num_no_patterns, __in_ecount(num_no_patterns) Z3_ast const* no_patterns, +        __in unsigned num_decls, __in_ecount(num_decls) Z3_sort const* sorts, +        __in_ecount(num_decls) Z3_symbol const* decl_names, +        __in Z3_ast body);++    /**+       \brief Create a universal quantifier using a list of constants that+       will form the set of bound variables.++       \param c logical context.+       \param weight quantifiers are associated with weights indicating the importance of using +              the quantifier during instantiation. By default, pass the weight 0.+       \param num_bound number of constants to be abstracted into bound variables.+       \param bound array of constants to be abstracted into bound variables.+       \param num_patterns number of patterns.+       \param patterns array containing the patterns created using #Z3_mk_pattern.+       \param body the body of the quantifier.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_exists_const++    */++    Z3_ast Z3_API Z3_mk_forall_const(+        __in Z3_context c, +        unsigned weight,+        unsigned num_bound,+        __in_ecount(num_bound) Z3_app const* bound,+        unsigned num_patterns,+        __in_ecount(num_patterns) Z3_pattern const* patterns,+        __in Z3_ast body+        );++    /**+       \brief Similar to #Z3_mk_forall_const.++       \brief Create an existential quantifier using a list of constants that+       will form the set of bound variables.++       \param c logical context.+       \param weight quantifiers are associated with weights indicating the importance of using +              the quantifier during instantiation. By default, pass the weight 0.+       \param num_bound number of constants to be abstracted into bound variables.+       \param bound array of constants to be abstracted into bound variables.+       \param num_patterns number of patterns.+       \param patterns array containing the patterns created using #Z3_mk_pattern.+       \param body the body of the quantifier.+       +       \sa Z3_mk_pattern+       \sa Z3_mk_forall_const+    */++    Z3_ast Z3_API Z3_mk_exists_const(+        __in Z3_context c, +        unsigned weight,+        unsigned num_bound,+        __in_ecount(num_bound) Z3_app const* bound,+        unsigned num_patterns,+        __in_ecount(num_patterns) Z3_pattern const* patterns,+        __in Z3_ast body+        );++    /**+       \brief Create a universal or existential +       quantifier using a list of constants that+       will form the set of bound variables.+    */++    Z3_ast Z3_API Z3_mk_quantifier_const(+        __in Z3_context c, +        Z3_bool is_forall,+        unsigned weight,+        unsigned num_bound,  __in_ecount(num_bound) Z3_app const* bound,+        unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const* patterns,+        __in Z3_ast body+        );++++    /**+       \brief Create a universal or existential +       quantifier using a list of constants that+       will form the set of bound variables.+    */++    Z3_ast Z3_API Z3_mk_quantifier_const_ex(+        __in Z3_context c, +        Z3_bool is_forall,+        unsigned weight,+        __in Z3_symbol quantifier_id,+        __in Z3_symbol skolem_id,+        unsigned num_bound,  __in_ecount(num_bound) Z3_app const* bound,+        unsigned num_patterns, __in_ecount(num_patterns) Z3_pattern const* patterns,+        unsigned num_no_patterns, __in_ecount(num_no_patterns) Z3_ast const* no_patterns,+        __in Z3_ast body+        );+++++    /*@}*/+++    /**+       @name Accessors+    */+    /*@{*/++    /** +        \brief Return a unique identifier for \c t.+    */+    unsigned Z3_API Z3_get_ast_id(__in Z3_context c, Z3_ast t);++    /** +        \brief Return a unique identifier for \c f.+    */+    unsigned Z3_API Z3_get_func_decl_id(__in Z3_context c, Z3_func_decl f);++    /** +        \brief Return a unique identifier for \c s.+    */+    unsigned Z3_API Z3_get_sort_id(__in Z3_context c, Z3_sort s);++++    /**+       \brief Return true if the given expression \c t is well sorted.+    */+    Z3_bool Z3_API Z3_is_well_sorted(__in Z3_context c, __in Z3_ast t);++    /**+       \brief Return \c Z3_INT_SYMBOL if the symbol was constructed+       using #Z3_mk_int_symbol, and \c Z3_STRING_SYMBOL if the symbol+       was constructed using #Z3_mk_string_symbol.+    */+    Z3_symbol_kind Z3_API Z3_get_symbol_kind(__in Z3_context c, __in Z3_symbol s);++    /**+       \brief \mlh get_symbol_int c s \endmlh+       Return the symbol int value. +       +       \pre Z3_get_symbol_kind(s) == Z3_INT_SYMBOL++       \sa Z3_mk_int_symbol+    */+    int Z3_API Z3_get_symbol_int(__in Z3_context c, __in Z3_symbol s);+    +    /**+       \brief \mlh get_symbol_string c s \endmlh+       Return the symbol name. ++       \pre Z3_get_symbol_string(s) == Z3_STRING_SYMBOL++       \conly \warning The returned buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_get_symbol_string.++       \sa Z3_mk_string_symbol+    */+    Z3_string Z3_API Z3_get_symbol_string(__in Z3_context c, __in Z3_symbol s);+++    /**+       \brief Return the kind of the given AST.+    */+    Z3_ast_kind Z3_API Z3_get_ast_kind(__in Z3_context c, __in Z3_ast a);++    +    /**+       \brief Return numeral value, as a string of a numeric constant term++       \pre Z3_get_ast_kind(c, a) == Z3_NUMERAL_AST+    */+    Z3_string Z3_API Z3_get_numeral_string(__in Z3_context c, __in Z3_ast a);+++    /**+       \brief Return numeral value, as a pair of 64 bit numbers if the representation fits.++       \param c logical context.+       \param a term.+       \param num numerator.+       \param den denominator.+       +       Preturn \c Z3_TRUE if the numeral value fits in 64 bit numerals, \c Z3_FALSE otherwise.++       \pre Z3_get_ast_kind(a) == Z3_NUMERAL_AST+    */+    Z3_bool Z3_API Z3_get_numeral_small(__in Z3_context c, __in Z3_ast a, __out __int64* num, __out __int64* den);+++    /**+       \brief \mlh get_numeral_int c v \endmlh+       Similar to #Z3_get_numeral_string, but only succeeds if+       the value can fit in a machine int. Return Z3_TRUE if the call succeeded.++       \pre Z3_get_ast_kind(c, v) == Z3_NUMERAL_AST+      +       \sa Z3_get_numeral_string+    */+    Z3_bool Z3_API Z3_get_numeral_int(__in Z3_context c, __in Z3_ast v, __out int* i);++    /**+       \brief \mlh get_numeral_uint c v \endmlh+       Similar to #Z3_get_numeral_string, but only succeeds if+       the value can fit in a machine unsigned int. Return Z3_TRUE if the call succeeded.++       \pre Z3_get_ast_kind(c, v) == Z3_NUMERAL_AST+      +       \sa Z3_get_numeral_string+    */+    Z3_bool Z3_API Z3_get_numeral_uint(__in Z3_context c, __in Z3_ast v, __out unsigned* u);++#ifndef CAMLIDL+    /**+       \brief \mlh get_numeral_uint64 c v \endmlh+       Similar to #Z3_get_numeral_string, but only succeeds if+       the value can fit in a machine unsigned __int64 int. Return Z3_TRUE if the call succeeded.++       \pre Z3_get_ast_kind(c, v) == Z3_NUMERAL_AST+      +       \sa Z3_get_numeral_string+    */+    Z3_bool Z3_API Z3_get_numeral_uint64(__in Z3_context c, __in Z3_ast v, __out unsigned __int64* u);+#endif // CAMLIDL++#ifndef CAMLIDL+    /**+       \brief \mlh get_numeral_int64 c v \endmlh+       Similar to #Z3_get_numeral_string, but only succeeds if+       the value can fit in a machine __int64 int. Return Z3_TRUE if the call succeeded.++       \pre Z3_get_ast_kind(c, v) == Z3_NUMERAL_AST++       \sa Z3_get_numeral_string+    */+    Z3_bool Z3_API Z3_get_numeral_int64(__in Z3_context c, __in Z3_ast v, __out __int64* i);+#endif // CAMLIDL++#ifndef CAMLIDL+    /**+       \brief \mlh get_numeral_rational_int64 c x y\endmlh+       Similar to #Z3_get_numeral_string, but only succeeds if+       the value can fit as a reational number as machine __int64 int. Return Z3_TRUE if the call succeeded.++       \pre Z3_get_ast_kind(c, v) == Z3_NUMERAL_AST++       \sa Z3_get_numeral_string+    */+    Z3_bool Z3_API Z3_get_numeral_rational_int64(__in Z3_context c, __in Z3_ast v, __out __int64* num, __out __int64* den);+#endif // CAMLIDL++    /**+       \brief Return Z3_L_TRUE if \c a is true, Z3_L_FALSE if it is false, and Z3_L_UNDEF otherwise.+    */+    Z3_lbool Z3_API Z3_get_bool_value(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return the declaration of a constant or function application.+    */+    Z3_func_decl Z3_API Z3_get_app_decl(__in Z3_context c, __in Z3_app a);++    /**+       \brief \mlh get_app_num_args c a \endmlh+       Return the number of argument of an application. If \c t+       is an constant, then the number of arguments is 0.+    */+    unsigned Z3_API Z3_get_app_num_args(__in Z3_context c, __in Z3_app a);++    /**+       \brief \mlh get_app_arg c a i \endmlh+       Return the i-th argument of the given application.+       +       \pre i < Z3_get_num_args(c, a)+    */+    Z3_ast Z3_API Z3_get_app_arg(__in Z3_context c, __in Z3_app a, __in unsigned i);++    /**+       \brief Return index of de-Brujin bound variable.++       \pre Z3_get_ast_kind(a) == Z3_VAR_AST+    */+    unsigned Z3_API Z3_get_index_value(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Determine if quantifier is universal.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_bool Z3_API Z3_is_quantifier_forall(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Obtain weight of quantifier.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    unsigned Z3_API Z3_get_quantifier_weight(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return number of patterns used in quantifier.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    unsigned Z3_API Z3_get_quantifier_num_patterns(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return i'th pattern.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_pattern Z3_API Z3_get_quantifier_pattern_ast(__in Z3_context c, __in Z3_ast a, unsigned i);++    /**+       \brief Return number of no_patterns used in quantifier.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    unsigned Z3_API Z3_get_quantifier_num_no_patterns(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return i'th no_pattern.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_ast Z3_API Z3_get_quantifier_no_pattern_ast(__in Z3_context c, __in Z3_ast a, unsigned i);++    /**+       \brief Return symbol of the i'th bound variable.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_symbol Z3_API Z3_get_quantifier_bound_name(__in Z3_context c, __in Z3_ast a, unsigned i);++    /**+       \brief Return sort of the i'th bound variable.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_sort Z3_API Z3_get_quantifier_bound_sort(__in Z3_context c, __in Z3_ast a, unsigned i);++    /**+       \brief Return body of quantifier.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    Z3_ast Z3_API Z3_get_quantifier_body(__in Z3_context c, __in Z3_ast a);++++    /**+       \brief Return number of bound variables of quantifier.+       +       \pre Z3_get_ast_kind(a) == Z3_QUANTIFIER_AST+    */+    unsigned Z3_API Z3_get_quantifier_num_bound(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return the constant declaration name as a symbol. +    */+    Z3_symbol Z3_API Z3_get_decl_name(__in Z3_context c, __in Z3_func_decl d);++    /**+       \brief Return the number of parameters associated with a declaration.+    */+    unsigned Z3_API Z3_get_decl_num_parameters(__in Z3_context c, __in Z3_func_decl d);++    /**+       \brief Return the parameter type associated with a declaration.+       +       \param c the context+       \param d the function declaration+       \param idx is the index of the named parameter it should be between 0 and the number of parameters.+    */+    Z3_parameter_kind Z3_API Z3_get_decl_parameter_kind(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the integer value associated with an integer parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_INT+    */+    int Z3_API Z3_get_decl_int_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the double value associated with an double parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_DOUBLE+    */+    double Z3_API Z3_get_decl_double_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the double value associated with an double parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_SYMBOL+    */+    Z3_symbol Z3_API Z3_get_decl_symbol_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);+    /**+       \brief Return the sort value associated with a sort parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_SORT+    */+    Z3_sort Z3_API Z3_get_decl_sort_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the expresson value associated with an expression parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_AST+    */+    Z3_ast Z3_API Z3_get_decl_ast_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the expresson value associated with an expression parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_FUNC_DECL+    */+    Z3_func_decl Z3_API Z3_get_decl_func_decl_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the rational value, as a string, associated with a rational parameter.++       \pre Z3_get_decl_parameter_kind(c, d, idx) == Z3_PARAMETER_RATIONAL+    */+    Z3_string Z3_API Z3_get_decl_rational_parameter(__in Z3_context c, __in Z3_func_decl d, unsigned idx);++    /**+       \brief Return the sort name as a symbol. +    */+    Z3_symbol Z3_API Z3_get_sort_name(__in Z3_context c, __in Z3_sort d);++    /**+       \brief Return the sort of an AST node.+       +       The AST node must be a constant, application, numeral, bound variable, or quantifier.++    */+    Z3_sort Z3_API Z3_get_sort(__in Z3_context c, __in Z3_ast a);++    /**+       \brief Return the number of parameters of the given declaration.++       \sa Z3_get_domain_size+    */+    unsigned Z3_API Z3_get_domain_size(__in Z3_context c, __in Z3_func_decl d);++    /**+       \brief \mlh get_domain c d i \endmlh+       Return the sort of the i-th parameter of the given function declaration.+       +       \pre i < Z3_get_domain_size(d)++       \sa Z3_get_domain_size+    */+    Z3_sort Z3_API Z3_get_domain(__in Z3_context c, __in Z3_func_decl d, __in unsigned i);++    /**+       \brief \mlh get_range c d \endmlh+       Return the range of the given declaration. ++       If \c d is a constant (i.e., has zero arguments), then this+       function returns the sort of the constant.+    */+    Z3_sort Z3_API Z3_get_range(__in Z3_context c, __in Z3_func_decl d);++    /**+       \brief Return the sort kind (e.g., array, tuple, int, bool, etc).++       \sa Z3_sort_kind+    */+    Z3_sort_kind Z3_API Z3_get_sort_kind(__in Z3_context c, __in Z3_sort t);++    /**+       \brief \mlh get_bv_sort_size c t \endmlh+       Return the size of the given bit-vector sort. ++       \pre Z3_get_sort_kind(c, t) == Z3_BV_SORT++       \sa Z3_mk_bv_sort+       \sa Z3_get_sort_kind+    */+    unsigned Z3_API Z3_get_bv_sort_size(__in Z3_context c, __in Z3_sort t);++    /**+       \brief \mlh get_array_sort_domain c t \endmlh+       Return the domain of the given array sort.+       +       \pre Z3_get_sort_kind(c, t) == Z3_ARRAY_SORT++       \sa Z3_mk_array_sort+       \sa Z3_get_sort_kind+    */+    Z3_sort Z3_API Z3_get_array_sort_domain(__in Z3_context c, __in Z3_sort t);++    /**+       \brief \mlh get_array_sort_range c t \endmlh +       Return the range of the given array sort. ++       \pre Z3_get_sort_kind(c, t) == Z3_ARRAY_SORT++       \sa Z3_mk_array_sort+       \sa Z3_get_sort_kind+    */+    Z3_sort Z3_API Z3_get_array_sort_range(__in Z3_context c, __in Z3_sort t);++    /**+       \brief \mlh get_tuple_sort_mk_decl c t \endmlh+       Return the constructor declaration of the given tuple+       sort. ++       \pre Z3_get_sort_kind(c, t) == Z3_DATATYPE_SORT++       \sa Z3_mk_tuple_sort+       \sa Z3_get_sort_kind+    */+    Z3_func_decl Z3_API Z3_get_tuple_sort_mk_decl(__in Z3_context c, __in Z3_sort t);++    /**+       \brief Return declaration kind corresponding to declaration.+    */+    Z3_decl_kind Z3_API Z3_get_decl_kind(__in Z3_context c, __in Z3_func_decl d);+    +    /**+       \brief \mlh get_tuple_sort_num_fields c t \endmlh+       Return the number of fields of the given tuple sort. ++       \pre Z3_get_sort_kind(c, t) == Z3_DATATYPE_SORT++       \mlonly \remark Consider using the function {!Z3.get_tuple_sort}, which +       returns a tuple: tuple constructor, and an array of the tuple sort fields. \endmlonly++       \sa Z3_mk_tuple_sort+       \sa Z3_get_sort_kind+    */+    unsigned Z3_API Z3_get_tuple_sort_num_fields(__in Z3_context c, __in Z3_sort t);++    /**+       \brief \mlh get_tuple_sort_field_decl c t i \endmlh+       Return the i-th field declaration (i.e., projection function declaration)+       of the given tuple sort. ++       \mlonly \remark Consider using the function {!Z3.get_tuple_sort}, which +       returns a tuple: tuple constructor, and an array of the tuple sort fields. \endmlonly++       \pre Z3_get_sort_kind(t) == Z3_DATATYPE_SORT+       \pre i < Z3_get_tuple_sort_num_fields(c, t)+       +       \sa Z3_mk_tuple_sort+       \sa Z3_get_sort_kind+    */+    Z3_func_decl Z3_API Z3_get_tuple_sort_field_decl(__in Z3_context c, __in Z3_sort t, __in unsigned i);++    /** +        \brief Return number of constructors for datatype.++        \pre Z3_get_sort_kind(t) == Z3_DATATYPE_SORT++        \sa Z3_get_datatype_sort_constructor+        \sa Z3_get_datatype_sort_recognizer+        \sa Z3_get_datatype_sort_constructor_accessor++    */+    unsigned Z3_API Z3_get_datatype_sort_num_constructors(+        __in Z3_context c, __in Z3_sort t);++    /** +        \brief Return idx'th constructor.++        \pre Z3_get_sort_kind(t) == Z3_DATATYPE_SORT+        \pre idx < Z3_get_datatype_sort_num_constructors(c, t)++        \sa Z3_get_datatype_sort_num_constructors+        \sa Z3_get_datatype_sort_recognizer+        \sa Z3_get_datatype_sort_constructor_accessor++    */+    Z3_func_decl Z3_API Z3_get_datatype_sort_constructor(+        __in Z3_context c, __in Z3_sort t, unsigned idx);++    /** +        \brief Return idx'th recognizer.++        \pre Z3_get_sort_kind(t) == Z3_DATATYPE_SORT+        \pre idx < Z3_get_datatype_sort_num_constructors(c, t)++        \sa Z3_get_datatype_sort_num_constructors+        \sa Z3_get_datatype_sort_constructor+        \sa Z3_get_datatype_sort_constructor_accessor++    */+    Z3_func_decl Z3_API Z3_get_datatype_sort_recognizer(+        __in Z3_context c, __in Z3_sort t, unsigned idx);++    /** +        \brief Return idx_a'th accessor for the idx_c'th constructor.++        \pre Z3_get_sort_kind(t) == Z3_DATATYPE_SORT+        \pre idx_c < Z3_get_datatype_sort_num_constructors(c, t)+        \pre idx_a < Z3_get_domain_size(c, Z3_get_datatype_sort_constructor(c, idx_c))++        \sa Z3_get_datatype_sort_num_constructors+        \sa Z3_get_datatype_sort_constructor+        \sa Z3_get_datatype_sort_recognizer+    */+    Z3_func_decl Z3_API Z3_get_datatype_sort_constructor_accessor(+        __in Z3_context c, __in Z3_sort t, unsigned idx_c, unsigned idx_a);+++    /** +        \brief Return arity of relation.++        \pre Z3_get_sort_kind(s) == Z3_RELATION_SORT++        \sa Z3_get_relation_column+    */++    unsigned Z3_API Z3_get_relation_arity(__in Z3_context c, __in Z3_sort s);++    /** +        \brief Return sort at i'th column of relation sort.++        \pre Z3_get_sort_kind(c, s) == Z3_RELATION_SORT+        \pre col < Z3_get_relation_arity(c, s)++        \sa Z3_get_relation_arity+    */+    Z3_sort Z3_API Z3_get_relation_column(__in Z3_context c, __in Z3_sort s, unsigned col);+++#ifndef CAMLIDL+    /** +        \brief Store the size of the sort in \c r. Return Z3_TRUE if the call succeeded.+        That is, Z3_get_sort_kind(s) == Z3_FINITE_DOMAIN_SORT+    */+    Z3_bool Z3_API Z3_get_finite_domain_sort_size(__in Z3_context c, __in Z3_sort s, __out unsigned __int64* r);+#endif++    /** +        \brief Return number of terms in pattern.+    */+    unsigned Z3_API Z3_get_pattern_num_terms(__in Z3_context c, __in Z3_pattern p);+    +    /**+       \brief Return i'th ast in pattern.+    */+    Z3_ast Z3_API Z3_get_pattern(__in Z3_context c, __in Z3_pattern p, __in unsigned idx);++++    /** +        \brief Interface to simplifier.++        Provides an interface to the AST simplifier used by Z3.+        It allows clients to piggyback on top of the AST simplifier+        for their own term manipulation.+    */+    Z3_ast Z3_API Z3_simplify(__in Z3_context c, __in Z3_ast a);++    /*@}*/++    /**+       @name Modifiers+    */+    /*@{*/++    /**+       \brief Update the arguments of term \c a using the arguments \c args.+       The number of arguments \c num_args should coincide +       with the number of arguments to \c a.+       If \c a is a quantifier, then num_args has to be 1.+    */+    Z3_ast Z3_API Z3_update_term(__in Z3_context c, __in Z3_ast a, __in unsigned num_args, __in_ecount(num_args) Z3_ast args[]);++    /**+       \brief Substitute every occurrence of <tt>from[i]</tt> in \c a with <tt>to[i]</tt>, for \c i smaller than \c num_exprs.+       The result is the new AST. The arrays \c from and \c to must have size \c num_exprs.+       For every \c i smaller than \c num_exprs, we must have that sort of <tt>from[i]</tt> must be equal to sort of <tt>to[i]</tt>.+    */+    Z3_ast Z3_API Z3_substitute(__in Z3_context c, +                                __in Z3_ast a, +                                __in unsigned num_exprs, +                                __in_ecount(num_exprs) Z3_ast from[], +                                __in_ecount(num_exprs) Z3_ast to[]);++    /**+       \brief Substitute the free variables in \c a with the expressions in \c to.+       For every \c i smaller than \c num_exprs, the variable with de-Bruijn index \c i is replaced with term <tt>to[i]</tt>.+    */+    Z3_ast Z3_API Z3_substitute_vars(__in Z3_context c, +                                     __in Z3_ast a, +                                     __in unsigned num_exprs, +                                     __in_ecount(num_exprs) Z3_ast to[]);+    +    /*@}*/++    ++    /**+       @name Coercions+    */+    /*@{*/++    /**+       \brief Convert a Z3_sort into Z3_ast. This is just type casting.+    */+    Z3_ast Z3_API Z3_sort_to_ast(__in Z3_context c, __in Z3_sort s);+    +    /**+       \brief Convert a Z3_func_decl into Z3_ast. This is just type casting.+    */+    Z3_ast Z3_API Z3_func_decl_to_ast(__in Z3_context c, __in Z3_func_decl f);+    +    /**+       \brief Convert a Z3_pattern into Z3_ast. This is just type casting.+    */+    Z3_ast Z3_API Z3_pattern_to_ast(__in Z3_context c, __in Z3_pattern p);++    /**+       \brief Convert a APP_AST into an AST. This is just type casting.+    */+    Z3_ast Z3_API Z3_app_to_ast(__in Z3_context c, __in Z3_app a);++    /**+       \brief Convert an AST into a APP_AST. This is just type casting.+       +       \warning This conversion is only safe if #Z3_get_ast_kind returns \c Z3_app.+    */+    Z3_app Z3_API Z3_to_app(__in Z3_context c, __in Z3_ast a);++    /*@}*/+    +    /**+       @name Constraints+    */+    /*@{*/++    /** +        \brief Create a backtracking point.+        +        The logical context can be viewed as a stack of contexts.  The+        scope level is the number of elements on this stack. The stack+        of contexts is simulated using trail (undo) stacks.++        \sa Z3_pop+    */+    void Z3_API Z3_push(__in Z3_context c);+    +    /**+       \brief Backtrack.+       +       Restores the context from the top of the stack, and pops it off the+       stack.  Any changes to the logical context (by #Z3_assert_cnstr or+       other functions) between the matching #Z3_push and \c Z3_pop+       operators are flushed, and the context is completely restored to+       what it was right before the #Z3_push.+       +       \sa Z3_push+    */+    void Z3_API Z3_pop(__in Z3_context c, __in unsigned num_scopes);+++    /**+       \brief Retrieve the current scope level.+       +       It retrieves the number of scopes that have been pushed, but not yet popped.+       +       \sa Z3_push+       \sa Z3_pop+    */+    unsigned Z3_API Z3_get_num_scopes(__in Z3_context c);+    +    /**+       \brief Persist AST through num_scopes pops.+       This function is only relevant if \c c was created using #Z3_mk_context.+       If \c c was created using #Z3_mk_context_rc, this function is a NOOP.+       +       Normally, for contexts created using #Z3_mk_context, +       references to terms are no longer valid when +       popping scopes beyond the level where the terms are created.+       If you want to reference a term below the scope where it+       was created, use this method to specify how many pops+       the term should survive.+       The num_scopes should be at most equal to the number of+       calls to Z3_push subtracted with the calls to Z3_pop.+    */+    void Z3_API Z3_persist_ast(__in Z3_context c, __in Z3_ast a, __in unsigned num_scopes);+++    /**+       \brief Assert a constraing into the logical context.+       +       After one assertion, the logical context may become+       inconsistent.  +       +       The functions #Z3_check or #Z3_check_and_get_model should be+       used to check whether the logical context is consistent or not.++       \sa Z3_check+       \sa Z3_check_and_get_model+    */+    void Z3_API Z3_assert_cnstr(__in Z3_context c, __in Z3_ast a);+    +    /**+       \brief Check whether the given logical context is consistent or not.++       If the logical context is not unsatisfiable (i.e., the return value is different from \c Z3_L_FALSE)+       and model construction is enabled (see #Z3_mk_config), then a model is stored in \c m. Otherwise,+       the value \c 0 is stored in \c m.+       The caller is responsible for deleting the model using the function #Z3_del_model.+       +       \remark Model construction must be enabled using configuration+       parameters (See, #Z3_mk_config).++       \sa Z3_check+       \sa Z3_del_model+    */+    Z3_lbool Z3_API Z3_check_and_get_model(__in Z3_context c, __out Z3_model * m);+    +    /**+       \brief Check whether the given logical context is consistent or not.++       The function #Z3_check_and_get_model should be used when models are needed.++       \sa Z3_check_and_get_model+    */+    Z3_lbool Z3_API Z3_check(__in Z3_context c);++    /**+       \brief Check whether the given logical context and optional assumptions is consistent or not.++       If the logical context is not unsatisfiable (i.e., the return value is different from \c Z3_L_FALSE),+       a non-0 model argument is passed in,+       and model construction is enabled (see #Z3_mk_config), then a model is stored in \c m. +       Otherwise, \c m is left unchanged.+       The caller is responsible for deleting the model using the function #Z3_del_model.+       +       \remark If the model argument is non-0, then model construction must be enabled using configuration+       parameters (See, #Z3_mk_config).++       \param c logical context.+       \param num_assumptions number of auxiliary assumptions.+       \param assumptions array of auxiliary assumptions+       \param m optional pointer to a model.+       \param proof optional pointer to a proof term.+       \param core_size size of unsatisfiable core. +       \param core pointer to an array receiveing unsatisfiable core. +              The unsatisfiable core is a subset of the assumptions, so the array has the same size as the assumptions.+              The \c core array is not populated if \c core_size is set to 0.++       \pre assumptions comprises of propositional literals.+            In other words, you cannot use compound formulas for assumptions, +            but should use propositional variables or negations of propositional variables.+              +       \sa Z3_check+       \sa Z3_del_model+    */+    Z3_lbool Z3_API Z3_check_assumptions(+        __in Z3_context c, +        __in unsigned num_assumptions, __in_ecount(num_assumptions) Z3_ast assumptions[], +        __out Z3_model * m, __out Z3_ast* proof, +        __inout unsigned* core_size, __inout_ecount(num_assumptions) Z3_ast core[]+        );++    /**+       \brief Retrieve congruence class representatives for terms.++       The function can be used for relying on Z3 to identify equal terms under the current+       set of assumptions. The array of terms and array of class identifiers should have+       the same length. The class identifiers are numerals that are assigned to the same+       value for their corresponding terms if the current context forces the terms to be+       equal. You cannot deduce that terms corresponding to different numerals must be all different, +       (especially when using non-convex theories).+       All implied equalities are returned by this call.+       This means that two terms map to the same class identifier if and only if+       the current context implies that they are equal.++       A side-effect of the function is a satisfiability check.+       The function return Z3_L_FALSE if the current assertions are not satisfiable.++       \sa Z3_check_and_get_model+       \sa Z3_check+    */++    Z3_lbool Z3_API Z3_get_implied_equalities(+        __in Z3_context c, +        __in unsigned num_terms,+        __in_ecount(num_terms) Z3_ast terms[],+        __out_ecount(num_terms) unsigned class_ids[]+        );+++    /**+       \brief Delete a model object.+       +       \sa Z3_check_and_get_model+    */+    void Z3_API Z3_del_model(__in Z3_context c, __in Z3_model m);++    /**+       @name Search control.+    */+    /*@{*/+    /**+       \brief Cancel an ongoing check.+       +       Notifies the current check to abort and return.+       This method should be called from a different thread+       than the one performing the check.+    */++    void Z3_API Z3_soft_check_cancel(__in Z3_context c);+    /*@}*/++    /*@{*/++    /**+       \brief Retrieve reason for search failure.+       +       If a call to #Z3_check or #Z3_check_and_get_model returns Z3_L_UNDEF, +       use this facility to determine the more detailed cause of search failure.+    */+    Z3_search_failure Z3_API Z3_get_search_failure(__in Z3_context c);++    /*@}*/+++    /**+       @name Labels.+    */+    /*@{*/+    /** +        \brief Retrieve the set of labels that were relevant in+        the context of the current satisfied context.++        \sa Z3_del_literals+        \sa Z3_get_num_literals+        \sa Z3_get_label_symbol+        \sa Z3_get_literal+    */+    Z3_literals Z3_API Z3_get_relevant_labels(__in Z3_context c);++    /** +        \brief Retrieve the set of literals that satisfy the current context.++        \sa Z3_del_literals+        \sa Z3_get_num_literals+        \sa Z3_get_label_symbol+        \sa Z3_get_literal+    */+    Z3_literals Z3_API Z3_get_relevant_literals(__in Z3_context c);++    /** +        \brief Retrieve the set of literals that whose assignment were +        guess, but not propagated during the search.++        \sa Z3_del_literals+        \sa Z3_get_num_literals+        \sa Z3_get_label_symbol+        \sa Z3_get_literal+    */+    Z3_literals Z3_API Z3_get_guessed_literals(__in Z3_context c);+++    /**+       \brief Delete a labels context.+       +       \sa Z3_get_relevant_labels+    */+    void Z3_API Z3_del_literals(__in Z3_context c, __in Z3_literals lbls);++    /**+       \brief Retrieve the number of label symbols that were returned.+       +       \sa Z3_get_relevant_labels+    */+    unsigned Z3_API Z3_get_num_literals(__in Z3_context c, __in Z3_literals lbls);++    /**+       \brief Retrieve label symbol at idx.+    */+    Z3_symbol Z3_API Z3_get_label_symbol(__in Z3_context c, __in Z3_literals lbls, __in unsigned idx);++    /**+       \brief Retrieve literal expression at idx.+    */+    Z3_ast Z3_API Z3_get_literal(__in Z3_context c, __in Z3_literals lbls, __in unsigned idx);++    /**+       \brief Disable label.+       +       The disabled label is not going to be used when blocking the subsequent search.++       \sa Z3_block_literals+    */+    void Z3_API Z3_disable_literal(__in Z3_context c, __in Z3_literals lbls, __in unsigned idx);++    /**+       \brief Block subsequent checks using the remaining enabled labels.+    */+    void Z3_API Z3_block_literals(__in Z3_context c, __in Z3_literals lbls);++    /*@}*/++++    /**+       @name Model navigation+     */+    /*@{*/+    +    /**+       \brief Return the number of constants assigned by the given model.+       +       \mlonly \remark Consider using {!Z3.get_model_constants}. \endmlonly++       \sa Z3_get_model_constant+    */+    unsigned Z3_API Z3_get_model_num_constants(__in Z3_context c, __in Z3_model m);++    /**+       \brief \mlh get_model_constant c m i \endmlh+       Return the i-th constant in the given model. ++       \mlonly \remark Consider using {!Z3.get_model_constants}. \endmlonly++       \pre i < Z3_get_model_num_constants(c, m)++       \sa Z3_eval+    */+    Z3_func_decl Z3_API Z3_get_model_constant(__in Z3_context c, __in Z3_model m, __in unsigned i);++    /**+       \brief Return the value of the given constant or function +              in the given model.+       +    */+    Z3_bool Z3_API Z3_eval_func_decl(__in Z3_context c, __in Z3_model m, __in Z3_func_decl decl, __out Z3_ast* v);+++    /**+       \brief \mlh is_array_value c v \endmlh+       Determine whether the term encodes an array value.       +       Return the number of entries mapping to non-default values of the array.+    */+    Z3_bool Z3_API Z3_is_array_value(__in Z3_context c, __in Z3_model m, __in Z3_ast v, __out unsigned* num_entries);+++    /**+       \brief \mlh get_array_value c v \endmlh+       An array values is represented as a dictionary plus a+       default (else) value. This function returns the array graph.++       \pre Z3_TRUE == Z3_is_array_value(c, v, &num_entries)       +    */+    void Z3_API Z3_get_array_value(__in Z3_context c, +                                   __in Z3_model m,+                                   __in Z3_ast v,+                                   __in unsigned num_entries,+                                   __inout_ecount(num_entries) Z3_ast indices[],+                                   __inout_ecount(num_entries) Z3_ast values[],+                                   __out Z3_ast* else_value+                                   );++        +    /**+       \brief Return the number of function interpretations in the given model.+       +       A function interpretation is represented as a finite map and an 'else' value.+       Each entry in the finite map represents the value of a function given a set of arguments.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly+       +       \sa Z3_get_model_func_decl+       \sa Z3_get_model_func_else+       \sa Z3_get_model_func_num_entries+       \sa Z3_get_model_func_entry_num_args+       \sa Z3_get_model_func_entry_arg+     */+    unsigned Z3_API Z3_get_model_num_funcs(__in Z3_context c, __in Z3_model m);+    +    +    /**+       \brief \mlh get_model_func_decl c m i \endmlh+       Return the declaration of the i-th function in the given model.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly++       \pre i < Z3_get_model_num_funcs(c, m)++       \sa Z3_get_model_num_funcs+    */+    Z3_func_decl Z3_API Z3_get_model_func_decl(__in Z3_context c, __in Z3_model m, __in unsigned i);++    /**+       \brief \mlh get_model_func_else c m i \endmlh+       Return the 'else' value of the i-th function interpretation in the given model.+ +       A function interpretation is represented as a finite map and an 'else' value.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly+       +       \pre i < Z3_get_model_num_funcs(c, m)++       \sa Z3_get_model_num_funcs+       \sa Z3_get_model_func_num_entries+       \sa Z3_get_model_func_entry_num_args+       \sa Z3_get_model_func_entry_arg+    */+    Z3_ast Z3_API Z3_get_model_func_else(__in Z3_context c, __in Z3_model m, __in unsigned i);++    /**+       \brief \mlh get_model_func_num_entries c m i \endmlh+       Return the number of entries of the i-th function interpretation in the given model.+ +       A function interpretation is represented as a finite map and an 'else' value.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly+       +       \pre i < Z3_get_model_num_funcs(c, m)++       \sa Z3_get_model_num_funcs+       \sa Z3_get_model_func_else+       \sa Z3_get_model_func_entry_num_args+       \sa Z3_get_model_func_entry_arg+    */+    unsigned Z3_API Z3_get_model_func_num_entries(__in Z3_context c, __in Z3_model m, __in unsigned i);++    +    /**+       \brief \mlh get_model_func_entry_num_args c m i j \endmlh+       Return the number of arguments of the j-th entry of the i-th function interpretation in the given+       model.++       A function interpretation is represented as a finite map and an 'else' value.+       This function returns the j-th entry of this map.+      +       An entry represents the value of a function given a set of arguments.+       \conly That is: it has the following format <tt>f(args[0],...,args[num_args - 1]) = val</tt>.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly++       \pre i < Z3_get_model_num_funcs(c, m)+       \pre j < Z3_get_model_func_num_entries(c, m, i)++       \sa Z3_get_model_num_funcs+       \sa Z3_get_model_func_num_entries +       \sa Z3_get_model_func_entry_arg+    */+    unsigned Z3_API Z3_get_model_func_entry_num_args(__in Z3_context c,+                                                     __in Z3_model m,+                                                     __in unsigned i,+                                                     __in unsigned j);+    +    /**+       \brief \mlh get_model_func_entry_arg c m i j k \endmlh+       Return the k-th argument of the j-th entry of the i-th function interpretation in the given+       model.++       A function interpretation is represented as a finite map and an 'else' value.+       This function returns the j-th entry of this map.+      +       An entry represents the value of a function given a set of arguments.+       \conly That is: it has the following format <tt>f(args[0],...,args[num_args - 1]) = val</tt>.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly++       \pre i < Z3_get_model_num_funcs(c, m)+       \pre j < Z3_get_model_func_num_entries(c, m, i)+       \pre k < Z3_get_model_func_entry_num_args(c, m, i, j)++       \sa Z3_get_model_num_funcs+       \sa Z3_get_model_func_num_entries +       \sa Z3_get_model_func_entry_num_args+    */+    Z3_ast Z3_API Z3_get_model_func_entry_arg(__in Z3_context c,+                                                __in Z3_model m,+                                                __in unsigned i,+                                                __in unsigned j,+                                                __in unsigned k);+    +    /**+       \brief \mlh get_model_func_entry_value c m i j \endmlh+       Return the return value of the j-th entry of the i-th function interpretation in the given+       model.++       A function interpretation is represented as a finite map and an 'else' value.+       This function returns the j-th entry of this map.+      +       An entry represents the value of a function given a set of arguments.+       \conly That is: it has the following format <tt>f(args[0],...,args[num_args - 1]) = val</tt>.++       \mlonly \remark Consider using {!Z3.get_model_funcs}. \endmlonly++       \pre i < Z3_get_model_num_funcs(c, m)+       \pre j < Z3_get_model_func_num_entries(c, m, i)++       \sa Z3_get_model_num_funcs+       \sa Z3_get_model_func_num_entries +    */+    Z3_ast Z3_API Z3_get_model_func_entry_value(__in Z3_context c,+                                                  __in Z3_model m,+                                                  __in unsigned i,+                                                  __in unsigned j);+    +    /**+       \brief \mlh eval c m t \endmlh+       Evaluate the AST node \c t in the given model. +       \conly Return \c Z3_TRUE if succeeded, and store the result in \c v.+       \mlonly Return a pair: Boolean and value. The Boolean is true if the term was successfully evaluated. \endmlonly++       The evaluation may fail for the following reasons:++       - \c t contains a quantifier.++       - the model \c m is partial, that is, it doesn't have a complete interpretation for uninterpreted functions. +         That is, the option <tt>MODEL_PARTIAL=true</tt> was used.++       - \c t is type incorrect.+    */+    Z3_bool Z3_API Z3_eval(__in Z3_context c, __in Z3_model m, __in Z3_ast t, __out Z3_ast * v);++    /**+       \brief Evaluate declaration given values.++       Provides direct way to evaluate declarations+       without going over terms.+     */+    Z3_bool Z3_API Z3_eval_decl(__in Z3_context c, __in Z3_model m, +                                __in Z3_func_decl d, +                                __in unsigned num_args,+                                __in_ecount(num_args) Z3_ast args[],+                                __out Z3_ast* v);++++    +    /*@}*/++    /**+       @name Interaction logging.+    */+    /*@{*/+    +    /**+       \brief Log interaction to a file.+    */+    Z3_bool Z3_API Z3_open_log(__in Z3_context c, __in_z Z3_string filename);++    /**+       \brief Append user-defined string to interaction log.+       +       The interaction log is opened using Z3_open_log.+       It contains the formulas that are checked using Z3.+       You can use this command to append comments, for instance.+    */+    void Z3_API Z3_append_log(__in Z3_context c, __in_z Z3_string string);+++    /**+       \brief Close interaction log.+    */+    void Z3_API Z3_close_log(__in Z3_context c);+    /*@}*/+++    /**+       @name String conversion+    */+    /*@{*/++    /**+       \brief Select mode for the format used for pretty-printing AST nodes.++       The default mode for pretty printing AST nodes is to produce+       SMT-LIB style output where common subexpressions are printed +       at each occurrence. The mode is called Z3_PRINT_SMTLIB_FULL.+       To print shared common subexpressions only once, +       use the Z3_PRINT_LOW_LEVEL mode.+       To print in way that conforms to SMT-LIB standards and uses let+       expressions to share common sub-expressions use Z3_PRINT_SMTLIB_COMPLIANT.++       \sa Z3_ast_to_string+       \sa Z3_pattern_to_string+       \sa Z3_func_decl_to_string++    */+    void Z3_API Z3_set_ast_print_mode(__in Z3_context c, __in Z3_ast_print_mode mode);++    /**+       \brief Convert the given AST node into a string.++       \conly \warning The result buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_ast_to_string.+       \sa Z3_pattern_to_string+       \sa Z3_sort_to_string+    */+    Z3_string Z3_API Z3_ast_to_string(__in Z3_context c, __in Z3_ast a);+    Z3_string Z3_API Z3_pattern_to_string(__in Z3_context c, __in Z3_pattern p);+    Z3_string Z3_API Z3_sort_to_string(__in Z3_context c, __in Z3_sort s);+    Z3_string Z3_API Z3_func_decl_to_string(__in Z3_context c, __in Z3_func_decl d);++    /**+       \brief Convert the given model into a string.++       \conly \warning The result buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_model_to_string.+    */+    Z3_string Z3_API Z3_model_to_string(__in Z3_context c, __in Z3_model m);++    /**+       \brief Convert the given benchmark into SMT-LIB formatted string.++       \conly \warning The result buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_benchmark_to_smtlib_string.++       \param c - context.+       \param name - name of benchmark. The argument is optional.+       \param logic - the benchmark logic. +       \param status - the status string (sat, unsat, or unknown)+       \param attributes - other attributes, such as source, difficulty or category.+       \param num_assumptions - number of assumptions.+       \param assumptions - auxiliary assumptions.+       \param formula - formula to be checked for consistency in conjunction with assumptions.+    */+    Z3_string Z3_API Z3_benchmark_to_smtlib_string(__in   Z3_context c, +                                                   __in_z Z3_string name,+                                                   __in_z Z3_string logic,+                                                   __in_z Z3_string status,+                                                   __in_z Z3_string attributes,+                                                   __in   unsigned num_assumptions,+                                                   __in_ecount(num_assumptions) Z3_ast assumptions[],+                                                   __in   Z3_ast formula);+    ++    /**+       \brief Convert the given logical context into a string.+       +       This function is mainly used for debugging purposes. It displays+       the internal structure of a logical context.++       \conly \warning The result buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_context_to_string.+    */+    Z3_string Z3_API Z3_context_to_string(__in Z3_context c);+++    /**+       \brief Return runtime statistics as a string.+       +       This function is mainly used for debugging purposes. It displays+       statistics of the search activity.++       \conly \warning The result buffer is statically allocated by Z3. It will+       \conly be automatically deallocated when #Z3_del_context is invoked.+       \conly So, the buffer is invalidated in the next call to \c Z3_context_to_string.+    */+    Z3_string Z3_API Z3_statistics_to_string(__in Z3_context c);+++    /**+       \brief Extract satisfying assignment from context as a conjunction.+       +       This function can be used for debugging purposes. It returns a conjunction+       of formulas that are assigned to true in the current context.+       This conjunction will contain not only the assertions that are set to true+       under the current assignment, but will also include additional literals+       if there has been a call to #Z3_check or #Z3_check_and_get_model.       +     */+    Z3_ast Z3_API Z3_get_context_assignment(__in Z3_context c);++    /*@}*/++    /**+       @name Parser interface+    */+    /*@{*/+    /**+       \brief \mlh parse_smtlib_string c str sort_names sorts decl_names decls \endmlh+       Parse the given string using the SMT-LIB parser. +              +       The symbol table of the parser can be initialized using the given sorts and declarations. +       The symbols in the arrays \c sort_names and \c decl_names don't need to match the names+       of the sorts and declarations in the arrays \c sorts and \c decls. This is an useful feature+       since we can use arbitrary names to reference sorts and declarations defined using the C API.++       The formulas, assumptions and declarations defined in \c str can be extracted using the functions:+       #Z3_get_smtlib_num_formulas, #Z3_get_smtlib_formula, #Z3_get_smtlib_num_assumptions, #Z3_get_smtlib_assumption, +       #Z3_get_smtlib_num_decls, and #Z3_get_smtlib_decl.+     */+    void Z3_API Z3_parse_smtlib_string(__in Z3_context c, +                                       __in_z Z3_string str,+                                       __in unsigned num_sorts,+                                       __in_ecount(num_sorts) Z3_symbol sort_names[],+                                       __in_ecount(num_sorts) Z3_sort sorts[],+                                       __in unsigned num_decls,+                                       __in_ecount(num_decls) Z3_symbol decl_names[],+                                       __in_ecount(num_decls) Z3_func_decl decls[]                     +                                       );+    +    /**+       \brief Similar to #Z3_parse_smtlib_string, but reads the benchmark from a file.+    */+    void Z3_API Z3_parse_smtlib_file(__in Z3_context c, +                                     __in_z Z3_string file_name,+                                     __in unsigned num_sorts,+                                     __in_ecount(num_sorts) Z3_symbol sort_names[],+                                     __in_ecount(num_sorts) Z3_sort sorts[],+                                     __in unsigned num_decls,+                                     __in_ecount(num_decls) Z3_symbol decl_names[],+                                     __in_ecount(num_decls) Z3_func_decl decls[]  +                                     );++    /**+       \brief Return the number of SMTLIB formulas parsed by the last call to #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.+    */+    unsigned Z3_API Z3_get_smtlib_num_formulas(__in Z3_context c);++    /**+       \brief \mlh get_smtlib_formula c i \endmlh+       Return the i-th formula parsed by the last call to #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.++       \pre i < Z3_get_smtlib_num_formulas(c)+    */+    Z3_ast Z3_API Z3_get_smtlib_formula(__in Z3_context c, __in unsigned i);++    /**+       \brief Return the number of SMTLIB assumptions parsed by #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.+    */+    unsigned Z3_API Z3_get_smtlib_num_assumptions(__in Z3_context c);++    /**+       \brief \mlh get_smtlib_assumption c i \endmlh+       Return the i-th assumption parsed by the last call to #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.++       \pre i < Z3_get_smtlib_num_assumptions(c)+    */+    Z3_ast Z3_API Z3_get_smtlib_assumption(__in Z3_context c, __in unsigned i);++    /**+       \brief Return the number of declarations parsed by #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.+    */+    unsigned Z3_API Z3_get_smtlib_num_decls(__in Z3_context c);++    /**+       \brief \mlh get_smtlib_decl c i \endmlh+       Return the i-th declaration parsed by the last call to #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.++       \pre i < Z3_get_smtlib_num_decls(c)+    */+    Z3_func_decl Z3_API Z3_get_smtlib_decl(__in Z3_context c, __in unsigned i);++    /**+       \brief Return the number of sorts parsed by #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.+    */+    unsigned Z3_API Z3_get_smtlib_num_sorts(__in Z3_context c);++    /**+       \brief \mlh get_smtlib_sort c i \endmlh+       Return the i-th sort parsed by the last call to #Z3_parse_smtlib_string or #Z3_parse_smtlib_file.++       \pre i < Z3_get_smtlib_num_sorts(c)+    */+    Z3_sort Z3_API Z3_get_smtlib_sort(__in Z3_context c, __in unsigned i);++    /**+       \brief \mlh get_smtlib_error c \endmlh+       Retrieve that last error message information generated from parsing.+    */+    Z3_string Z3_API Z3_get_smtlib_error(__in Z3_context c);++    /**+       \brief \mlh parse_z3_string c str \endmlh+       Parse the given string using the Z3 native parser.+       +       Return the conjunction of asserts made in the input.+     */+    Z3_ast Z3_API Z3_parse_z3_string(__in Z3_context c, __in_z Z3_string str);+    +    /**+       \brief Similar to #Z3_parse_z3_string, but reads the benchmark from a file.+    */+    Z3_ast Z3_API Z3_parse_z3_file(__in Z3_context c, __in_z Z3_string file_name);++    /**+       \brief \mlh parse_smtlib2_string c str \endmlh+       Parse the given string using the SMT-LIB2 parser. +              +       It returns a formula comprising of the conjunction of assertions in the scope+       (up to push/pop) at the end of the string.+     */+    Z3_ast Z3_API Z3_parse_smtlib2_string(__in Z3_context c, +                                          __in_z Z3_string str,+                                          __in unsigned num_sorts,+                                          __in_ecount(num_sorts) Z3_symbol sort_names[],+                                          __in_ecount(num_sorts) Z3_sort sorts[],+                                          __in unsigned num_decls,+                                          __in_ecount(num_decls) Z3_symbol decl_names[],+                                          __in_ecount(num_decls) Z3_func_decl decls[]  +                                          );+    +    /**+       \brief Similar to #Z3_parse_smtlib2_string, but reads the benchmark from a file.+    */+    Z3_ast Z3_API Z3_parse_smtlib2_file(__in Z3_context c, +                                        __in_z Z3_string file_name,+                                          __in unsigned num_sorts,+                                          __in_ecount(num_sorts) Z3_symbol sort_names[],+                                          __in_ecount(num_sorts) Z3_sort sorts[],+                                          __in unsigned num_decls,+                                          __in_ecount(num_decls) Z3_symbol decl_names[],+                                          __in_ecount(num_decls) Z3_func_decl decls[]    +                                        );+++#ifndef CAMLIDL+    /**+       \brief \mlh parse_simplify_string c str \endmlh+       Parse the given string using the Simplify parser.+       +       Return the conjunction of asserts made in the input.+     */+    Z3_ast Z3_API Z3_parse_simplify_string(__in Z3_context c, __in_z Z3_string str, __out Z3_string* parser_output);+    +    /**+       \brief Similar to #Z3_parse_simplify_string, but reads the benchmark from a file.+    */+    Z3_ast Z3_API Z3_parse_simplify_file(__in Z3_context c, __in_z Z3_string file_name, __out Z3_string* parser_output);+#endif // CAMLIDL++    /*@}*/++#ifndef CAMLIDL+    /**+       @name Error Handling+    */+    /*@{*/++    /**+       \brief Return the error code for the last API call.+       +       A call to a Z3 function may return a non Z3_OK error code,+       when it is not used correctly.++       \sa Z3_set_error_handler+    */+    Z3_error_code Z3_API Z3_get_error_code(__in Z3_context c);++    /**+       \brief Register a Z3 error handler.+       +       A call to a Z3 function may return a non Z3_OK error code, when+       it is not used correctly.  An error handler can be registered+       and will be called in this case.  To disable the use of the+       error handler, simply register with h=NULL.++       \sa Z3_get_error_code+    */+    void Z3_API Z3_set_error_handler(__in Z3_context c, __in Z3_error_handler h);+    +    /**+       \brief Set an error.+    */+    void Z3_API Z3_set_error(__in Z3_context c, __in Z3_error_code e);++    /**+       \brief Return a string describing the given error code.+     */+    Z3_string Z3_API Z3_get_error_msg(__in Z3_error_code err);+    /*@}*/++#endif // CAMLIDL++    /**+       @name Miscellaneous+    */+    /*@{*/+    +    /**+       \brief Return Z3 version number information.+    */+    void Z3_API Z3_get_version(__out unsigned * major, +                               __out unsigned * minor, +                               __out unsigned * build_number, +                               __out unsigned * revision_number);+++    /**+       \brief Reset all allocated resources. ++       Use this facility on out-of memory errors. +       It allows discharging the previous state and resuming afresh.+       Any pointers previously returned by the API+       become invalid.+    */+    void Z3_API Z3_reset_memory(void);+    +    /*@}*/++    /** +        @name External Theory Plugins+    */+    /*@{*/+    +#ifndef CAMLIDL++    //+    // callbacks and void* don't work with CAMLIDL.+    // +    typedef Z3_bool Z3_reduce_eq_callback_fptr(__in Z3_theory t, __in Z3_ast a, __in Z3_ast b, __out Z3_ast * r);++    typedef Z3_bool Z3_reduce_app_callback_fptr(__in Z3_theory, __in Z3_func_decl, __in unsigned, __in Z3_ast const [], __out Z3_ast *);+++    typedef Z3_bool Z3_reduce_distinct_callback_fptr(__in Z3_theory, __in unsigned, __in Z3_ast const [], __out Z3_ast *);++    typedef void Z3_theory_callback_fptr(__in Z3_theory t);+    +    typedef Z3_bool Z3_theory_final_check_callback_fptr(__in Z3_theory);+    +    typedef void Z3_theory_ast_callback_fptr(__in Z3_theory, __in Z3_ast);+    +    typedef void Z3_theory_ast_bool_callback_fptr(__in Z3_theory, __in Z3_ast, __in Z3_bool);+    +    typedef void Z3_theory_ast_ast_callback_fptr(__in Z3_theory, __in Z3_ast, __in Z3_ast);+++    /**+       \brief Create a new user defined theory. The new theory will be identified by the name \c th_name.+       A theory must be created before asserting any assertion to the given context.+       Return NULL in case of failure.++       \c data is a pointer to an external data-structure that may be used to store+       theory specific additional data.+    */+    Z3_theory Z3_API Z3_mk_theory(__in Z3_context c, __in_z Z3_string th_name, __in Z3_theory_data data);++    /**+       \brief Return a pointer to the external data-structure supplied to the function #Z3_mk_theory.++       \see Z3_mk_theory+    */+    Z3_theory_data Z3_API Z3_theory_get_ext_data(__in Z3_theory t);++#endif+    +    /**+       \brief Create an interpreted theory sort.+    */+    Z3_sort Z3_API Z3_theory_mk_sort(__in Z3_context c, __in Z3_theory t, __in Z3_symbol s);+    +    /**+       \brief Create an interpreted theory constant value. Values are assumed to be different from each other.+    */+    Z3_ast Z3_API Z3_theory_mk_value(__in Z3_context c, __in Z3_theory t, __in Z3_symbol n, __in Z3_sort s);++    /**+       \brief Create an interpreted constant for the given theory.+    */+    Z3_ast Z3_API Z3_theory_mk_constant(__in Z3_context c, __in Z3_theory t, __in Z3_symbol n, __in Z3_sort s);+    +    /**+       \brief Create an interpreted function declaration for the given theory.+    */+    Z3_func_decl Z3_API Z3_theory_mk_func_decl(__in Z3_context c, __in Z3_theory t, __in Z3_symbol n,+                                               __in unsigned domain_size, __in_ecount(domain_size) Z3_sort const domain[],+                                               __in Z3_sort range);++    /**+       \brief Return the context where the given theory is installed.+    */+    Z3_context Z3_API Z3_theory_get_context(__in Z3_theory t);++++#ifndef CAMLIDL+    /**+       \brief Set a callback that is invoked when theory \c t is deleted.+       This callback should be used to delete external data-structures associated with the given theory.++       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+       +       \see Z3_mk_theory +       \see Z3_theory_get_ext_data+    */+    void Z3_API Z3_set_delete_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);+    +    /**+       \brief Set a callback for simplifying operators of the given theory.+       The callback \c f is invoked by Z3's simplifier.++       It is of the form <tt>f(t, d, n, args, r)</tt>, where:+         - \c t is the given theory+         - \c d is the declaration of the theory operator+         - \c n is the number of arguments in the array \c args+         - \c args are arguments for the theory operator+         - \c r should contain the result: an expression equivalent to <tt>d(args[0], ..., args[n-1])</tt>.++      If <tt>f(t, d, n, args, r)</tt> returns false, then \c r is ignored, and Z3 assumes that no simplification was performed.+    */+    void Z3_API Z3_set_reduce_app_callback(__in Z3_theory t, __in Z3_reduce_app_callback_fptr f);+    +    /**+       \brief Set a callback for simplifying the atom <tt>s_1 = s_2</tt>, when the+       sort of \c s_1 and \c s_2 is an interpreted sort of the given theory.+       The callback \c f is invoked by Z3's simplifier.+       +       It has the form <tt>f(t, s_1, s_2, r)</tt>, where:+         - \c t is the given theory+         - \c s_1 is the left-hand-side+         - \c s_2 is the right-hand-side+         - \c r should contain the result: an expression equivalent to <tt>s_1 = s_2</tt>.+         +       If <tt>f(t, s_1, s_2, r)</tt> returns false, then \c r is ignored, and Z3 assumes that no simplification was performed.+    */+    void Z3_API Z3_set_reduce_eq_callback(__in Z3_theory t, __in Z3_reduce_eq_callback_fptr f);++    /**+       \brief Set a callback for simplifying the atom <tt>distinct(s_1, ..., s_n)</tt>, when the+       sort of \c s_1, ..., \c s_n is an interpreted sort of the given theory.+       The callback \c f is invoked by Z3's simplifier.+       +       It has the form <tt>f(t, n, args, r)</tt>, where:+         - \c t is the given theory+         - \c n is the number of arguments in the array \c args+         - \c args are arguments for distinct.+         - \c r should contain the result: an expression equivalent to <tt>distinct(s_1, ..., s_n)</tt>.+         +       If <tt>f(t, n, args, r)</tt> returns false, then \c r is ignored, and Z3 assumes that no simplification was performed.+    */+    void Z3_API Z3_set_reduce_distinct_callback(__in Z3_theory t, __in Z3_reduce_distinct_callback_fptr f);+    +    /**+       \brief Set a callback that is invoked when a theory application+       is finally added into the logical context. Note that, not every+       application contained in an asserted expression is actually+       added into the logical context because it may be simplified+       during a preprocessing step.+    +       The callback has the form <tt>f(t, n)</tt>, where+       - \c t is the given theory+       +       - \c n is a theory application, that is, an expression of the form <tt>g(...)</tt> where \c g is a theory operator.++       \remark An expression \c n added to the logical context at search level \c n,+       will remain in the logical context until this level is backtracked.+    */+    void Z3_API Z3_set_new_app_callback(__in Z3_theory t, __in Z3_theory_ast_callback_fptr f);++    /**+       \brief Set a callback that is invoked when an expression of+       sort \c s, where \c s is an interpreted sort of the theory \c+       t, is finally added into the logical context. Note that, not+       every expression contained in an asserted expression is+       actually added into the logical context because it may be+       simplified during a preprocessing step.++       The callback has the form <tt>f(t, n)</tt>, where+       - \c t is the given theory+       +       - \c n is an expression of sort \c s, where \c s is an interpreted sort of \c t.++       \remark An expression \c n added to the logical context at search level \c n,+       will remain in the logical context until this level is backtracked.+    */+    void Z3_API Z3_set_new_elem_callback(__in Z3_theory t, __in Z3_theory_ast_callback_fptr f);++    /**+       \brief Set a callback that is invoked when Z3 starts searching for a+       satisfying assignment.+       +       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+    */+    void Z3_API Z3_set_init_search_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);+        +    /**+       \brief Set a callback that is invoked when Z3 creates a+       case-split (aka backtracking point). ++       When a case-split is created we say the search level is increased.+       +       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+    */+    void Z3_API Z3_set_push_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);+ +    /**+       \brief Set a callback that is invoked when Z3 backtracks a+       case-split.++       When a case-split is backtracked we say the search level is decreased.+       +       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+    */+    void Z3_API Z3_set_pop_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);++    /**+       \brief Set a callback that is invoked when Z3 restarts the+       search for a satisfying assignment.+       +       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+    */+    void Z3_API Z3_set_restart_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);++    /**+       \brief Set a callback that is invoked when the logical context+       is reset by the user. This callback is useful for reseting any+       data-structure maintained by the user theory solver.+       +       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory+    */+    void Z3_API Z3_set_reset_callback(__in Z3_theory t, __in Z3_theory_callback_fptr f);++    /**+       \brief Set a callback that is invoked before Z3 starts building a model.+       A theory may use this callback to perform expensive operations.++       The callback has the form <tt>f(t)</tt>, where+       - \c t is the given theory++       If the theory return \c Z3_false, Z3 will assume that theory is giving up,+       and it will assume that it was not possible to decide if the asserted constraints+       are satisfiable or not.+    */+    void Z3_API Z3_set_final_check_callback(__in Z3_theory t, __in Z3_theory_final_check_callback_fptr f);++    /**+       \brief Set a callback that is invoked when an equality <tt>s_1 = s_2</tt>+       is found by the logical context.++       The callback has the form <tt>f(t, s_1, s_2)</tt>, where:+         - \c t is the given theory+         - \c s_1 is the left-hand-side+         - \c s_2 is the right-hand-side+    */+    void Z3_API Z3_set_new_eq_callback(__in Z3_theory t, __in Z3_theory_ast_ast_callback_fptr f);++    /**+       \brief Set a callback that is invoked when a disequality <tt>s_1 != s_2</tt>+       is found by the logical context.++       The callback has the form <tt>f(t, s_1, s_2)</tt>, where:+         - \c t is the given theory+         - \c s_1 is the left-hand-side+         - \c s_2 is the right-hand-side+    */+    void Z3_API Z3_set_new_diseq_callback(__in Z3_theory t, __in Z3_theory_ast_ast_callback_fptr f);++    /**+       \brief Set a callback that is invoked when a theory predicate is assigned to true/false by Z3.+       +       The callback has the form <tt>f(t, p, v)</tt>, where:+         - \c t is the given theory+         - \c p is the assigned predicate.+         - \c v is the value (true/false) assigned to \c p.+    */+    void Z3_API Z3_set_new_assignment_callback(__in Z3_theory t, __in Z3_theory_ast_bool_callback_fptr f);++    /**+       \brief Set a callback that is invoked when an expression is+       marked as relevant during the search. This callback is only+       invoked when relevancy propagation is enabled.+       +       The callback has the form <tt>f(t, n)</tt>, where:+         - \c t is the given theory+         - \c n is the relevant expression+    */+    void Z3_API Z3_set_new_relevant_callback(__in Z3_theory t, __in Z3_theory_ast_callback_fptr f);++#endif // CAMLIDL+    /**+       \brief Assert a theory axiom/lemmas during the search.+       +       An axiom added at search level \c n will remain in the logical context until +       level \c n is backtracked. ++       The callbacks for push (#Z3_set_push_callback) and pop+       (#Z3_set_pop_callback) can be used to track when the search+       level is increased (i.e., new case-split) and decreased (i.e.,+       case-split is backtracked).+       +       Z3 tracks the theory axioms asserted. So, multiple assertions of the same axiom are+       ignored.+    */+    void Z3_API Z3_theory_assert_axiom(__in Z3_theory t, __in Z3_ast ax);++    /**+       \brief Inform to the logical context that \c lhs and \c rhs have the same interpretation+       in the model being built by theory \c t. If lhs = rhs is inconsistent with other theories,+       then the logical context will backtrack.++       For more information, see the paper "Model-Based Theory Combination" in the Z3 website.+    */+    void Z3_API Z3_theory_assume_eq(__in Z3_theory t, __in Z3_ast lhs, __in Z3_ast rhs);++    /**+       \brief Enable/disable the simplification of theory axioms asserted using #Z3_theory_assert_axiom.+       By default, the simplification of theory specific operators is disabled. +       That is, the reduce theory callbacks are not invoked for theory axioms.+       The default behavior is useful when asserting axioms stating properties of theory operators.+    */+    void Z3_API Z3_theory_enable_axiom_simplification(__in Z3_theory t, __in Z3_bool flag);++    /**+       \brief Return the root of the equivalence class containing \c n.+    */+    Z3_ast Z3_API Z3_theory_get_eqc_root(__in Z3_theory t, __in Z3_ast n);+    +    /**+       \brief Return the next element in the equivalence class containing \c n.++       The elements in an equivalence class are organized in a circular list.+       You can traverse the list by calling this function multiple times +       using the result from the previous call. This is illustrated in the+       code snippet below.+       \code+           Z3_ast curr = n;+           do+             curr = Z3_theory_get_eqc_next(theory, curr);+           while (curr != n);+       \endcode+    */+    Z3_ast Z3_API Z3_theory_get_eqc_next(__in Z3_theory t, __in Z3_ast n);++    /**+       \brief Return the number of parents of \c n that are operators of the given theory. +    */+    unsigned Z3_API Z3_theory_get_num_parents(__in Z3_theory t, __in Z3_ast n);+    +    /**+       \brief Return the i-th parent of \c n. +       See #Z3_theory_get_num_parents. +    */+    Z3_ast Z3_API Z3_theory_get_parent(__in Z3_theory t, __in Z3_ast n, __in unsigned i);++    /**+       \brief Return \c Z3_TRUE if \c n is an interpreted theory value.+    */+    Z3_bool Z3_API Z3_theory_is_value(__in Z3_theory t, __in Z3_ast n);++    /**+       \brief Return \c Z3_TRUE if \c d is an interpreted theory declaration.+    */+    Z3_bool Z3_API Z3_theory_is_decl(__in Z3_theory t, __in Z3_func_decl d);+    +    /**+       \brief Return the number of expressions of the given theory in+       the logical context. These are the expressions notified using the+       callback #Z3_set_new_elem_callback.+    */+    unsigned Z3_API Z3_theory_get_num_elems(__in Z3_theory t);+    +    /**+       \brief Return the i-th elem of the given theory in the logical context.+       +       \see Z3_theory_get_num_elems+    */+    Z3_ast Z3_API Z3_theory_get_elem(__in Z3_theory t, __in unsigned i);++    /**+       \brief Return the number of theory applications in the logical+       context. These are the expressions notified using the callback+       #Z3_set_new_app_callback.+    */+    unsigned Z3_API Z3_theory_get_num_apps(__in Z3_theory t);+    +    /**+       \brief Return the i-th application of the given theory in the logical context.+       +       \see Z3_theory_get_num_apps+    */+    Z3_ast Z3_API Z3_theory_get_app(__in Z3_theory t, __in unsigned i);++    /*@}*/++    +    /** +        @name Fixedpoint and Datalog facilities+    */+    /*@{*/+    /** +       \brief Add a universal Horn clause as a named rule.+       The \c horn_rule should be of the form:+ +       \code+           horn_rule ::= (forall (bound-vars) horn_rule)+                      |  (=> atoms horn_rule)+                      |  atom+       \endcode+    */+    void Z3_API Z3_datalog_add_rule(__in Z3_context c, __in Z3_ast horn_rule, __in Z3_symbol name);+    +    /** +        \brief Pose a query against the asserted rules.++        The query returns a formula that encodes the set of+        satisfying instances for the query.++        \code+           query ::= (exists (bound-vars) query)+                 |  literals +        \endcode++    */+    Z3_ast Z3_API Z3_datalog_query(__in Z3_context c,  __in Z3_ast q);++    /**+       \brief Configure the predicate representation.++       It sets the predicate to use a set of domains given by the list of symbols.+       The domains given by the list of symbols must belong to a set+       of built-in domains.+    */++    void Z3_API Z3_datalog_set_predicate_representation(+        __in Z3_context c, __in Z3_func_decl f, +        __in unsigned num_relations, +        __in_ecount(num_relations) Z3_symbol const relation_kinds[]);++    /**+         \brief Parse a file in Datalog format and process the queries in it.+    */+    void Z3_API Z3_datalog_parse_file(__in Z3_context c, Z3_string filename);++    /**+         \brief The following utilities allows adding user-defined domains.+    */++#ifndef CAMLIDL+    typedef void Z3_datalog_reduce_assign_callback_fptr(+        __in Z3_context, __in Z3_func_decl, +        __in unsigned, __in Z3_ast const [], +        __in unsigned, __in Z3_ast const []); ++    typedef void Z3_datalog_reduce_app_callback_fptr(+        __in Z3_context, __in Z3_func_decl, +        __in unsigned, __in Z3_ast const [], +        __out Z3_ast*);+++    /**+         \brief Initialize the context with a user-defined state.++    */+    void Z3_API Z3_datalog_init(__in Z3_context c, __in void* state);++    /**+         \brief Retrieve the user-define state.+    */+    void* Z3_API Z3_datalog_get_context(__in Z3_context c);+    ++    /**+         \brief Register a callback to destructive updates.++         Registers are identified with terms encoded as fresh constants,          +    */+    void Z3_API Z3_datalog_set_reduce_assign_callback(+        __in Z3_context c, __in Z3_datalog_reduce_assign_callback_fptr cb);++    /**+         \brief Register a callback for buildling terms based on +         the relational operators.+    */+    void Z3_API Z3_datalog_set_reduce_app_callback(+        __in Z3_context c, __in Z3_datalog_reduce_app_callback_fptr cb);++#endif++    /*@}*/+    +#ifndef CAMLIDL+#ifdef __cplusplus+};+#endif // __cplusplus+#else+}+#endif // CAMLIDL++/*@}*/
+ external/z3/lib/libz3-a-32b view

file too large to diff

+ external/z3/lib/libz3-a-64b view

file too large to diff

+ external/z3/lib/libz3-so-32b view

file too large to diff

+ external/z3/lib/libz3-so-64b view

file too large to diff

+ external/z3/ocaml/build-lib.sh view
@@ -0,0 +1,8 @@+#!/bin/bash++gcc -I../include -I`ocamlc -where` -c z3_stubs.c -c z3_theory_stubs.c+ocamlopt -c z3.mli+ocamlopt -c z3.ml+ar rcs libz3stubs.a z3_stubs.o z3_theory_stubs.o+ranlib libz3stubs.a+ocamlopt -a -o z3.cmxa -cclib -lz3stubs z3.cmx
+ external/z3/ocaml/z3.ml view
@@ -0,0 +1,1499 @@+(* File generated from z3.idl *)
+
+type config
+and context
+and sort
+and func_decl
+and ast
+and app
+and pattern
+and symbol
+and parameter
+and model
+and literals
+and constructor
+and constructor_list
+and theory
+and theory_data
+and enum_1 =
+  | L_FALSE
+  | L_UNDEF
+  | L_TRUE
+and lbool = enum_1
+and enum_2 =
+  | INT_SYMBOL
+  | STRING_SYMBOL
+and symbol_kind = enum_2
+and enum_3 =
+  | PARAMETER_INT
+  | PARAMETER_DOUBLE
+  | PARAMETER_RATIONAL
+  | PARAMETER_SYMBOL
+  | PARAMETER_SORT
+  | PARAMETER_AST
+  | PARAMETER_FUNC_DECL
+and parameter_kind = enum_3
+and enum_4 =
+  | UNINTERPRETED_SORT
+  | BOOL_SORT
+  | INT_SORT
+  | REAL_SORT
+  | BV_SORT
+  | ARRAY_SORT
+  | DATATYPE_SORT
+  | RELATION_SORT
+  | FINITE_DOMAIN_SORT
+  | UNKNOWN_SORT
+and sort_kind = enum_4
+and enum_5 =
+  | NUMERAL_AST
+  | APP_AST
+  | VAR_AST
+  | QUANTIFIER_AST
+  | UNKNOWN_AST
+and ast_kind = enum_5
+and enum_6 =
+  | OP_TRUE
+  | OP_FALSE
+  | OP_EQ
+  | OP_DISTINCT
+  | OP_ITE
+  | OP_AND
+  | OP_OR
+  | OP_IFF
+  | OP_XOR
+  | OP_NOT
+  | OP_IMPLIES
+  | OP_OEQ
+  | OP_ANUM
+  | OP_LE
+  | OP_GE
+  | OP_LT
+  | OP_GT
+  | OP_ADD
+  | OP_SUB
+  | OP_UMINUS
+  | OP_MUL
+  | OP_DIV
+  | OP_IDIV
+  | OP_REM
+  | OP_MOD
+  | OP_TO_REAL
+  | OP_TO_INT
+  | OP_IS_INT
+  | OP_STORE
+  | OP_SELECT
+  | OP_CONST_ARRAY
+  | OP_ARRAY_MAP
+  | OP_ARRAY_DEFAULT
+  | OP_SET_UNION
+  | OP_SET_INTERSECT
+  | OP_SET_DIFFERENCE
+  | OP_SET_COMPLEMENT
+  | OP_SET_SUBSET
+  | OP_AS_ARRAY
+  | OP_BNUM
+  | OP_BIT1
+  | OP_BIT0
+  | OP_BNEG
+  | OP_BADD
+  | OP_BSUB
+  | OP_BMUL
+  | OP_BSDIV
+  | OP_BUDIV
+  | OP_BSREM
+  | OP_BUREM
+  | OP_BSMOD
+  | OP_BSDIV0
+  | OP_BUDIV0
+  | OP_BSREM0
+  | OP_BUREM0
+  | OP_BSMOD0
+  | OP_ULEQ
+  | OP_SLEQ
+  | OP_UGEQ
+  | OP_SGEQ
+  | OP_ULT
+  | OP_SLT
+  | OP_UGT
+  | OP_SGT
+  | OP_BAND
+  | OP_BOR
+  | OP_BNOT
+  | OP_BXOR
+  | OP_BNAND
+  | OP_BNOR
+  | OP_BXNOR
+  | OP_CONCAT
+  | OP_SIGN_EXT
+  | OP_ZERO_EXT
+  | OP_EXTRACT
+  | OP_REPEAT
+  | OP_BREDOR
+  | OP_BREDAND
+  | OP_BCOMP
+  | OP_BSHL
+  | OP_BLSHR
+  | OP_BASHR
+  | OP_ROTATE_LEFT
+  | OP_ROTATE_RIGHT
+  | OP_EXT_ROTATE_LEFT
+  | OP_EXT_ROTATE_RIGHT
+  | OP_INT2BV
+  | OP_BV2INT
+  | OP_CARRY
+  | OP_XOR3
+  | OP_PR_UNDEF
+  | OP_PR_TRUE
+  | OP_PR_ASSERTED
+  | OP_PR_GOAL
+  | OP_PR_MODUS_PONENS
+  | OP_PR_REFLEXIVITY
+  | OP_PR_SYMMETRY
+  | OP_PR_TRANSITIVITY
+  | OP_PR_TRANSITIVITY_STAR
+  | OP_PR_MONOTONICITY
+  | OP_PR_QUANT_INTRO
+  | OP_PR_DISTRIBUTIVITY
+  | OP_PR_AND_ELIM
+  | OP_PR_NOT_OR_ELIM
+  | OP_PR_REWRITE
+  | OP_PR_REWRITE_STAR
+  | OP_PR_PULL_QUANT
+  | OP_PR_PULL_QUANT_STAR
+  | OP_PR_PUSH_QUANT
+  | OP_PR_ELIM_UNUSED_VARS
+  | OP_PR_DER
+  | OP_PR_QUANT_INST
+  | OP_PR_HYPOTHESIS
+  | OP_PR_LEMMA
+  | OP_PR_UNIT_RESOLUTION
+  | OP_PR_IFF_TRUE
+  | OP_PR_IFF_FALSE
+  | OP_PR_COMMUTATIVITY
+  | OP_PR_DEF_AXIOM
+  | OP_PR_DEF_INTRO
+  | OP_PR_APPLY_DEF
+  | OP_PR_IFF_OEQ
+  | OP_PR_NNF_POS
+  | OP_PR_NNF_NEG
+  | OP_PR_NNF_STAR
+  | OP_PR_CNF_STAR
+  | OP_PR_SKOLEMIZE
+  | OP_PR_MODUS_PONENS_OEQ
+  | OP_PR_TH_LEMMA
+  | OP_RA_STORE
+  | OP_RA_EMPTY
+  | OP_RA_IS_EMPTY
+  | OP_RA_JOIN
+  | OP_RA_UNION
+  | OP_RA_WIDEN
+  | OP_RA_PROJECT
+  | OP_RA_FILTER
+  | OP_RA_NEGATION_FILTER
+  | OP_RA_RENAME
+  | OP_RA_COMPLEMENT
+  | OP_RA_SELECT
+  | OP_RA_CLONE
+  | OP_FD_LT
+  | OP_UNINTERPRETED
+and decl_kind = enum_6
+and enum_7 =
+  | NO_FAILURE
+  | UNKNOWN
+  | TIMEOUT
+  | MEMOUT_WATERMARK
+  | CANCELED
+  | NUM_CONFLICTS
+  | THEORY
+  | QUANTIFIERS
+and search_failure = enum_7
+and enum_8 =
+  | PRINT_SMTLIB_FULL
+  | PRINT_LOW_LEVEL
+  | PRINT_SMTLIB_COMPLIANT
+  | PRINT_SMTLIB2_COMPLIANT
+and ast_print_mode = enum_8
+
+external mk_config : unit -> config
+	= "camlidl_z3_Z3_mk_config"
+
+external del_config : config -> unit
+	= "camlidl_z3_Z3_del_config"
+
+external set_param_value : config -> string -> string -> unit
+	= "camlidl_z3_Z3_set_param_value"
+
+external mk_context : config -> context
+	= "camlidl_z3_Z3_mk_context"
+
+external mk_context_rc : config -> context
+	= "camlidl_z3_Z3_mk_context_rc"
+
+external set_logic : context -> string -> bool
+	= "camlidl_z3_Z3_set_logic"
+
+external del_context : context -> unit
+	= "camlidl_z3_Z3_del_context"
+
+external inc_ref : context -> ast -> unit
+	= "camlidl_z3_Z3_inc_ref"
+
+external dec_ref : context -> ast -> unit
+	= "camlidl_z3_Z3_dec_ref"
+
+external trace_to_file : context -> string -> bool
+	= "camlidl_z3_Z3_trace_to_file"
+
+external trace_to_stderr : context -> unit
+	= "camlidl_z3_Z3_trace_to_stderr"
+
+external trace_to_stdout : context -> unit
+	= "camlidl_z3_Z3_trace_to_stdout"
+
+external trace_off : context -> unit
+	= "camlidl_z3_Z3_trace_off"
+
+external toggle_warning_messages : bool -> unit
+	= "camlidl_z3_Z3_toggle_warning_messages"
+
+external update_param_value : context -> string -> string -> unit
+	= "camlidl_z3_Z3_update_param_value"
+
+external mk_int_symbol : context -> int -> symbol
+	= "camlidl_z3_Z3_mk_int_symbol"
+
+external mk_string_symbol : context -> string -> symbol
+	= "camlidl_z3_Z3_mk_string_symbol"
+
+external is_eq_sort : context -> sort -> sort -> bool
+	= "camlidl_z3_Z3_is_eq_sort"
+
+external mk_uninterpreted_sort : context -> symbol -> sort
+	= "camlidl_z3_Z3_mk_uninterpreted_sort"
+
+external mk_bool_sort : context -> sort
+	= "camlidl_z3_Z3_mk_bool_sort"
+
+external mk_int_sort : context -> sort
+	= "camlidl_z3_Z3_mk_int_sort"
+
+external mk_real_sort : context -> sort
+	= "camlidl_z3_Z3_mk_real_sort"
+
+external mk_bv_sort : context -> int -> sort
+	= "camlidl_z3_Z3_mk_bv_sort"
+
+external mk_array_sort : context -> sort -> sort -> sort
+	= "camlidl_z3_Z3_mk_array_sort"
+
+external mk_tuple_sort : context -> symbol -> symbol array -> sort array -> sort * func_decl * func_decl array
+	= "camlidl_z3_Z3_mk_tuple_sort"
+
+external mk_enumeration_sort : context -> symbol -> symbol array -> sort * func_decl array * func_decl array
+	= "camlidl_z3_Z3_mk_enumeration_sort"
+
+external mk_list_sort : context -> symbol -> sort -> sort * func_decl * func_decl * func_decl * func_decl * func_decl * func_decl
+	= "camlidl_z3_Z3_mk_list_sort"
+
+external mk_constructor : context -> symbol -> symbol -> symbol array -> sort array -> int array -> constructor
+	= "camlidl_z3_Z3_mk_constructor_bytecode" "camlidl_z3_Z3_mk_constructor"
+
+external query_constructor : context -> constructor -> int -> func_decl * func_decl * func_decl array
+	= "camlidl_z3_Z3_query_constructor"
+
+external del_constructor : context -> constructor -> unit
+	= "camlidl_z3_Z3_del_constructor"
+
+external mk_datatype : context -> symbol -> constructor array -> sort * constructor array
+	= "camlidl_z3_Z3_mk_datatype"
+
+external mk_constructor_list : context -> constructor array -> constructor_list
+	= "camlidl_z3_Z3_mk_constructor_list"
+
+external del_constructor_list : context -> constructor_list -> unit
+	= "camlidl_z3_Z3_del_constructor_list"
+
+external mk_datatypes : context -> symbol array -> constructor_list array -> sort array * constructor_list array
+	= "camlidl_z3_Z3_mk_datatypes"
+
+external mk_injective_function : context -> symbol -> sort array -> sort -> func_decl
+	= "camlidl_z3_Z3_mk_injective_function"
+
+external is_eq_ast : context -> ast -> ast -> bool
+	= "camlidl_z3_Z3_is_eq_ast"
+
+external is_eq_func_decl : context -> func_decl -> func_decl -> bool
+	= "camlidl_z3_Z3_is_eq_func_decl"
+
+external mk_func_decl : context -> symbol -> sort array -> sort -> func_decl
+	= "camlidl_z3_Z3_mk_func_decl"
+
+external mk_app : context -> func_decl -> ast array -> ast
+	= "camlidl_z3_Z3_mk_app"
+
+external mk_const : context -> symbol -> sort -> ast
+	= "camlidl_z3_Z3_mk_const"
+
+external mk_label : context -> symbol -> bool -> ast -> ast
+	= "camlidl_z3_Z3_mk_label"
+
+external mk_fresh_func_decl : context -> string -> sort array -> sort -> func_decl
+	= "camlidl_z3_Z3_mk_fresh_func_decl"
+
+external mk_fresh_const : context -> string -> sort -> ast
+	= "camlidl_z3_Z3_mk_fresh_const"
+
+external mk_true : context -> ast
+	= "camlidl_z3_Z3_mk_true"
+
+external mk_false : context -> ast
+	= "camlidl_z3_Z3_mk_false"
+
+external mk_eq : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_eq"
+
+external mk_distinct : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_distinct"
+
+external mk_not : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_not"
+
+external mk_ite : context -> ast -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_ite"
+
+external mk_iff : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_iff"
+
+external mk_implies : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_implies"
+
+external mk_xor : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_xor"
+
+external mk_and : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_and"
+
+external mk_or : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_or"
+
+external mk_add : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_add"
+
+external mk_mul : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_mul"
+
+external mk_sub : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_sub"
+
+external mk_unary_minus : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_unary_minus"
+
+external mk_div : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_div"
+
+external mk_mod : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_mod"
+
+external mk_rem : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_rem"
+
+external mk_lt : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_lt"
+
+external mk_le : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_le"
+
+external mk_gt : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_gt"
+
+external mk_ge : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_ge"
+
+external mk_int2real : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_int2real"
+
+external mk_real2int : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_real2int"
+
+external mk_is_int : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_is_int"
+
+external mk_bvnot : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvnot"
+
+external mk_bvredand : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvredand"
+
+external mk_bvredor : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvredor"
+
+external mk_bvand : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvand"
+
+external mk_bvor : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvor"
+
+external mk_bvxor : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvxor"
+
+external mk_bvnand : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvnand"
+
+external mk_bvnor : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvnor"
+
+external mk_bvxnor : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvxnor"
+
+external mk_bvneg : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvneg"
+
+external mk_bvadd : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvadd"
+
+external mk_bvsub : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsub"
+
+external mk_bvmul : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvmul"
+
+external mk_bvudiv : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvudiv"
+
+external mk_bvsdiv : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsdiv"
+
+external mk_bvurem : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvurem"
+
+external mk_bvsrem : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsrem"
+
+external mk_bvsmod : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsmod"
+
+external mk_bvult : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvult"
+
+external mk_bvslt : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvslt"
+
+external mk_bvule : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvule"
+
+external mk_bvsle : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsle"
+
+external mk_bvuge : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvuge"
+
+external mk_bvsge : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsge"
+
+external mk_bvugt : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvugt"
+
+external mk_bvsgt : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsgt"
+
+external mk_concat : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_concat"
+
+external mk_extract : context -> int -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_extract"
+
+external mk_sign_ext : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_sign_ext"
+
+external mk_zero_ext : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_zero_ext"
+
+external mk_repeat : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_repeat"
+
+external mk_bvshl : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvshl"
+
+external mk_bvlshr : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvlshr"
+
+external mk_bvashr : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvashr"
+
+external mk_rotate_left : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_rotate_left"
+
+external mk_rotate_right : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_rotate_right"
+
+external mk_ext_rotate_left : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_ext_rotate_left"
+
+external mk_ext_rotate_right : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_ext_rotate_right"
+
+external mk_int2bv : context -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_int2bv"
+
+external mk_bv2int : context -> ast -> bool -> ast
+	= "camlidl_z3_Z3_mk_bv2int"
+
+external mk_bvadd_no_overflow : context -> ast -> ast -> bool -> ast
+	= "camlidl_z3_Z3_mk_bvadd_no_overflow"
+
+external mk_bvadd_no_underflow : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvadd_no_underflow"
+
+external mk_bvsub_no_overflow : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsub_no_overflow"
+
+external mk_bvsub_no_underflow : context -> ast -> ast -> bool -> ast
+	= "camlidl_z3_Z3_mk_bvsub_no_underflow"
+
+external mk_bvsdiv_no_overflow : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvsdiv_no_overflow"
+
+external mk_bvneg_no_overflow : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvneg_no_overflow"
+
+external mk_bvmul_no_overflow : context -> ast -> ast -> bool -> ast
+	= "camlidl_z3_Z3_mk_bvmul_no_overflow"
+
+external mk_bvmul_no_underflow : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_bvmul_no_underflow"
+
+external mk_select : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_select"
+
+external mk_store : context -> ast -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_store"
+
+external mk_const_array : context -> sort -> ast -> ast
+	= "camlidl_z3_Z3_mk_const_array"
+
+external mk_map : context -> func_decl -> int -> ast -> ast
+	= "camlidl_z3_Z3_mk_map"
+
+external mk_array_default : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_array_default"
+
+external mk_set_sort : context -> sort -> sort
+	= "camlidl_z3_Z3_mk_set_sort"
+
+external mk_empty_set : context -> sort -> ast
+	= "camlidl_z3_Z3_mk_empty_set"
+
+external mk_full_set : context -> sort -> ast
+	= "camlidl_z3_Z3_mk_full_set"
+
+external mk_set_add : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_add"
+
+external mk_set_del : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_del"
+
+external mk_set_union : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_set_union"
+
+external mk_set_intersect : context -> ast array -> ast
+	= "camlidl_z3_Z3_mk_set_intersect"
+
+external mk_set_difference : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_difference"
+
+external mk_set_complement : context -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_complement"
+
+external mk_set_member : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_member"
+
+external mk_set_subset : context -> ast -> ast -> ast
+	= "camlidl_z3_Z3_mk_set_subset"
+
+external mk_numeral : context -> string -> sort -> ast
+	= "camlidl_z3_Z3_mk_numeral"
+
+external mk_real : context -> int -> int -> ast
+	= "camlidl_z3_Z3_mk_real"
+
+external mk_int : context -> int -> sort -> ast
+	= "camlidl_z3_Z3_mk_int"
+
+external mk_unsigned_int : context -> int -> sort -> ast
+	= "camlidl_z3_Z3_mk_unsigned_int"
+
+external mk_pattern : context -> ast array -> pattern
+	= "camlidl_z3_Z3_mk_pattern"
+
+external mk_bound : context -> int -> sort -> ast
+	= "camlidl_z3_Z3_mk_bound"
+
+external mk_forall : context -> int -> pattern array -> sort array -> symbol array -> ast -> ast
+	= "camlidl_z3_Z3_mk_forall_bytecode" "camlidl_z3_Z3_mk_forall"
+
+external mk_exists : context -> int -> pattern array -> sort array -> symbol array -> ast -> ast
+	= "camlidl_z3_Z3_mk_exists_bytecode" "camlidl_z3_Z3_mk_exists"
+
+external mk_quantifier : context -> bool -> int -> pattern array -> sort array -> symbol array -> ast -> ast
+	= "camlidl_z3_Z3_mk_quantifier_bytecode" "camlidl_z3_Z3_mk_quantifier"
+
+external mk_quantifier_ex : context -> bool -> int -> symbol -> symbol -> pattern array -> ast array -> sort array -> symbol array -> ast -> ast
+	= "camlidl_z3_Z3_mk_quantifier_ex_bytecode" "camlidl_z3_Z3_mk_quantifier_ex"
+
+external mk_forall_const : context -> int -> app array -> pattern array -> ast -> ast
+	= "camlidl_z3_Z3_mk_forall_const"
+
+external mk_exists_const : context -> int -> app array -> pattern array -> ast -> ast
+	= "camlidl_z3_Z3_mk_exists_const"
+
+external mk_quantifier_const : context -> bool -> int -> app array -> pattern array -> ast -> ast
+	= "camlidl_z3_Z3_mk_quantifier_const_bytecode" "camlidl_z3_Z3_mk_quantifier_const"
+
+external mk_quantifier_const_ex : context -> bool -> int -> symbol -> symbol -> app array -> pattern array -> ast array -> ast -> ast
+	= "camlidl_z3_Z3_mk_quantifier_const_ex_bytecode" "camlidl_z3_Z3_mk_quantifier_const_ex"
+
+external get_ast_id : context -> ast -> int
+	= "camlidl_z3_Z3_get_ast_id"
+
+external get_func_decl_id : context -> func_decl -> int
+	= "camlidl_z3_Z3_get_func_decl_id"
+
+external get_sort_id : context -> sort -> int
+	= "camlidl_z3_Z3_get_sort_id"
+
+external is_well_sorted : context -> ast -> bool
+	= "camlidl_z3_Z3_is_well_sorted"
+
+external get_symbol_kind : context -> symbol -> symbol_kind
+	= "camlidl_z3_Z3_get_symbol_kind"
+
+external get_symbol_int : context -> symbol -> int
+	= "camlidl_z3_Z3_get_symbol_int"
+
+external get_symbol_string : context -> symbol -> string
+	= "camlidl_z3_Z3_get_symbol_string"
+
+external get_ast_kind : context -> ast -> ast_kind
+	= "camlidl_z3_Z3_get_ast_kind"
+
+external get_numeral_string : context -> ast -> string
+	= "camlidl_z3_Z3_get_numeral_string"
+
+external get_numeral_small : context -> ast -> bool * int64 * int64
+	= "camlidl_z3_Z3_get_numeral_small"
+
+external get_numeral_int : context -> ast -> bool * int
+	= "camlidl_z3_Z3_get_numeral_int"
+
+external get_numeral_uint : context -> ast -> bool * int
+	= "camlidl_z3_Z3_get_numeral_uint"
+
+external get_bool_value : context -> ast -> lbool
+	= "camlidl_z3_Z3_get_bool_value"
+
+external get_app_decl : context -> app -> func_decl
+	= "camlidl_z3_Z3_get_app_decl"
+
+external get_app_num_args : context -> app -> int
+	= "camlidl_z3_Z3_get_app_num_args"
+
+external get_app_arg : context -> app -> int -> ast
+	= "camlidl_z3_Z3_get_app_arg"
+
+external get_index_value : context -> ast -> int
+	= "camlidl_z3_Z3_get_index_value"
+
+external is_quantifier_forall : context -> ast -> bool
+	= "camlidl_z3_Z3_is_quantifier_forall"
+
+external get_quantifier_weight : context -> ast -> int
+	= "camlidl_z3_Z3_get_quantifier_weight"
+
+external get_quantifier_num_patterns : context -> ast -> int
+	= "camlidl_z3_Z3_get_quantifier_num_patterns"
+
+external get_quantifier_pattern_ast : context -> ast -> int -> pattern
+	= "camlidl_z3_Z3_get_quantifier_pattern_ast"
+
+external get_quantifier_num_no_patterns : context -> ast -> int
+	= "camlidl_z3_Z3_get_quantifier_num_no_patterns"
+
+external get_quantifier_no_pattern_ast : context -> ast -> int -> ast
+	= "camlidl_z3_Z3_get_quantifier_no_pattern_ast"
+
+external get_quantifier_bound_name : context -> ast -> int -> symbol
+	= "camlidl_z3_Z3_get_quantifier_bound_name"
+
+external get_quantifier_bound_sort : context -> ast -> int -> sort
+	= "camlidl_z3_Z3_get_quantifier_bound_sort"
+
+external get_quantifier_body : context -> ast -> ast
+	= "camlidl_z3_Z3_get_quantifier_body"
+
+external get_quantifier_num_bound : context -> ast -> int
+	= "camlidl_z3_Z3_get_quantifier_num_bound"
+
+external get_decl_name : context -> func_decl -> symbol
+	= "camlidl_z3_Z3_get_decl_name"
+
+external get_decl_num_parameters : context -> func_decl -> int
+	= "camlidl_z3_Z3_get_decl_num_parameters"
+
+external get_decl_parameter_kind : context -> func_decl -> int -> parameter_kind
+	= "camlidl_z3_Z3_get_decl_parameter_kind"
+
+external get_decl_int_parameter : context -> func_decl -> int -> int
+	= "camlidl_z3_Z3_get_decl_int_parameter"
+
+external get_decl_double_parameter : context -> func_decl -> int -> float
+	= "camlidl_z3_Z3_get_decl_double_parameter"
+
+external get_decl_symbol_parameter : context -> func_decl -> int -> symbol
+	= "camlidl_z3_Z3_get_decl_symbol_parameter"
+
+external get_decl_sort_parameter : context -> func_decl -> int -> sort
+	= "camlidl_z3_Z3_get_decl_sort_parameter"
+
+external get_decl_ast_parameter : context -> func_decl -> int -> ast
+	= "camlidl_z3_Z3_get_decl_ast_parameter"
+
+external get_decl_func_decl_parameter : context -> func_decl -> int -> func_decl
+	= "camlidl_z3_Z3_get_decl_func_decl_parameter"
+
+external get_decl_rational_parameter : context -> func_decl -> int -> string
+	= "camlidl_z3_Z3_get_decl_rational_parameter"
+
+external get_sort_name : context -> sort -> symbol
+	= "camlidl_z3_Z3_get_sort_name"
+
+external get_sort : context -> ast -> sort
+	= "camlidl_z3_Z3_get_sort"
+
+external get_domain_size : context -> func_decl -> int
+	= "camlidl_z3_Z3_get_domain_size"
+
+external get_domain : context -> func_decl -> int -> sort
+	= "camlidl_z3_Z3_get_domain"
+
+external get_range : context -> func_decl -> sort
+	= "camlidl_z3_Z3_get_range"
+
+external get_sort_kind : context -> sort -> sort_kind
+	= "camlidl_z3_Z3_get_sort_kind"
+
+external get_bv_sort_size : context -> sort -> int
+	= "camlidl_z3_Z3_get_bv_sort_size"
+
+external get_array_sort_domain : context -> sort -> sort
+	= "camlidl_z3_Z3_get_array_sort_domain"
+
+external get_array_sort_range : context -> sort -> sort
+	= "camlidl_z3_Z3_get_array_sort_range"
+
+external get_tuple_sort_mk_decl : context -> sort -> func_decl
+	= "camlidl_z3_Z3_get_tuple_sort_mk_decl"
+
+external get_decl_kind : context -> func_decl -> decl_kind
+	= "camlidl_z3_Z3_get_decl_kind"
+
+external get_tuple_sort_num_fields : context -> sort -> int
+	= "camlidl_z3_Z3_get_tuple_sort_num_fields"
+
+external get_tuple_sort_field_decl : context -> sort -> int -> func_decl
+	= "camlidl_z3_Z3_get_tuple_sort_field_decl"
+
+external get_datatype_sort_num_constructors : context -> sort -> int
+	= "camlidl_z3_Z3_get_datatype_sort_num_constructors"
+
+external get_datatype_sort_constructor : context -> sort -> int -> func_decl
+	= "camlidl_z3_Z3_get_datatype_sort_constructor"
+
+external get_datatype_sort_recognizer : context -> sort -> int -> func_decl
+	= "camlidl_z3_Z3_get_datatype_sort_recognizer"
+
+external get_datatype_sort_constructor_accessor : context -> sort -> int -> int -> func_decl
+	= "camlidl_z3_Z3_get_datatype_sort_constructor_accessor"
+
+external get_relation_arity : context -> sort -> int
+	= "camlidl_z3_Z3_get_relation_arity"
+
+external get_relation_column : context -> sort -> int -> sort
+	= "camlidl_z3_Z3_get_relation_column"
+
+external get_pattern_num_terms : context -> pattern -> int
+	= "camlidl_z3_Z3_get_pattern_num_terms"
+
+external get_pattern : context -> pattern -> int -> ast
+	= "camlidl_z3_Z3_get_pattern"
+
+external simplify : context -> ast -> ast
+	= "camlidl_z3_Z3_simplify"
+
+external update_term : context -> ast -> ast array -> ast
+	= "camlidl_z3_Z3_update_term"
+
+external substitute : context -> ast -> ast array -> ast array -> ast
+	= "camlidl_z3_Z3_substitute"
+
+external substitute_vars : context -> ast -> ast array -> ast
+	= "camlidl_z3_Z3_substitute_vars"
+
+external sort_to_ast : context -> sort -> ast
+	= "camlidl_z3_Z3_sort_to_ast"
+
+external func_decl_to_ast : context -> func_decl -> ast
+	= "camlidl_z3_Z3_func_decl_to_ast"
+
+external pattern_to_ast : context -> pattern -> ast
+	= "camlidl_z3_Z3_pattern_to_ast"
+
+external app_to_ast : context -> app -> ast
+	= "camlidl_z3_Z3_app_to_ast"
+
+external to_app : context -> ast -> app
+	= "camlidl_z3_Z3_to_app"
+
+external push : context -> unit
+	= "camlidl_z3_Z3_push"
+
+external pop : context -> int -> unit
+	= "camlidl_z3_Z3_pop"
+
+external get_num_scopes : context -> int
+	= "camlidl_z3_Z3_get_num_scopes"
+
+external persist_ast : context -> ast -> int -> unit
+	= "camlidl_z3_Z3_persist_ast"
+
+external assert_cnstr : context -> ast -> unit
+	= "camlidl_z3_Z3_assert_cnstr"
+
+external check_and_get_model : context -> lbool * model
+	= "camlidl_z3_Z3_check_and_get_model"
+
+external check : context -> lbool
+	= "camlidl_z3_Z3_check"
+
+external check_assumptions : context -> ast array -> int -> ast array -> lbool * model * ast * int * ast array
+	= "camlidl_z3_Z3_check_assumptions"
+
+external get_implied_equalities : context -> ast array -> lbool * int array
+	= "camlidl_z3_Z3_get_implied_equalities"
+
+external del_model : context -> model -> unit
+	= "camlidl_z3_Z3_del_model"
+
+external soft_check_cancel : context -> unit
+	= "camlidl_z3_Z3_soft_check_cancel"
+
+external get_search_failure : context -> search_failure
+	= "camlidl_z3_Z3_get_search_failure"
+
+external get_relevant_labels : context -> literals
+	= "camlidl_z3_Z3_get_relevant_labels"
+
+external get_relevant_literals : context -> literals
+	= "camlidl_z3_Z3_get_relevant_literals"
+
+external get_guessed_literals : context -> literals
+	= "camlidl_z3_Z3_get_guessed_literals"
+
+external del_literals : context -> literals -> unit
+	= "camlidl_z3_Z3_del_literals"
+
+external get_num_literals : context -> literals -> int
+	= "camlidl_z3_Z3_get_num_literals"
+
+external get_label_symbol : context -> literals -> int -> symbol
+	= "camlidl_z3_Z3_get_label_symbol"
+
+external get_literal : context -> literals -> int -> ast
+	= "camlidl_z3_Z3_get_literal"
+
+external disable_literal : context -> literals -> int -> unit
+	= "camlidl_z3_Z3_disable_literal"
+
+external block_literals : context -> literals -> unit
+	= "camlidl_z3_Z3_block_literals"
+
+external get_model_num_constants : context -> model -> int
+	= "camlidl_z3_Z3_get_model_num_constants"
+
+external get_model_constant : context -> model -> int -> func_decl
+	= "camlidl_z3_Z3_get_model_constant"
+
+external eval_func_decl : context -> model -> func_decl -> bool * ast
+	= "camlidl_z3_Z3_eval_func_decl"
+
+external is_array_value : context -> model -> ast -> bool * int
+	= "camlidl_z3_Z3_is_array_value"
+
+external get_array_value : context -> model -> ast -> ast array -> ast array -> ast array * ast array * ast
+	= "camlidl_z3_Z3_get_array_value"
+
+external get_model_num_funcs : context -> model -> int
+	= "camlidl_z3_Z3_get_model_num_funcs"
+
+external get_model_func_decl : context -> model -> int -> func_decl
+	= "camlidl_z3_Z3_get_model_func_decl"
+
+external get_model_func_else : context -> model -> int -> ast
+	= "camlidl_z3_Z3_get_model_func_else"
+
+external get_model_func_num_entries : context -> model -> int -> int
+	= "camlidl_z3_Z3_get_model_func_num_entries"
+
+external get_model_func_entry_num_args : context -> model -> int -> int -> int
+	= "camlidl_z3_Z3_get_model_func_entry_num_args"
+
+external get_model_func_entry_arg : context -> model -> int -> int -> int -> ast
+	= "camlidl_z3_Z3_get_model_func_entry_arg"
+
+external get_model_func_entry_value : context -> model -> int -> int -> ast
+	= "camlidl_z3_Z3_get_model_func_entry_value"
+
+external eval : context -> model -> ast -> bool * ast
+	= "camlidl_z3_Z3_eval"
+
+external eval_decl : context -> model -> func_decl -> ast array -> bool * ast
+	= "camlidl_z3_Z3_eval_decl"
+
+external open_log : context -> string -> bool
+	= "camlidl_z3_Z3_open_log"
+
+external append_log : context -> string -> unit
+	= "camlidl_z3_Z3_append_log"
+
+external close_log : context -> unit
+	= "camlidl_z3_Z3_close_log"
+
+external set_ast_print_mode : context -> ast_print_mode -> unit
+	= "camlidl_z3_Z3_set_ast_print_mode"
+
+external ast_to_string : context -> ast -> string
+	= "camlidl_z3_Z3_ast_to_string"
+
+external pattern_to_string : context -> pattern -> string
+	= "camlidl_z3_Z3_pattern_to_string"
+
+external sort_to_string : context -> sort -> string
+	= "camlidl_z3_Z3_sort_to_string"
+
+external func_decl_to_string : context -> func_decl -> string
+	= "camlidl_z3_Z3_func_decl_to_string"
+
+external model_to_string : context -> model -> string
+	= "camlidl_z3_Z3_model_to_string"
+
+external benchmark_to_smtlib_string : context -> string -> string -> string -> string -> ast array -> ast -> string
+	= "camlidl_z3_Z3_benchmark_to_smtlib_string_bytecode" "camlidl_z3_Z3_benchmark_to_smtlib_string"
+
+external context_to_string : context -> string
+	= "camlidl_z3_Z3_context_to_string"
+
+external statistics_to_string : context -> string
+	= "camlidl_z3_Z3_statistics_to_string"
+
+external get_context_assignment : context -> ast
+	= "camlidl_z3_Z3_get_context_assignment"
+
+external parse_smtlib_string : context -> string -> symbol array -> sort array -> symbol array -> func_decl array -> unit
+	= "camlidl_z3_Z3_parse_smtlib_string_bytecode" "camlidl_z3_Z3_parse_smtlib_string"
+
+external parse_smtlib_file : context -> string -> symbol array -> sort array -> symbol array -> func_decl array -> unit
+	= "camlidl_z3_Z3_parse_smtlib_file_bytecode" "camlidl_z3_Z3_parse_smtlib_file"
+
+external get_smtlib_num_formulas : context -> int
+	= "camlidl_z3_Z3_get_smtlib_num_formulas"
+
+external get_smtlib_formula : context -> int -> ast
+	= "camlidl_z3_Z3_get_smtlib_formula"
+
+external get_smtlib_num_assumptions : context -> int
+	= "camlidl_z3_Z3_get_smtlib_num_assumptions"
+
+external get_smtlib_assumption : context -> int -> ast
+	= "camlidl_z3_Z3_get_smtlib_assumption"
+
+external get_smtlib_num_decls : context -> int
+	= "camlidl_z3_Z3_get_smtlib_num_decls"
+
+external get_smtlib_decl : context -> int -> func_decl
+	= "camlidl_z3_Z3_get_smtlib_decl"
+
+external get_smtlib_num_sorts : context -> int
+	= "camlidl_z3_Z3_get_smtlib_num_sorts"
+
+external get_smtlib_sort : context -> int -> sort
+	= "camlidl_z3_Z3_get_smtlib_sort"
+
+external get_smtlib_error : context -> string
+	= "camlidl_z3_Z3_get_smtlib_error"
+
+external parse_z3_string : context -> string -> ast
+	= "camlidl_z3_Z3_parse_z3_string"
+
+external parse_z3_file : context -> string -> ast
+	= "camlidl_z3_Z3_parse_z3_file"
+
+external parse_smtlib2_string : context -> string -> symbol array -> sort array -> symbol array -> func_decl array -> ast
+	= "camlidl_z3_Z3_parse_smtlib2_string_bytecode" "camlidl_z3_Z3_parse_smtlib2_string"
+
+external parse_smtlib2_file : context -> string -> symbol array -> sort array -> symbol array -> func_decl array -> ast
+	= "camlidl_z3_Z3_parse_smtlib2_file_bytecode" "camlidl_z3_Z3_parse_smtlib2_file"
+
+external get_version : unit -> int * int * int * int
+	= "camlidl_z3_Z3_get_version"
+
+external reset_memory : unit -> unit
+	= "camlidl_z3_Z3_reset_memory"
+
+external theory_mk_sort : context -> theory -> symbol -> sort
+	= "camlidl_z3_Z3_theory_mk_sort"
+
+external theory_mk_value : context -> theory -> symbol -> sort -> ast
+	= "camlidl_z3_Z3_theory_mk_value"
+
+external theory_mk_constant : context -> theory -> symbol -> sort -> ast
+	= "camlidl_z3_Z3_theory_mk_constant"
+
+external theory_mk_func_decl : context -> theory -> symbol -> sort array -> sort -> func_decl
+	= "camlidl_z3_Z3_theory_mk_func_decl"
+
+external theory_get_context : theory -> context
+	= "camlidl_z3_Z3_theory_get_context"
+
+external theory_assert_axiom : theory -> ast -> unit
+	= "camlidl_z3_Z3_theory_assert_axiom"
+
+external theory_assume_eq : theory -> ast -> ast -> unit
+	= "camlidl_z3_Z3_theory_assume_eq"
+
+external theory_enable_axiom_simplification : theory -> bool -> unit
+	= "camlidl_z3_Z3_theory_enable_axiom_simplification"
+
+external theory_get_eqc_root : theory -> ast -> ast
+	= "camlidl_z3_Z3_theory_get_eqc_root"
+
+external theory_get_eqc_next : theory -> ast -> ast
+	= "camlidl_z3_Z3_theory_get_eqc_next"
+
+external theory_get_num_parents : theory -> ast -> int
+	= "camlidl_z3_Z3_theory_get_num_parents"
+
+external theory_get_parent : theory -> ast -> int -> ast
+	= "camlidl_z3_Z3_theory_get_parent"
+
+external theory_is_value : theory -> ast -> bool
+	= "camlidl_z3_Z3_theory_is_value"
+
+external theory_is_decl : theory -> func_decl -> bool
+	= "camlidl_z3_Z3_theory_is_decl"
+
+external theory_get_num_elems : theory -> int
+	= "camlidl_z3_Z3_theory_get_num_elems"
+
+external theory_get_elem : theory -> int -> ast
+	= "camlidl_z3_Z3_theory_get_elem"
+
+external theory_get_num_apps : theory -> int
+	= "camlidl_z3_Z3_theory_get_num_apps"
+
+external theory_get_app : theory -> int -> ast
+	= "camlidl_z3_Z3_theory_get_app"
+
+external datalog_add_rule : context -> ast -> symbol -> unit
+	= "camlidl_z3_Z3_datalog_add_rule"
+
+external datalog_query : context -> ast -> ast
+	= "camlidl_z3_Z3_datalog_query"
+
+external datalog_set_predicate_representation : context -> func_decl -> symbol array -> unit
+	= "camlidl_z3_Z3_datalog_set_predicate_representation"
+
+external datalog_parse_file : context -> string -> unit
+	= "camlidl_z3_Z3_datalog_parse_file"
+
+
+
+
+(* Internal auxillary functions: *)
+
+(* Transform a pair of arrays into an array of pairs *)
+let array_combine a b =
+  if Array.length a <> Array.length b then raise (Invalid_argument "array_combine");
+  Array.init (Array.length a) (fun i->(a.(i),b.(i)));;
+
+(* [a |> b] is the pipeline operator for [b(a)] *)
+let ( |> ) x f = f x;;
+
+
+(* Extensions, except for refinement: *)
+let mk_context_x configs = 
+  let config = mk_config() in
+  let f(param_id,param_value) = set_param_value config param_id param_value in
+  Array.iter f configs;
+  let context = mk_context config in
+  del_config config;
+  context;;
+
+let get_app_args c a =
+  Array.init (get_app_num_args c a) (get_app_arg c a);;
+
+let get_domains c d =
+  Array.init (get_domain_size c d) (get_domain c d);;
+
+let get_array_sort c t = (get_array_sort_domain c t, get_array_sort_range c t);;
+
+let get_tuple_sort c ty = 
+  (get_tuple_sort_mk_decl c ty,
+   Array.init (get_tuple_sort_num_fields c ty) (get_tuple_sort_field_decl c ty));;
+
+type datatype_constructor_refined = { 
+   constructor : func_decl; 
+   recognizer : func_decl; 
+   accessors : func_decl array 
+}
+
+let get_datatype_sort c ty = 
+  Array.init (get_datatype_sort_num_constructors c ty)
+  (fun idx_c -> 
+   let constr = get_datatype_sort_constructor c ty idx_c in
+   let recog = get_datatype_sort_recognizer  c ty idx_c in
+   let num_acc = get_domain_size c constr in
+   { constructor = constr;
+     recognizer = recog;
+     accessors = Array.init num_acc (get_datatype_sort_constructor_accessor c ty idx_c);
+   })
+
+let get_model_constants c m =
+  Array.init (get_model_num_constants c m) (get_model_constant c m);;
+
+
+let get_model_func_entry c m i j =
+  (Array.init
+     (get_model_func_entry_num_args c m i j)
+     (get_model_func_entry_arg c m i j),
+   get_model_func_entry_value c m i j);;
+
+let get_model_func_entries c m i =
+  Array.init (get_model_func_num_entries c m i) (get_model_func_entry c m i);;
+
+let get_model_funcs c m =
+  Array.init (get_model_num_funcs c m)
+    (fun i->(get_model_func_decl c m i |> get_decl_name c,
+             get_model_func_entries c m i,
+             get_model_func_else c m i));;
+ 
+let get_smtlib_formulas c = 
+  Array.init (get_smtlib_num_formulas c) (get_smtlib_formula c);;
+
+let get_smtlib_assumptions c = 
+  Array.init (get_smtlib_num_assumptions c) (get_smtlib_assumption c);;
+
+let get_smtlib_decls c =
+  Array.init (get_smtlib_num_decls c) (get_smtlib_decl c);;
+
+let get_smtlib_parse_results c =
+  (get_smtlib_formulas c, get_smtlib_assumptions c, get_smtlib_decls c);;
+
+let parse_smtlib_string_formula c a1 a2 a3 a4 a5 = 
+  (parse_smtlib_string c a1 a2 a3 a4 a5;
+   match get_smtlib_formulas c with [|f|] -> f | _ -> failwith "Z3: parse_smtlib_string_formula");;
+
+let parse_smtlib_file_formula c a1 a2 a3 a4 a5 = 
+  (parse_smtlib_file c a1 a2 a3 a4 a5;
+   match get_smtlib_formulas c with [|f|] -> f | _ -> failwith "Z3: parse_smtlib_file_formula");;
+
+let parse_smtlib_string_x c a1 a2 a3 a4 a5 = 
+  (parse_smtlib_string c a1 a2 a3 a4 a5; get_smtlib_parse_results c);;
+
+let parse_smtlib_file_x c a1 a2 a3 a4 a5 = 
+  (parse_smtlib_file c a1 a2 a3 a4 a5; get_smtlib_parse_results c);;
+
+(* Refinement: *)
+
+type symbol_refined =
+  | Symbol_int of int
+  | Symbol_string of string
+  | Symbol_unknown;;
+
+let symbol_refine c s =
+  match get_symbol_kind c s with
+  | INT_SYMBOL -> Symbol_int (get_symbol_int c s)
+  | STRING_SYMBOL -> Symbol_string (get_symbol_string c s);;
+
+type sort_refined =
+  | Sort_uninterpreted of symbol
+  | Sort_bool
+  | Sort_int
+  | Sort_real
+  | Sort_bv of int
+  | Sort_array of (sort * sort)
+  | Sort_datatype of datatype_constructor_refined array
+  | Sort_relation
+  | Sort_finite_domain
+  | Sort_unknown of symbol;;
+
+let sort_refine c ty =
+  match get_sort_kind c ty with
+  | UNINTERPRETED_SORT -> Sort_uninterpreted (get_sort_name c ty)
+  | BOOL_SORT -> Sort_bool
+  | INT_SORT -> Sort_int
+  | REAL_SORT -> Sort_real
+  | BV_SORT -> Sort_bv (get_bv_sort_size c ty)
+  | ARRAY_SORT -> Sort_array (get_array_sort_domain c ty, get_array_sort_range c ty)
+  | DATATYPE_SORT -> Sort_datatype (get_datatype_sort c ty)
+  | RELATION_SORT -> Sort_relation 
+  | FINITE_DOMAIN_SORT -> Sort_finite_domain
+  | UNKNOWN_SORT -> Sort_unknown (get_sort_name c ty);;
+
+let get_pattern_terms c p = 
+  Array.init (get_pattern_num_terms c p) (get_pattern c p)
+
+type binder_type = | Forall | Exists 
+
+type numeral_refined = 
+  | Numeral_small  of int64 * int64
+  | Numeral_large  of string
+
+type term_refined = 
+  | Term_app        of decl_kind * func_decl * ast array
+  | Term_quantifier of binder_type * int * ast array array * (symbol *sort) array * ast
+  | Term_numeral    of numeral_refined * sort
+  | Term_var        of int * sort
+
+let term_refine c t = 
+  match get_ast_kind c t with
+  | NUMERAL_AST -> 
+      let (is_small, n, d) = get_numeral_small c t in
+      if is_small then 
+	Term_numeral(Numeral_small(n,d), get_sort c t)
+      else
+	Term_numeral(Numeral_large(get_numeral_string c t), get_sort c t)
+  | APP_AST   -> 
+      let t' = to_app c t in
+      let f =  get_app_decl c t' in
+      let num_args = get_app_num_args c t' in
+      let args = Array.init num_args (get_app_arg c t') in
+      let k = get_decl_kind c f in
+      Term_app (k, f, args)
+  | QUANTIFIER_AST -> 
+      let bt = if is_quantifier_forall c t then Forall else Exists in
+      let w = get_quantifier_weight c t                            in
+      let np = get_quantifier_num_patterns c t                     in
+      let pats = Array.init np (get_quantifier_pattern_ast c t)    in
+      let pats = Array.map (get_pattern_terms c) pats              in
+      let nb = get_quantifier_num_bound c t                        in
+      let bound = Array.init nb 
+	  (fun i -> (get_quantifier_bound_name c t i, get_quantifier_bound_sort c t i)) in
+      let body = get_quantifier_body c t in
+      Term_quantifier(bt, w, pats, bound, body)
+  | VAR_AST -> 
+      Term_var(get_index_value c t, get_sort c t)
+  | _ -> assert false
+
+
+type theory_callbacks = 
+  {
+     mutable delete_theory : unit -> unit;
+     mutable reduce_eq : ast -> ast -> ast option;
+     mutable reduce_app : func_decl -> ast array -> ast option;
+     mutable reduce_distinct : ast array -> ast option;
+     mutable final_check : unit -> bool;
+     mutable new_app : ast -> unit;
+     mutable new_elem : ast -> unit;
+     mutable init_search: unit -> unit;
+     mutable push: unit -> unit;
+     mutable pop: unit -> unit;
+     mutable restart : unit -> unit;
+     mutable reset: unit -> unit;
+     mutable new_eq : ast -> ast -> unit;
+     mutable new_diseq : ast -> ast -> unit;
+     mutable new_assignment: ast -> bool -> unit;
+     mutable new_relevant : ast -> unit;
+  }
+
+let mk_theory_callbacks() = 
+    {
+     delete_theory = (fun () -> ());
+     reduce_eq = (fun _ _ -> None);
+     reduce_app = (fun _ _ -> None);
+     reduce_distinct = (fun _ -> None);
+     final_check = (fun _ -> true);
+     new_app = (fun _ -> ());
+     new_elem = (fun _ -> ());
+     init_search= (fun () -> ());
+     push= (fun () -> ());
+     pop= (fun () -> ());
+     restart = (fun () -> ());
+     reset= (fun () -> ());
+     new_eq = (fun _ _ -> ());
+     new_diseq = (fun _ _ -> ());
+     new_assignment = (fun _ _ -> ());
+     new_relevant = (fun _ -> ());
+    }
+
+
+external get_theory_callbacks : theory -> theory_callbacks = "get_theory_callbacks"
+external mk_theory_register : context -> string -> theory_callbacks -> theory = "mk_theory_register"
+external set_delete_callback_register : theory -> unit = "set_delete_callback_register"
+external set_reduce_app_callback_register : theory -> unit = "set_reduce_app_callback_register"
+external set_reduce_eq_callback_register : theory -> unit = "set_reduce_eq_callback_register"
+external set_reduce_distinct_callback_register : theory -> unit = "set_reduce_distinct_callback_register"
+external set_new_app_callback_register : theory -> unit = "set_new_app_callback_register"
+external set_new_elem_callback_register : theory -> unit = "set_new_elem_callback_register"
+external set_init_search_callback_register : theory -> unit = "set_init_search_callback_register"
+external set_push_callback_register : theory -> unit = "set_push_callback_register"
+external set_pop_callback_register : theory -> unit = "set_pop_callback_register"
+external set_restart_callback_register : theory -> unit = "set_restart_callback_register"
+external set_reset_callback_register : theory -> unit = "set_reset_callback_register"
+external set_final_check_callback_register : theory -> unit = "set_final_check_callback_register"
+external set_new_eq_callback_register : theory -> unit = "set_new_eq_callback_register"
+external set_new_diseq_callback_register : theory -> unit = "set_new_diseq_callback_register"
+external set_new_assignment_callback_register : theory -> unit = "set_new_assignment_callback_register"
+external set_new_relevant_callback_register : theory -> unit = "set_new_relevant_callback_register"
+
+let is_some opt = 
+    match opt with
+    | Some v -> true
+    | None   -> false
+
+let get_some opt = 
+    match opt with
+    | Some v -> v
+    | None   -> failwith "None unexpected"
+
+  
+
+
+let apply_delete (th:theory_callbacks) = th.delete_theory ()
+let set_delete_callback th cb = 
+    let cbs = get_theory_callbacks th in
+    cbs.delete_theory <- cb;
+    set_delete_callback_register th
+
+let mk_theory context name = 
+    Callback.register "is_some" is_some;
+    Callback.register "get_some" get_some;
+    Callback.register "apply_delete" apply_delete;
+    let cbs = mk_theory_callbacks() in
+    mk_theory_register context name cbs
+
+
+let apply_reduce_app (th:theory_callbacks) f args = th.reduce_app f args
+let set_reduce_app_callback th cb = 
+    Callback.register "apply_reduce_app" apply_reduce_app;
+    let cbs = get_theory_callbacks th in
+    cbs.reduce_app <- cb;
+    set_reduce_app_callback_register th
+
+let apply_reduce_eq (th:theory_callbacks) a b = th.reduce_eq a b
+let set_reduce_eq_callback th cb = 
+    Callback.register "apply_reduce_eq" apply_reduce_eq;
+    let cbs = get_theory_callbacks th in
+    cbs.reduce_eq <- cb;
+    set_reduce_eq_callback_register th
+
+let apply_reduce_distinct (th:theory_callbacks) args = th.reduce_distinct args
+let set_reduce_distinct_callback th cb = 
+    Callback.register "apply_reduce_distinct" apply_reduce_distinct;
+    let cbs = get_theory_callbacks th in
+    cbs.reduce_distinct <- cb;
+    set_reduce_distinct_callback_register th
+ 
+
+let apply_new_app (th:theory_callbacks) a = th.new_app a
+let set_new_app_callback th cb = 
+    Callback.register "apply_new_app" apply_new_app;
+    let cbs = get_theory_callbacks th in
+    cbs.new_app <- cb;
+    set_new_app_callback_register th
+
+let apply_new_elem (th:theory_callbacks) a = th.new_elem a
+let set_new_elem_callback th cb = 
+    Callback.register "apply_new_elem" apply_new_elem;
+    let cbs = get_theory_callbacks th in
+    cbs.new_elem <- cb;
+    set_new_elem_callback_register th
+
+
+let apply_init_search (th:theory_callbacks) = th.init_search()
+let set_init_search_callback th cb = 
+    Callback.register "apply_init_search" apply_init_search;
+    let cbs = get_theory_callbacks th in
+    cbs.init_search <- cb;
+    set_init_search_callback_register th
+
+
+let apply_push (th:theory_callbacks) = th.push()
+let set_push_callback th cb = 
+    Callback.register "apply_push" apply_push;
+    let cbs = get_theory_callbacks th in
+    cbs.push <- cb;
+    set_push_callback_register th
+
+let apply_pop (th:theory_callbacks) = th.pop()
+let set_pop_callback th cb = 
+    Callback.register "apply_pop" apply_pop;
+    let cbs = get_theory_callbacks th in
+    cbs.pop <- cb;
+    set_pop_callback_register th
+ 
+
+let apply_restart (th:theory_callbacks) = th.restart()
+let set_restart_callback th cb = 
+    Callback.register "apply_restart" apply_restart;
+    let cbs = get_theory_callbacks th in
+    cbs.restart <- cb;
+    set_restart_callback_register th
+ 
+
+let apply_reset (th:theory_callbacks) = th.reset()
+let set_reset_callback th cb = 
+    Callback.register "apply_reset" apply_reset;
+    let cbs = get_theory_callbacks th in
+    cbs.reset <- cb;
+    set_reset_callback_register th
+
+let apply_final_check (th:theory_callbacks) = th.final_check()
+let set_final_check_callback th cb = 
+    Callback.register "apply_final_check" apply_final_check;
+    let cbs = get_theory_callbacks th in
+    cbs.final_check <- cb;
+    set_final_check_callback_register th
+
+let apply_new_eq (th:theory_callbacks) a b = th.new_eq a b
+let set_new_eq_callback th cb = 
+    Callback.register "apply_new_eq" apply_new_eq;
+    let cbs = get_theory_callbacks th in
+    cbs.new_eq <- cb;
+    set_new_eq_callback_register th
+
+
+let apply_new_diseq (th:theory_callbacks) a b = th.new_diseq a b
+let set_new_diseq_callback th cb = 
+    Callback.register "apply_new_diseq" apply_new_diseq;
+    let cbs = get_theory_callbacks th in
+    cbs.new_diseq <- cb;
+    set_new_diseq_callback_register th
+
+let apply_new_assignment (th:theory_callbacks) a b = th.new_assignment a b
+let set_new_assignment_callback th cb = 
+    Callback.register "apply_new_assignment" apply_new_assignment;
+    let cbs = get_theory_callbacks th in
+    cbs.new_assignment <- cb;
+    set_new_assignment_callback_register th
+
+let apply_new_relevant (th:theory_callbacks) a = th.new_relevant a
+let set_new_relevant_callback th cb = 
+    Callback.register "apply_new_relevant" apply_new_relevant;
+    let cbs = get_theory_callbacks th in
+    cbs.new_relevant <- cb;
+    set_new_relevant_callback_register th
+ 
+
+
+
+
+ external/z3/ocaml/z3_stubs.c view
@@ -0,0 +1,7761 @@+/* File generated from z3.idl */
+
+#include <stddef.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#ifdef Custom_tag
+#include <caml/custom.h>
+#include <caml/bigarray.h>
+#endif
+#include <caml/camlidlruntime.h>
+
+
+#include "z3.h"
+
+#pragma warning(disable:4090)
+#ifndef __int64
+#define __int64 long long
+#endif
+Z3_error_handler caml_z3_error_handler;
+void caml_z3_error_handler(Z3_error_code e) { static char buffer[128]; char * msg = Z3_get_error_msg(e); if (strlen(msg) > 100) { failwith("Z3: error message is too big"); } else { sprintf(buffer, "Z3: %s", msg); failwith(buffer); } }
+void camlidl_ml2c_z3_Z3_config(value _v1, Z3_config * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_config *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_config(Z3_config * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_config) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_config *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_context(value _v1, Z3_context * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_context *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_context(Z3_context * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_context) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_context *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_sort(value _v1, Z3_sort * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_sort *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_sort(Z3_sort * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_sort) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_sort *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_func_decl(value _v1, Z3_func_decl * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_func_decl *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_func_decl(Z3_func_decl * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_func_decl) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_func_decl *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_ast(value _v1, Z3_ast * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_ast *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_ast(Z3_ast * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_ast) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_ast *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_app(value _v1, Z3_app * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_app *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_app(Z3_app * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_app) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_app *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_pattern(value _v1, Z3_pattern * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_pattern *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_pattern(Z3_pattern * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_pattern) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_pattern *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_symbol(value _v1, Z3_symbol * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_symbol *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_symbol(Z3_symbol * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_symbol) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_symbol *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_parameter(value _v1, Z3_parameter * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_parameter *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_parameter(Z3_parameter * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_parameter) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_parameter *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_model(value _v1, Z3_model * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_model *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_model(Z3_model * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_model) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_model *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_literals(value _v1, Z3_literals * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_literals *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_literals(Z3_literals * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_literals) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_literals *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_constructor(value _v1, Z3_constructor * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_constructor *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_constructor(Z3_constructor * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_constructor) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_constructor *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_constructor_list(value _v1, Z3_constructor_list * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_constructor_list *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_constructor_list(Z3_constructor_list * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_constructor_list) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_constructor_list *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_theory(value _v1, Z3_theory * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_theory *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_theory(Z3_theory * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_theory) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_theory *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+void camlidl_ml2c_z3_Z3_theory_data(value _v1, Z3_theory_data * _c2, camlidl_ctx _ctx)
+{
+  *_c2 = *((Z3_theory_data *) Bp_val(_v1));
+}
+
+value camlidl_c2ml_z3_Z3_theory_data(Z3_theory_data * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_alloc((sizeof(Z3_theory_data) + sizeof(value) - 1) / sizeof(value), Abstract_tag);
+  *((Z3_theory_data *) Bp_val(_v1)) = *_c2;
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_1[3] = {
+  Z3_L_FALSE,
+  Z3_L_UNDEF,
+  Z3_L_TRUE,
+};
+
+void camlidl_ml2c_z3_Z3_lbool(value _v1, Z3_lbool * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_1[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_lbool(Z3_lbool * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  switch((*_c2)) {
+  case Z3_L_FALSE: _v1 = Val_int(0); break;
+  case Z3_L_UNDEF: _v1 = Val_int(1); break;
+  case Z3_L_TRUE: _v1 = Val_int(2); break;
+  default: invalid_argument("typedef Z3_lbool: bad enum  value");
+  }
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_2[2] = {
+  Z3_INT_SYMBOL,
+  Z3_STRING_SYMBOL,
+};
+
+void camlidl_ml2c_z3_Z3_symbol_kind(value _v1, Z3_symbol_kind * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_2[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_symbol_kind(Z3_symbol_kind * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  switch((*_c2)) {
+  case Z3_INT_SYMBOL: _v1 = Val_int(0); break;
+  case Z3_STRING_SYMBOL: _v1 = Val_int(1); break;
+  default: invalid_argument("typedef Z3_symbol_kind: bad enum  value");
+  }
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_3[7] = {
+  Z3_PARAMETER_INT,
+  Z3_PARAMETER_DOUBLE,
+  Z3_PARAMETER_RATIONAL,
+  Z3_PARAMETER_SYMBOL,
+  Z3_PARAMETER_SORT,
+  Z3_PARAMETER_AST,
+  Z3_PARAMETER_FUNC_DECL,
+};
+
+void camlidl_ml2c_z3_Z3_parameter_kind(value _v1, Z3_parameter_kind * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_3[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_parameter_kind(Z3_parameter_kind * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_find_enum((*_c2), camlidl_transl_table_z3_enum_3, 7, "typedef Z3_parameter_kind: bad enum  value");
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_4[10] = {
+  Z3_UNINTERPRETED_SORT,
+  Z3_BOOL_SORT,
+  Z3_INT_SORT,
+  Z3_REAL_SORT,
+  Z3_BV_SORT,
+  Z3_ARRAY_SORT,
+  Z3_DATATYPE_SORT,
+  Z3_RELATION_SORT,
+  Z3_FINITE_DOMAIN_SORT,
+  Z3_UNKNOWN_SORT,
+};
+
+void camlidl_ml2c_z3_Z3_sort_kind(value _v1, Z3_sort_kind * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_4[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_sort_kind(Z3_sort_kind * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_find_enum((*_c2), camlidl_transl_table_z3_enum_4, 10, "typedef Z3_sort_kind: bad enum  value");
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_5[5] = {
+  Z3_NUMERAL_AST,
+  Z3_APP_AST,
+  Z3_VAR_AST,
+  Z3_QUANTIFIER_AST,
+  Z3_UNKNOWN_AST,
+};
+
+void camlidl_ml2c_z3_Z3_ast_kind(value _v1, Z3_ast_kind * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_5[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_ast_kind(Z3_ast_kind * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_find_enum((*_c2), camlidl_transl_table_z3_enum_5, 5, "typedef Z3_ast_kind: bad enum  value");
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_6[144] = {
+  Z3_OP_TRUE,
+  Z3_OP_FALSE,
+  Z3_OP_EQ,
+  Z3_OP_DISTINCT,
+  Z3_OP_ITE,
+  Z3_OP_AND,
+  Z3_OP_OR,
+  Z3_OP_IFF,
+  Z3_OP_XOR,
+  Z3_OP_NOT,
+  Z3_OP_IMPLIES,
+  Z3_OP_OEQ,
+  Z3_OP_ANUM,
+  Z3_OP_LE,
+  Z3_OP_GE,
+  Z3_OP_LT,
+  Z3_OP_GT,
+  Z3_OP_ADD,
+  Z3_OP_SUB,
+  Z3_OP_UMINUS,
+  Z3_OP_MUL,
+  Z3_OP_DIV,
+  Z3_OP_IDIV,
+  Z3_OP_REM,
+  Z3_OP_MOD,
+  Z3_OP_TO_REAL,
+  Z3_OP_TO_INT,
+  Z3_OP_IS_INT,
+  Z3_OP_STORE,
+  Z3_OP_SELECT,
+  Z3_OP_CONST_ARRAY,
+  Z3_OP_ARRAY_MAP,
+  Z3_OP_ARRAY_DEFAULT,
+  Z3_OP_SET_UNION,
+  Z3_OP_SET_INTERSECT,
+  Z3_OP_SET_DIFFERENCE,
+  Z3_OP_SET_COMPLEMENT,
+  Z3_OP_SET_SUBSET,
+  Z3_OP_AS_ARRAY,
+  Z3_OP_BNUM,
+  Z3_OP_BIT1,
+  Z3_OP_BIT0,
+  Z3_OP_BNEG,
+  Z3_OP_BADD,
+  Z3_OP_BSUB,
+  Z3_OP_BMUL,
+  Z3_OP_BSDIV,
+  Z3_OP_BUDIV,
+  Z3_OP_BSREM,
+  Z3_OP_BUREM,
+  Z3_OP_BSMOD,
+  Z3_OP_BSDIV0,
+  Z3_OP_BUDIV0,
+  Z3_OP_BSREM0,
+  Z3_OP_BUREM0,
+  Z3_OP_BSMOD0,
+  Z3_OP_ULEQ,
+  Z3_OP_SLEQ,
+  Z3_OP_UGEQ,
+  Z3_OP_SGEQ,
+  Z3_OP_ULT,
+  Z3_OP_SLT,
+  Z3_OP_UGT,
+  Z3_OP_SGT,
+  Z3_OP_BAND,
+  Z3_OP_BOR,
+  Z3_OP_BNOT,
+  Z3_OP_BXOR,
+  Z3_OP_BNAND,
+  Z3_OP_BNOR,
+  Z3_OP_BXNOR,
+  Z3_OP_CONCAT,
+  Z3_OP_SIGN_EXT,
+  Z3_OP_ZERO_EXT,
+  Z3_OP_EXTRACT,
+  Z3_OP_REPEAT,
+  Z3_OP_BREDOR,
+  Z3_OP_BREDAND,
+  Z3_OP_BCOMP,
+  Z3_OP_BSHL,
+  Z3_OP_BLSHR,
+  Z3_OP_BASHR,
+  Z3_OP_ROTATE_LEFT,
+  Z3_OP_ROTATE_RIGHT,
+  Z3_OP_EXT_ROTATE_LEFT,
+  Z3_OP_EXT_ROTATE_RIGHT,
+  Z3_OP_INT2BV,
+  Z3_OP_BV2INT,
+  Z3_OP_CARRY,
+  Z3_OP_XOR3,
+  Z3_OP_PR_UNDEF,
+  Z3_OP_PR_TRUE,
+  Z3_OP_PR_ASSERTED,
+  Z3_OP_PR_GOAL,
+  Z3_OP_PR_MODUS_PONENS,
+  Z3_OP_PR_REFLEXIVITY,
+  Z3_OP_PR_SYMMETRY,
+  Z3_OP_PR_TRANSITIVITY,
+  Z3_OP_PR_TRANSITIVITY_STAR,
+  Z3_OP_PR_MONOTONICITY,
+  Z3_OP_PR_QUANT_INTRO,
+  Z3_OP_PR_DISTRIBUTIVITY,
+  Z3_OP_PR_AND_ELIM,
+  Z3_OP_PR_NOT_OR_ELIM,
+  Z3_OP_PR_REWRITE,
+  Z3_OP_PR_REWRITE_STAR,
+  Z3_OP_PR_PULL_QUANT,
+  Z3_OP_PR_PULL_QUANT_STAR,
+  Z3_OP_PR_PUSH_QUANT,
+  Z3_OP_PR_ELIM_UNUSED_VARS,
+  Z3_OP_PR_DER,
+  Z3_OP_PR_QUANT_INST,
+  Z3_OP_PR_HYPOTHESIS,
+  Z3_OP_PR_LEMMA,
+  Z3_OP_PR_UNIT_RESOLUTION,
+  Z3_OP_PR_IFF_TRUE,
+  Z3_OP_PR_IFF_FALSE,
+  Z3_OP_PR_COMMUTATIVITY,
+  Z3_OP_PR_DEF_AXIOM,
+  Z3_OP_PR_DEF_INTRO,
+  Z3_OP_PR_APPLY_DEF,
+  Z3_OP_PR_IFF_OEQ,
+  Z3_OP_PR_NNF_POS,
+  Z3_OP_PR_NNF_NEG,
+  Z3_OP_PR_NNF_STAR,
+  Z3_OP_PR_CNF_STAR,
+  Z3_OP_PR_SKOLEMIZE,
+  Z3_OP_PR_MODUS_PONENS_OEQ,
+  Z3_OP_PR_TH_LEMMA,
+  Z3_OP_RA_STORE,
+  Z3_OP_RA_EMPTY,
+  Z3_OP_RA_IS_EMPTY,
+  Z3_OP_RA_JOIN,
+  Z3_OP_RA_UNION,
+  Z3_OP_RA_WIDEN,
+  Z3_OP_RA_PROJECT,
+  Z3_OP_RA_FILTER,
+  Z3_OP_RA_NEGATION_FILTER,
+  Z3_OP_RA_RENAME,
+  Z3_OP_RA_COMPLEMENT,
+  Z3_OP_RA_SELECT,
+  Z3_OP_RA_CLONE,
+  Z3_OP_FD_LT,
+  Z3_OP_UNINTERPRETED,
+};
+
+void camlidl_ml2c_z3_Z3_decl_kind(value _v1, Z3_decl_kind * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_6[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_decl_kind(Z3_decl_kind * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_find_enum((*_c2), camlidl_transl_table_z3_enum_6, 144, "typedef Z3_decl_kind: bad enum  value");
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_7[8] = {
+  Z3_NO_FAILURE,
+  Z3_UNKNOWN,
+  Z3_TIMEOUT,
+  Z3_MEMOUT_WATERMARK,
+  Z3_CANCELED,
+  Z3_NUM_CONFLICTS,
+  Z3_THEORY,
+  Z3_QUANTIFIERS,
+};
+
+void camlidl_ml2c_z3_Z3_search_failure(value _v1, Z3_search_failure * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_7[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_search_failure(Z3_search_failure * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  _v1 = camlidl_find_enum((*_c2), camlidl_transl_table_z3_enum_7, 8, "typedef Z3_search_failure: bad enum  value");
+  return _v1;
+}
+
+int camlidl_transl_table_z3_enum_8[4] = {
+  Z3_PRINT_SMTLIB_FULL,
+  Z3_PRINT_LOW_LEVEL,
+  Z3_PRINT_SMTLIB_COMPLIANT,
+  Z3_PRINT_SMTLIB2_COMPLIANT,
+};
+
+void camlidl_ml2c_z3_Z3_ast_print_mode(value _v1, Z3_ast_print_mode * _c2, camlidl_ctx _ctx)
+{
+  (*_c2) = camlidl_transl_table_z3_enum_8[Int_val(_v1)];
+}
+
+value camlidl_c2ml_z3_Z3_ast_print_mode(Z3_ast_print_mode * _c2, camlidl_ctx _ctx)
+{
+value _v1;
+  switch((*_c2)) {
+  case Z3_PRINT_SMTLIB_FULL: _v1 = Val_int(0); break;
+  case Z3_PRINT_LOW_LEVEL: _v1 = Val_int(1); break;
+  case Z3_PRINT_SMTLIB_COMPLIANT: _v1 = Val_int(2); break;
+  case Z3_PRINT_SMTLIB2_COMPLIANT: _v1 = Val_int(3); break;
+  default: invalid_argument("typedef Z3_ast_print_mode: bad enum  value");
+  }
+  return _v1;
+}
+
+value camlidl_z3_Z3_mk_config(value _unit)
+{
+  Z3_config _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  _res = Z3_mk_config();
+  _vres = camlidl_c2ml_z3_Z3_config(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_del_config(
+	value _v_c)
+{
+  Z3_config c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_config(_v_c, &c, _ctx);
+  Z3_del_config(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_set_param_value(
+	value _v_c,
+	value _v_param_id,
+	value _v_param_value)
+{
+  Z3_config c; /*in*/
+  char const *param_id; /*in*/
+  char const *param_value; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_config(_v_c, &c, _ctx);
+  param_id = String_val(_v_param_id);
+  param_value = String_val(_v_param_value);
+  Z3_set_param_value(c, param_id, param_value);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_mk_context(
+	value _v_c)
+{
+  Z3_config c; /*in*/
+  Z3_context _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_config(_v_c, &c, _ctx);
+  _res = Z3_mk_context(c);
+  _vres = camlidl_c2ml_z3_Z3_context(&_res, _ctx);
+  camlidl_free(_ctx);
+  /* begin user-supplied deallocation sequence */
+Z3_set_error_handler(_res, caml_z3_error_handler);
+  /* end user-supplied deallocation sequence */
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_context_rc(
+	value _v_c)
+{
+  Z3_config c; /*in*/
+  Z3_context _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_config(_v_c, &c, _ctx);
+  _res = Z3_mk_context_rc(c);
+  _vres = camlidl_c2ml_z3_Z3_context(&_res, _ctx);
+  camlidl_free(_ctx);
+  /* begin user-supplied deallocation sequence */
+Z3_set_error_handler(_res, caml_z3_error_handler);
+  /* end user-supplied deallocation sequence */
+  return _vres;
+}
+
+value camlidl_z3_Z3_set_logic(
+	value _v_c,
+	value _v_logic)
+{
+  Z3_context c; /*in*/
+  char const *logic; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  logic = String_val(_v_logic);
+  _res = Z3_set_logic(c, logic);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_del_context(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_del_context(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_inc_ref(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  Z3_inc_ref(c, a);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_dec_ref(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  Z3_dec_ref(c, a);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_trace_to_file(
+	value _v_c,
+	value _v_trace_file)
+{
+  Z3_context c; /*in*/
+  char const *trace_file; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  trace_file = String_val(_v_trace_file);
+  _res = Z3_trace_to_file(c, trace_file);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_trace_to_stderr(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_trace_to_stderr(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_trace_to_stdout(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_trace_to_stdout(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_trace_off(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_trace_off(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_toggle_warning_messages(
+	value _v_enabled)
+{
+  int enabled; /*in*/
+  enabled = Int_val(_v_enabled);
+  Z3_toggle_warning_messages(enabled);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_update_param_value(
+	value _v_c,
+	value _v_param_id,
+	value _v_param_value)
+{
+  Z3_context c; /*in*/
+  char const *param_id; /*in*/
+  char const *param_value; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  param_id = String_val(_v_param_id);
+  param_value = String_val(_v_param_value);
+  Z3_update_param_value(c, param_id, param_value);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_mk_int_symbol(
+	value _v_c,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  int i; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_mk_int_symbol(c, i);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_string_symbol(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  char const *s; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  s = String_val(_v_s);
+  _res = Z3_mk_string_symbol(c, s);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_is_eq_sort(
+	value _v_c,
+	value _v_s1,
+	value _v_s2)
+{
+  Z3_context c; /*in*/
+  Z3_sort s1; /*in*/
+  Z3_sort s2; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s1, &s1, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s2, &s2, _ctx);
+  _res = Z3_is_eq_sort(c, s1, s2);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_uninterpreted_sort(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _res = Z3_mk_uninterpreted_sort(c, s);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bool_sort(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_mk_bool_sort(c);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_int_sort(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_mk_int_sort(c);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_real_sort(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_mk_real_sort(c);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bv_sort(
+	value _v_c,
+	value _v_sz)
+{
+  Z3_context c; /*in*/
+  unsigned int sz; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  sz = Int_val(_v_sz);
+  _res = Z3_mk_bv_sort(c, sz);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_array_sort(
+	value _v_c,
+	value _v_domain,
+	value _v_range)
+{
+  Z3_context c; /*in*/
+  Z3_sort domain; /*in*/
+  Z3_sort range; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_domain, &domain, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_range, &range, _ctx);
+  _res = Z3_mk_array_sort(c, domain, range);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_tuple_sort(
+	value _v_c,
+	value _v_mk_tuple_name,
+	value _v_field_names,
+	value _v_field_sorts)
+{
+  Z3_context c; /*in*/
+  Z3_symbol mk_tuple_name; /*in*/
+  unsigned int num_fields; /*in*/
+  Z3_symbol const *field_names; /*in*/
+  Z3_sort const *field_sorts; /*in*/
+  Z3_func_decl *mk_tuple_decl; /*out*/
+  Z3_func_decl *proj_decl; /*out*/
+  Z3_sort _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  Z3_func_decl _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vresult;
+  value _vres[3] = { 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_mk_tuple_name, &mk_tuple_name, _ctx);
+  _c1 = Wosize_val(_v_field_names);
+  field_names = camlidl_malloc(_c1 * sizeof(Z3_symbol const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_field_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &field_names[_c2], _ctx);
+  }
+  num_fields = _c1;
+  _c4 = Wosize_val(_v_field_sorts);
+  field_sorts = camlidl_malloc(_c4 * sizeof(Z3_sort const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_field_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &field_sorts[_c5], _ctx);
+  }
+  num_fields = _c4;
+  mk_tuple_decl = &_c7;
+  proj_decl = camlidl_malloc(num_fields * sizeof(Z3_func_decl ), _ctx);
+  _res = Z3_mk_tuple_sort(c, mk_tuple_name, num_fields, field_names, field_sorts, mk_tuple_decl, proj_decl);
+  Begin_roots_block(_vres, 3)
+    _vres[0] = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+    _vres[1] = camlidl_c2ml_z3_Z3_func_decl(&*mk_tuple_decl, _ctx);
+    _vres[2] = camlidl_alloc(num_fields, 0);
+    Begin_root(_vres[2])
+      for (_c8 = 0; _c8 < num_fields; _c8++) {
+        _v9 = camlidl_c2ml_z3_Z3_func_decl(&proj_decl[_c8], _ctx);
+        modify(&Field(_vres[2], _c8), _v9);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(3, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_mk_enumeration_sort(
+	value _v_c,
+	value _v_name,
+	value _v_enum_names)
+{
+  Z3_context c; /*in*/
+  Z3_symbol name; /*in*/
+  unsigned int n; /*in*/
+  Z3_symbol const *enum_names; /*in*/
+  Z3_func_decl *enum_consts; /*out*/
+  Z3_func_decl *enum_testers; /*out*/
+  Z3_sort _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  value _v5;
+  mlsize_t _c6;
+  value _v7;
+  value _vresult;
+  value _vres[3] = { 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_name, &name, _ctx);
+  _c1 = Wosize_val(_v_enum_names);
+  enum_names = camlidl_malloc(_c1 * sizeof(Z3_symbol const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_enum_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &enum_names[_c2], _ctx);
+  }
+  n = _c1;
+  enum_consts = camlidl_malloc(n * sizeof(Z3_func_decl ), _ctx);
+  enum_testers = camlidl_malloc(n * sizeof(Z3_func_decl ), _ctx);
+  _res = Z3_mk_enumeration_sort(c, name, n, enum_names, enum_consts, enum_testers);
+  Begin_roots_block(_vres, 3)
+    _vres[0] = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+    _vres[1] = camlidl_alloc(n, 0);
+    Begin_root(_vres[1])
+      for (_c4 = 0; _c4 < n; _c4++) {
+        _v5 = camlidl_c2ml_z3_Z3_func_decl(&enum_consts[_c4], _ctx);
+        modify(&Field(_vres[1], _c4), _v5);
+      }
+    End_roots()
+    _vres[2] = camlidl_alloc(n, 0);
+    Begin_root(_vres[2])
+      for (_c6 = 0; _c6 < n; _c6++) {
+        _v7 = camlidl_c2ml_z3_Z3_func_decl(&enum_testers[_c6], _ctx);
+        modify(&Field(_vres[2], _c6), _v7);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(3, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_mk_list_sort(
+	value _v_c,
+	value _v_name,
+	value _v_elem_sort)
+{
+  Z3_context c; /*in*/
+  Z3_symbol name; /*in*/
+  Z3_sort elem_sort; /*in*/
+  Z3_func_decl *nil_decl; /*out*/
+  Z3_func_decl *is_nil_decl; /*out*/
+  Z3_func_decl *cons_decl; /*out*/
+  Z3_func_decl *is_cons_decl; /*out*/
+  Z3_func_decl *head_decl; /*out*/
+  Z3_func_decl *tail_decl; /*out*/
+  Z3_sort _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  Z3_func_decl _c1;
+  Z3_func_decl _c2;
+  Z3_func_decl _c3;
+  Z3_func_decl _c4;
+  Z3_func_decl _c5;
+  Z3_func_decl _c6;
+  value _vresult;
+  value _vres[7] = { 0, 0, 0, 0, 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_name, &name, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_elem_sort, &elem_sort, _ctx);
+  nil_decl = &_c1;
+  is_nil_decl = &_c2;
+  cons_decl = &_c3;
+  is_cons_decl = &_c4;
+  head_decl = &_c5;
+  tail_decl = &_c6;
+  _res = Z3_mk_list_sort(c, name, elem_sort, nil_decl, is_nil_decl, cons_decl, is_cons_decl, head_decl, tail_decl);
+  Begin_roots_block(_vres, 7)
+    _vres[0] = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+    _vres[1] = camlidl_c2ml_z3_Z3_func_decl(&*nil_decl, _ctx);
+    _vres[2] = camlidl_c2ml_z3_Z3_func_decl(&*is_nil_decl, _ctx);
+    _vres[3] = camlidl_c2ml_z3_Z3_func_decl(&*cons_decl, _ctx);
+    _vres[4] = camlidl_c2ml_z3_Z3_func_decl(&*is_cons_decl, _ctx);
+    _vres[5] = camlidl_c2ml_z3_Z3_func_decl(&*head_decl, _ctx);
+    _vres[6] = camlidl_c2ml_z3_Z3_func_decl(&*tail_decl, _ctx);
+    _vresult = camlidl_alloc_small(7, 0);
+    { mlsize_t _c7;
+      for (_c7 = 0; _c7 < 7; _c7++) Field(_vresult, _c7) = _vres[_c7];
+    }
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_mk_constructor(
+	value _v_c,
+	value _v_name,
+	value _v_recognizer,
+	value _v_field_names,
+	value _v_sorts,
+	value _v_sort_refs)
+{
+  Z3_context c; /*in*/
+  Z3_symbol name; /*in*/
+  Z3_symbol recognizer; /*in*/
+  unsigned int num_fields; /*in*/
+  Z3_symbol const *field_names; /*in*/
+  Z3_sort const *sorts; /*in*/
+  unsigned int *sort_refs; /*in*/
+  Z3_constructor _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_name, &name, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_recognizer, &recognizer, _ctx);
+  _c1 = Wosize_val(_v_field_names);
+  field_names = camlidl_malloc(_c1 * sizeof(Z3_symbol const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_field_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &field_names[_c2], _ctx);
+  }
+  num_fields = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_fields = _c4;
+  _c7 = Wosize_val(_v_sort_refs);
+  sort_refs = camlidl_malloc(_c7 * sizeof(unsigned int ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_sort_refs, _c8);
+    sort_refs[_c8] = Int_val(_v9);
+  }
+  num_fields = _c7;
+  _res = Z3_mk_constructor(c, name, recognizer, num_fields, field_names, sorts, sort_refs);
+  _vres = camlidl_c2ml_z3_Z3_constructor(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_constructor_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_constructor(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_query_constructor(
+	value _v_c,
+	value _v_constr,
+	value _v_num_fields)
+{
+  Z3_context c; /*in*/
+  Z3_constructor constr; /*in*/
+  unsigned int num_fields; /*in*/
+  Z3_func_decl *constructor; /*out*/
+  Z3_func_decl *tester; /*out*/
+  Z3_func_decl *accessors; /*out*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  Z3_func_decl _c1;
+  Z3_func_decl _c2;
+  mlsize_t _c3;
+  value _v4;
+  value _vresult;
+  value _vres[3] = { 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_constructor(_v_constr, &constr, _ctx);
+  num_fields = Int_val(_v_num_fields);
+  constructor = &_c1;
+  tester = &_c2;
+  accessors = camlidl_malloc(num_fields * sizeof(Z3_func_decl ), _ctx);
+  Z3_query_constructor(c, constr, num_fields, constructor, tester, accessors);
+  Begin_roots_block(_vres, 3)
+    _vres[0] = camlidl_c2ml_z3_Z3_func_decl(&*constructor, _ctx);
+    _vres[1] = camlidl_c2ml_z3_Z3_func_decl(&*tester, _ctx);
+    _vres[2] = camlidl_alloc(num_fields, 0);
+    Begin_root(_vres[2])
+      for (_c3 = 0; _c3 < num_fields; _c3++) {
+        _v4 = camlidl_c2ml_z3_Z3_func_decl(&accessors[_c3], _ctx);
+        modify(&Field(_vres[2], _c3), _v4);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(3, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_del_constructor(
+	value _v_c,
+	value _v_constr)
+{
+  Z3_context c; /*in*/
+  Z3_constructor constr; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_constructor(_v_constr, &constr, _ctx);
+  Z3_del_constructor(c, constr);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_mk_datatype(
+	value _v_c,
+	value _v_name,
+	value _v_constructors)
+{
+  Z3_context c; /*in*/
+  Z3_symbol name; /*in*/
+  unsigned int num_constructors; /*in*/
+  Z3_constructor *constructors; /*in,out*/
+  Z3_sort _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  value _v5;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_name, &name, _ctx);
+  _c1 = Wosize_val(_v_constructors);
+  constructors = camlidl_malloc(_c1 * sizeof(Z3_constructor ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_constructors, _c2);
+    camlidl_ml2c_z3_Z3_constructor(_v3, &constructors[_c2], _ctx);
+  }
+  num_constructors = _c1;
+  _res = Z3_mk_datatype(c, name, num_constructors, constructors);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+    _vres[1] = camlidl_alloc(num_constructors, 0);
+    Begin_root(_vres[1])
+      for (_c4 = 0; _c4 < num_constructors; _c4++) {
+        _v5 = camlidl_c2ml_z3_Z3_constructor(&constructors[_c4], _ctx);
+        modify(&Field(_vres[1], _c4), _v5);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_mk_constructor_list(
+	value _v_c,
+	value _v_constructors)
+{
+  Z3_context c; /*in*/
+  unsigned int num_constructors; /*in*/
+  Z3_constructor *constructors; /*in*/
+  Z3_constructor_list _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_constructors);
+  constructors = camlidl_malloc(_c1 * sizeof(Z3_constructor ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_constructors, _c2);
+    camlidl_ml2c_z3_Z3_constructor(_v3, &constructors[_c2], _ctx);
+  }
+  num_constructors = _c1;
+  _res = Z3_mk_constructor_list(c, num_constructors, constructors);
+  _vres = camlidl_c2ml_z3_Z3_constructor_list(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_del_constructor_list(
+	value _v_c,
+	value _v_clist)
+{
+  Z3_context c; /*in*/
+  Z3_constructor_list clist; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_constructor_list(_v_clist, &clist, _ctx);
+  Z3_del_constructor_list(c, clist);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_mk_datatypes(
+	value _v_c,
+	value _v_sort_names,
+	value _v_constructor_lists)
+{
+  Z3_context c; /*in*/
+  unsigned int num_sorts; /*in*/
+  Z3_symbol *sort_names; /*in*/
+  Z3_sort *sorts; /*out*/
+  Z3_constructor_list *constructor_lists; /*in,out*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  value _v8;
+  mlsize_t _c9;
+  value _v10;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_sort_names);
+  sort_names = camlidl_malloc(_c1 * sizeof(Z3_symbol ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_sort_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &sort_names[_c2], _ctx);
+  }
+  num_sorts = _c1;
+  _c4 = Wosize_val(_v_constructor_lists);
+  constructor_lists = camlidl_malloc(_c4 * sizeof(Z3_constructor_list ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_constructor_lists, _c5);
+    camlidl_ml2c_z3_Z3_constructor_list(_v6, &constructor_lists[_c5], _ctx);
+  }
+  num_sorts = _c4;
+  sorts = camlidl_malloc(num_sorts * sizeof(Z3_sort ), _ctx);
+  Z3_mk_datatypes(c, num_sorts, sort_names, sorts, constructor_lists);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = camlidl_alloc(num_sorts, 0);
+    Begin_root(_vres[0])
+      for (_c7 = 0; _c7 < num_sorts; _c7++) {
+        _v8 = camlidl_c2ml_z3_Z3_sort(&sorts[_c7], _ctx);
+        modify(&Field(_vres[0], _c7), _v8);
+      }
+    End_roots()
+    _vres[1] = camlidl_alloc(num_sorts, 0);
+    Begin_root(_vres[1])
+      for (_c9 = 0; _c9 < num_sorts; _c9++) {
+        _v10 = camlidl_c2ml_z3_Z3_constructor_list(&constructor_lists[_c9], _ctx);
+        modify(&Field(_vres[1], _c9), _v10);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_mk_injective_function(
+	value _v_c,
+	value _v_s,
+	value _v_domain,
+	value _v_range)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  unsigned int domain_size; /*in*/
+  Z3_sort const *domain; /*in*/
+  Z3_sort range; /*in*/
+  Z3_func_decl _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _c1 = Wosize_val(_v_domain);
+  domain = camlidl_malloc(_c1 * sizeof(Z3_sort const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_domain, _c2);
+    camlidl_ml2c_z3_Z3_sort(_v3, &domain[_c2], _ctx);
+  }
+  domain_size = _c1;
+  camlidl_ml2c_z3_Z3_sort(_v_range, &range, _ctx);
+  _res = Z3_mk_injective_function(c, s, domain_size, domain, range);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_is_eq_ast(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_is_eq_ast(c, t1, t2);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_is_eq_func_decl(
+	value _v_c,
+	value _v_f1,
+	value _v_f2)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl f1; /*in*/
+  Z3_func_decl f2; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f1, &f1, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f2, &f2, _ctx);
+  _res = Z3_is_eq_func_decl(c, f1, f2);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_func_decl(
+	value _v_c,
+	value _v_s,
+	value _v_domain,
+	value _v_range)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  unsigned int domain_size; /*in*/
+  Z3_sort const *domain; /*in*/
+  Z3_sort range; /*in*/
+  Z3_func_decl _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _c1 = Wosize_val(_v_domain);
+  domain = camlidl_malloc(_c1 * sizeof(Z3_sort const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_domain, _c2);
+    camlidl_ml2c_z3_Z3_sort(_v3, &domain[_c2], _ctx);
+  }
+  domain_size = _c1;
+  camlidl_ml2c_z3_Z3_sort(_v_range, &range, _ctx);
+  _res = Z3_mk_func_decl(c, s, domain_size, domain, range);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_app(
+	value _v_c,
+	value _v_d,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_app(c, d, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_const(
+	value _v_c,
+	value _v_s,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_const(c, s, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_label(
+	value _v_c,
+	value _v_s,
+	value _v_is_pos,
+	value _v_f)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  int is_pos; /*in*/
+  Z3_ast f; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  is_pos = Int_val(_v_is_pos);
+  camlidl_ml2c_z3_Z3_ast(_v_f, &f, _ctx);
+  _res = Z3_mk_label(c, s, is_pos, f);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_fresh_func_decl(
+	value _v_c,
+	value _v_prefix,
+	value _v_domain,
+	value _v_range)
+{
+  Z3_context c; /*in*/
+  char const *prefix; /*in*/
+  unsigned int domain_size; /*in*/
+  Z3_sort const *domain; /*in*/
+  Z3_sort range; /*in*/
+  Z3_func_decl _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  prefix = String_val(_v_prefix);
+  _c1 = Wosize_val(_v_domain);
+  domain = camlidl_malloc(_c1 * sizeof(Z3_sort const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_domain, _c2);
+    camlidl_ml2c_z3_Z3_sort(_v3, &domain[_c2], _ctx);
+  }
+  domain_size = _c1;
+  camlidl_ml2c_z3_Z3_sort(_v_range, &range, _ctx);
+  _res = Z3_mk_fresh_func_decl(c, prefix, domain_size, domain, range);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_fresh_const(
+	value _v_c,
+	value _v_prefix,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  char const *prefix; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  prefix = String_val(_v_prefix);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_fresh_const(c, prefix, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_true(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_mk_true(c);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_false(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_mk_false(c);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_eq(
+	value _v_c,
+	value _v_l,
+	value _v_r)
+{
+  Z3_context c; /*in*/
+  Z3_ast l; /*in*/
+  Z3_ast r; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_l, &l, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_r, &r, _ctx);
+  _res = Z3_mk_eq(c, l, r);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_distinct(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_distinct(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_not(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_mk_not(c, a);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_ite(
+	value _v_c,
+	value _v_t1,
+	value _v_t2,
+	value _v_t3)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast t3; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t3, &t3, _ctx);
+  _res = Z3_mk_ite(c, t1, t2, t3);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_iff(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_iff(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_implies(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_implies(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_xor(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_xor(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_and(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_and(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_or(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_or(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_add(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_add(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_mul(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_mul(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_sub(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_sub(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_unary_minus(
+	value _v_c,
+	value _v_arg)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg, &arg, _ctx);
+  _res = Z3_mk_unary_minus(c, arg);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_div(
+	value _v_c,
+	value _v_arg1,
+	value _v_arg2)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg1; /*in*/
+  Z3_ast arg2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg1, &arg1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg2, &arg2, _ctx);
+  _res = Z3_mk_div(c, arg1, arg2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_mod(
+	value _v_c,
+	value _v_arg1,
+	value _v_arg2)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg1; /*in*/
+  Z3_ast arg2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg1, &arg1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg2, &arg2, _ctx);
+  _res = Z3_mk_mod(c, arg1, arg2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_rem(
+	value _v_c,
+	value _v_arg1,
+	value _v_arg2)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg1; /*in*/
+  Z3_ast arg2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg1, &arg1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg2, &arg2, _ctx);
+  _res = Z3_mk_rem(c, arg1, arg2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_lt(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_lt(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_le(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_le(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_gt(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_gt(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_ge(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_ge(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_int2real(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_int2real(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_real2int(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_real2int(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_is_int(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_is_int(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvnot(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_bvnot(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvredand(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_bvredand(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvredor(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_bvredor(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvand(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvand(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvor(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvor(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvxor(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvxor(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvnand(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvnand(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvnor(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvnor(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvxnor(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvxnor(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvneg(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_bvneg(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvadd(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvadd(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsub(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsub(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvmul(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvmul(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvudiv(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvudiv(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsdiv(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsdiv(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvurem(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvurem(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsrem(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsrem(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsmod(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsmod(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvult(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvult(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvslt(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvslt(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvule(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvule(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsle(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsle(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvuge(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvuge(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsge(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsge(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvugt(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvugt(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsgt(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsgt(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_concat(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_concat(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_extract(
+	value _v_c,
+	value _v_high,
+	value _v_low,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int high; /*in*/
+  unsigned int low; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  high = Int_val(_v_high);
+  low = Int_val(_v_low);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_extract(c, high, low, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_sign_ext(
+	value _v_c,
+	value _v_i,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_sign_ext(c, i, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_zero_ext(
+	value _v_c,
+	value _v_i,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_zero_ext(c, i, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_repeat(
+	value _v_c,
+	value _v_i,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_repeat(c, i, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvshl(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvshl(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvlshr(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvlshr(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvashr(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvashr(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_rotate_left(
+	value _v_c,
+	value _v_i,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_rotate_left(c, i, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_rotate_right(
+	value _v_c,
+	value _v_i,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_rotate_right(c, i, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_ext_rotate_left(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_ext_rotate_left(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_ext_rotate_right(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_ext_rotate_right(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_int2bv(
+	value _v_c,
+	value _v_n,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  unsigned int n; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  n = Int_val(_v_n);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_int2bv(c, n, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bv2int(
+	value _v_c,
+	value _v_t1,
+	value _v_is_signed)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  int is_signed; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  is_signed = Int_val(_v_is_signed);
+  _res = Z3_mk_bv2int(c, t1, is_signed);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvadd_no_overflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2,
+	value _v_is_signed)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  int is_signed; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  is_signed = Int_val(_v_is_signed);
+  _res = Z3_mk_bvadd_no_overflow(c, t1, t2, is_signed);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvadd_no_underflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvadd_no_underflow(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsub_no_overflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsub_no_overflow(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsub_no_underflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2,
+	value _v_is_signed)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  int is_signed; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  is_signed = Int_val(_v_is_signed);
+  _res = Z3_mk_bvsub_no_underflow(c, t1, t2, is_signed);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvsdiv_no_overflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvsdiv_no_overflow(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvneg_no_overflow(
+	value _v_c,
+	value _v_t1)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  _res = Z3_mk_bvneg_no_overflow(c, t1);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvmul_no_overflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2,
+	value _v_is_signed)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  int is_signed; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  is_signed = Int_val(_v_is_signed);
+  _res = Z3_mk_bvmul_no_overflow(c, t1, t2, is_signed);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bvmul_no_underflow(
+	value _v_c,
+	value _v_t1,
+	value _v_t2)
+{
+  Z3_context c; /*in*/
+  Z3_ast t1; /*in*/
+  Z3_ast t2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t1, &t1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t2, &t2, _ctx);
+  _res = Z3_mk_bvmul_no_underflow(c, t1, t2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_select(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_i, &i, _ctx);
+  _res = Z3_mk_select(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_store(
+	value _v_c,
+	value _v_a,
+	value _v_i,
+	value _v_v)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast i; /*in*/
+  Z3_ast v; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_i, &i, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  _res = Z3_mk_store(c, a, i, v);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_const_array(
+	value _v_c,
+	value _v_domain,
+	value _v_v)
+{
+  Z3_context c; /*in*/
+  Z3_sort domain; /*in*/
+  Z3_ast v; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_domain, &domain, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  _res = Z3_mk_const_array(c, domain, v);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_map(
+	value _v_c,
+	value _v_f,
+	value _v_n,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl f; /*in*/
+  unsigned int n; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  Z3_ast _c1;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f, &f, _ctx);
+  n = Int_val(_v_n);
+  args = &_c1;
+  camlidl_ml2c_z3_Z3_ast(_v_args, &_c1, _ctx);
+  _res = Z3_mk_map(c, f, n, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_array_default(
+	value _v_c,
+	value _v_array)
+{
+  Z3_context c; /*in*/
+  Z3_ast array; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_array, &array, _ctx);
+  _res = Z3_mk_array_default(c, array);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_sort(
+	value _v_c,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_set_sort(c, ty);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_empty_set(
+	value _v_c,
+	value _v_domain)
+{
+  Z3_context c; /*in*/
+  Z3_sort domain; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_domain, &domain, _ctx);
+  _res = Z3_mk_empty_set(c, domain);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_full_set(
+	value _v_c,
+	value _v_domain)
+{
+  Z3_context c; /*in*/
+  Z3_sort domain; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_domain, &domain, _ctx);
+  _res = Z3_mk_full_set(c, domain);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_add(
+	value _v_c,
+	value _v_set,
+	value _v_elem)
+{
+  Z3_context c; /*in*/
+  Z3_ast set; /*in*/
+  Z3_ast elem; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_set, &set, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_elem, &elem, _ctx);
+  _res = Z3_mk_set_add(c, set, elem);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_del(
+	value _v_c,
+	value _v_set,
+	value _v_elem)
+{
+  Z3_context c; /*in*/
+  Z3_ast set; /*in*/
+  Z3_ast elem; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_set, &set, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_elem, &elem, _ctx);
+  _res = Z3_mk_set_del(c, set, elem);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_union(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_set_union(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_intersect(
+	value _v_c,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast const *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_mk_set_intersect(c, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_difference(
+	value _v_c,
+	value _v_arg1,
+	value _v_arg2)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg1; /*in*/
+  Z3_ast arg2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg1, &arg1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg2, &arg2, _ctx);
+  _res = Z3_mk_set_difference(c, arg1, arg2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_complement(
+	value _v_c,
+	value _v_arg)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg, &arg, _ctx);
+  _res = Z3_mk_set_complement(c, arg);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_member(
+	value _v_c,
+	value _v_elem,
+	value _v_set)
+{
+  Z3_context c; /*in*/
+  Z3_ast elem; /*in*/
+  Z3_ast set; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_elem, &elem, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_set, &set, _ctx);
+  _res = Z3_mk_set_member(c, elem, set);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_set_subset(
+	value _v_c,
+	value _v_arg1,
+	value _v_arg2)
+{
+  Z3_context c; /*in*/
+  Z3_ast arg1; /*in*/
+  Z3_ast arg2; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg1, &arg1, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_arg2, &arg2, _ctx);
+  _res = Z3_mk_set_subset(c, arg1, arg2);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_numeral(
+	value _v_c,
+	value _v_numeral,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  char const *numeral; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  numeral = String_val(_v_numeral);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_numeral(c, numeral, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_real(
+	value _v_c,
+	value _v_num,
+	value _v_den)
+{
+  Z3_context c; /*in*/
+  int num; /*in*/
+  int den; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  num = Int_val(_v_num);
+  den = Int_val(_v_den);
+  _res = Z3_mk_real(c, num, den);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_int(
+	value _v_c,
+	value _v_v,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  int v; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  v = Int_val(_v_v);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_int(c, v, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_unsigned_int(
+	value _v_c,
+	value _v_v,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  unsigned int v; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  v = Int_val(_v_v);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_unsigned_int(c, v, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_pattern(
+	value _v_c,
+	value _v_terms)
+{
+  Z3_context c; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_ast const *terms; /*in*/
+  Z3_pattern _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_terms);
+  terms = camlidl_malloc(_c1 * sizeof(Z3_ast const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_terms, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &terms[_c2], _ctx);
+  }
+  num_patterns = _c1;
+  _res = Z3_mk_pattern(c, num_patterns, terms);
+  _vres = camlidl_c2ml_z3_Z3_pattern(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_bound(
+	value _v_c,
+	value _v_index,
+	value _v_ty)
+{
+  Z3_context c; /*in*/
+  unsigned int index; /*in*/
+  Z3_sort ty; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  index = Int_val(_v_index);
+  camlidl_ml2c_z3_Z3_sort(_v_ty, &ty, _ctx);
+  _res = Z3_mk_bound(c, index, ty);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_forall(
+	value _v_c,
+	value _v_weight,
+	value _v_patterns,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_sort const *sorts; /*in*/
+  Z3_symbol const *decl_names; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c1 * sizeof(Z3_pattern const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_patterns, _c2);
+    camlidl_ml2c_z3_Z3_pattern(_v3, &patterns[_c2], _ctx);
+  }
+  num_patterns = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_decls = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol const ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_forall(c, weight, num_patterns, patterns, num_decls, sorts, decl_names, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_forall_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_forall(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_mk_exists(
+	value _v_c,
+	value _v_weight,
+	value _v_patterns,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_sort const *sorts; /*in*/
+  Z3_symbol const *decl_names; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c1 * sizeof(Z3_pattern const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_patterns, _c2);
+    camlidl_ml2c_z3_Z3_pattern(_v3, &patterns[_c2], _ctx);
+  }
+  num_patterns = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_decls = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol const ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_exists(c, weight, num_patterns, patterns, num_decls, sorts, decl_names, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_exists_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_exists(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_mk_quantifier(
+	value _v_c,
+	value _v_is_forall,
+	value _v_weight,
+	value _v_patterns,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  int is_forall; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_sort const *sorts; /*in*/
+  Z3_symbol const *decl_names; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  is_forall = Int_val(_v_is_forall);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c1 * sizeof(Z3_pattern const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_patterns, _c2);
+    camlidl_ml2c_z3_Z3_pattern(_v3, &patterns[_c2], _ctx);
+  }
+  num_patterns = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_decls = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol const ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_quantifier(c, is_forall, weight, num_patterns, patterns, num_decls, sorts, decl_names, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_quantifier_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_quantifier(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]);
+}
+
+value camlidl_z3_Z3_mk_quantifier_ex(
+	value _v_c,
+	value _v_is_forall,
+	value _v_weight,
+	value _v_quantifier_id,
+	value _v_skolem_id,
+	value _v_patterns,
+	value _v_no_patterns,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  int is_forall; /*in*/
+  unsigned int weight; /*in*/
+  Z3_symbol quantifier_id; /*in*/
+  Z3_symbol skolem_id; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  unsigned int num_no_patterns; /*in*/
+  Z3_ast const *no_patterns; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_sort const *sorts; /*in*/
+  Z3_symbol const *decl_names; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  mlsize_t _c11;
+  value _v12;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  is_forall = Int_val(_v_is_forall);
+  weight = Int_val(_v_weight);
+  camlidl_ml2c_z3_Z3_symbol(_v_quantifier_id, &quantifier_id, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_skolem_id, &skolem_id, _ctx);
+  _c1 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c1 * sizeof(Z3_pattern const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_patterns, _c2);
+    camlidl_ml2c_z3_Z3_pattern(_v3, &patterns[_c2], _ctx);
+  }
+  num_patterns = _c1;
+  _c4 = Wosize_val(_v_no_patterns);
+  no_patterns = camlidl_malloc(_c4 * sizeof(Z3_ast const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_no_patterns, _c5);
+    camlidl_ml2c_z3_Z3_ast(_v6, &no_patterns[_c5], _ctx);
+  }
+  num_no_patterns = _c4;
+  _c7 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c7 * sizeof(Z3_sort const ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_sorts, _c8);
+    camlidl_ml2c_z3_Z3_sort(_v9, &sorts[_c8], _ctx);
+  }
+  num_decls = _c7;
+  _c10 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c10 * sizeof(Z3_symbol const ), _ctx);
+  for (_c11 = 0; _c11 < _c10; _c11++) {
+    _v12 = Field(_v_decl_names, _c11);
+    camlidl_ml2c_z3_Z3_symbol(_v12, &decl_names[_c11], _ctx);
+  }
+  num_decls = _c10;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_quantifier_ex(c, is_forall, weight, quantifier_id, skolem_id, num_patterns, patterns, num_no_patterns, no_patterns, num_decls, sorts, decl_names, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_quantifier_ex_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_quantifier_ex(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8], argv[9]);
+}
+
+value camlidl_z3_Z3_mk_forall_const(
+	value _v_c,
+	value _v_weight,
+	value _v_bound,
+	value _v_patterns,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_bound; /*in*/
+  Z3_app const *bound; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_bound);
+  bound = camlidl_malloc(_c1 * sizeof(Z3_app const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_bound, _c2);
+    camlidl_ml2c_z3_Z3_app(_v3, &bound[_c2], _ctx);
+  }
+  num_bound = _c1;
+  _c4 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c4 * sizeof(Z3_pattern const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_patterns, _c5);
+    camlidl_ml2c_z3_Z3_pattern(_v6, &patterns[_c5], _ctx);
+  }
+  num_patterns = _c4;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_forall_const(c, weight, num_bound, bound, num_patterns, patterns, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_exists_const(
+	value _v_c,
+	value _v_weight,
+	value _v_bound,
+	value _v_patterns,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_bound; /*in*/
+  Z3_app const *bound; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_bound);
+  bound = camlidl_malloc(_c1 * sizeof(Z3_app const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_bound, _c2);
+    camlidl_ml2c_z3_Z3_app(_v3, &bound[_c2], _ctx);
+  }
+  num_bound = _c1;
+  _c4 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c4 * sizeof(Z3_pattern const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_patterns, _c5);
+    camlidl_ml2c_z3_Z3_pattern(_v6, &patterns[_c5], _ctx);
+  }
+  num_patterns = _c4;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_exists_const(c, weight, num_bound, bound, num_patterns, patterns, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_quantifier_const(
+	value _v_c,
+	value _v_is_forall,
+	value _v_weight,
+	value _v_bound,
+	value _v_patterns,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  int is_forall; /*in*/
+  unsigned int weight; /*in*/
+  unsigned int num_bound; /*in*/
+  Z3_app const *bound; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  is_forall = Int_val(_v_is_forall);
+  weight = Int_val(_v_weight);
+  _c1 = Wosize_val(_v_bound);
+  bound = camlidl_malloc(_c1 * sizeof(Z3_app const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_bound, _c2);
+    camlidl_ml2c_z3_Z3_app(_v3, &bound[_c2], _ctx);
+  }
+  num_bound = _c1;
+  _c4 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c4 * sizeof(Z3_pattern const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_patterns, _c5);
+    camlidl_ml2c_z3_Z3_pattern(_v6, &patterns[_c5], _ctx);
+  }
+  num_patterns = _c4;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_quantifier_const(c, is_forall, weight, num_bound, bound, num_patterns, patterns, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_quantifier_const_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_quantifier_const(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_mk_quantifier_const_ex(
+	value _v_c,
+	value _v_is_forall,
+	value _v_weight,
+	value _v_quantifier_id,
+	value _v_skolem_id,
+	value _v_bound,
+	value _v_patterns,
+	value _v_no_patterns,
+	value _v_body)
+{
+  Z3_context c; /*in*/
+  int is_forall; /*in*/
+  unsigned int weight; /*in*/
+  Z3_symbol quantifier_id; /*in*/
+  Z3_symbol skolem_id; /*in*/
+  unsigned int num_bound; /*in*/
+  Z3_app const *bound; /*in*/
+  unsigned int num_patterns; /*in*/
+  Z3_pattern const *patterns; /*in*/
+  unsigned int num_no_patterns; /*in*/
+  Z3_ast const *no_patterns; /*in*/
+  Z3_ast body; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  is_forall = Int_val(_v_is_forall);
+  weight = Int_val(_v_weight);
+  camlidl_ml2c_z3_Z3_symbol(_v_quantifier_id, &quantifier_id, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_skolem_id, &skolem_id, _ctx);
+  _c1 = Wosize_val(_v_bound);
+  bound = camlidl_malloc(_c1 * sizeof(Z3_app const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_bound, _c2);
+    camlidl_ml2c_z3_Z3_app(_v3, &bound[_c2], _ctx);
+  }
+  num_bound = _c1;
+  _c4 = Wosize_val(_v_patterns);
+  patterns = camlidl_malloc(_c4 * sizeof(Z3_pattern const ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_patterns, _c5);
+    camlidl_ml2c_z3_Z3_pattern(_v6, &patterns[_c5], _ctx);
+  }
+  num_patterns = _c4;
+  _c7 = Wosize_val(_v_no_patterns);
+  no_patterns = camlidl_malloc(_c7 * sizeof(Z3_ast const ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_no_patterns, _c8);
+    camlidl_ml2c_z3_Z3_ast(_v9, &no_patterns[_c8], _ctx);
+  }
+  num_no_patterns = _c7;
+  camlidl_ml2c_z3_Z3_ast(_v_body, &body, _ctx);
+  _res = Z3_mk_quantifier_const_ex(c, is_forall, weight, quantifier_id, skolem_id, num_bound, bound, num_patterns, patterns, num_no_patterns, no_patterns, body);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_mk_quantifier_const_ex_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_mk_quantifier_const_ex(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8]);
+}
+
+value camlidl_z3_Z3_get_ast_id(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_ast t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t, &t, _ctx);
+  _res = Z3_get_ast_id(c, t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_func_decl_id(
+	value _v_c,
+	value _v_f)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl f; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f, &f, _ctx);
+  _res = Z3_get_func_decl_id(c, f);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_sort_id(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_sort s; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_get_sort_id(c, s);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_is_well_sorted(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_ast t; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t, &t, _ctx);
+  _res = Z3_is_well_sorted(c, t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_symbol_kind(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  Z3_symbol_kind _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _res = Z3_get_symbol_kind(c, s);
+  _vres = camlidl_c2ml_z3_Z3_symbol_kind(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_symbol_int(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _res = Z3_get_symbol_int(c, s);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_symbol_string(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_symbol s; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _res = Z3_get_symbol_string(c, s);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_ast_kind(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast_kind _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_ast_kind(c, a);
+  _vres = camlidl_c2ml_z3_Z3_ast_kind(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_numeral_string(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_numeral_string(c, a);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_numeral_small(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  __int64 *num; /*out*/
+  __int64 *den; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  __int64 _c1;
+  __int64 _c2;
+  value _vresult;
+  value _vres[3] = { 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  num = &_c1;
+  den = &_c2;
+  _res = Z3_get_numeral_small(c, a, num, den);
+  Begin_roots_block(_vres, 3)
+    _vres[0] = Val_int(_res);
+    _vres[1] = copy_int64(*num);
+    _vres[2] = copy_int64(*den);
+    _vresult = camlidl_alloc_small(3, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_numeral_int(
+	value _v_c,
+	value _v_v)
+{
+  Z3_context c; /*in*/
+  Z3_ast v; /*in*/
+  int *i; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  int _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  i = &_c1;
+  _res = Z3_get_numeral_int(c, v, i);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = Val_int(*i);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_numeral_uint(
+	value _v_c,
+	value _v_v)
+{
+  Z3_context c; /*in*/
+  Z3_ast v; /*in*/
+  unsigned int *u; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  unsigned int _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  u = &_c1;
+  _res = Z3_get_numeral_uint(c, v, u);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = Val_int(*u);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_bool_value(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_lbool _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_bool_value(c, a);
+  _vres = camlidl_c2ml_z3_Z3_lbool(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_app_decl(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_app a; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_app(_v_a, &a, _ctx);
+  _res = Z3_get_app_decl(c, a);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_app_num_args(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_app a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_app(_v_a, &a, _ctx);
+  _res = Z3_get_app_num_args(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_app_arg(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_app a; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_app(_v_a, &a, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_app_arg(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_index_value(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_index_value(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_is_quantifier_forall(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_is_quantifier_forall(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_weight(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_quantifier_weight(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_num_patterns(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_quantifier_num_patterns(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_pattern_ast(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int i; /*in*/
+  Z3_pattern _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_quantifier_pattern_ast(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_pattern(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_num_no_patterns(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_quantifier_num_no_patterns(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_no_pattern_ast(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_quantifier_no_pattern_ast(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_bound_name(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int i; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_quantifier_bound_name(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_bound_sort(
+	value _v_c,
+	value _v_a,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int i; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_quantifier_bound_sort(c, a, i);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_body(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_quantifier_body(c, a);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_quantifier_num_bound(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_quantifier_num_bound(c, a);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_name(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_get_decl_name(c, d);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_num_parameters(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_get_decl_num_parameters(c, d);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_parameter_kind(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  Z3_parameter_kind _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_parameter_kind(c, d, idx);
+  _vres = camlidl_c2ml_z3_Z3_parameter_kind(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_int_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_int_parameter(c, d, idx);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_double_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  double _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_double_parameter(c, d, idx);
+  _vres = copy_double(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_symbol_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_symbol_parameter(c, d, idx);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_sort_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_sort_parameter(c, d, idx);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_ast_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_ast_parameter(c, d, idx);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_func_decl_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_func_decl_parameter(c, d, idx);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_rational_parameter(
+	value _v_c,
+	value _v_d,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int idx; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_decl_rational_parameter(c, d, idx);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_sort_name(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_sort d; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_d, &d, _ctx);
+  _res = Z3_get_sort_name(c, d);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_sort(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_get_sort(c, a);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_domain_size(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_get_domain_size(c, d);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_domain(
+	value _v_c,
+	value _v_d,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int i; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_domain(c, d, i);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_range(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_get_range(c, d);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_sort_kind(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  Z3_sort_kind _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_sort_kind(c, t);
+  _vres = camlidl_c2ml_z3_Z3_sort_kind(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_bv_sort_size(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_bv_sort_size(c, t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_array_sort_domain(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_array_sort_domain(c, t);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_array_sort_range(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_array_sort_range(c, t);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_tuple_sort_mk_decl(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_tuple_sort_mk_decl(c, t);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_decl_kind(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  Z3_decl_kind _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_get_decl_kind(c, d);
+  _vres = camlidl_c2ml_z3_Z3_decl_kind(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_tuple_sort_num_fields(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_tuple_sort_num_fields(c, t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_tuple_sort_field_decl(
+	value _v_c,
+	value _v_t,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int i; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_tuple_sort_field_decl(c, t, i);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_datatype_sort_num_constructors(
+	value _v_c,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  _res = Z3_get_datatype_sort_num_constructors(c, t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_datatype_sort_constructor(
+	value _v_c,
+	value _v_t,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int idx; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_datatype_sort_constructor(c, t, idx);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_datatype_sort_recognizer(
+	value _v_c,
+	value _v_t,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int idx; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_datatype_sort_recognizer(c, t, idx);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_datatype_sort_constructor_accessor(
+	value _v_c,
+	value _v_t,
+	value _v_idx_c,
+	value _v_idx_a)
+{
+  Z3_context c; /*in*/
+  Z3_sort t; /*in*/
+  unsigned int idx_c; /*in*/
+  unsigned int idx_a; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_t, &t, _ctx);
+  idx_c = Int_val(_v_idx_c);
+  idx_a = Int_val(_v_idx_a);
+  _res = Z3_get_datatype_sort_constructor_accessor(c, t, idx_c, idx_a);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_relation_arity(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_sort s; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_get_relation_arity(c, s);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_relation_column(
+	value _v_c,
+	value _v_s,
+	value _v_col)
+{
+  Z3_context c; /*in*/
+  Z3_sort s; /*in*/
+  unsigned int col; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  col = Int_val(_v_col);
+  _res = Z3_get_relation_column(c, s, col);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_pattern_num_terms(
+	value _v_c,
+	value _v_p)
+{
+  Z3_context c; /*in*/
+  Z3_pattern p; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_pattern(_v_p, &p, _ctx);
+  _res = Z3_get_pattern_num_terms(c, p);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_pattern(
+	value _v_c,
+	value _v_p,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_pattern p; /*in*/
+  unsigned int idx; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_pattern(_v_p, &p, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_pattern(c, p, idx);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_simplify(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_simplify(c, a);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_update_term(
+	value _v_c,
+	value _v_a,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast *args; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  _res = Z3_update_term(c, a, num_args, args);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_substitute(
+	value _v_c,
+	value _v_a,
+	value _v_from,
+	value _v_to)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int num_exprs; /*in*/
+  Z3_ast *from; /*in*/
+  Z3_ast *to; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _c1 = Wosize_val(_v_from);
+  from = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_from, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &from[_c2], _ctx);
+  }
+  num_exprs = _c1;
+  _c4 = Wosize_val(_v_to);
+  to = camlidl_malloc(_c4 * sizeof(Z3_ast ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_to, _c5);
+    camlidl_ml2c_z3_Z3_ast(_v6, &to[_c5], _ctx);
+  }
+  num_exprs = _c4;
+  _res = Z3_substitute(c, a, num_exprs, from, to);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_substitute_vars(
+	value _v_c,
+	value _v_a,
+	value _v_to)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int num_exprs; /*in*/
+  Z3_ast *to; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _c1 = Wosize_val(_v_to);
+  to = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_to, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &to[_c2], _ctx);
+  }
+  num_exprs = _c1;
+  _res = Z3_substitute_vars(c, a, num_exprs, to);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_sort_to_ast(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_sort s; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_sort_to_ast(c, s);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_func_decl_to_ast(
+	value _v_c,
+	value _v_f)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl f; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f, &f, _ctx);
+  _res = Z3_func_decl_to_ast(c, f);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_pattern_to_ast(
+	value _v_c,
+	value _v_p)
+{
+  Z3_context c; /*in*/
+  Z3_pattern p; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_pattern(_v_p, &p, _ctx);
+  _res = Z3_pattern_to_ast(c, p);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_app_to_ast(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_app a; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_app(_v_a, &a, _ctx);
+  _res = Z3_app_to_ast(c, a);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_to_app(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  Z3_app _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_to_app(c, a);
+  _vres = camlidl_c2ml_z3_Z3_app(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_push(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_push(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_pop(
+	value _v_c,
+	value _v_num_scopes)
+{
+  Z3_context c; /*in*/
+  unsigned int num_scopes; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  num_scopes = Int_val(_v_num_scopes);
+  Z3_pop(c, num_scopes);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_get_num_scopes(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_num_scopes(c);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_persist_ast(
+	value _v_c,
+	value _v_a,
+	value _v_num_scopes)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  unsigned int num_scopes; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  num_scopes = Int_val(_v_num_scopes);
+  Z3_persist_ast(c, a, num_scopes);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_assert_cnstr(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  Z3_assert_cnstr(c, a);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_check_and_get_model(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_model *m; /*out*/
+  Z3_lbool _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  Z3_model _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  m = &_c1;
+  _res = Z3_check_and_get_model(c, m);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = camlidl_c2ml_z3_Z3_lbool(&_res, _ctx);
+    _vres[1] = camlidl_c2ml_z3_Z3_model(&*m, _ctx);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_check(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_lbool _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_check(c);
+  _vres = camlidl_c2ml_z3_Z3_lbool(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_check_assumptions(
+	value _v_c,
+	value _v_assumptions,
+	value _v_core_size,
+	value _v_core)
+{
+  Z3_context c; /*in*/
+  unsigned int num_assumptions; /*in*/
+  Z3_ast *assumptions; /*in*/
+  Z3_model *m; /*out*/
+  Z3_ast *proof; /*out*/
+  unsigned int *core_size; /*in,out*/
+  Z3_ast *core; /*in,out*/
+  Z3_lbool _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  unsigned int _c4;
+  mlsize_t _c5;
+  mlsize_t _c6;
+  value _v7;
+  Z3_model _c8;
+  Z3_ast _c9;
+  mlsize_t _c10;
+  value _v11;
+  value _vresult;
+  value _vres[5] = { 0, 0, 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_assumptions);
+  assumptions = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_assumptions, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &assumptions[_c2], _ctx);
+  }
+  num_assumptions = _c1;
+  core_size = &_c4;
+  _c4 = Int_val(_v_core_size);
+  _c5 = Wosize_val(_v_core);
+  core = camlidl_malloc(_c5 * sizeof(Z3_ast ), _ctx);
+  for (_c6 = 0; _c6 < _c5; _c6++) {
+    _v7 = Field(_v_core, _c6);
+    camlidl_ml2c_z3_Z3_ast(_v7, &core[_c6], _ctx);
+  }
+  num_assumptions = _c5;
+  m = &_c8;
+  proof = &_c9;
+  _res = Z3_check_assumptions(c, num_assumptions, assumptions, m, proof, core_size, core);
+  Begin_roots_block(_vres, 5)
+    _vres[0] = camlidl_c2ml_z3_Z3_lbool(&_res, _ctx);
+    _vres[1] = camlidl_c2ml_z3_Z3_model(&*m, _ctx);
+    _vres[2] = camlidl_c2ml_z3_Z3_ast(&*proof, _ctx);
+    _vres[3] = Val_int(*core_size);
+    _vres[4] = camlidl_alloc(num_assumptions, 0);
+    Begin_root(_vres[4])
+      for (_c10 = 0; _c10 < num_assumptions; _c10++) {
+        _v11 = camlidl_c2ml_z3_Z3_ast(&core[_c10], _ctx);
+        modify(&Field(_vres[4], _c10), _v11);
+      }
+    End_roots()
+    _vresult = camlidl_alloc_small(5, 0);
+    { mlsize_t _c12;
+      for (_c12 = 0; _c12 < 5; _c12++) Field(_vresult, _c12) = _vres[_c12];
+    }
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_implied_equalities(
+	value _v_c,
+	value _v_terms)
+{
+  Z3_context c; /*in*/
+  unsigned int num_terms; /*in*/
+  Z3_ast *terms; /*in*/
+  unsigned int *class_ids; /*out*/
+  Z3_lbool _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  value _v5;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _c1 = Wosize_val(_v_terms);
+  terms = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_terms, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &terms[_c2], _ctx);
+  }
+  num_terms = _c1;
+  class_ids = camlidl_malloc(num_terms * sizeof(unsigned int ), _ctx);
+  _res = Z3_get_implied_equalities(c, num_terms, terms, class_ids);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = camlidl_c2ml_z3_Z3_lbool(&_res, _ctx);
+    _vres[1] = camlidl_alloc(num_terms, 0);
+    for (_c4 = 0; _c4 < num_terms; _c4++) {
+      _v5 = Val_int(class_ids[_c4]);
+      modify(&Field(_vres[1], _c4), _v5);
+    }
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_del_model(
+	value _v_c,
+	value _v_m)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  Z3_del_model(c, m);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_soft_check_cancel(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_soft_check_cancel(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_get_search_failure(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_search_failure _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_search_failure(c);
+  _vres = camlidl_c2ml_z3_Z3_search_failure(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_relevant_labels(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_literals _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_relevant_labels(c);
+  _vres = camlidl_c2ml_z3_Z3_literals(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_relevant_literals(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_literals _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_relevant_literals(c);
+  _vres = camlidl_c2ml_z3_Z3_literals(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_guessed_literals(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_literals _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_guessed_literals(c);
+  _vres = camlidl_c2ml_z3_Z3_literals(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_del_literals(
+	value _v_c,
+	value _v_lbls)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  Z3_del_literals(c, lbls);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_get_num_literals(
+	value _v_c,
+	value _v_lbls)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  _res = Z3_get_num_literals(c, lbls);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_label_symbol(
+	value _v_c,
+	value _v_lbls,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  unsigned int idx; /*in*/
+  Z3_symbol _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_label_symbol(c, lbls, idx);
+  _vres = camlidl_c2ml_z3_Z3_symbol(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_literal(
+	value _v_c,
+	value _v_lbls,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  unsigned int idx; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  idx = Int_val(_v_idx);
+  _res = Z3_get_literal(c, lbls, idx);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_disable_literal(
+	value _v_c,
+	value _v_lbls,
+	value _v_idx)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  unsigned int idx; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  idx = Int_val(_v_idx);
+  Z3_disable_literal(c, lbls, idx);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_block_literals(
+	value _v_c,
+	value _v_lbls)
+{
+  Z3_context c; /*in*/
+  Z3_literals lbls; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_literals(_v_lbls, &lbls, _ctx);
+  Z3_block_literals(c, lbls);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_get_model_num_constants(
+	value _v_c,
+	value _v_m)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  _res = Z3_get_model_num_constants(c, m);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_constant(
+	value _v_c,
+	value _v_m,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_model_constant(c, m, i);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_eval_func_decl(
+	value _v_c,
+	value _v_m,
+	value _v_decl)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  Z3_func_decl decl; /*in*/
+  Z3_ast *v; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  Z3_ast _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_decl, &decl, _ctx);
+  v = &_c1;
+  _res = Z3_eval_func_decl(c, m, decl, v);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = camlidl_c2ml_z3_Z3_ast(&*v, _ctx);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_is_array_value(
+	value _v_c,
+	value _v_m,
+	value _v_v)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  Z3_ast v; /*in*/
+  unsigned int *num_entries; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  unsigned int _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  num_entries = &_c1;
+  _res = Z3_is_array_value(c, m, v, num_entries);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = Val_int(*num_entries);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_array_value(
+	value _v_c,
+	value _v_m,
+	value _v_v,
+	value _v_indices,
+	value _v_values)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  Z3_ast v; /*in*/
+  unsigned int num_entries; /*in*/
+  Z3_ast *indices; /*in,out*/
+  Z3_ast *values; /*in,out*/
+  Z3_ast *else_value; /*out*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  Z3_ast _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  value _v11;
+  value _vresult;
+  value _vres[3] = { 0, 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_v, &v, _ctx);
+  _c1 = Wosize_val(_v_indices);
+  indices = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_indices, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &indices[_c2], _ctx);
+  }
+  num_entries = _c1;
+  _c4 = Wosize_val(_v_values);
+  values = camlidl_malloc(_c4 * sizeof(Z3_ast ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_values, _c5);
+    camlidl_ml2c_z3_Z3_ast(_v6, &values[_c5], _ctx);
+  }
+  num_entries = _c4;
+  else_value = &_c7;
+  Z3_get_array_value(c, m, v, num_entries, indices, values, else_value);
+  Begin_roots_block(_vres, 3)
+    _vres[0] = camlidl_alloc(num_entries, 0);
+    Begin_root(_vres[0])
+      for (_c8 = 0; _c8 < num_entries; _c8++) {
+        _v9 = camlidl_c2ml_z3_Z3_ast(&indices[_c8], _ctx);
+        modify(&Field(_vres[0], _c8), _v9);
+      }
+    End_roots()
+    _vres[1] = camlidl_alloc(num_entries, 0);
+    Begin_root(_vres[1])
+      for (_c10 = 0; _c10 < num_entries; _c10++) {
+        _v11 = camlidl_c2ml_z3_Z3_ast(&values[_c10], _ctx);
+        modify(&Field(_vres[1], _c10), _v11);
+      }
+    End_roots()
+    _vres[2] = camlidl_c2ml_z3_Z3_ast(&*else_value, _ctx);
+    _vresult = camlidl_alloc_small(3, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_get_model_num_funcs(
+	value _v_c,
+	value _v_m)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  _res = Z3_get_model_num_funcs(c, m);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_decl(
+	value _v_c,
+	value _v_m,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_model_func_decl(c, m, i);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_else(
+	value _v_c,
+	value _v_m,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_model_func_else(c, m, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_num_entries(
+	value _v_c,
+	value _v_m,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_model_func_num_entries(c, m, i);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_entry_num_args(
+	value _v_c,
+	value _v_m,
+	value _v_i,
+	value _v_j)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  unsigned int j; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  j = Int_val(_v_j);
+  _res = Z3_get_model_func_entry_num_args(c, m, i, j);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_entry_arg(
+	value _v_c,
+	value _v_m,
+	value _v_i,
+	value _v_j,
+	value _v_k)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  unsigned int j; /*in*/
+  unsigned int k; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  j = Int_val(_v_j);
+  k = Int_val(_v_k);
+  _res = Z3_get_model_func_entry_arg(c, m, i, j, k);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_model_func_entry_value(
+	value _v_c,
+	value _v_m,
+	value _v_i,
+	value _v_j)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  unsigned int i; /*in*/
+  unsigned int j; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  i = Int_val(_v_i);
+  j = Int_val(_v_j);
+  _res = Z3_get_model_func_entry_value(c, m, i, j);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_eval(
+	value _v_c,
+	value _v_m,
+	value _v_t)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  Z3_ast t; /*in*/
+  Z3_ast *v; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  Z3_ast _c1;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_t, &t, _ctx);
+  v = &_c1;
+  _res = Z3_eval(c, m, t, v);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = camlidl_c2ml_z3_Z3_ast(&*v, _ctx);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_eval_decl(
+	value _v_c,
+	value _v_m,
+	value _v_d,
+	value _v_args)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  Z3_func_decl d; /*in*/
+  unsigned int num_args; /*in*/
+  Z3_ast *args; /*in*/
+  Z3_ast *v; /*out*/
+  int _res;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  Z3_ast _c4;
+  value _vresult;
+  value _vres[2] = { 0, 0, };
+
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _c1 = Wosize_val(_v_args);
+  args = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_args, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &args[_c2], _ctx);
+  }
+  num_args = _c1;
+  v = &_c4;
+  _res = Z3_eval_decl(c, m, d, num_args, args, v);
+  Begin_roots_block(_vres, 2)
+    _vres[0] = Val_int(_res);
+    _vres[1] = camlidl_c2ml_z3_Z3_ast(&*v, _ctx);
+    _vresult = camlidl_alloc_small(2, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+  End_roots()
+  camlidl_free(_ctx);
+  return _vresult;
+}
+
+value camlidl_z3_Z3_open_log(
+	value _v_c,
+	value _v_filename)
+{
+  Z3_context c; /*in*/
+  char const *filename; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  filename = String_val(_v_filename);
+  _res = Z3_open_log(c, filename);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_append_log(
+	value _v_c,
+	value _v_string)
+{
+  Z3_context c; /*in*/
+  char const *string; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  string = String_val(_v_string);
+  Z3_append_log(c, string);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_close_log(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  Z3_close_log(c);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_set_ast_print_mode(
+	value _v_c,
+	value _v_mode)
+{
+  Z3_context c; /*in*/
+  Z3_ast_print_mode mode; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast_print_mode(_v_mode, &mode, _ctx);
+  Z3_set_ast_print_mode(c, mode);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_ast_to_string(
+	value _v_c,
+	value _v_a)
+{
+  Z3_context c; /*in*/
+  Z3_ast a; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_a, &a, _ctx);
+  _res = Z3_ast_to_string(c, a);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_pattern_to_string(
+	value _v_c,
+	value _v_p)
+{
+  Z3_context c; /*in*/
+  Z3_pattern p; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_pattern(_v_p, &p, _ctx);
+  _res = Z3_pattern_to_string(c, p);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_sort_to_string(
+	value _v_c,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_sort s; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_sort_to_string(c, s);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_func_decl_to_string(
+	value _v_c,
+	value _v_d)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl d; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_func_decl_to_string(c, d);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_model_to_string(
+	value _v_c,
+	value _v_m)
+{
+  Z3_context c; /*in*/
+  Z3_model m; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_model(_v_m, &m, _ctx);
+  _res = Z3_model_to_string(c, m);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_benchmark_to_smtlib_string(
+	value _v_c,
+	value _v_name,
+	value _v_logic,
+	value _v_status,
+	value _v_attributes,
+	value _v_assumptions,
+	value _v_formula)
+{
+  Z3_context c; /*in*/
+  char const *name; /*in*/
+  char const *logic; /*in*/
+  char const *status; /*in*/
+  char const *attributes; /*in*/
+  unsigned int num_assumptions; /*in*/
+  Z3_ast *assumptions; /*in*/
+  Z3_ast formula; /*in*/
+  char const *_res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  name = String_val(_v_name);
+  logic = String_val(_v_logic);
+  status = String_val(_v_status);
+  attributes = String_val(_v_attributes);
+  _c1 = Wosize_val(_v_assumptions);
+  assumptions = camlidl_malloc(_c1 * sizeof(Z3_ast ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_assumptions, _c2);
+    camlidl_ml2c_z3_Z3_ast(_v3, &assumptions[_c2], _ctx);
+  }
+  num_assumptions = _c1;
+  camlidl_ml2c_z3_Z3_ast(_v_formula, &formula, _ctx);
+  _res = Z3_benchmark_to_smtlib_string(c, name, logic, status, attributes, num_assumptions, assumptions, formula);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_benchmark_to_smtlib_string_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_benchmark_to_smtlib_string(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]);
+}
+
+value camlidl_z3_Z3_context_to_string(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_context_to_string(c);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_statistics_to_string(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_statistics_to_string(c);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_context_assignment(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_context_assignment(c);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_smtlib_string(
+	value _v_c,
+	value _v_str,
+	value _v_sort_names,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_decls)
+{
+  Z3_context c; /*in*/
+  char const *str; /*in*/
+  unsigned int num_sorts; /*in*/
+  Z3_symbol *sort_names; /*in*/
+  Z3_sort *sorts; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_symbol *decl_names; /*in*/
+  Z3_func_decl *decls; /*in*/
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  mlsize_t _c11;
+  value _v12;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  str = String_val(_v_str);
+  _c1 = Wosize_val(_v_sort_names);
+  sort_names = camlidl_malloc(_c1 * sizeof(Z3_symbol ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_sort_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &sort_names[_c2], _ctx);
+  }
+  num_sorts = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_sorts = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  _c10 = Wosize_val(_v_decls);
+  decls = camlidl_malloc(_c10 * sizeof(Z3_func_decl ), _ctx);
+  for (_c11 = 0; _c11 < _c10; _c11++) {
+    _v12 = Field(_v_decls, _c11);
+    camlidl_ml2c_z3_Z3_func_decl(_v12, &decls[_c11], _ctx);
+  }
+  num_decls = _c10;
+  Z3_parse_smtlib_string(c, str, num_sorts, sort_names, sorts, num_decls, decl_names, decls);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_parse_smtlib_string_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_parse_smtlib_string(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_parse_smtlib_file(
+	value _v_c,
+	value _v_file_name,
+	value _v_sort_names,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_decls)
+{
+  Z3_context c; /*in*/
+  char const *file_name; /*in*/
+  unsigned int num_sorts; /*in*/
+  Z3_symbol *sort_names; /*in*/
+  Z3_sort *sorts; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_symbol *decl_names; /*in*/
+  Z3_func_decl *decls; /*in*/
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  mlsize_t _c11;
+  value _v12;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  file_name = String_val(_v_file_name);
+  _c1 = Wosize_val(_v_sort_names);
+  sort_names = camlidl_malloc(_c1 * sizeof(Z3_symbol ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_sort_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &sort_names[_c2], _ctx);
+  }
+  num_sorts = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_sorts = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  _c10 = Wosize_val(_v_decls);
+  decls = camlidl_malloc(_c10 * sizeof(Z3_func_decl ), _ctx);
+  for (_c11 = 0; _c11 < _c10; _c11++) {
+    _v12 = Field(_v_decls, _c11);
+    camlidl_ml2c_z3_Z3_func_decl(_v12, &decls[_c11], _ctx);
+  }
+  num_decls = _c10;
+  Z3_parse_smtlib_file(c, file_name, num_sorts, sort_names, sorts, num_decls, decl_names, decls);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_parse_smtlib_file_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_parse_smtlib_file(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_get_smtlib_num_formulas(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_smtlib_num_formulas(c);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_formula(
+	value _v_c,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_smtlib_formula(c, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_num_assumptions(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_smtlib_num_assumptions(c);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_assumption(
+	value _v_c,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_smtlib_assumption(c, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_num_decls(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_smtlib_num_decls(c);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_decl(
+	value _v_c,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_func_decl _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_smtlib_decl(c, i);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_num_sorts(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_smtlib_num_sorts(c);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_sort(
+	value _v_c,
+	value _v_i)
+{
+  Z3_context c; /*in*/
+  unsigned int i; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_get_smtlib_sort(c, i);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_get_smtlib_error(
+	value _v_c)
+{
+  Z3_context c; /*in*/
+  char const *_res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  _res = Z3_get_smtlib_error(c);
+  _vres = copy_string(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_z3_string(
+	value _v_c,
+	value _v_str)
+{
+  Z3_context c; /*in*/
+  char const *str; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  str = String_val(_v_str);
+  _res = Z3_parse_z3_string(c, str);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_z3_file(
+	value _v_c,
+	value _v_file_name)
+{
+  Z3_context c; /*in*/
+  char const *file_name; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  file_name = String_val(_v_file_name);
+  _res = Z3_parse_z3_file(c, file_name);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_smtlib2_string(
+	value _v_c,
+	value _v_str,
+	value _v_sort_names,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_decls)
+{
+  Z3_context c; /*in*/
+  char const *str; /*in*/
+  unsigned int num_sorts; /*in*/
+  Z3_symbol *sort_names; /*in*/
+  Z3_sort *sorts; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_symbol *decl_names; /*in*/
+  Z3_func_decl *decls; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  mlsize_t _c11;
+  value _v12;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  str = String_val(_v_str);
+  _c1 = Wosize_val(_v_sort_names);
+  sort_names = camlidl_malloc(_c1 * sizeof(Z3_symbol ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_sort_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &sort_names[_c2], _ctx);
+  }
+  num_sorts = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_sorts = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  _c10 = Wosize_val(_v_decls);
+  decls = camlidl_malloc(_c10 * sizeof(Z3_func_decl ), _ctx);
+  for (_c11 = 0; _c11 < _c10; _c11++) {
+    _v12 = Field(_v_decls, _c11);
+    camlidl_ml2c_z3_Z3_func_decl(_v12, &decls[_c11], _ctx);
+  }
+  num_decls = _c10;
+  _res = Z3_parse_smtlib2_string(c, str, num_sorts, sort_names, sorts, num_decls, decl_names, decls);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_smtlib2_string_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_parse_smtlib2_string(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_parse_smtlib2_file(
+	value _v_c,
+	value _v_file_name,
+	value _v_sort_names,
+	value _v_sorts,
+	value _v_decl_names,
+	value _v_decls)
+{
+  Z3_context c; /*in*/
+  char const *file_name; /*in*/
+  unsigned int num_sorts; /*in*/
+  Z3_symbol *sort_names; /*in*/
+  Z3_sort *sorts; /*in*/
+  unsigned int num_decls; /*in*/
+  Z3_symbol *decl_names; /*in*/
+  Z3_func_decl *decls; /*in*/
+  Z3_ast _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  mlsize_t _c4;
+  mlsize_t _c5;
+  value _v6;
+  mlsize_t _c7;
+  mlsize_t _c8;
+  value _v9;
+  mlsize_t _c10;
+  mlsize_t _c11;
+  value _v12;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  file_name = String_val(_v_file_name);
+  _c1 = Wosize_val(_v_sort_names);
+  sort_names = camlidl_malloc(_c1 * sizeof(Z3_symbol ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_sort_names, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &sort_names[_c2], _ctx);
+  }
+  num_sorts = _c1;
+  _c4 = Wosize_val(_v_sorts);
+  sorts = camlidl_malloc(_c4 * sizeof(Z3_sort ), _ctx);
+  for (_c5 = 0; _c5 < _c4; _c5++) {
+    _v6 = Field(_v_sorts, _c5);
+    camlidl_ml2c_z3_Z3_sort(_v6, &sorts[_c5], _ctx);
+  }
+  num_sorts = _c4;
+  _c7 = Wosize_val(_v_decl_names);
+  decl_names = camlidl_malloc(_c7 * sizeof(Z3_symbol ), _ctx);
+  for (_c8 = 0; _c8 < _c7; _c8++) {
+    _v9 = Field(_v_decl_names, _c8);
+    camlidl_ml2c_z3_Z3_symbol(_v9, &decl_names[_c8], _ctx);
+  }
+  num_decls = _c7;
+  _c10 = Wosize_val(_v_decls);
+  decls = camlidl_malloc(_c10 * sizeof(Z3_func_decl ), _ctx);
+  for (_c11 = 0; _c11 < _c10; _c11++) {
+    _v12 = Field(_v_decls, _c11);
+    camlidl_ml2c_z3_Z3_func_decl(_v12, &decls[_c11], _ctx);
+  }
+  num_decls = _c10;
+  _res = Z3_parse_smtlib2_file(c, file_name, num_sorts, sort_names, sorts, num_decls, decl_names, decls);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_parse_smtlib2_file_bytecode(value * argv, int argn)
+{
+  return camlidl_z3_Z3_parse_smtlib2_file(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
+}
+
+value camlidl_z3_Z3_get_version(value _unit)
+{
+  unsigned int *major; /*out*/
+  unsigned int *minor; /*out*/
+  unsigned int *build_number; /*out*/
+  unsigned int *revision_number; /*out*/
+  unsigned int _c1;
+  unsigned int _c2;
+  unsigned int _c3;
+  unsigned int _c4;
+  value _vresult;
+  value _vres[4] = { 0, 0, 0, 0, };
+
+  major = &_c1;
+  minor = &_c2;
+  build_number = &_c3;
+  revision_number = &_c4;
+  Z3_get_version(major, minor, build_number, revision_number);
+  Begin_roots_block(_vres, 4)
+    _vres[0] = Val_int(*major);
+    _vres[1] = Val_int(*minor);
+    _vres[2] = Val_int(*build_number);
+    _vres[3] = Val_int(*revision_number);
+    _vresult = camlidl_alloc_small(4, 0);
+    Field(_vresult, 0) = _vres[0];
+    Field(_vresult, 1) = _vres[1];
+    Field(_vresult, 2) = _vres[2];
+    Field(_vresult, 3) = _vres[3];
+  End_roots()
+  return _vresult;
+}
+
+value camlidl_z3_Z3_reset_memory(value _unit)
+{
+  Z3_reset_memory();
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_theory_mk_sort(
+	value _v_c,
+	value _v_t,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_theory t; /*in*/
+  Z3_symbol s; /*in*/
+  Z3_sort _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_s, &s, _ctx);
+  _res = Z3_theory_mk_sort(c, t, s);
+  _vres = camlidl_c2ml_z3_Z3_sort(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_mk_value(
+	value _v_c,
+	value _v_t,
+	value _v_n,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_theory t; /*in*/
+  Z3_symbol n; /*in*/
+  Z3_sort s; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_n, &n, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_theory_mk_value(c, t, n, s);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_mk_constant(
+	value _v_c,
+	value _v_t,
+	value _v_n,
+	value _v_s)
+{
+  Z3_context c; /*in*/
+  Z3_theory t; /*in*/
+  Z3_symbol n; /*in*/
+  Z3_sort s; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_n, &n, _ctx);
+  camlidl_ml2c_z3_Z3_sort(_v_s, &s, _ctx);
+  _res = Z3_theory_mk_constant(c, t, n, s);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_mk_func_decl(
+	value _v_c,
+	value _v_t,
+	value _v_n,
+	value _v_domain,
+	value _v_range)
+{
+  Z3_context c; /*in*/
+  Z3_theory t; /*in*/
+  Z3_symbol n; /*in*/
+  unsigned int domain_size; /*in*/
+  Z3_sort const *domain; /*in*/
+  Z3_sort range; /*in*/
+  Z3_func_decl _res;
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_n, &n, _ctx);
+  _c1 = Wosize_val(_v_domain);
+  domain = camlidl_malloc(_c1 * sizeof(Z3_sort const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_domain, _c2);
+    camlidl_ml2c_z3_Z3_sort(_v3, &domain[_c2], _ctx);
+  }
+  domain_size = _c1;
+  camlidl_ml2c_z3_Z3_sort(_v_range, &range, _ctx);
+  _res = Z3_theory_mk_func_decl(c, t, n, domain_size, domain, range);
+  _vres = camlidl_c2ml_z3_Z3_func_decl(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_context(
+	value _v_t)
+{
+  Z3_theory t; /*in*/
+  Z3_context _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  _res = Z3_theory_get_context(t);
+  _vres = camlidl_c2ml_z3_Z3_context(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_assert_axiom(
+	value _v_t,
+	value _v_ax)
+{
+  Z3_theory t; /*in*/
+  Z3_ast ax; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_ax, &ax, _ctx);
+  Z3_theory_assert_axiom(t, ax);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_theory_assume_eq(
+	value _v_t,
+	value _v_lhs,
+	value _v_rhs)
+{
+  Z3_theory t; /*in*/
+  Z3_ast lhs; /*in*/
+  Z3_ast rhs; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_lhs, &lhs, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_rhs, &rhs, _ctx);
+  Z3_theory_assume_eq(t, lhs, rhs);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_theory_enable_axiom_simplification(
+	value _v_t,
+	value _v_flag)
+{
+  Z3_theory t; /*in*/
+  int flag; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  flag = Int_val(_v_flag);
+  Z3_theory_enable_axiom_simplification(t, flag);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_theory_get_eqc_root(
+	value _v_t,
+	value _v_n)
+{
+  Z3_theory t; /*in*/
+  Z3_ast n; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_n, &n, _ctx);
+  _res = Z3_theory_get_eqc_root(t, n);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_eqc_next(
+	value _v_t,
+	value _v_n)
+{
+  Z3_theory t; /*in*/
+  Z3_ast n; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_n, &n, _ctx);
+  _res = Z3_theory_get_eqc_next(t, n);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_num_parents(
+	value _v_t,
+	value _v_n)
+{
+  Z3_theory t; /*in*/
+  Z3_ast n; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_n, &n, _ctx);
+  _res = Z3_theory_get_num_parents(t, n);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_parent(
+	value _v_t,
+	value _v_n,
+	value _v_i)
+{
+  Z3_theory t; /*in*/
+  Z3_ast n; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_n, &n, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_theory_get_parent(t, n, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_is_value(
+	value _v_t,
+	value _v_n)
+{
+  Z3_theory t; /*in*/
+  Z3_ast n; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_n, &n, _ctx);
+  _res = Z3_theory_is_value(t, n);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_is_decl(
+	value _v_t,
+	value _v_d)
+{
+  Z3_theory t; /*in*/
+  Z3_func_decl d; /*in*/
+  int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_d, &d, _ctx);
+  _res = Z3_theory_is_decl(t, d);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_num_elems(
+	value _v_t)
+{
+  Z3_theory t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  _res = Z3_theory_get_num_elems(t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_elem(
+	value _v_t,
+	value _v_i)
+{
+  Z3_theory t; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_theory_get_elem(t, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_num_apps(
+	value _v_t)
+{
+  Z3_theory t; /*in*/
+  unsigned int _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  _res = Z3_theory_get_num_apps(t);
+  _vres = Val_int(_res);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_theory_get_app(
+	value _v_t,
+	value _v_i)
+{
+  Z3_theory t; /*in*/
+  unsigned int i; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_theory(_v_t, &t, _ctx);
+  i = Int_val(_v_i);
+  _res = Z3_theory_get_app(t, i);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_datalog_add_rule(
+	value _v_c,
+	value _v_horn_rule,
+	value _v_name)
+{
+  Z3_context c; /*in*/
+  Z3_ast horn_rule; /*in*/
+  Z3_symbol name; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_horn_rule, &horn_rule, _ctx);
+  camlidl_ml2c_z3_Z3_symbol(_v_name, &name, _ctx);
+  Z3_datalog_add_rule(c, horn_rule, name);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_datalog_query(
+	value _v_c,
+	value _v_q)
+{
+  Z3_context c; /*in*/
+  Z3_ast q; /*in*/
+  Z3_ast _res;
+  value _vres;
+
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_ast(_v_q, &q, _ctx);
+  _res = Z3_datalog_query(c, q);
+  _vres = camlidl_c2ml_z3_Z3_ast(&_res, _ctx);
+  camlidl_free(_ctx);
+  return _vres;
+}
+
+value camlidl_z3_Z3_datalog_set_predicate_representation(
+	value _v_c,
+	value _v_f,
+	value _v_relation_kinds)
+{
+  Z3_context c; /*in*/
+  Z3_func_decl f; /*in*/
+  unsigned int num_relations; /*in*/
+  Z3_symbol const *relation_kinds; /*in*/
+  mlsize_t _c1;
+  mlsize_t _c2;
+  value _v3;
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  camlidl_ml2c_z3_Z3_func_decl(_v_f, &f, _ctx);
+  _c1 = Wosize_val(_v_relation_kinds);
+  relation_kinds = camlidl_malloc(_c1 * sizeof(Z3_symbol const ), _ctx);
+  for (_c2 = 0; _c2 < _c1; _c2++) {
+    _v3 = Field(_v_relation_kinds, _c2);
+    camlidl_ml2c_z3_Z3_symbol(_v3, &relation_kinds[_c2], _ctx);
+  }
+  num_relations = _c1;
+  Z3_datalog_set_predicate_representation(c, f, num_relations, relation_kinds);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+value camlidl_z3_Z3_datalog_parse_file(
+	value _v_c,
+	value _v_filename)
+{
+  Z3_context c; /*in*/
+  char const *filename; /*in*/
+  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
+  camlidl_ctx _ctx = &_ctxs;
+  camlidl_ml2c_z3_Z3_context(_v_c, &c, _ctx);
+  filename = String_val(_v_filename);
+  Z3_datalog_parse_file(c, filename);
+  camlidl_free(_ctx);
+  return Val_unit;
+}
+
+ external/z3/ocaml/z3_theory_stubs.c view
@@ -0,0 +1,337 @@+/*++
+Copyright (c) 2010 Microsoft Corporation
+
+Module Name:
+
+    z3_theory_stubs.c
+
+Abstract:
+
+    OCaml C bindings for callbacks between OCaml and C for
+    theory plugins. 
+    The API for theory plugins require associating a set of
+    callbacks as C function pointers.  
+    We use the following strategy:
+
+    - store in the user_ext_data blob that theory constructors allow
+      a record of callback functions.
+
+    - define catch-all static callback functions that access the 
+      ML record with the callbacks. It then invokes these through user-registered
+      application functions that apply the callback stored in the record to the
+      actual parameters.
+      It is tempting to avoid this user-registered callback and directly access 
+      the record of callback functions and apply the proper field. 
+      However, the layout of records appears to be opaque, or at least we assume it is
+      so, from the C runtime.
+
+Author:
+
+
+Revision History:
+--*/
+
+#include <stddef.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#ifdef Custom_tag
+#include <caml/custom.h>
+#include <caml/bigarray.h>
+#endif
+
+#include "z3.h"
+
+#define ML_SIZE(_ty) ((sizeof(_ty) + sizeof(value) - 1)/ sizeof(value))
+
+static value mk_func_decl(Z3_func_decl f) {
+    value _f = alloc(ML_SIZE(Z3_func_decl), Abstract_tag);
+    *((Z3_func_decl*) Bp_val(_f)) = f;
+    return _f;
+}
+
+static value Val_ast(Z3_ast a) {
+    value _a = alloc(ML_SIZE(Z3_ast), Abstract_tag);
+    *((Z3_ast*) Bp_val(_a)) = a;
+    return _a;
+}
+
+
+static value Val_ast_array(unsigned int sz, Z3_ast const args[]) {
+    value res;
+    Z3_ast* args1;
+    unsigned int i;
+    args1 = malloc((sz+1)*sizeof(Z3_ast));
+    for (i = 0; i < sz; ++i) {
+        args1[i] = args[i];
+    }
+    args1[sz] = 0;
+    res = alloc_array((value (*)(char const*))Val_ast, (const char**)args1);
+    free(args1);
+    return res;
+}
+
+// ------------------
+// get_theory_callbacks
+// 
+
+value get_theory_callbacks(value th) 
+{
+    Z3_theory _th = *((Z3_theory*) Bp_val(th));
+    return (value) Z3_theory_get_ext_data(_th);
+}
+
+// ------------------
+// delete_theory
+// 
+static void delete_callback_static(Z3_theory th) 
+{
+    CAMLparam0();
+    CAMLlocal1(f);  
+    value user_data = (value) Z3_theory_get_ext_data(th);
+    f = *(caml_named_value("apply_delete")) ;
+    callback(f, user_data);
+    remove_global_root(&user_data);
+    CAMLreturn0;
+}
+
+#define SET_CALLBACK(_cb_name)                     \
+    value set_ ## _cb_name ## _callback_register(value th)  \
+    {                                              \
+        CAMLparam1(th);                                         \
+        Z3_theory _th = *((Z3_theory*) Bp_val(th));                     \
+        Z3_set_ ## _cb_name ## _callback(_th, _cb_name ## _callback_static);   \
+        CAMLreturn(Val_unit);                                           \
+    }                                                                   \
+
+SET_CALLBACK(delete);
+
+
+// ------------------
+// mk_theory
+// 
+
+value mk_theory_register(value context, value name, value user_data) 
+{
+    CAMLparam3(context, name, user_data);
+    Z3_context _context = *((Z3_context *) Bp_val(context));
+    value _th;
+    Z3_theory th;
+    register_global_root(&user_data);
+    th = Z3_mk_theory(_context, String_val(name), (void*)user_data);
+    Z3_set_delete_callback(th, delete_callback_static);
+    _th = alloc(ML_SIZE(Z3_context), Abstract_tag);
+    *((Z3_theory*) Bp_val(_th)) = th;
+    CAMLreturn(_th);
+}
+
+
+// -------------------
+// reduce_app_callback
+
+static Z3_bool reduce_app_callback_static(Z3_theory th, Z3_func_decl f, unsigned num_args, Z3_ast const args[], Z3_ast* r) {
+    CAMLparam0();
+    CAMLlocal4(cb, _r, _v, _args);
+    value user_data;
+    Z3_bool result;
+
+    _args = Val_ast_array(num_args, args);
+
+    user_data = (value) Z3_theory_get_ext_data(th);
+
+    cb = *(caml_named_value("apply_reduce_app"));
+    _r = callback3(cb, user_data, mk_func_decl(f), _args);
+
+    cb = *(caml_named_value("is_some"));
+    _v = callback(cb, _r);
+    result = 0 != Bool_val(_v);
+
+    if (result && r) {
+        cb = *(caml_named_value("get_some"));
+        _v = callback(cb, _r);
+        *r = *((Z3_ast*) Bp_val(_v));
+    }
+
+    CAMLreturn (result);
+}
+
+SET_CALLBACK(reduce_app);
+
+// -------------------
+// reduce_eq_callback
+
+static Z3_bool reduce_eq_callback_static(Z3_theory th, Z3_ast a, Z3_ast b, Z3_ast * r) 
+{
+    CAMLparam0();
+    CAMLlocal5(cb, _r, _a, _b, _v);
+    value user_data;
+    Z3_bool result;
+
+    _a = Val_ast(a);
+    _b = Val_ast(b);
+
+    user_data = (value) Z3_theory_get_ext_data(th);
+
+    cb = *(caml_named_value("apply_reduce_eq"));
+    _r = callback3(cb, user_data, _a, _b);
+
+    cb = *(caml_named_value("is_some"));
+    _v = callback(cb, _r);
+    result = 0 != Bool_val(_v);
+
+    if (result && r) {
+        cb = *(caml_named_value("get_some"));
+        _v = callback(cb, _r);
+        *r = *((Z3_ast*) Bp_val(_v));
+    }
+
+    CAMLreturn (result);
+}
+
+SET_CALLBACK(reduce_eq);
+
+
+// -------------------
+// reduce_distinct
+
+static Z3_bool reduce_distinct_callback_static(Z3_theory th, unsigned n, Z3_ast const args[], Z3_ast * r)
+{
+    CAMLparam0();
+    CAMLlocal4(cb, _r, _args, _v);
+    value user_data;
+    Z3_bool result;
+
+    _args = Val_ast_array(n, args);
+
+    user_data = (value) Z3_theory_get_ext_data(th);
+
+    cb = *(caml_named_value("apply_reduce_distinct"));
+    _r = callback2(cb, user_data, _args);
+
+    cb = *(caml_named_value("is_some"));
+    _v = callback(cb, _r);
+    result = 0 != Bool_val(_v);
+
+    if (result && r) {
+        cb = *(caml_named_value("get_some"));
+        _v = callback(cb, _r);
+        *r = *((Z3_ast*) Bp_val(_v));
+    }
+
+    CAMLreturn (result);
+}
+
+SET_CALLBACK(reduce_distinct);
+
+// -------------------
+// new_app
+
+#define AST_CALLBACK(_cb_name) \
+static void _cb_name##_callback_static(Z3_theory th, Z3_ast a)        \
+{                                                           \
+    CAMLparam0();                                           \
+    CAMLlocal3(cb, _a, user_data);                          \
+    _a = Val_ast(a);                                         \
+    user_data = (value) Z3_theory_get_ext_data(th);         \
+    cb = *(caml_named_value("apply_" #_cb_name));           \
+    callback2(cb, user_data, _a);                           \
+    CAMLreturn0;                                            \
+}                                                           \
+
+AST_CALLBACK(new_app);
+SET_CALLBACK(new_app);
+
+// -------------------
+// new_elem
+
+AST_CALLBACK(new_elem);
+SET_CALLBACK(new_elem);
+
+// -------------------
+// init_search
+
+#define TH_CALLBACK(_cb_name) \
+static void _cb_name##_callback_static(Z3_theory th)        \
+{                                                           \
+    CAMLparam0();                                           \
+    CAMLlocal2(cb, user_data);                              \
+    user_data = (value) Z3_theory_get_ext_data(th);         \
+    cb = *(caml_named_value("apply_" #_cb_name));           \
+    callback(cb, user_data);                                \
+    CAMLreturn0;                                            \
+}                                                           \
+
+TH_CALLBACK(init_search);
+SET_CALLBACK(init_search);
+
+// -------------------
+// push
+
+TH_CALLBACK(push);
+SET_CALLBACK(push);
+
+TH_CALLBACK(pop);
+SET_CALLBACK(pop);
+
+TH_CALLBACK(restart);
+SET_CALLBACK(restart);
+
+TH_CALLBACK(reset);
+SET_CALLBACK(reset);
+
+        
+#define FC_CALLBACK(_cb_name) \
+    static Z3_bool _cb_name##_callback_static(Z3_theory th)             \
+    {                                                                   \
+    CAMLparam0();                                                       \
+    CAMLlocal3(cb, r, user_data);                                       \
+    user_data = (value) Z3_theory_get_ext_data(th);                     \
+    cb = *(caml_named_value("apply_" #_cb_name));                       \
+    r = callback(cb, user_data);                                        \
+    CAMLreturn (Bool_val(r) != 0);                                      \
+    }                                                                   \
+    
+FC_CALLBACK(final_check);
+SET_CALLBACK(final_check);
+
+#define AST_AST_CALLBACK(_cb_name) \
+    static void _cb_name##_callback_static(Z3_theory th, Z3_ast a, Z3_ast b)     \
+    {                                                                   \
+        CAMLparam0();                                                   \
+        CAMLlocal4(cb, _a, _b, user_data);                              \
+        _a = Val_ast(a);                                                \
+        _b = Val_ast(b);                                                \
+        user_data = (value) Z3_theory_get_ext_data(th);                 \
+        cb = *(caml_named_value("apply_" #_cb_name));                   \
+        callback3(cb, user_data, _a, _b);                               \
+        CAMLreturn0;                                                    \
+    }                                                                   \
+    
+AST_AST_CALLBACK(new_eq);
+SET_CALLBACK(new_eq);
+
+AST_AST_CALLBACK(new_diseq);
+SET_CALLBACK(new_diseq);
+
+#define AST_BOOL_CALLBACK(_cb_name) \
+    static void _cb_name##_callback_static(Z3_theory th, Z3_ast a, Z3_bool b)     \
+    {                                                                   \
+        CAMLparam0();                                                   \
+        CAMLlocal4(cb, _a, _b, user_data);                              \
+        _a = Val_ast(a);                                                \
+        _b = Val_bool(b);                                               \
+        user_data = (value) Z3_theory_get_ext_data(th);                 \
+        cb = *(caml_named_value("apply_" #_cb_name));                   \
+        callback3(cb, user_data, _a, _b);                               \
+        CAMLreturn0;                                                    \
+    }                                                                   \
+
+    
+AST_BOOL_CALLBACK(new_assignment);
+SET_CALLBACK(new_assignment);
+
+AST_CALLBACK(new_relevant);
+SET_CALLBACK(new_relevant);
+ liquid-fixpoint.cabal view
@@ -0,0 +1,133 @@+name:                liquid-fixpoint+version:             0.1.0.0+synopsis:            Predicate Abstraction-based Horn-Clause/Implication Constraint Solver+homepage:            https://github.com/ucsd-progsys/liquid-fixpoint+license:             BSD3+license-file:        LICENSE+author:              Ranjit Jhala+maintainer:          jhala@cs.ucsd.edu+category:            Language+build-type:          Custom +cabal-version:       >=1.8++description:     This package is a Haskell wrapper to the SMTLIB-based+                 Horn-Clause/Logical Implication constraint solver used+                 for Liquid Types. +                 .+                 The solver itself is written in Ocaml. +                 .+                 The package includes: +                 .+                 1. Types for Expressions, Predicates, Constraints, Solutions+                 .+                 2. Code for serializing the above+                 .+                 3. Code for parsing the results from the fixpoint.native binary+                 .+                 4. The Ocaml fixpoint code+                 .+                 5. (Deprecated) Z3 binaries if you want to link against the API.+                 .+                 Requirements+                 .+                 In addition to the .cabal dependencies you require +                 .+                 - A Recent Ocaml compiler+                 .+                 - A Z3 Binary (<http://z3.codeplex.com>)+++Extra-Source-Files: configure+                  , external/fixpoint/Makefile+                  , external/fixpoint/*.ml+                  , external/fixpoint/smtZ3.mem.ml+                  , external/fixpoint/smtZ3.nomem.ml+                  , external/fixpoint/*.mli+                  , external/fixpoint/*.mll+                  , external/fixpoint/*.mly+                  , external/misc/*.ml+                  , external/misc/*.mli+                  , external/ocamlgraph/.depend+                  , external/ocamlgraph/Makefile+                  , external/ocamlgraph/Makefile.in+                  , external/ocamlgraph/META+                  , external/ocamlgraph/META.in+                  , external/ocamlgraph/configure+                  , external/ocamlgraph/configure.in+                  , external/ocamlgraph/lib/*.ml+                  , external/ocamlgraph/lib/*.mli+                  , external/ocamlgraph/src/*.ml+                  , external/ocamlgraph/src/*.mli+                  , external/ocamlgraph/src/*.mll+                  , external/ocamlgraph/src/*.mly+                  , external/z3/include/*.h+                  , external/z3/lib/libz3-a-32b+                  , external/z3/lib/libz3-a-64b+                  , external/z3/lib/libz3-so-32b+                  , external/z3/lib/libz3-so-64b+                  , external/z3/ocaml/build-lib.sh+                  , external/z3/ocaml/z3.ml+                  , external/z3/ocaml/*.c++Flag z3mem+  Description: Link to Z3+  Default:     False++Executable fixpoint+  Main-is:       Fixpoint.hs+  Build-Depends: base >= 4 && < 5+               , ghc==7.6.3+               , array+               , syb+               , cmdargs+               , ansi-terminal+               , bifunctors+               , bytestring+               , containers+               , deepseq+               , directory+               , filemanip+               , filepath+               , ghc-prim+               , mtl+               , parsec+               , pretty+               , process+               , text+               , hashable<1.2+               , unordered-containers+               , liquid-fixpoint++Library+  hs-source-dirs:  src+  Exposed-Modules: Language.Fixpoint.Names,+                   Language.Fixpoint.Files,+                   Language.Fixpoint.Config,+                   Language.Fixpoint.Types,+                   Language.Fixpoint.Sort,+                   Language.Fixpoint.Interface, +                   Language.Fixpoint.Parse,+                   Language.Fixpoint.PrettyPrint,+                   Language.Fixpoint.Misc+  +  Build-Depends: base+               , ghc==7.6.3+               , array+               , syb+               , cmdargs+               , ansi-terminal+               , bifunctors+               , bytestring+               , containers+               , deepseq+               , directory+               , filemanip+               , filepath+               , ghc-prim+               , mtl+               , parsec+               , pretty+               , process+               , text+               , hashable<1.2+               , unordered-containers
+ src/Language/Fixpoint/Config.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE UndecidableInstances      #-}+++module Language.Fixpoint.Config (+    Config  (..)+  , Command (..)+  , SMTSolver (..)+  , GenQualifierSort (..)+  , withTarget +) where  +  +import Language.Fixpoint.Files+import System.FilePath       +import System.Console.CmdArgs.Default+import Data.Typeable        (Typeable)+import Data.Generics        (Data)+++class Command a  where+  command :: a -> String++------------------------------------------------------------------------+-- Configuration Options -----------------------------------------------+------------------------------------------------------------------------++withTarget        :: Config -> FilePath -> Config +withTarget cfg fq = cfg { inFile = fq } { outFile = fq `withExt` Out }++data Config +  = Config { +      inFile   :: FilePath         -- target fq-file +    , outFile  :: FilePath         -- output file+    , solver   :: SMTSolver        -- which SMT solver to use +    , genSorts :: GenQualifierSort -- generalize qualifier sorts+    } deriving (Eq,Data,Typeable,Show)++instance Default Config where+  def = Config "" def def def++instance Command Config where +  command c =  command (genSorts c)    +            ++ command (solver c) +            ++ " -out " +            ++ (outFile c) ++ " " ++ (inFile c)++---------------------------------------------------------------------------------------+-- newtype OFilePath = O FilePath +--     deriving (Eq, Data,Typeable,Show)+-- +-- instance Default OFilePath where +--   def = O "out"+-- +-- instance Command OFilePath where +--   command (O s) = " -out " ++ s++newtype GenQualifierSort = GQS Bool +    deriving (Eq, Data,Typeable,Show)++instance Default GenQualifierSort where+  def = GQS False++instance Command GenQualifierSort where+  command (GQS True)  = ""+  command (GQS False) = "-no-gen-qual-sorts" ++---------------------------------------------------------------------------------------++data SMTSolver = Z3 | Cvc4 | Mathsat | Z3mem+                 deriving (Eq,Data,Typeable)++instance Command SMTSolver where +  command s = " -smtsolver " ++ show s++instance Default SMTSolver where+  def = Z3++instance Show SMTSolver where +  show Z3      = "z3"+  show Cvc4    = "cvc4"+  show Mathsat = "mathsat"+  show Z3mem   = "z3mem"++smtSolver "z3"      = Z3+smtSolver "cvc4"    = Cvc4+smtSolver "mathsat" = Mathsat+smtSolver "z3mem"   = Z3mem+smtSolver other     = error $ "ERROR: unsupported SMT Solver = " ++ other++-- defaultSolver       :: Maybe SMTSolver -> SMTSolver+-- defaultSolver       = fromMaybe Z3 +++
+ src/Language/Fixpoint/Files.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module contains Haskell variables representing globally visible +-- names for files, paths, extensions.+--+-- Rather than have strings floating around the system, all constant names+-- should be defined here, and the (exported) variables should be used and+-- manipulated elsewhere.++module Language.Fixpoint.Files (+  +  -- * Hardwired file extension names+    Ext (..)+  , extFileName+  , extModuleName+  , withExt+  , isExtFile+ +  -- * Hardwired paths +  , getFixpointPath, getZ3LibPath++  -- * Various generic utility functions for finding and removing files+  , getHsTargets+  , getFileInDirs+  , findFileInDirs+  , copyFiles+  +) where++import qualified Control.Exception            as Ex+import           Control.Monad -- .State+import           Data.Functor                 ((<$>))+import           Data.List                    hiding (find)+import           Data.Maybe                   (fromMaybe)+import           System.Directory+import           System.Environment+import           System.FilePath+import           System.FilePath.Find+import           Language.Fixpoint.Misc++------------------------------------------------------------+-- | Hardwired Paths and Files -----------------------------+------------------------------------------------------------++getFixpointPath = fromMaybe msg <$> findExecutable "fixpoint.native"+  where msg     = errorstar "Cannot find fixpoint binary [fixpoint.native]"++getZ3LibPath    = dropFileName <$> getFixpointPath+++checkM f msg p +  = do ex <- f p+       if ex then return p else errorstar $ "Cannot find " ++ msg ++ " at :" ++ p+++-----------------------------------------------------------------------------------++data Ext = Cgi    -- ^ Constraint Generation Information +         | Fq     -- ^ Input to constraint solving (fixpoint)+         | Out    -- ^ Output from constraint solving (fixpoint)+         | Html   -- ^ HTML file with inferred type annotations +         | Annot  -- ^ Text file with inferred types +         | Hs     -- ^ Target source +         | LHs    -- ^ Literate Haskell target source file+         | Spec   -- ^ Spec file (e.g. include/Prelude.spec) +         | Hquals -- ^ Qualifiers file (e.g. include/Prelude.hquals)+         | Result -- ^ Final result: SAFE/UNSAFE+         | Cst    -- ^ HTML file with templates?+         | Mkdn   -- ^ Markdown file (temporarily generated from .Lhs + annots) +         | Json   -- ^ JSON file containing result (annots + errors)+         | Saved  -- ^ Previous version of source (for incremental checking)+         | Pred   +         | PAss    +         | Dat    +         deriving (Eq, Ord, Show)++extMap e = go e+  where +    go Cgi    = ".cgi"+    go Pred   = ".pred"+    go PAss   = ".pass"+    go Dat    = ".dat"+    go Out    = ".fqout"+    go Fq     = ".fq"+    go Html   = ".html"+    go Cst    = ".cst"+    go Annot  = ".annot"+    go Hs     = ".hs"+    go LHs    = ".lhs"+    go Mkdn   = ".markdown"+    go Json   = ".json"+    go Spec   = ".spec"+    go Hquals = ".hquals" +    go Result = ".out"+    go Saved  = ".bak"+    go _      = errorstar $ "extMap: Unknown extension " ++ show e++withExt         :: FilePath -> Ext -> FilePath +withExt f ext   =  replaceExtension f (extMap ext)++extFileName     :: Ext -> FilePath -> FilePath+extFileName ext = (`addExtension` (extMap ext))++isExtFile ::  Ext -> FilePath -> Bool+isExtFile ext = ((extMap ext) ==) . takeExtension++extModuleName ::  String -> Ext -> FilePath+extModuleName modName ext =+  case explode modName of+    [] -> errorstar $ "malformed module name: " ++ modName+    ws -> extFileName ext $ foldr1 (</>) ws+  where explode = words . map (\c -> if c == '.' then ' ' else c)++copyFiles :: [FilePath] -> FilePath -> IO ()+copyFiles srcs tgt+  = do Ex.catch (removeFile tgt) $ \(_ :: Ex.IOException) -> return ()+       forM_ srcs (readFile >=> appendFile tgt)+++----------------------------------------------------------------------------------++getHsTargets p+  | hasTrailingPathSeparator p = getHsSourceFiles p+  | otherwise                  = return [p]++getHsSourceFiles = find dirs hs+  where hs   = extension ==? ".hs" ||? extension ==? ".lhs"+        dirs = liftM (not . ("dist" `isSuffixOf`)) directory++---------------------------------------------------------------------------+++getFileInDirs :: FilePath -> [FilePath] -> IO (Maybe FilePath)+getFileInDirs name = findFirst (testM doesFileExist . (</> name))++findFileInDirs ::  FilePath -> [FilePath] -> IO FilePath+findFileInDirs file dirs+  = liftM (fromMaybe err) (findFirst (find always (fileName ==? file)) dirs)+    where err = errorstar $ "findFileInDirs: cannot find " ++ file ++ " in " ++ show dirs
+ src/Language/Fixpoint/Interface.hs view
@@ -0,0 +1,127 @@+module Language.Fixpoint.Interface (+    +    -- * Containing Constraints+    FInfo (..)+ +    -- * Invoke Solver on Set of Constraints+  , solve+  , solveFile++    -- * Function to determine outcome+  , resultExit+ +    -- * Validity Query+  , checkValid ++) where++{- Interfacing with Fixpoint Binary -}++import Data.Hashable+import Data.Monoid+import Data.Functor+import Data.List+import qualified Data.HashMap.Strict as M+import System.IO        (hPutStr, withFile, IOMode (..))+import System.Exit+import System.Directory (getTemporaryDirectory)+import System.FilePath  ((</>))+import Text.Printf++import Language.Fixpoint.Config+import Language.Fixpoint.Types         hiding (kuts, lits)+import Language.Fixpoint.Misc+import Language.Fixpoint.Parse            (rr)+import Language.Fixpoint.Files+import Text.PrettyPrint.HughesPJ+import System.Console.CmdArgs.Default+import System.Console.CmdArgs.Verbosity++---------------------------------------------------------------------------+-- | One Shot validity query ----------------------------------------------+---------------------------------------------------------------------------++---------------------------------------------------------------------------+checkValid :: (Hashable a) => a -> [(Symbol, Sort)] -> Pred -> IO (FixResult a) +---------------------------------------------------------------------------+checkValid n xts p +  = do file   <- (</> show (hash n)) <$> getTemporaryDirectory+       (r, _) <- solve def file [] $ validFInfo n xts p+       return (sinfo <$> r)  ++validFInfo         :: a -> [(Symbol, Sort)] -> Pred -> FInfo a+validFInfo l xts p = FI constrm [] benv emptySEnv [] ksEmpty []+  where +    constrm        = M.singleton 0 $ validSubc l ibenv p +    binds          = [(x, trueSortedReft t) | (x, t) <- xts]+    ibenv          = insertsIBindEnv bids emptyIBindEnv+    (bids, benv)   = foldlMap (\e (x,t) -> insertBindEnv x t e) emptyBindEnv binds++validSubc         :: a -> IBindEnv -> Pred -> SubC a  +validSubc l env p = subC env PTrue lhs rhs i t l+  where +    lhs           = top+    rhs           = RR mempty (predReft p)+    i             = Just 0+    t             = []++result         :: a -> Bool -> FixResult a    +result _ True  = Safe +result x False = Unsafe [x]+++---------------------------------------------------------------------------+-- | Solve a system of horn-clause constraints ----------------------------+---------------------------------------------------------------------------++---------------------------------------------------------------------------+solve :: Config -> FilePath -> [FilePath] -> FInfo a +      -> IO (FixResult (SubC a), M.HashMap Symbol Pred)+---------------------------------------------------------------------------+solve cfg fn hqs fi+  =   {-# SCC "Solve" #-}  execFq cfg fn hqs fi+  >>= {-# SCC "exitFq" #-} exitFq fn (cm fi) +      +execFq cfg fn hqs fi+  = do copyFiles hqs fq+       appendFile fq qstr +       withFile fq AppendMode (\h -> {-# SCC "HPrintDump" #-} hPutStr h (render d))+       solveFile $ cfg `withTarget` fq+    where +       fq   = extFileName Fq fn+       d    = {-# SCC "FixPointify" #-} toFixpoint fi +       qstr = render ((vcat $ toFix <$> (quals fi)) $$ text "\n")++---------------------------------------------------------------------------+solveFile :: Config -> IO ExitCode +---------------------------------------------------------------------------+solveFile cfg+  = do fp  <- getFixpointPath+       z3  <- getZ3LibPath+       v   <- (\b -> if b then "-v 1" else "") <$> isLoud+       ec  <- {-# SCC "sysCall:Fixpoint" #-} executeShellCommand "fixpoint" $ fixCommand cfg fp z3 v+       return ec+ +fixCommand cfg fp z3 verbosity +  = printf "LD_LIBRARY_PATH=%s %s %s -notruekvars -refinesort -noslice -nosimple -strictsortcheck -sortedquals %s" +           z3 fp verbosity (command cfg)++exitFq _ _ (ExitFailure n) | (n /= 1) +  = return (Crash [] "Unknown Error", M.empty)+exitFq fn cm _ +  = do str <- {-# SCC "readOut" #-} readFile (extFileName Out fn)+       let (x, y) = {-# SCC "parseFixOut" #-} rr ({-# SCC "sanitizeFixpointOutput" #-} sanitizeFixpointOutput str)+       return  $ (plugC cm x, y) ++plugC = fmap . mlookup++sanitizeFixpointOutput +  = unlines +  . filter (not . ("//"     `isPrefixOf`)) +  . chopAfter ("//QUALIFIERS" `isPrefixOf`)+  . lines++resultExit Safe        = ExitSuccess+resultExit (Unsafe _)  = ExitFailure 1+resultExit _           = ExitFailure 2+
+ src/Language/Fixpoint/Misc.hs view
@@ -0,0 +1,358 @@+{-# LANGUAGE DeriveDataTypeable, TupleSections, NoMonomorphismRestriction, ScopedTypeVariables #-}++module Language.Fixpoint.Misc where++import Data.Hashable+import qualified Control.Exception     as Ex+-- import qualified Data.HashSet        as S +import qualified Data.HashMap.Strict   as M+import qualified Data.List             as L+import qualified Data.ByteString       as B+import Data.ByteString.Char8    (pack, unpack)+import Control.Applicative      ((<$>))+import Control.Monad            (forM_)+import Data.Maybe               (fromJust)+import Data.Maybe               (catMaybes, fromMaybe)++import System.Exit+import System.Process           (system)+import Debug.Trace              (trace)+import Data.Data+import System.Console.ANSI+import System.Console.CmdArgs.Verbosity (whenLoud)++import Text.PrettyPrint.HughesPJ++-----------------------------------------------------------------------------------+------------ Support for Colored Logging ------------------------------------------+-----------------------------------------------------------------------------------++data Moods = Ok | Loud | Sad | Happy | Angry ++moodColor Ok    = Black+moodColor Loud  = Blue +moodColor Sad   = Magenta +moodColor Happy = Green +moodColor Angry = Red ++wrapStars msg = "\n**** " ++ msg ++ " " ++ replicate (74 - length msg) '*'+    +withColor c act+  = do setSGR [ SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid c] +       act+       setSGR [ Reset]++colorStrLn c       = withColor (moodColor c) . putStrLn +colorPhaseLn c msg = colorStrLn c . wrapStars .  (msg ++)+startPhase c msg   = colorPhaseLn c "START: " msg >> colorStrLn Ok " "+doneLine   c msg   = colorPhaseLn c "DONE:  " msg >> colorStrLn Ok " "++donePhase c str +  = case lines str of +      (l:ls) -> doneLine c l >> forM_ ls (colorPhaseLn c "")+      _      -> return ()++-----------------------------------------------------------------------------------++data Empty = Emp deriving (Data, Typeable, Eq, Show)++unIntersperse x ys+  = case L.elemIndex x ys of+      Nothing -> [ys]+      Just i  -> let (y, _:ys') = splitAt i ys +                 in (y : unIntersperse x ys')++(=>>) m f = m >>= (\x -> f x >> return x)++wrap l r s = l ++ s ++ r++repeats n  = concat . replicate n++errorstar  = error . wrap (stars ++ "\n") (stars ++ "\n") +  where stars = repeats 3 $ wrapStars "ERROR"++errortext  = errorstar . render ++putDocLn :: Doc -> IO ()+putDocLn = putStrLn . render ++assertstar _   True  x = x+assertstar msg False x = errorstar msg ++findWithDefaultL f ls d = fromMaybe d (L.find f ls)++fst3 ::  (a, b, c) -> a+fst3 (x,_,_) = x++snd3 ::  (a, b, c) -> b+snd3 (_,x,_) = x++thd3 ::  (a, b, c) -> c+thd3 (_,_,x) = x+++single ::  a -> [a]+single x = [x]++mapFst f (x, y)  = (f x, y)+mapSnd f (x, y)  = (x, f y)++mapFst3 f (x, y, z) = (f x, y, z)+mapSnd3 f (x, y, z) = (x, f y, z)+mapThd3 f (x, y, z) = (x, y, f z)++expandSnd = concatMap (\(xs, y) -> (, y) <$> xs)++mapPair ::  (a -> b) -> (a, a) -> (b, b)+mapPair f (x, y) = (f x, f y)++-- mlookup ::  (Show k, Hashable k) => M.HashMap k v -> k -> v+mlookup m k +  = case M.lookup k m of+      Just v  -> v+      Nothing -> errorstar $ "mlookup: unknown key " ++ show k+++mfromJust ::  String -> Maybe a -> a+mfromJust _ (Just x) = x +mfromJust s Nothing  = errorstar $ "mfromJust: Nothing " ++ s++boxStrCat ::  String -> [String] -> String +boxStrCat sep = ("[" ++) . (++ "]") . L.intercalate sep ++tryIgnore :: String -> IO () -> IO ()+tryIgnore s a = Ex.catch a $ \e -> +                do let err = show (e :: Ex.IOException)+                   putStrLn ("Warning: Couldn't do " ++ s ++ ": " ++ err)+                   return ()++traceShow     ::  Show a => String -> a -> a+traceShow s x = trace ("\nTrace: [" ++ s ++ "] : " ++ show x) $ x++warnShow      ::  Show a => String -> a -> a+warnShow s x  = trace ("\nWarning: [" ++ s ++ "] : " ++ show x) $ x++-- inserts       ::  Hashable k => k -> v -> M.HashMap k [v] -> M.HashMap k [v]+inserts k v m = M.insert k (v : M.lookupDefault [] k m) m++-- group         :: Hashable k => [(k, v)] -> M.HashMap k [v]+group         = L.foldl' (\m (k, v) -> inserts k v m) M.empty ++groupList     = M.toList . group++-- groupMap      :: Hashable k => (a -> k) -> [a] -> M.HashMap k [a]+groupMap f xs = L.foldl' (\m x -> inserts (f x) x m) M.empty xs ++sortNub :: (Ord a) => [a] -> [a]+sortNub = nubOrd . L.sort+  where nubOrd (x:t@(y:_)) +          | x == y    = nubOrd t +          | otherwise = x : nubOrd t+        nubOrd xs = xs+++sortDiff :: (Ord a) => [a] -> [a] -> [a]+sortDiff x1s x2s                 = go (sortNub x1s) (sortNub x2s)+  where go xs@(x:xs') ys@(y:ys') +          | x <  y               = x : go xs' ys+          | x == y               = go xs' ys'+          | otherwise            = go xs ys'+        go xs []                 = xs+        go [] _                  = []+++++distinct ::  Ord a => [a] -> Bool+distinct xs = length xs == length (sortNub xs)++tr_reverse ::  [a] -> [a]+tr_reverse      = L.foldl' (flip (:)) []  ++tr_foldr' ::  (a -> b -> b) -> b -> [a] -> b+tr_foldr' f b   = L.foldl' (flip f) b . tr_reverse ++safeZip msg xs ys +  | nxs == nys +  = zip xs ys+  | otherwise              +  = errorstar $ "safeZip called on non-eq-sized lists (nxs = " ++ show nxs ++ ", nys = " ++ show nys ++ ") : " ++ msg+  where nxs = length xs+        nys = length ys++-- eqLen = on (==) length ++safeZipWith msg f xs ys +  | nxs == nys +  = zipWith f xs ys+  | otherwise              +  = errorstar $ "safeZipWith called on non-eq-sized lists (nxs = " ++ show nxs ++ ", nys = " ++ show nys ++ ") : " ++ msg+    where nxs = length xs+          nys = length ys++-- safe0ZipWith msg f xs ys +--   | length xs == length ys +--   = zipWith f xs ys+-- safe0ZipWith _ _ [] _+--   = []+-- safe0ZipWith _ _ _ []+--   = []+-- safe0ZipWith msg _ xs ys +--   = errorstar $ "safeZipWith called on non-eq-sized lists (nxs = " ++ show nxs ++ ", nys = " ++ show nys ++ ") : " ++ msg+--     where nxs = length xs+--           nys = length ys+++-- safeFromList :: (Hashable k, Show k, Show a) => String -> [(k, a)] -> M.HashMap k a+safeFromList msg = L.foldl' safeAdd M.empty +  where safeAdd m (k, v) +          | k `M.member` m = errorstar $ msg ++ "Duplicate key " ++ show k ++ "maps to: \n" ++ (show v) ++ "\n and \n" ++ show (m M.! k)+          | otherwise      = M.insert k v m++safeUnion msg m1 m2 = +  case L.find (`M.member` m1) (M.keys m2) of+    Just k  -> errorstar $ "safeUnion with common key = " ++ show k ++ " " ++ msg+    Nothing -> M.union m1 m2++safeHead _   (x:_) = x+safeHead msg _     = errorstar $ "safeHead with empty list " ++ msg++safeLast _ xs@(_:_) = last xs+safeLast msg _      = errorstar $ "safeLast with empty list " ++ msg++safeInit _ xs@(_:_) = init xs+safeInit msg _      = errorstar $ "safeInit with empty list " ++ msg+++-- memoIndex :: (Hashable b) => (a -> Maybe b) -> [a] -> [Maybe Int]+memoIndex f = snd . L.mapAccumL foo M.empty +  where +  foo memo z =+    case f z of +      Nothing -> (memo, Nothing)+      Just k  -> case k `M.lookup` memo of +                   Just i  -> (memo, Just i)+                   Nothing -> (M.insert k (M.size memo) memo, Just (M.size memo))++checkFail ::  [Char] -> (a -> Bool) -> a -> a+checkFail msg f x +  | f x+  = x+  | otherwise+  = errorstar $ "Check-Failure: " ++ msg++chopAfter ::  (a -> Bool) -> [a] -> [a]+chopAfter f xs +  = case L.findIndex f xs of+      Just n  -> take n xs+      Nothing -> xs++chopPrefix p xs +  | p `L.isPrefixOf` xs+  = Just $ drop (length p) xs+  | otherwise +  = Nothing++firstElem ::  (Eq a) => [(a, t)] -> [a] -> Maybe Int+firstElem seps str +  = case catMaybes [ L.elemIndex c str | (c, _) <- seps ] of +      [] -> Nothing+      is -> Just $ minimum is ++chopAlt ::  (Eq a) => [(a, a)] -> [a] -> [[a]]+chopAlt seps    = go +  where go  s   = maybe [s] (go' s) (firstElem seps s)+        go' s i = let (s0, s1@(c:_)) = splitAt i s +                      (Just c')      = lookup c seps +                  in case L.elemIndex c' s1 of+                       Nothing -> [s1]+                       Just i' -> let (s2, s3) = splitAt (i' + 1) s1 in +                                  s0 : s2 : go s3++firstElems ::  [(B.ByteString, B.ByteString)] -> B.ByteString -> Maybe (Int, B.ByteString, (B.ByteString, B.ByteString))+firstElems seps str +  = case splitters seps str of +      [] -> Nothing+      is -> Just $ L.minimumBy (\x y -> compare (fst3 x) (fst3 y)) is ++splitters seps str +  = [(i, c', z) | (c, c') <- seps+                , let z   = B.breakSubstring c str+                , let i   = B.length (fst z)+                , i < B.length str                 ]+++bchopAlts :: [(B.ByteString, B.ByteString)] -> B.ByteString -> [B.ByteString]+bchopAlts seps  = go +  where +    go  s                 = maybe [s] (go' s) (firstElems seps s)+    go' s (i,c',(s0, s1)) = if (B.length s2 == B.length s1) then [B.concat [s0,s1]] else (s0 : s2' : go s3')+                            where (s2, s3) = B.breakSubstring c' s1+                                  s2'      = B.append s2 c'+                                  s3'      = B.drop (B.length c') s3 ++chopAlts seps str = unpack <$> bchopAlts [(pack c, pack c') | (c, c') <- seps] (pack str)++findFirst ::  Monad m => (t -> m [a]) -> [t] -> m (Maybe a)+findFirst _ []     = return Nothing+findFirst f (x:xs) = do r <- f x+                        case r of +                          y:_ -> return (Just y)+                          []  -> findFirst f xs++testM f x = do b <- f x+               return $ if b then [x] else [] ++-- unions :: (Hashable a) => [S.HashSet a] -> S.HashSet a+-- unions = foldl' S.union S.empty+-- Just S.unions!++stripParens ('(':xs)  = stripParens xs+stripParens xs        = stripParens' (reverse xs)+stripParens' (')':xs) = stripParens' xs+stripParens' xs       = reverse xs++ifM :: (Monad m) => m Bool -> m a -> m a -> m a+ifM bm xm ym +  = do b <- bm+       if b then xm else ym++executeShellCommand phase cmd +  = do whenLoud $ putStrLn $ "EXEC: " ++ cmd +       Ex.bracket_ (startPhase Loud phase) (donePhase Loud phase) $ system cmd++checkExitCode _   (ExitSuccess)   = return ()+checkExitCode cmd (ExitFailure n) = errorstar $ "cmd: " ++ cmd ++ " failure code " ++ show n ++hashMapToAscList    ::  Ord a => M.HashMap a b -> [(a, b)]+hashMapToAscList    = L.sortBy (\x y -> compare (fst x) (fst y)) . M.toList++hashMapMapWithKey   :: (k -> v1 -> v2) -> M.HashMap k v1 -> M.HashMap k v2+hashMapMapWithKey f = fromJust . M.traverseWithKey (\k v -> Just (f k v)) ++hashMapMapKeys      :: (Eq k, Hashable k) => (t -> k) -> M.HashMap t v -> M.HashMap k v+hashMapMapKeys f    = M.fromList . fmap (mapFst f) . M.toList +++applyNonNull def _ [] = def+applyNonNull _   f xs = f xs++concatMapM f = fmap concat . mapM f ++++angleBrackets p    = char '<' <> p <> char '>'+dot                = char '.'+arrow              = text "->"+dcolon             = colon <> colon+intersperse d ds   = hsep $ punctuate d ds++tshow              = text . show++foldlMap           :: (a -> b -> (c, a)) -> a -> [b] -> ([c], a)+foldlMap f b xs    = (reverse zs, res)+  where +    (zs, res)      = L.foldl' ff ([], b) xs+    ff (ys, acc) x = let (y, acc') = f acc x in (y:ys, acc')++
+ src/Language/Fixpoint/Names.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module contains Haskell variables representing globally visible names.+--   Rather than have strings floating around the system, all constant names+--   should be defined here, and the (exported) variables should be used and+--   manipulated elsewhere.++module Language.Fixpoint.Names (+  +  -- * Hardwired global names +    dummyName+  , preludeName+  , boolConName+  , funConName+  , listConName+  , tupConName+  , propConName+  , strConName+  , vvName+  , symSepName+  , dropModuleNames +  , takeModuleNames+) where++import Data.List                (intercalate)+import Language.Fixpoint.Misc   (errorstar, safeLast, stripParens)++----------------------------------------------------------------------------+--------------- Global Name Definitions ------------------------------------+----------------------------------------------------------------------------++preludeName  = "Prelude"+dummyName    = "_LIQUID_dummy"+boolConName  = "Bool"+funConName   = "->"+listConName  = "[]" -- "List"+tupConName   = "()" -- "Tuple"+propConName  = "Prop"+strConName   = "Str"+vvName       = "VV"+symSepName   = '#'++-- dropModuleNames []  = []+-- dropModuleNames s  +--   | s == tupConName = tupConName +--   | otherwise       = safeLast msg $ words $ dotWhite `fmap` stripParens s+--   where +--     msg             = "dropModuleNames: " ++ s +--     dotWhite '.'    = ' '+--     dotWhite c      = c++dropModuleNames          = mungeModuleNames safeLast "dropModuleNames: "+takeModuleNames          = mungeModuleNames safeInit "takeModuleNames: "++safeInit _ xs@(_:_)      = intercalate "." $ init xs+safeInit msg _           = errorstar $ "safeInit with empty list " ++ msg++mungeModuleNames _ _ []  = []+mungeModuleNames f msg s  +  | s == tupConName      = tupConName +  | otherwise            = f (msg ++ s) $ words $ dotWhite `fmap` stripParens s+  where +    dotWhite '.'         = ' '+    dotWhite c           = c+
+ src/Language/Fixpoint/Parse.hs view
@@ -0,0 +1,484 @@+{-# LANGUAGE NoMonomorphismRestriction, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, TupleSections #-}++module Language.Fixpoint.Parse (+  +  -- * Top Level Class for Parseable Values  +    Inputable (..)+  +  -- * Top Level Class for Parseable Values  +  , Parser++  -- * Lexer to add new tokens+  , lexer ++  -- * Some Important keyword and parsers+  , reserved, reservedOp+  , parens  , brackets+  , semi    , comma     +  , colon   , dcolon +  , whiteSpace, blanks++  -- * Parsing basic entities+  , fTyConP     -- Type constructors+  , lowerIdP    -- Lower-case identifiers+  , upperIdP    -- Upper-case identifiers+  , symbolP     -- Arbitrary Symbols+  , constantP   -- (Integer) Constants+  , integer     -- Integer++  -- * Parsing recursive entities+  , exprP       -- Expressions+  , predP       -- Refinement Predicates+  , qualifierP  -- Qualifiers++  -- * Some Combinators+  , condIdP     -- condIdP  :: [Char] -> (String -> Bool) -> Parser String++  -- * Getting a Fresh Integer while parsing+  , freshIntP++  -- * Parsing Function+  , doParse' +  , parseFromFile+  , remainderP +  ) where++import Control.Applicative ((<*>), (<$>), (<*))+import Control.Monad+import Text.Parsec+import Text.Parsec.Expr+import Text.Parsec.Language+import Text.Parsec.String hiding (Parser, parseFromFile)+import Text.Printf  (printf)+import qualified Text.Parsec.Token as Token+import qualified Data.HashMap.Strict as M++import Data.Char (isLower, toUpper)+import Language.Fixpoint.Misc hiding (dcolon)+import Language.Fixpoint.Types+import Data.Maybe(maybe)++type Parser = Parsec String Integer ++--------------------------------------------------------------------++languageDef =+  emptyDef { Token.commentStart    = "/* "+           , Token.commentEnd      = " */"+           , Token.commentLine     = "--"+           , Token.identStart      = satisfy (\_ -> False) +           , Token.identLetter     = satisfy (\_ -> False)+           , Token.reservedNames   = [ "SAT"+                                     , "UNSAT"+                                     , "true"+                                     , "false"+                                     , "mod"+                                     , "data"+                                     , "Bexp"+                                     , "forall"+                                     , "exists"+                                     , "assume"+                                     , "measure"+                                     , "module"+                                     , "spec"+                                     , "where"+                                     , "True"+                                     , "Int"+                                     , "import"+                                     , "_|_"+                                     , "|"+                                     , "if", "then", "else"+                                     ]+           , Token.reservedOpNames = [ "+", "-", "*", "/", "\\"+                                     , "<", ">", "<=", ">=", "=", "!=" , "/="+                                     , "mod", "and", "or" +                                  --, "is"+                                     , "&&", "||"+                                     , "~", "=>", "<=>"+                                     , "->"+                                     , ":="+                                     , "&", "^", "<<", ">>", "--"+                                     , "?", "Bexp" -- , "'"+                                     ]+           }++lexer         = Token.makeTokenParser languageDef+reserved      = Token.reserved      lexer+reservedOp    = Token.reservedOp    lexer+parens        = Token.parens        lexer+brackets      = Token.brackets      lexer+semi          = Token.semi          lexer+colon         = Token.colon         lexer+comma         = Token.comma         lexer+whiteSpace    = Token.whiteSpace    lexer+stringLiteral = Token.stringLiteral lexer++-- identifier = Token.identifier lexer+++blanks  = many (satisfy (`elem` [' ', '\t']))++integer =   try (liftM toInt is) +       <|>  liftM (negate . toInt) (char '-' >> is)+  where is      = liftM2 (\is _ -> is) (many1 digit) blanks +        toInt s = (read s) :: Integer ++----------------------------------------------------------------+------------------------- Expressions --------------------------+----------------------------------------------------------------++condIdP  :: [Char] -> (String -> Bool) -> Parser String+condIdP chars f +  = do c  <- letter+       cs <- many (satisfy (`elem` chars))+       blanks+       if f (c:cs) then return (c:cs) else parserZero++upperIdP :: Parser String+upperIdP = condIdP symChars (not . isLower . head)++lowerIdP :: Parser String+lowerIdP = condIdP symChars (isLower . head)++symbolP :: Parser Symbol+symbolP = liftM stringSymbol symCharsP ++constantP :: Parser Constant+constantP = liftM I integer++symconstP :: Parser SymConst+symconstP = SL <$> stringLiteral ++exprP :: Parser Expr +exprP =  expr2P <|> lexprP++lexprP :: Parser Expr +lexprP   +  =  try (parens exprP)+ <|> try (parens exprCastP)+ <|> try (parens $ condP EIte exprP)+ <|> try exprFunP+ <|> try (liftM (EVar . stringSymbol) upperIdP)+ <|> liftM expr symbolP + <|> liftM ECon constantP+ <|> liftM ESym symconstP+ <|> (reserved "_|_" >> return EBot)++exprFunP           =  (try exprFunSpacesP) <|> (try exprFunSemisP) <|> exprFunCommasP+  where +    exprFunSpacesP = parens $ liftM2 EApp funSymbolP (sepBy exprP spaces) +    exprFunCommasP = liftM2 EApp funSymbolP (parens        $ sepBy exprP comma)+    exprFunSemisP  = liftM2 EApp funSymbolP (parenBrackets $ sepBy exprP semi)+    funSymbolP     = symbolP -- liftM stringSymbol lowerIdP+++parenBrackets  = parens . brackets ++expr2P = buildExpressionParser bops lexprP++bops = [ [Infix  (reservedOp "*"   >> return (EBin Times)) AssocLeft]+       , [Infix  (reservedOp "/"   >> return (EBin Div  )) AssocLeft]+       , [Infix  (reservedOp "+"   >> return (EBin Plus )) AssocLeft]+       , [Infix  (reservedOp "-"   >> return (EBin Minus)) AssocLeft]+       , [Infix  (reservedOp "mod" >> return (EBin Mod  )) AssocLeft]+       ]+++exprCastP+  = do e  <- exprP +       ((try dcolon) <|> colon)+       so <- sortP+       return $ ECst e so++dcolon = string "::" <* spaces++sortP+  =   try (string "Integer" >>  return FInt)+  <|> try (string "Int"     >>  return FInt)+  <|> try (string "int"     >>  return FInt)+  <|> try (FObj . stringSymbol <$> lowerIdP)+  <|> (FApp <$> fTyConP <*> many sortP     )++symCharsP  = (condIdP symChars (\_ -> True))++---------------------------------------------------------------------+-------------------------- Predicates -------------------------------+---------------------------------------------------------------------++predP :: Parser Pred+predP =  try (parens pred2P)+     <|> try (parens $ condP pIte predP)+     <|> try (reservedOp "not" >> liftM PNot predP)+     <|> try (reservedOp "&&" >> liftM PAnd predsP)+     <|> try (reservedOp "||" >> liftM POr  predsP)+     <|> (qmP >> liftM PBexp exprP)+     <|> (reserved "true"  >> return PTrue)+     <|> (reserved "false" >> return PFalse)+     <|> (try predrP)+     <|> (try (liftM PBexp exprFunP))++qmP    = reserved "?" <|> reserved "Bexp"++pred2P = buildExpressionParser lops predP ++predsP = brackets $ sepBy predP semi++lops = [ [Prefix (reservedOp "~"   >> return PNot)]+       , [Infix  (reservedOp "&&"  >> return (\x y -> PAnd [x,y])) AssocRight]+       , [Infix  (reservedOp "||"  >> return (\x y -> POr  [x,y])) AssocRight]+       , [Infix  (reservedOp "=>"  >> return PImp) AssocRight]+       , [Infix  (reservedOp "<=>" >> return PIff) AssocRight]]+       +predrP = do e1    <- expr2P+            r     <- brelP+            e2    <- expr2P +            return $ r e1 e2++brelP ::  Parser (Expr -> Expr -> Pred)+brelP =  (reservedOp "==" >> return (PAtom Eq))+     <|> (reservedOp "="  >> return (PAtom Eq))+     <|> (reservedOp "!=" >> return (PAtom Ne))+     <|> (reservedOp "/=" >> return (PAtom Ne))+     <|> (reservedOp "<"  >> return (PAtom Lt))+     <|> (reservedOp "<=" >> return (PAtom Le))+     <|> (reservedOp ">"  >> return (PAtom Gt))+     <|> (reservedOp ">=" >> return (PAtom Ge))++condIteP f bodyP +  = do reserved "if" +       p <- predP+       reserved "then"+       b1 <- bodyP +       reserved "else"+       b2 <- bodyP +       return $ f p b1 b2++condQmP f bodyP +  = do p  <- predP +       reserved "?"+       b1 <- bodyP +       colon+       b2 <- bodyP +       return $ f p b1 b2++condP f bodyP +   =   try (condIteP f bodyP)+   <|> (condQmP f bodyP)++----------------------------------------------------------------------------------+------------------------------------ BareTypes -----------------------------------+----------------------------------------------------------------------------------++fTyConP+  =   (reserved "int"  >> return intFTyCon)+  <|> (reserved "bool" >> return boolFTyCon)+  <|> (stringFTycon   <$> upperIdP)++refasP :: Parser [Refa]+refasP  =  (try (brackets $ sepBy (RConc <$> predP) semi)) +       <|> liftM ((:[]) . RConc) predP++---------------------------------------------------------------------+-- | Parsing Qualifiers ---------------------------------------------+---------------------------------------------------------------------++-- qualifierP = mkQual <$> upperIdP <*> parens $ sepBy1 sortBindP comma <*> predP++qualifierP = do n      <- upperIdP +                params <- parens $ sepBy1 sortBindP comma+                _      <- colon+                body   <- predP+                return  $ mkQual n params body++sortBindP  = (,) <$> symbolP <* colon <*> sortP++mkQual n xts p = Q n ((vv, t) : yts) (subst su p)+  where +    (vv,t):zts = xts+    yts        = mapFst mkParam <$> zts+    su         = mkSubst $ zipWith (\(z,_) (y,_) -> (z, eVar y)) zts yts +                       +mkParam s      = stringSymbolRaw ('~' : toUpper c : cs) +  where +    (c:cs)     = symbolString s +++---------------------------------------------------------------------+------------ Interacting with Fixpoint ------------------------------+---------------------------------------------------------------------++fixResultP :: Parser a -> Parser (FixResult a)+fixResultP pp +  =  (reserved "SAT"   >> return Safe)+ <|> (reserved "UNSAT" >> Unsafe <$> (brackets $ sepBy pp comma))  + <|> (reserved "CRASH" >> crashP pp)++++crashP pp+  = do i   <- pp+       msg <- many anyChar+       return $ Crash [i] msg++predSolP +  = parens $ (predP  <* (comma >> iQualP)) +    ++iQualP+  = upperIdP >> (parens $ sepBy symbolP comma)++solution1P+  = do reserved "solution:" +       k  <- symbolP +       reserved ":=" +       ps <- brackets $ sepBy predSolP semi+       return (k, simplify $ PAnd ps)++solutionP :: Parser (M.HashMap Symbol Pred)+solutionP +  = M.fromList <$> sepBy solution1P whiteSpace++solutionFileP +  = liftM2 (,) (fixResultP integer) solutionP++------------------------------------------------------------------------++remainderP p  +  = do res <- p+       str <- stateInput <$> getParserState+       return (res, str) ++doParse' parser f s+  = case runParser (remainderP p) 0 f s of+      Left e         -> errorstar $ printf "parseError %s\n when parsing from %s\n" +                                      (show e) f +      Right (r, "")  -> r+      Right (_, rem) -> errorstar $ printf "doParse has leftover when parsing: %s\nfrom file %s\n"+                                      rem f+  where p = whiteSpace >> parser+++parseFromFile :: Parser b -> SourceName -> IO b+parseFromFile p f = doParse' p f <$> readFile f++freshIntP :: Parser Integer+freshIntP = do n <- stateUser <$> getParserState+               updateState (+ 1)+               return n++----------------------------------------------------------------------------------------+------------------------ Bundling Parsers into a Typeclass -----------------------------+----------------------------------------------------------------------------------------++class Inputable a where+  rr  :: String -> a+  rr' :: String -> String -> a+  rr' = \_ -> rr+  rr  = rr' "" ++instance Inputable Symbol where+  rr' = doParse' symbolP++instance Inputable Constant where+  rr' = doParse' constantP ++instance Inputable Pred where+  rr' = doParse' predP ++instance Inputable Expr where+  rr' = doParse' exprP ++instance Inputable [Refa] where+  rr' = doParse' refasP++instance Inputable (FixResult Integer) where+  rr' = doParse' $ fixResultP integer++instance Inputable (FixResult Integer, FixSolution) where+  rr' = doParse' solutionFileP ++{-+---------------------------------------------------------------+--------------------------- Testing ---------------------------+---------------------------------------------------------------++sa  = "0"+sb  = "x"+sc  = "(x0 + y0 + z0) "+sd  = "(x+ y * 1)"+se  = "_|_ "+sf  = "(1 + x + _|_)"+sg  = "f(x,y,z)"+sh  = "(f((x+1), (y * a * b - 1), _|_))"+si  = "(2 + f((x+1), (y * a * b - 1), _|_))"++s0  = "true"+s1  = "false"+s2  = "v > 0"+s3  = "(0 < v && v < 100)"+s4  = "(x < v && v < y+10 && v < z)"+s6  = "[(v > 0)]"+s6' = "x"+s7' = "(x <=> y)"+s8' = "(x <=> a = b)"+s9' = "(x <=> (a <= b && b < c))"++s7  = "{ v: Int | [(v > 0)] }"+s8  = "x:{ v: Int | v > 0 } -> {v : Int | v >= x}"+s9  = "v = x+y"+s10 = "{v: Int | v = x + y}"++s11 = "x:{v:Int | true } -> {v:Int | true }" +s12 = "y : {v:Int | true } -> {v:Int | v = x }"+s13 = "x:{v:Int | true } -> y:{v:Int | true} -> {v:Int | v = x + y}"+s14 = "x:{v:a  | true} -> y:{v:b | true } -> {v:a | (x < v && v < y) }"+s15 = "x:Int -> Bool"+s16 = "x:Int -> y:Int -> {v:Int | v = x + y}"+s17 = "a"+s18 = "x:a -> Bool"+s20 = "forall a . x:Int -> Bool"++s21 = "x:{v : GHC.Prim.Int# | true } -> {v : Int | true }" ++r0  = (rr s0) :: Pred+r0' = (rr s0) :: [Refa]+r1  = (rr s1) :: [Refa]+++e1, e2  :: Expr  +e1  = rr "(k_1 + k_2)"+e2  = rr "k_1" ++o1, o2, o3 :: FixResult Integer+o1  = rr "SAT " +o2  = rr "UNSAT [1, 2, 9,10]"+o3  = rr "UNSAT []" ++-- sol1 = doParse solution1P "solution: k_5 := [0 <= VV_int]"+-- sol2 = doParse solution1P "solution: k_4 := [(0 <= VV_int)]" ++b0, b1, b2, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13 :: BareType+b0  = rr "Int"+b1  = rr "x:{v:Int | true } -> y:{v:Int | true} -> {v:Int | v = x + y}"+b2  = rr "x:{v:Int | true } -> y:{v:Int | true} -> {v:Int | v = x - y}"+b4  = rr "forall a . x : a -> Bool"+b5  = rr "Int -> Int -> Int"+b6  = rr "(Int -> Int) -> Int"+b7  = rr "({v: Int | v > 10} -> Int) -> Int"+b8  = rr "(x:Int -> {v: Int | v > x}) -> {v: Int | v > 10}"+b9  = rr "x:Int -> {v: Int | v > x} -> {v: Int | v > 10}"+b10 = rr "[Int]"+b11 = rr "x:[Int] -> {v: Int | v > 10}"+b12 = rr "[Int] -> String"+b13 = rr "x:(Int, [Bool]) -> [(String, String)]"++-- b3 :: BareType+-- b3  = rr "x:Int -> y:Int -> {v:Bool | ((v is True) <=> x = y)}"++m1 = ["len :: [a] -> Int", "len (Nil) = 0", "len (Cons x xs) = 1 + len(xs)"]+m2 = ["tog :: LL a -> Int", "tog (Nil) = 100", "tog (Cons y ys) = 200"]++me1, me2 :: Measure.Measure BareType Symbol +me1 = (rr $ intercalate "\n" m1) +me2 = (rr $ intercalate "\n" m2)+-}
+ src/Language/Fixpoint/PrettyPrint.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE FlexibleContexts           #-} +{-# LANGUAGE FlexibleInstances          #-}+++module Language.Fixpoint.PrettyPrint where++import Text.PrettyPrint.HughesPJ+import Language.Fixpoint.Types+import Language.Fixpoint.Misc+import Control.Applicative      ((<$>))+import Text.Parsec++class PPrint a where+  pprint :: a -> Doc++showpp :: (PPrint a) => a -> String +showpp = render . pprint ++instance PPrint a => PPrint (Maybe a) where+  pprint = maybe (text "Nothing") ((text "Just" <+>) . pprint)++instance PPrint a => PPrint [a] where+  pprint = brackets . intersperse comma . map pprint++instance (PPrint a, PPrint b, PPrint c) => PPrint (a, b, c) where+  pprint (x, y, z)  = parens $ (pprint x) <> text "," <> (pprint y) <> text "," <> (pprint z) +++instance (PPrint a, PPrint b) => PPrint (a,b) where+  pprint (x, y)  = (pprint x) <+> text ":" <+> (pprint y)++instance PPrint SourcePos where+  pprint = text . show ++instance PPrint () where+  pprint = text . show ++instance PPrint String where +  pprint = text ++instance PPrint Int where+  pprint = toFix++instance PPrint Integer where+  pprint = toFix++instance PPrint Constant where+  pprint = toFix++instance PPrint Brel where+  pprint Eq = text "=="+  pprint Ne = text "/="+  pprint r  = toFix r++instance PPrint Bop where+  pprint  = toFix ++instance PPrint Sort where+  pprint = toFix  ++instance PPrint Symbol where+  pprint = toFix++instance PPrint SymConst where+  pprint (SL x)          = doubleQuotes $ text x++instance PPrint Expr where+  pprint (EApp f es)     = parens $ intersperse empty $ (pprint f) : (pprint <$> es) +  pprint (ESym c)        = pprint c +  pprint (ECon c)        = pprint c +  pprint (EVar s)        = pprint s+  pprint (ELit s _)      = pprint s+  pprint (EBin o e1 e2)  = parens $ pprint e1 <+> pprint o <+> pprint e2+  pprint (EIte p e1 e2)  = parens $ text "if" <+> pprint p <+> text "then" <+> pprint e1 <+> text "else" <+> pprint e2 +  pprint (ECst e so)     = parens $ pprint e <+> text " : " <+> pprint so +  pprint (EBot)          = text "_|_"++instance PPrint Pred where+  pprint PTop            = text "???"+  pprint PTrue           = trueD +  pprint PFalse          = falseD+  pprint (PBexp e)       = parens $ pprint e+  pprint (PNot p)        = parens $ text "not" <+> parens (pprint p)+  pprint (PImp p1 p2)    = parens $ (pprint p1) <+> text "=>"  <+> (pprint p2)+  pprint (PIff p1 p2)    = parens $ (pprint p1) <+> text "<=>" <+> (pprint p2)+  pprint (PAnd ps)       = parens $ pprintBin trueD  andD ps+  pprint (POr  ps)       = parens $ pprintBin falseD orD  ps +  pprint (PAtom r e1 e2) = parens $ pprint e1 <+> pprint r <+> pprint e2+  pprint (PAll xts p)    = text "forall" <+> toFix xts <+> text "." <+> pprint p++trueD  = text "true"+falseD = text "false"+andD   = text " &&"+orD    = text " ||"++pprintBin b _ [] = b+pprintBin _ o xs = intersperse o $ pprint <$> xs ++pprintBin b o []     = b+pprintBin b o [x]    = pprint x+pprintBin b o (x:xs) = pprint x <+> o <+> pprintBin b o xs ++instance PPrint Refa where+  pprint (RConc p)     = pprint p+  pprint k             = toFix k+ +instance PPrint Reft where +  pprint r@(Reft (_,ras)) +    | isTauto r        = text "true"+    | otherwise        = {- intersperse comma -} pprintBin trueD andD $ flattenRefas ras++ ++instance PPrint SortedReft where+  pprint (RR so (Reft (v, ras))) +    = braces +    $ (pprint v) <+> (text ":") <+> (toFix so) <+> (text "|") <+> pprint ras+++++++++
+ src/Language/Fixpoint/Sort.hs view
@@ -0,0 +1,323 @@++-- | This module has the functions that perform sort-checking, and related+-- operations on Fixpoint expressions and predicates.++module Language.Fixpoint.Sort  ( +  -- * Checking Well-Formedness+    checkSorted+  , checkSortedReft+  , checkSortedReftFull+  , pruneUnsortedReft+  ) where++++import Language.Fixpoint.Types+import Language.Fixpoint.Misc+import Text.PrettyPrint.HughesPJ+import Text.Printf+import Control.Monad.Error (catchError, throwError)+import Control.Monad+import Control.Applicative+import Data.Maybe           (fromMaybe, catMaybes)+import qualified Data.HashMap.Strict as M++import Debug.Trace          (trace)++-- | Types used throughout checker++type CheckM a = Either String a+type Env      = Symbol -> SESearch Sort+fProp         = FApp boolFTyCon [] +-- fProp         = FApp propFTyCon [] ++-------------------------------------------------------------------------+-- | Checking Refinements -----------------------------------------------+-------------------------------------------------------------------------++checkSortedReft :: SEnv SortedReft -> [Symbol] -> SortedReft -> Maybe Doc+checkSortedReft env xs sr = applyNonNull Nothing error unknowns +  where +    error                 = Just . (text "Unknown symbols:" <+>) . toFix +    unknowns              = [ x | x <- syms sr, not (x `elem` v : xs), not (x `memberSEnv` env)]    +    Reft (v,_)            = sr_reft sr ++checkSortedReftFull :: Checkable a => SEnv SortedReft -> a -> Maybe Doc+checkSortedReftFull γ t+  = case check γ' t of+      Left err -> Just (text err)+      Right _  -> Nothing+    where +      γ' = mapSEnv sr_sort γ  ++checkSorted :: Checkable a => SEnv Sort -> a -> Maybe Doc+checkSorted γ t+  = case check γ t of+      Left err -> Just (text err)+      Right _  -> Nothing++pruneUnsortedReft :: SEnv Sort -> SortedReft -> SortedReft+pruneUnsortedReft γ (RR s (Reft (v, ras)))+  = RR s (Reft (v, catMaybes (go <$> ras))) +  where +    go r = case checkRefa f r of+            Left war -> trace (wmsg war r) $ Nothing+            Right _  -> Just r+    γ' = insertSEnv v s γ+    f  = (`lookupSEnvWithDistance` γ')++    wmsg t r = "WARNING: prune unsorted reft:\n" ++ showFix r ++ "\n" ++ t++checkRefa f (RConc p) = checkPred f p+checkRefa f _         = return ()+++class Checkable a where+  check :: SEnv Sort -> a -> CheckM ()++instance Checkable Refa where+  check γ = checkRefa (`lookupSEnvWithDistance` γ)++instance Checkable Expr where+  check γ e = do {checkExpr f e; return ()}+   where f =  (`lookupSEnvWithDistance` γ)++instance Checkable Pred where+  check γ = checkPred f+   where f = (`lookupSEnvWithDistance` γ)++instance Checkable SortedReft where+  check γ (RR s (Reft (v, ras))) = mapM_ (check γ') ras+   where γ' = insertSEnv v s γ  ++-------------------------------------------------------------------------+-- | Checking Expressions -----------------------------------------------+-------------------------------------------------------------------------++checkExpr                  :: Env -> Expr -> CheckM Sort ++checkExpr _ EBot           = throwError "Type Error: Bot"+checkExpr _ (ECon _)       = return FInt +checkExpr f (EVar x)       = checkSym f x+checkExpr f (EBin o e1 e2) = checkOp f e1 o e2+checkExpr f (EIte p e1 e2) = checkIte f p e1 e2+checkExpr f (ECst e t)     = checkCst f t e+checkExpr f (EApp g es)    = checkApp f Nothing g es+checkExpr f (ELit _ t)     = return t++-- | Helper for checking symbol occurrences++checkSym f x               +  = case f x of +     Found s -> return s+     Alts xs -> throwError $ errUnboundAlts x xs+--   $ traceFix ("checkSym: x = " ++ showFix x) (f x)++-- | Helper for checking if-then-else expressions++checkIte f p e1 e2 +  = do tp <- checkPred f p+       t1 <- checkExpr f e1+       t2 <- checkExpr f e2+       if t1 == t2 +         then return t1+         else throwError (errIte e1 e2 t1 t2) ++-- | Helper for checking cast expressions ++checkCst f t (EApp g es) +  = checkApp f (Just t) g es+checkCst f t e           +  = do t' <- checkExpr f e+       if t == t' +         then return t+         else throwError (errCast e t' t)++-- | Helper for checking uninterpreted function applications++checkApp' f to g es +  = do gt           <- checkSym f g+       (n, its, ot) <- sortFunction gt+       unless (length its == length es) $ throwError (errArgArity g its es)+       ets          <- mapM (checkExpr f) es+       θ            <- unify its ets+       let t         = apply θ ot+       case to of+         Nothing    -> return (θ, t)+         Just t'    -> do θ' <- unifyMany θ [t] [t']+                          return (θ', apply θ' t)+++checkApp f to g es+  = snd <$> checkApp' f to g es+++-- | Helper for checking binary (numeric) operations++checkOp f e1 o e2 +  = do t1 <- checkExpr f e1+       t2 <- checkExpr f e2+       checkOpTy f (EBin o e1 e2) t1 t2++checkOpTy f _ FInt FInt          +  = return FInt++checkOpTy f e t@(FObj l) t'@(FObj l')+  | l == l'+  = checkNumeric f l >> return t++checkOpTy f e t t'+  = throwError $ errOp e t t'++checkNumeric f l+  = do t <- checkSym f l+       unless (t == FNum) (throwError $ errNonNumeric l)+       return ()++-------------------------------------------------------------------------+-- | Checking Predicates ------------------------------------------------+-------------------------------------------------------------------------++checkPred                  :: Env -> Pred -> CheckM () ++checkPred f PTrue          = return ()+checkPred f PFalse         = return ()+checkPred f (PBexp e)      = checkPredBExp f e +checkPred f (PNot p)       = checkPred f p+checkPred f (PImp p p')    = mapM_ (checkPred f) [p, p'] +checkPred f (PIff p p')    = mapM_ (checkPred f) [p, p']+checkPred f (PAnd ps)      = mapM_ (checkPred f) ps+checkPred f (POr ps)       = mapM_ (checkPred f) ps+checkPred f (PAtom r e e') = checkRel f r e e'+checkPred f p              = throwError $ errUnexpectedPred p++checkPredBExp f e          = do t <- checkExpr f e+                                unless (t == fProp) (throwError $ errBExp e t)+                                return ()+  ++-- | Checking Relations++checkRel f Eq (EVar x) (EApp g es) = checkRelEqVar f x g es+checkRel f Eq (EApp g es) (EVar x) = checkRelEqVar f x g es+checkRel f r  e1 e2                = do t1 <- checkExpr f e1+                                        t2 <- checkExpr f e2+                                        checkRelTy f (PAtom r e1 e2) r t1 t2++checkRelTy :: (Fixpoint a) => Env -> a -> Brel -> Sort -> Sort -> CheckM ()+checkRelTy f _ _ (FObj l) (FObj l') | l /= l' +  = (checkNumeric f l >> checkNumeric f l') `catchError` (\_ -> throwError $ errNonNumerics l l') +checkRelTy f _ _ FInt (FObj l)     = (checkNumeric f l) `catchError` (\_ -> throwError $ errNonNumeric l) +checkRelTy f _ _ (FObj l) FInt     = (checkNumeric f l) `catchError` (\_ -> throwError $ errNonNumeric l)+checkRelTy _ e Eq t1 t2            = unless (t1 == t2 && t1 /= fProp) (throwError $ errRel e t1 t2)+checkRelTy _ e Ne t1 t2            = unless (t1 == t2 && t1 /= fProp) (throwError $ errRel e t1 t2)+checkRelTy _ e _  t1 t2            = unless (t1 == t2)                (throwError $ errRel e t1 t2)+++-- | Special case for polymorphic singleton variable equality e.g. (x = Set_emp) ++checkRelEqVar f x g es             = do tx <- checkSym f x+                                        _  <- checkApp f (Just tx) g es+                                        return ()+++++-------------------------------------------------------------------------+-- | Error messages -----------------------------------------------------+-------------------------------------------------------------------------++errUnify t1 t2       = printf "Cannot unify %s with %s" (showFix t1) (showFix t2)++errUnifyMany ts ts'  = printf "Cannot unify types with different cardinalities %s and %s" +                         (showFix ts) (showFix ts')++errRel e t1 t2       = printf "Invalid Relation %s with operand types %s and %s" +                         (showFix e) (showFix t1) (showFix t2)++errBExp e t          = printf "BExp %s with non-propositional type %s" (showFix e) (showFix t)++errOp e t t' +  | t == t'          = printf "Operands have non-numeric types %s in %s"  +                         (showFix t) (showFix e)+  | otherwise        = printf "Operands have different types %s and %s in %s" +                         (showFix t) (showFix t') (showFix e)++errArgArity g its es = printf "Measure %s expects %d args but gets %d in %s" +                         (showFix g) (length its) (length es) (showFix (EApp g es))++errIte e1 e2 t1 t2   = printf "Mismatched branches in Ite: then %s : %s, else %s : %s" +                         (showFix e1) (showFix t1) (showFix e2) (showFix t2) ++errCast e t' t       = printf "Cannot cast %s of sort %s to incompatible sort %s" +                         (showFix e) (showFix t') (showFix t)++errUnbound x         = printf "Unbound Symbol %s" (showFix x)+errUnboundAlts x xs  = printf "Unbound Symbol %s\n Perhaps you meant: %s" +                        (showFix x) +                        (foldr1 (\w s -> w ++ ", " ++ s) (showFix <$> xs))++errNonFunction t     = printf "Sort %s is not a function" (showFix t)++errNonNumeric  l     = printf "FObj sort %s is not numeric" (showFix l)+errNonNumerics l l'   = printf "FObj sort %s and %s are different and not numeric" (showFix l) (showFix l')++errUnexpectedPred p  = printf "Sort Checking: Unexpected Predicate %s" (showFix p)++-------------------------------------------------------------------------+-- | Utilities for working with sorts -----------------------------------+-------------------------------------------------------------------------++-- | Unification of Sorts++unify                              = unifyMany (Th M.empty)++unifyMany θ ts ts' +  | length ts == length ts'        = foldM (uncurry . unify1) θ $ zip ts ts'+  | otherwise                      = throwError $ errUnifyMany ts ts'++-- unify1 _ FNum _                    = Nothing+unify1 θ (FVar i) t                = unifyVar θ i t+unify1 θ t (FVar i)                = unifyVar θ i t+unify1 θ (FApp c ts) (FApp c' ts')  +  | c == c'                        = unifyMany θ ts ts' +unify1 θ t1 t2  +  | t1 == t2                       = return θ+  | otherwise                      = throwError $ errUnify t1 t2++unifyVar θ i t +  = case lookupVar i θ of+      Just t' -> if t == t' then return θ else throwError (errUnify t t') +      Nothing -> return $ updateVar i t θ ++-- | Sort Substitutions+newtype TVSubst      = Th (M.HashMap Int Sort) ++-- | API for manipulating substitutions+lookupVar i (Th m)   = M.lookup i m+updateVar i t (Th m) = Th (M.insert i t m)++-------------------------------------------------------------------------+-- | Applying a Type Substitution ---------------------------------------+-------------------------------------------------------------------------++apply θ          = sortMap f+  where+    f t@(FVar i) = fromMaybe t (lookupVar i θ)+    f t          = t++sortMap f (FFunc n ts) = FFunc n (sortMap f <$> ts)+sortMap f (FApp  c ts) = FApp  c (sortMap f <$> ts)+sortMap f t            = f t++------------------------------------------------------------------------+-- | Deconstruct a function-sort ---------------------------------------+------------------------------------------------------------------------++sortFunction (FFunc n ts') = return (n, ts, t) +  where +    ts                     = take numArgs ts'+    t                      = last ts'+    numArgs                = length ts' - 1++sortFunction t             = throwError $ errNonFunction t
+ src/Language/Fixpoint/Types.hs view
@@ -0,0 +1,1439 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE UndecidableInstances      #-}++-- | This module contains the data types, operations and serialization functions +-- for representing Fixpoint's implication (i.e. subtyping) and well-formedness +-- constraints in Haskell. The actual constraint solving is done by the+-- `fixpoint.native` which is written in Ocaml.++module Language.Fixpoint.Types (++  -- * Top level serialization  +    Fixpoint (..)+  , toFixpoint+  , FInfo (..)++  -- * Rendering+  , showFix+  , traceFix+  , resultDoc ++  -- * Embedding to Fixpoint Types+  , Sort (..), FTycon, TCEmb+  , intFTyCon, boolFTyCon, strFTyCon, propFTyCon+  , stringFTycon, fTyconString++  -- * Symbols+  , Symbol(..)+  , anfPrefix, tempPrefix, vv, intKvar+  , symChars, isNonSymbol, nonSymbol+  , isNontrivialVV+  , stringSymbol, symbolString+  +  -- * Creating Symbols+  , dummySymbol, intSymbol, tempSymbol+  , qualifySymbol, stringSymbolRaw+  , suffixSymbol++  -- * Expressions and Predicates+  , SymConst (..), Constant (..)+  , Bop (..), Brel (..)+  , Expr (..), Pred (..)+  , eVar+  , eProp+  , pAnd, pOr, pIte+  , isTautoPred++  -- * Generalizing Embedding with Typeclasses +  , Symbolic (..)+  , Expression (..)+  , Predicate (..)++  -- * Constraints and Solutions+  , SubC, WfC, subC, lhsCs, rhsCs, wfC, Tag, FixResult (..), FixSolution, addIds, sinfo +  , trueSubCKvar+  , removeLhsKvars++  -- * Environments+  , SEnv, SESearch(..)+  , emptySEnv, toListSEnv, fromListSEnv+  , mapSEnv+  , insertSEnv, deleteSEnv, memberSEnv, lookupSEnv+  , intersectWithSEnv+  , filterSEnv+  , lookupSEnvWithDistance++  , FEnv, insertFEnv +  , IBindEnv, BindId, insertsIBindEnv, deleteIBindEnv, emptyIBindEnv+  , BindEnv, insertBindEnv, emptyBindEnv++  -- * Refinements+  , Refa (..), SortedReft (..), Reft(..), Reftable(..) + +  -- * Constructing Refinements+  , trueSortedReft          -- trivial reft+  , trueRefa                -- trivial reft+  , exprReft                -- singleton: v == e+  , notExprReft             -- singleton: v /= e+  , symbolReft              -- singleton: v == x+  , propReft                -- singleton: Prop(v) <=> p+  , predReft                -- any pred : p+  , isFunctionSortedReft+  , isNonTrivialSortedReft+  , isTautoReft+  , isSingletonReft+  , isEVar+  , isFalse+  , flattenRefas, squishRefas+  , shiftVV++  -- * Substitutions +  , Subst, Subable (..)+  , emptySubst, mkSubst, catSubst+  , substExcept, substfExcept, subst1Except+  , sortSubst++  -- * Visitors+  , reftKVars++  -- * Functions on @Result@+  , colorResult ++  -- * Cut KVars+  , Kuts (..), ksEmpty, ksUnion++  -- * Qualifiers+  , Qualifier (..)++ ) where++import GHC.Generics         (Generic)+import Debug.Trace          (trace)++import Data.Typeable        (Typeable)+import Data.Generics        (Data)+import Data.Monoid hiding   ((<>))+import Data.Functor+import Data.Char            (ord, chr, isAlpha, isUpper, toLower)+import Data.List            (sort, stripPrefix)+import Data.Hashable        ++import Data.Maybe           (fromMaybe)+import Text.Printf          (printf)+import Control.DeepSeq+import Control.Arrow        ((***))++import Language.Fixpoint.Misc+import Text.PrettyPrint.HughesPJ++import qualified Data.HashMap.Strict as M+import qualified Data.HashSet        as S+import Data.Array            hiding (indices)+import Language.Fixpoint.Names++class Fixpoint a where+  toFix    :: a -> Doc++  simplify :: a -> a +  simplify =  id+++------------------------------------------------------------------------++showFix :: (Fixpoint a) => a -> String+showFix =  render . toFix++traceFix     ::  (Fixpoint a) => String -> a -> a+traceFix s x = trace ("\nTrace: [" ++ s ++ "] : " ++ showFix x) $ x++type TCEmb a    = M.HashMap a FTycon  ++-- instance (Eq a, Hashable a) => Monoid (TCEmb a) where+--   mappend m1 m2 = M.fromList (M.toList m1 ++ M.toList m2)+--   mempty        = M.empty++exprSymbols :: Expr -> [Symbol]+exprSymbols = go+  where +    go (EVar x)        = [x]+    -- go (EDat x _)      = [x]+    go (ELit x _)      = [x]+    go (EApp f es)     = f : concatMap go es+    go (EBin _ e1 e2)  = go e1 ++ go e2 +    go (EIte p e1 e2)  = predSymbols p ++ go e1 ++ go e2 +    go (ECst e _)      = go e+    go _               = []++predSymbols :: Pred -> [Symbol]+predSymbols = go+  where +    go (PAnd ps)        = concatMap go ps+    go (POr ps)         = concatMap go ps+    go (PNot p)         = go p+    go (PIff p1 p2)     = go p1 ++ go p2+    go (PImp p1 p2)     = go p1 ++ go p2+    go (PBexp e)        = exprSymbols e+    go (PAtom _ e1 e2)  = exprSymbols e1 ++ exprSymbols e2+    go (PAll xts p)     = (fst <$> xts) ++ go p+    go _                = []++reftKVars :: Reft -> [Symbol]+reftKVars (Reft (_,ras)) = [k | (RKvar k _) <- ras]++---------------------------------------------------------------+---------- (Kut) Sets of Kvars --------------------------------+---------------------------------------------------------------++newtype Kuts = KS (S.HashSet Symbol) ++instance NFData Kuts where+  rnf (KS _) = () -- rnf s++instance Fixpoint Kuts where+  toFix (KS s) = vcat $ ((text "cut " <>) . toFix) <$> S.toList s++ksEmpty             = KS S.empty+ksUnion kvs (KS s') = KS (S.union (S.fromList kvs) s')++---------------------------------------------------------------+---------- Converting Constraints to Fixpoint Input -----------+---------------------------------------------------------------++instance (Eq a, Hashable a, Fixpoint a) => Fixpoint (S.HashSet a) where+  toFix xs = brackets $ sep $ punctuate (text ";") (toFix <$> S.toList xs)+  simplify = S.fromList . map simplify . S.toList++instance Fixpoint a => Fixpoint (Maybe a) where+  toFix    = maybe (text "Nothing") ((text "Just" <+>) . toFix)+  simplify = fmap simplify++instance Fixpoint a => Fixpoint [a] where+  toFix xs = brackets $ sep $ punctuate (text ";") (fmap toFix xs)+  simplify = map simplify++instance (Fixpoint a, Fixpoint b) => Fixpoint (a,b) where+  toFix   (x,y)  = (toFix x) <+> text ":" <+> (toFix y)+  simplify (x,y) = (simplify x, simplify y) ++toFix_gs (SE e)        +  = vcat  $ map (toFix_constant . mapSnd sr_sort) $ hashMapToAscList e+toFix_constant (c, so) +  = text "constant" <+> toFix c <+> text ":" <+> toFix so ++++----------------------------------------------------------------------+------------------------ Type Constructors ---------------------------+----------------------------------------------------------------------++newtype FTycon = TC Symbol deriving (Eq, Ord, Show, Data, Typeable)+++intFTyCon  = TC (S "int")+boolFTyCon = TC (S "bool")+strFTyCon  = TC (S strConName)+propFTyCon = TC (S propConName)++-- listFTyCon = TC (S listConName)++-- isListTC   = (listFTyCon ==)+isListTC (TC (S c)) = c == listConName+isTupTC (TC (S c))  = c == tupConName++fTyconString (TC (S s)) = s++stringFTycon :: String -> FTycon+stringFTycon c +  | c == listConName = TC . S $ listConName+  | otherwise        = TC $ stringSymbol c+++----------------------------------------------------------------------+------------------------------- Sorts --------------------------------+----------------------------------------------------------------------++data Sort = FInt +          | FNum                 -- ^ numeric kind for Num tyvars+          | FObj  Symbol         -- ^ uninterpreted type+          | FVar  !Int           -- ^ fixpoint type variable+          | FFunc !Int ![Sort]   -- ^ type-var arity, in-ts ++ [out-t]+          | FApp FTycon [Sort]   -- ^ constructed type +	      deriving (Eq, Ord, Show, Generic, Data, Typeable)++instance Hashable Sort++newtype Sub = Sub [(Int, Sort)]++instance Fixpoint Sort where+  toFix = toFix_sort++toFix_sort (FVar i)     = text "@"   <> parens (toFix i)+toFix_sort FInt         = text "int"+toFix_sort (FObj x)     = toFix x+toFix_sort FNum         = text "num"+toFix_sort (FFunc n ts) = text "func" <> parens ((toFix n) <> (text ", ") <> (toFix ts))+toFix_sort (FApp c [t]) +  | isListTC c          = brackets $ toFix_sort t +toFix_sort (FApp c ts)  +  | isTupTC  c          = parens $ intersperse comma $ toFix_sort <$> ts +  | otherwise           = toFix c <+> intersperse space (fp <$> ts)+                          where fp s@(FApp _ (_:_)) = parens $ toFix_sort s +                                fp s                = toFix_sort s+++instance Fixpoint FTycon where+  toFix (TC s)       = toFix s++-------------------------------------------------------------------------------------------+sortSubst                  :: (M.HashMap Symbol Sort) -> Sort -> Sort+-------------------------------------------------------------------------------------------+sortSubst θ t@(FObj x)   = fromMaybe t (M.lookup x θ) +sortSubst θ (FFunc n ts) = FFunc n (sortSubst θ <$> ts)+sortSubst θ (FApp c ts)  = FApp c  (sortSubst θ <$> ts)+sortSubst _  t           = t+++---------------------------------------------------------------+---------------------------- Symbols --------------------------+---------------------------------------------------------------++symChars +  =  ['a' .. 'z']+  ++ ['A' .. 'Z'] +  ++ ['0' .. '9'] +  ++ ['_', '%', '.', '#']++data Symbol = S !String deriving (Eq, Ord, Data, Typeable)++instance Fixpoint Symbol where+  toFix (S x) = text x++instance Show Symbol where+  show (S x) = x++instance Show Subst where+  show = showFix++instance Fixpoint Subst where+  toFix (Su m) = case {- hashMapToAscList -} m of +                   []  -> empty+                   xys -> hcat $ map (\(x,y) -> brackets $ (toFix x) <> text ":=" <> (toFix y)) xys+++---------------------------------------------------------------------------+------ Converting Strings To Fixpoint ------------------------------------- +---------------------------------------------------------------------------++stringSymbolRaw :: String -> Symbol+stringSymbolRaw = S++stringSymbol :: String -> Symbol+stringSymbol s+  | isFixKey  s = encodeSym s +  | isFixSym' s = S s +  | otherwise   = encodeSym s -- S $ fixSymPrefix ++ concatMap encodeChar s++encodeSym s     = S $ fixSymPrefix ++ concatMap encodeChar s++symbolString :: Symbol -> String+symbolString (S str) +  = case chopPrefix fixSymPrefix str of+      Just s  -> concat $ zipWith tx indices $ chunks s +      Nothing -> str+    where +      chunks = unIntersperse symSepName +      tx i s = if even i then s else [decodeStr s]++indices :: [Integer]+indices = [0..]++okSymChars+  =  ['a' .. 'z']+  ++ ['A' .. 'Z'] +  ++ ['0' .. '9'] +  ++ ['_', '.'  ]++fixSymPrefix = "fix" ++ [symSepName]++suffixSymbol s suf = stringSymbol (symbolString s ++ suf)++isFixSym' (c:chs)  = isAlpha c && all (`elem` (symSepName:okSymChars)) chs+isFixSym' _        = False++isFixKey x = S.member x keywords+keywords   = S.fromList ["env", "id", "tag", "qualif", "constant", "cut", "bind", "constraint", "grd", "lhs", "rhs"]++encodeChar c +  | c `elem` okSymChars +  = [c]+  | otherwise+  = [symSepName] ++ (show $ ord c) ++ [symSepName]++decodeStr s +  = chr ((read s) :: Int)++qualifySymbol x sy +  | isQualified x' = sy +  | isParened x'   = stringSymbol (wrapParens (x ++ "." ++ stripParens x')) +  | otherwise      = stringSymbol (x ++ "." ++ x')+  where x' = symbolString sy ++isQualified y         = '.' `elem` y +wrapParens x          = "(" ++ x ++ ")"+isParened xs          = xs /= stripParens xs++---------------------------------------------------------------------++vv                  :: Maybe Integer -> Symbol+vv (Just i)         = S (vvName ++ [symSepName] ++ show i)+vv Nothing          = S vvName++vvCon               = S (vvName ++ [symSepName] ++ "F")++isNontrivialVV      = not . (vv_ ==) +++dummySymbol         = S dummyName+intSymbol x i       = S $ x ++ show i           ++tempSymbol          ::  String -> Integer -> Symbol+tempSymbol prefix n = intSymbol (tempPrefix ++ prefix) n++tempPrefix          = "lq_tmp_"+anfPrefix           = "lq_anf_" +nonSymbol           = S ""+isNonSymbol         = (0 ==) . length . symbolString++intKvar             :: Integer -> Symbol+intKvar             = intSymbol "k_" ++---------------------------------------------------------------+------------------------- Expressions -------------------------+---------------------------------------------------------------++-- | Uninterpreted constants that are embedded as  "constant symbol : Str"++data SymConst = SL !String+              deriving (Eq, Ord, Show, Data, Typeable)++data Constant = I  !Integer +              deriving (Eq, Ord, Show, Data, Typeable)++data Brel = Eq | Ne | Gt | Ge | Lt | Le +            deriving (Eq, Ord, Show, Data, Typeable)++data Bop  = Plus | Minus | Times | Div | Mod    +            deriving (Eq, Ord, Show, Data, Typeable) +	      -- NOTE: For "Mod" 2nd expr should be a constant or a var *)++data Expr = ESym !SymConst  +          | ECon !Constant +          | EVar !Symbol+          | ELit !Symbol !Sort+          | EApp !Symbol ![Expr]+          | EBin !Bop !Expr !Expr+          | EIte !Pred !Expr !Expr+          | ECst !Expr !Sort+          | EBot+          deriving (Eq, Ord, Show, Data, Typeable)++instance Fixpoint Integer where+  toFix = integer ++instance Fixpoint Constant where+  toFix (I i)  = toFix i++instance Fixpoint SymConst where +  toFix  = toFix . encodeSymConst++instance Fixpoint Brel where+  toFix Eq = text "="+  toFix Ne = text "!="+  toFix Gt = text ">"+  toFix Ge = text ">="+  toFix Lt = text "<"+  toFix Le = text "<="++instance Fixpoint Bop where+  toFix Plus  = text "+"+  toFix Minus = text "-"+  toFix Times = text "*"+  toFix Div   = text "/"+  toFix Mod   = text "mod"++instance Fixpoint Expr where+  toFix (ESym c)       = toFix $ encodeSymConst c+  toFix (ECon c)       = toFix c +  toFix (EVar s)       = toFix s+  toFix (ELit s _)     = toFix s+  toFix (EApp f es)    = (toFix f) <> (parens $ toFix es) +  toFix (EBin o e1 e2) = parens $ toFix e1 <+> toFix o <+> toFix e2+  toFix (EIte p e1 e2) = parens $ toFix p <+> text "?" <+> toFix e1 <+> text ":" <+> toFix e2 +  toFix (ECst e so)    = parens $ toFix e <+> text " : " <+> toFix so +  toFix (EBot)         = text "_|_"++----------------------------------------------------------+--------------------- Predicates -------------------------+----------------------------------------------------------++data Pred = PTrue+          | PFalse+          | PAnd  ![Pred]+          | POr   ![Pred]+          | PNot  !Pred+          | PImp  !Pred !Pred+          | PIff  !Pred !Pred+          | PBexp !Expr+          | PAtom !Brel !Expr !Expr+          | PAll  ![(Symbol, Sort)] !Pred+          | PTop+          deriving (Eq, Ord, Show, Data, Typeable)++instance Fixpoint Pred where+  toFix PTop             = text "???"+  toFix PTrue            = text "true"+  toFix PFalse           = text "false"+  toFix (PBexp e)        = parens $ text "?" <+> toFix e+  toFix (PNot p)         = parens $ text "~" <+> parens (toFix p)+  toFix (PImp p1 p2)     = parens $ (toFix p1) <+> text "=>" <+> (toFix p2)+  toFix (PIff p1 p2)     = parens $ (toFix p1) <+> text "<=>" <+> (toFix p2)+  toFix (PAnd ps)        = text "&&" <+> toFix ps+  toFix (POr  ps)        = text "||" <+> toFix ps+  toFix (PAtom r e1 e2)  = parens $ toFix e1 <+> toFix r <+> toFix e2+  toFix (PAll xts p)     = text "forall" <+> (toFix xts) <+> text "." <+> (toFix p)++  simplify (PAnd [])     = PTrue+  simplify (POr  [])     = PFalse+  simplify (PAnd [p])    = simplify p+  simplify (POr  [p])    = simplify p+  +  simplify (PAnd ps)    +    | any isContraPred ps = PFalse+    | otherwise           = PAnd $ filter (not . isTautoPred) $ map simplify ps+  +  simplify (POr  ps)    +    | any isTautoPred ps = PTrue+    | otherwise          = POr  $ filter (not . isContraPred) $ map simplify ps ++  simplify p            +    | isContraPred p     = PFalse+    | isTautoPred  p     = PTrue+    | otherwise          = p++zero           = ECon (I 0)+one            = ECon (I 1)++isContraPred z = eqC z || (z `elem` contras)+  where+    contras    = [PFalse]   +    +    eqC (PAtom Eq (ECon x) (ECon y))+               = x /= y+    eqC (PAtom Ne x y)+               = x == y+    eqC _      = False++isTautoPred z  = eqT z || (z `elem` tautos)+  where +    tautos     = [PTrue]+    +    eqT (PAtom Le x y) +               = x == y+    eqT (PAtom Ge x y) +               = x == y+    eqT (PAtom Eq x y) +               = x == y+    eqT (PAtom Ne (ECon x) (ECon y))+               = x /= y+    eqT _      = False ++++isTautoReft (Reft (_, ras)) = all isTautoRa ras+isTautoRa (RConc p)         = isTautoPred p+isTautoRa _                 = False++isEVar (EVar _) = True+isEVar _        = False++isSingletonReft (Reft (v, [RConc (PAtom Eq e1 e2)])) +  | e1 == EVar v = Just e2+  | e2 == EVar v = Just e1+isSingletonReft _    = Nothing ++pAnd          = simplify . PAnd +pOr           = simplify . POr +pIte p1 p2 p3 = pAnd [p1 `PImp` p2, (PNot p1) `PImp` p3] ++mkProp        = PBexp . EApp (S propConName) . (: [])++ppr_reft (Reft (v, ras)) d +  | all isTautoRa ras+  = d+  | otherwise+  = braces (toFix v <+> colon <+> d <+> text "|" <+> ppRas ras)++ppr_reft_pred (Reft (_, ras))+  | all isTautoRa ras+  = text "true"+  | otherwise+  = ppRas ras++ppRas = cat . punctuate comma . map toFix . flattenRefas++------------------------------------------------------------------------+-- | Generalizing Symbol, Expression, Predicate into Classes -----------+------------------------------------------------------------------------++-- | Values that can be viewed as Symbols++class Symbolic a where+  symbol :: a -> Symbol++-- | Values that can be viewed as Expressions++class Expression a where+  expr   :: a -> Expr++-- | Values that can be viewed as Predicates++class Predicate a where+  prop   :: a -> Pred++instance Symbolic String where +  symbol = stringSymbol++instance Symbolic Symbol where +  symbol = id ++instance Expression Expr where+  expr = id++-- | The symbol may be an encoding of a SymConst.++instance Expression Symbol where+  expr s = maybe (eVar s) ESym (decodeSymConst s)  +  -- expr = eVar++instance Expression String where +  expr = ESym . SL++instance Expression Integer where+  expr = ECon . I++instance Expression Int where+  expr = expr . toInteger++instance Predicate Symbol where+  prop = eProp++instance Predicate Pred where+  prop = id ++instance Predicate Bool where+  prop True  = PTrue +  prop False = PFalse ++eVar          ::  Symbolic a => a -> Expr +eVar          = EVar . symbol ++eProp         ::  Symbolic a => a -> Pred+eProp         = mkProp . eVar++exprReft, notExprReft  ::  (Expression a) => a -> Reft+exprReft e             = Reft (vv_, [RConc $ PAtom Eq (eVar vv_)  (expr e)])+notExprReft e          = Reft (vv_, [RConc $ PAtom Ne (eVar vv_)  (expr e)])++propReft               ::  (Predicate a) => a -> Reft+propReft p             = Reft (vv_, [RConc $ PIff     (eProp vv_) (prop p)]) ++predReft               :: (Predicate a) => a -> Reft+predReft p             = Reft (vv_, [RConc $ prop p])+++++---------------------------------------------------------------+----------------- Refinements ---------------------------------+---------------------------------------------------------------++data Refa +  = RConc !Pred +  | RKvar !Symbol !Subst+  deriving (Eq, Ord, Show, Data, Typeable)++newtype Reft = Reft (Symbol, [Refa]) deriving (Eq, Ord, Data, Typeable)++instance Show Reft where+  show (Reft x) = render $ toFix x ++data SortedReft = RR { sr_sort :: !Sort, sr_reft :: !Reft } deriving (Eq)++isNonTrivialSortedReft (RR _ (Reft (_, ras)))+  = not $ null ras++isFunctionSortedReft (RR (FFunc _ _) _)+  = True+isFunctionSortedReft _+  = False++sortedReftValueVariable (RR _ (Reft (v,_))) = v++---------------------------------------------------------------+----------------- Environments  -------------------------------+---------------------------------------------------------------++toListSEnv              ::  SEnv a -> [(Symbol, a)]+toListSEnv (SE env)     = M.toList env+fromListSEnv            ::  [(Symbol, a)] -> SEnv a+fromListSEnv            = SE . M.fromList+mapSEnv f (SE env)      = SE (fmap f env)+deleteSEnv x (SE env)   = SE (M.delete x env)+insertSEnv x y (SE env) = SE (M.insert x y env)+lookupSEnv x (SE env)   = M.lookup x env+emptySEnv               = SE M.empty+memberSEnv x (SE env)   = M.member x env+intersectWithSEnv f (SE m1) (SE m2) = SE (M.intersectionWith f m1 m2)+filterSEnv f (SE m)     = SE (M.filter f m)+lookupSEnvWithDistance x (SE env)+  = case M.lookup x env of +     Just x  -> Found x+     Nothing -> Alts $ stringSymbol <$> alts +  where alts    = takeMin $ (zip (editDistance x' <$> ss) ss)+        ss      = symbolString <$> fst <$> M.toList env+        x'      = symbolString x+        takeMin = \xs ->  [x | (d, x) <- xs, d == getMin xs] +        getMin  = minimum . (fst <$>) ++data SESearch a = Found a | Alts [Symbol]++-- | Functions for Indexed Bind Environment ++emptyIBindEnv :: IBindEnv+emptyIBindEnv = FB (S.empty)++deleteIBindEnv :: BindId -> IBindEnv -> IBindEnv+deleteIBindEnv i (FB s) = FB (S.delete i s)++insertsIBindEnv :: [BindId] -> IBindEnv -> IBindEnv+insertsIBindEnv is (FB s) = FB (foldr S.insert s is)++-- | Functions for Global Binder Environment+insertBindEnv :: Symbol -> SortedReft -> BindEnv -> (BindId, BindEnv)+insertBindEnv x r (BE n m) = (n, BE (n + 1) (M.insert n (x, r) m))++emptyBindEnv :: BindEnv+emptyBindEnv = BE 0 M.empty+++instance Functor SEnv where+  fmap f (SE m) = SE $ fmap f m++instance Fixpoint Refa where+  toFix (RConc p)    = toFix p+  toFix (RKvar k su) = toFix k <> toFix su+  -- toFix (RPvar p)    = toFix p++instance Fixpoint Reft where+  toFix = ppr_reft_pred++instance Fixpoint SortedReft where+  toFix (RR so (Reft (v, ras))) +    = braces +    $ (toFix v) <+> (text ":") <+> (toFix so) <+> (text "|") <+> toFix ras++instance Fixpoint FEnv where+  toFix (SE m)   = toFix (hashMapToAscList m)++instance Fixpoint BindEnv where+  toFix (BE _ m) = vcat $ map toFix_bind $ hashMapToAscList m ++toFix_bind (i, (x, r)) = text "bind" <+> toFix i <+> toFix x <+> text ":" <+> toFix r   ++insertFEnv   = insertSEnv . lower +  where lower x@(S (c:chs)) +          | isUpper c = S $ toLower c : chs+          | otherwise = x+        lower z       = z++instance (Fixpoint a) => Fixpoint (SEnv a) where+  toFix (SE e) = vcat $ map pprxt $ hashMapToAscList e+	where pprxt (x, t) = toFix x <+> colon <> colon  <+> toFix t++instance Fixpoint (SEnv a) => Show (SEnv a) where+  show = render . toFix ++-----------------------------------------------------------------------------+------------------- Constraints ---------------------------------------------+-----------------------------------------------------------------------------++{-@ type Tag = { v : [Int] | len(v) = 1 } @-}+type Tag           = [Int] ++type BindId        = Int+type FEnv          = SEnv SortedReft ++newtype IBindEnv   = FB (S.HashSet BindId)+newtype SEnv a     = SE { se_binds :: M.HashMap Symbol a } deriving (Eq, Data, Typeable)+data BindEnv       = BE { be_size  :: Int+                        , be_binds :: M.HashMap BindId (Symbol, SortedReft) +                        }+++data SubC a = SubC { senv  :: !IBindEnv+                   , sgrd  :: !Pred+                   , slhs  :: !SortedReft+                   , srhs  :: !SortedReft+                   , sid   :: !(Maybe Integer)+                   , stag  :: !Tag+                   , sinfo :: !a+                   }++data WfC a  = WfC  { wenv  :: !IBindEnv+                   , wrft  :: !SortedReft+                   , wid   :: !(Maybe Integer) +                   , winfo :: !a+                   } -- deriving (Eq)++data FixResult a = Crash [a] String +                 | Safe +                 | Unsafe ![a] +                 | UnknownError !Doc+                   deriving (Show)++type FixSolution = M.HashMap Symbol Pred++instance Eq a => Eq (FixResult a) where +  Crash xs _ == Crash ys _         = xs == ys+  Unsafe xs == Unsafe ys           = xs == ys+  Safe      == Safe                = True+  _         == _                   = False++instance Monoid (FixResult a) where+  mempty                          = Safe+  mappend Safe x                  = x+  mappend x Safe                  = x+  mappend _ c@(Crash _ _)         = c +  mappend c@(Crash _ _) _         = c +  mappend (Unsafe xs) (Unsafe ys) = Unsafe (xs ++ ys)+  mappend u@(UnknownError _) _    = u +  mappend _ u@(UnknownError _)    = u ++instance Functor FixResult where +  fmap f (Crash xs msg)   = Crash (f <$> xs) msg+  fmap f (Unsafe xs)      = Unsafe (f <$> xs)+  fmap _ Safe             = Safe+  fmap _ (UnknownError d) = UnknownError d++instance (Ord a, Fixpoint a) => Fixpoint (FixResult (SubC a)) where+  toFix Safe             = text "Safe"+  toFix (UnknownError d) = text "Unknown Error!" <+> d+  toFix (Crash xs msg)   = vcat $ [ text "Crash!" ] ++  ppr_sinfos "CRASH: " xs ++ [parens (text msg)] +  toFix (Unsafe xs)      = vcat $ text "Unsafe:" : ppr_sinfos "WARNING: " xs++ppr_sinfos :: (Ord a, Fixpoint a) => String -> [SubC a] -> [Doc]+ppr_sinfos msg = map ((text msg <>) . toFix) . sort . fmap sinfo+++resultDoc :: (Ord a, Fixpoint a) => FixResult a -> Doc+resultDoc Safe             = text "Safe"+resultDoc (UnknownError d) = text "Unknown Error!" <+> d+resultDoc (Crash xs msg)   = vcat $ (text ("Crash!: " ++ msg)) : (((text "CRASH:" <+>) . toFix) <$> xs)+resultDoc (Unsafe xs)      = vcat $ (text "Unsafe:")           : (((text "WARNING:" <+>) . toFix) <$> xs)++++++colorResult (Safe)      = Happy +colorResult (Unsafe _)  = Angry +colorResult (_)         = Sad +++instance Show (SubC a) where+  show = showFix ++instance Fixpoint (IBindEnv) where+  toFix (FB ids) = text "env" <+> toFix ids ++instance Fixpoint (SubC a) where+  toFix c     = hang (text "\n\nconstraint:") 2 bd+     where bd =   -- text "env" <+> toFix (senv c) +                  toFix (senv c)+              $+$ text "grd" <+> toFix (sgrd c) +              $+$ text "lhs" <+> toFix (slhs c) +              $+$ text "rhs" <+> toFix (srhs c)+              $+$ (pprId (sid c) <+> pprTag (stag c)) ++instance Fixpoint (WfC a) where +  toFix w     = hang (text "\n\nwf:") 2 bd +    where bd  =   -- text "env"  <+> toFix (wenv w)+                  toFix (wenv w)+              $+$ text "reft" <+> toFix (wrft w) +              $+$ pprId (wid w)++pprId (Just i)  = text "id" <+> tshow i+pprId _         = text ""++pprTag []       = text ""+pprTag is       = text "tag" <+> toFix is ++instance Fixpoint Int where+  toFix = tshow ++-------------------------------------------------------+------------------- Substitutions ---------------------+-------------------------------------------------------++class Subable a where+  syms   :: a -> [Symbol]+  substa :: (Symbol -> Symbol) -> a -> a+  -- substa f  = substf (EVar . f) +  +  substf :: (Symbol -> Expr) -> a -> a+  subst  :: Subst -> a -> a+  subst1 :: a -> (Symbol, Expr) -> a+  -- subst1 y (x, e) = subst (Su $ M.singleton x e) y+  subst1 y (x, e) = subst (Su [(x,e)]) y++subst1Except :: (Subable a) => [Symbol] -> a -> (Symbol, Expr) -> a+subst1Except xs z su@(x, _) +  | x `elem` xs = z+  | otherwise   = subst1 z su++substfExcept :: (Symbol -> Expr) -> [Symbol] -> (Symbol -> Expr)+substfExcept f xs y = if y `elem` xs then EVar y else f y++substExcept  :: Subst -> [Symbol] -> Subst+-- substExcept  (Su m) xs = Su (foldr M.delete m xs) +substExcept  (Su xes) xs = Su $ filter (not . (`elem` xs) . fst) xes++instance Subable Symbol where+  substa f x               = f x+  substf f x               = subSymbol (Just (f x)) x+  subst su x               = subSymbol (Just $ appSubst su x) x -- subSymbol (M.lookup x s) x+  syms x                   = [x]++subSymbol (Just (EVar y)) _ = y+subSymbol Nothing         x = x+subSymbol a               b = errorstar (printf "Cannot substitute symbol %s with expression %s" (showFix b) (showFix a))++instance Subable Expr where+  syms                     = exprSymbols+  substa f                 = substf (EVar . f) +  substf f (EApp s es)     = EApp (substf f s) $ map (substf f) es +  substf f (EBin op e1 e2) = EBin op (substf f e1) (substf f e2)+  substf f (EIte p e1 e2)  = EIte (substf f p) (substf f e1) (substf f e2)+  substf f (ECst e so)     = ECst (substf f e) so+  substf f e@(EVar x)      = f x +  substf _ e               = e+ +  subst su (EApp f es)     = EApp (subst su f) $ map (subst su) es +  subst su (EBin op e1 e2) = EBin op (subst su e1) (subst su e2)+  subst su (EIte p e1 e2)  = EIte (subst su p) (subst su e1) (subst  su e2)+  subst su (ECst e so)     = ECst (subst su e) so+  subst su (EVar x)        = appSubst su x+  subst _ e                = e+++instance Subable Pred where+  syms                     = predSymbols+  substa f                 = substf (EVar . f) +  substf f (PAnd ps)       = PAnd $ map (substf f) ps+  substf f (POr  ps)       = POr  $ map (substf f) ps+  substf f (PNot p)        = PNot $ substf f p+  substf f (PImp p1 p2)    = PImp (substf f p1) (substf f p2)+  substf f (PIff p1 p2)    = PIff (substf f p1) (substf f p2)+  substf f (PBexp e)       = PBexp $ substf f e+  substf f (PAtom r e1 e2) = PAtom r (substf f e1) (substf f e2)+  substf _  (PAll _ _)     = errorstar $ "substf: FORALL" +  substf _  p              = p++  subst su (PAnd ps)       = PAnd $ map (subst su) ps+  subst su (POr  ps)       = POr  $ map (subst su) ps+  subst su (PNot p)        = PNot $ subst su p+  subst su (PImp p1 p2)    = PImp (subst su p1) (subst su p2)+  subst su (PIff p1 p2)    = PIff (subst su p1) (subst su p2)+  subst su (PBexp e)       = PBexp $ subst su e+  subst su (PAtom r e1 e2) = PAtom r (subst su e1) (subst su e2)+  subst _  (PAll _ _)      = errorstar $ "subst: FORALL" +  subst _  p               = p++instance Subable Refa where+  syms (RConc p)           = syms p+  syms (RKvar k (Su su'))  = k : concatMap syms ({- M.elems -} su') +  subst su (RConc p)       = RConc   $ subst su p+  subst su (RKvar k su')   = RKvar k $ su' `catSubst` su +  -- subst _  (RPvar p)     = RPvar p+  substa f                 = substf (EVar . f) +  substf f (RConc p)       = RConc (substf f p)+  substf _ ra@(RKvar _ _)  = ra++instance (Subable a, Subable b) => Subable (a,b) where+  syms  (x, y)   = syms x ++ syms y+  subst su (x,y) = (subst su x, subst su y)+  substf f (x,y) = (substf f x, substf f y)+  substa f (x,y) = (substa f x, substa f y)++instance Subable a => Subable [a] where+  syms   = concatMap syms+  subst  = map . subst +  substf = map . substf +  substa = map . substa ++instance Subable a => Subable (M.HashMap k a) where+  syms   = syms . M.elems +  subst  = M.map . subst +  substf = M.map . substf +  substa = M.map . substa++instance Subable Reft where+  syms (Reft (v, ras))      = v : syms ras+  substa f (Reft (v, ras))  = Reft (f v, substa f ras) +  subst su (Reft (v, ras))  = Reft (v, subst (substExcept su [v]) ras)+  substf f (Reft (v, ras))  = Reft (v, substf (substfExcept f [v]) ras)+  subst1 (Reft (v, ras)) su = Reft (v, subst1Except [v] ras su)+++instance Subable SortedReft where+  syms               = syms . sr_reft +  subst su (RR so r) = RR so $ subst su r+  substf f (RR so r) = RR so $ substf f r+  substa f (RR so r) = RR so $ substa f r+++-- newtype Subst  = Su (M.HashMap Symbol Expr) deriving (Eq)+newtype Subst = Su [(Symbol, Expr)] deriving (Eq, Ord, Data, Typeable)++mkSubst                  = Su -- . M.fromList+appSubst (Su s) x        = fromMaybe (EVar x) (lookup x s)+emptySubst               = Su [] -- M.empty+catSubst (Su s1) (Su s2) = Su $ s1' ++ s2+  where s1' = mapSnd (subst (Su s2)) <$> s1+  -- = Su $ s1' `M.union` s2+  --   where s1' = subst (Su s2) `M.map` s1++instance Monoid Subst where+  mempty  = emptySubst+  mappend = catSubst ++------------------------------------------------------------+------------- Generally Useful Refinements -----------------+------------------------------------------------------------++symbolReft    = exprReft . eVar ++vv_           = vv Nothing++trueSortedReft :: Sort -> SortedReft+trueSortedReft = (`RR` trueReft) ++trueReft  = Reft (vv_, [])+falseReft = Reft (vv_, [RConc PFalse])++trueRefa  = RConc PTrue++flattenRefas ::  [Refa] -> [Refa]+flattenRefas         = concatMap flatRa+  where +    flatRa (RConc p) = RConc <$> flatP p+    flatRa ra        = [ra]+    flatP  (PAnd ps) = concatMap flatP ps+    flatP  p         = [p]++squishRefas     ::  [Refa] -> [Refa]+squishRefas ras = (squish [p | RConc p <- ras]) : []+  where +    squish      = RConc . pAnd . sortNub . filter (not . isTautoPred) . concatMap conjuncts   +    +conjuncts (PAnd ps)          = concatMap conjuncts ps+conjuncts p | isTautoPred p  = []+            | otherwise      = [p]+----------------------------------------------------------------+---------------------- Strictness ------------------------------+----------------------------------------------------------------++instance NFData Symbol where+  rnf (S x) = rnf x++instance NFData FTycon where+  rnf (TC c)       = rnf c++instance NFData Sort where+  rnf (FVar x)     = rnf x+  rnf (FFunc n ts) = rnf n `seq` (rnf <$> ts) `seq` () +  rnf (FApp c ts)  = rnf c `seq` (rnf <$> ts) `seq` ()+  rnf (z)          = z `seq` ()++instance NFData Sub where+  rnf (Sub x) = rnf x++instance NFData Subst where+  rnf (Su x) = rnf x++instance NFData FEnv where+  rnf (SE x) = rnf x++instance NFData IBindEnv where+  rnf (FB x) = rnf x++instance NFData BindEnv where+  rnf (BE x m) = rnf x `seq` rnf m++instance NFData Constant where+  rnf (I x) = rnf x++instance NFData SymConst where +  rnf (SL x) = rnf x++instance NFData Brel +instance NFData Bop++instance NFData Expr where+  rnf (ESym x)        = rnf x+  rnf (ECon x)        = rnf x+  rnf (EVar x)        = rnf x+  -- rnf (EDat x1 x2)    = rnf x1 `seq` rnf x2+  rnf (ELit x1 x2)    = rnf x1 `seq` rnf x2+  rnf (EApp x1 x2)    = rnf x1 `seq` rnf x2+  rnf (EBin x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3+  rnf (EIte x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3+  rnf (ECst x1 x2)    = rnf x1 `seq` rnf x2+  rnf (_)             = ()++instance NFData Pred where+  rnf (PAnd x)         = rnf x+  rnf (POr  x)         = rnf x+  rnf (PNot x)         = rnf x+  rnf (PBexp x)        = rnf x+  rnf (PImp x1 x2)     = rnf x1 `seq` rnf x2+  rnf (PIff x1 x2)     = rnf x1 `seq` rnf x2+  rnf (PAll x1 x2)     = rnf x1 `seq` rnf x2+  rnf (PAtom x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3+  rnf (_)              = ()++instance NFData Refa where+  rnf (RConc x)     = rnf x+  rnf (RKvar x1 x2) = rnf x1 `seq` rnf x2+  -- rnf (RPvar _)     = () -- rnf x++instance NFData Reft where +  rnf (Reft (v, ras)) = rnf v `seq` rnf ras++instance NFData SortedReft where +  rnf (RR so r) = rnf so `seq` rnf r++instance (NFData a) => NFData (SubC a) where+  rnf (SubC x1 x2 x3 x4 x5 x6 x7) +    = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7++instance (NFData a) => NFData (WfC a) where+  rnf (WfC x1 x2 x3 x4) +    = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4++----------------------------------------------------------------------------+-------------- Hashable Instances -----------------------------------------+---------------------------------------------------------------------------++instance Hashable Symbol where +  hashWithSalt i (S s) = hashWithSalt i s++instance Hashable FTycon where+  hashWithSalt i (TC s) = hashWithSalt i s++---------------------------------------------------------------------------+-------- Constraint Constructor Wrappers ----------------------------------+---------------------------------------------------------------------------++wfC  = WfC++-- subC γ p r1@(RR _ (Reft (v,_))) (RR t2 r2) x y z +--    = SubC γ p r1 (RR t2 (shiftVV r2 v)) x y z+subC γ p (RR t1 r1) (RR t2 r2) x y z +    = SubC γ p (RR t1 (shiftVV r1 vvCon)) (RR t2 (shiftVV r2 vvCon)) x y z++lhsCs = sr_reft . slhs+rhsCs = sr_reft . srhs++removeLhsKvars cs vs +  = cs{slhs = goRR (slhs cs)} +  where goRR rr                     = rr{sr_reft = goReft (sr_reft rr)} +        goReft (Reft(v, rs))        = Reft(v, filter f rs)+        f (RKvar v _) | v `elem` vs = False+        f r                         = True +        +trueSubCKvar v+  = subC emptyIBindEnv PTrue mempty (RR mempty (Reft(vv_, [RKvar v emptySubst]))) Nothing [0] ++shiftVV r@(Reft (v, ras)) v' +   | v == v'   = r+   | otherwise = Reft (v', (subst1 ras (v, EVar v')))+++addIds = zipWith (\i c -> (i, shiftId i $ c {sid = Just i})) [1..]+  where -- Adding shiftId to have distinct VV for SMT conversion +    shiftId i c = c { slhs = shiftSR i $ slhs c } +                    { srhs = shiftSR i $ srhs c }+    shiftSR i sr = sr { sr_reft = shiftR i $ sr_reft sr }+    shiftR i r@(Reft (S v, _)) = shiftVV r (S (v ++ show i))+++-- subC γ p r1 r2 x y z   = (vvsu, SubC γ p r1' r2' x y z)+--   where (vvsu, r1', r2') = unifySRefts r1 r2 ++-- unifySRefts (RR t1 r1) (RR t2 r2) = (z, RR t1 r1', RR t2 r2')+--   where (r1', r2')                =  unifyRefts r1 r2++-- unifyRefts r1@(Reft (v1, _)) r2@(Reft (v2, _))+--    | v1 == v2  = (r1, r2)+--    | otherwise = (r1, shiftVV r2 v1)++-- unifySRefts (RR t1 r1) (RR t2 r2) = (z, RR t1 r1', RR t2 r2')+--   where (z, r1', r2')             =  unifyRefts r1 r2+--+-- unifyRefts r1@(Reft (v1, _)) r2@(Reft (v2, _))+--   | v1 == v2  = ((v1, emptySubst), r1, r2)+--   | v1 /= vv_ = let (su, r2') = shiftVV r2 v1 in ((v1, su), r1 , r2')+--   | otherwise = let (su, r1') = shiftVV r1 v2 in ((v2, su), r1', r2 ) +--+-- shiftVV (Reft (v, ras)) v' = (su, (Reft (v', subst su ras))) +--   where su = mkSubst [(v, EVar v')]+++------------------------------------------------------------------------+----------------- Qualifiers -------------------------------------------+------------------------------------------------------------------------+++data Qualifier = Q { q_name   :: String           -- ^ Name+                   , q_params :: [(Symbol, Sort)] -- ^ Parameters+                   , q_body   :: Pred             -- ^ Predicate+                   }+               deriving (Eq, Ord, Show, Data, Typeable)++instance Fixpoint Qualifier where +  toFix = pprQual++instance NFData Qualifier where+  rnf (Q x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3++pprQual (Q n xts p) = text "qualif" <+> text n <> parens args  <> colon <+> toFix p +  where args = intersperse comma (toFix <$> xts)++data FInfo a = FI { cm    :: M.HashMap Integer (SubC a)+                  , ws    :: ![WfC a] +                  , bs    :: !BindEnv+                  , gs    :: !FEnv+                  , lits  :: ![(Symbol, Sort)]+                  , kuts  :: Kuts +                  , quals :: ![Qualifier]+                  }++-- toFixs = brackets . hsep . punctuate comma -- . map toFix ++toFixpoint x'    = kutsDoc x' $+$ gsDoc x' $+$ conDoc x' $+$ bindsDoc x' $+$ csDoc x' $+$ wsDoc x'+  where conDoc   = vcat     . map toFix_constant . getLits +        csDoc    = vcat     . map toFix . M.elems . cm +        wsDoc    = vcat     . map toFix . ws +        kutsDoc  = toFix    . kuts+        bindsDoc = toFix    . bs+        gsDoc    = toFix_gs . gs++getLits x = lits x ++ symConstLits x+++-------------------------------------------------------------------------+-- | A Class Predicates for Valid Refinements Types ---------------------+-------------------------------------------------------------------------++class (Monoid r, Subable r) => Reftable r where +  isTauto :: r -> Bool+  ppTy    :: r -> Doc -> Doc+  +  top     :: r+  top     =  mempty+ +  -- | should also refactor `top` so it takes a parameter.+  bot     :: r -> r++  meet    :: r -> r -> r+  meet    = mappend++  toReft  :: r -> Reft+  params  :: r -> [Symbol]          -- ^ parameters for Reft, vv + others++instance Monoid Pred where+  mempty      = PTrue +  mappend p q = pAnd [p, q]++instance Monoid Reft where+  mempty  = trueReft+  mappend = meetReft++meetReft r@(Reft (v, ras)) r'@(Reft (v', ras')) +  | v == v'          = Reft (v , ras  ++ ras')+  | v == dummySymbol = Reft (v', ras' ++ (ras `subst1`  (v , EVar v'))) +  | otherwise        = Reft (v , ras  ++ (ras' `subst1` (v', EVar v )))++instance Subable () where+  syms _      = []+  subst _ ()  = ()+  substf _ () = ()+  substa _ () = ()++instance Reftable () where+  isTauto _ = True+  ppTy _  d = d+  top       = ()+  bot  _    = ()+  meet _ _  = ()+  toReft _  = top+  params _  = []++instance Reftable Reft where+  isTauto  = isTautoReft+  ppTy     = ppr_reft+  toReft   = id+  params _ = []+  bot    _ = falseReft++instance Monoid Sort where+  mempty            = FObj (S "any")+  mappend t1 t2 +    | t1 == mempty  = t2+    | t2 == mempty  = t1+    | t1 == t2      = t1+    | otherwise     = errorstar $ "mappend-sort: conflicting sorts t1 =" ++ show t1 ++ " t2 = " ++ show t2++instance Monoid SortedReft where+  mempty        = RR mempty mempty+  mappend t1 t2 = RR (mappend (sr_sort t1) (sr_sort t2)) (mappend (sr_reft t1) (sr_reft t2))++instance Reftable SortedReft where+  isTauto  = isTauto . toReft+  ppTy     = ppTy . toReft+  toReft   = sr_reft+  params _ = []+  bot s    = s { sr_reft = falseReft }++class Falseable a where+  isFalse :: a -> Bool++instance Falseable Pred where+  isFalse (PFalse) = True+  isFalse _        = False++instance Falseable Refa where+  isFalse (RConc p) = isFalse p+  isFalse _         = False++instance Falseable Reft where+  isFalse (Reft(_, rs)) = or [isFalse p | RConc p <- rs]++-- instance Expression a => Reftable a where+--   isTauto _ = isTauto . toReft +--   ppTy      = ppTy . toReft+--   toReft    = exprReft +--   params _  = []++-- instance Predicate a => Reftable a where+--   isTauto   = isTauto . toReft +--   ppTy      = ppTy . toReft+--   toReft    = propReft +--   params _  = []+++---------------------------------------------------------------+-- |String Constants ------------------------------------------+---------------------------------------------------------------++symConstLits    :: FInfo a -> [(Symbol, Sort)]+symConstLits fi = [(encodeSymConst c, sortSymConst c) | c <- symConsts fi]++-- | Replace all symbol-representations-of-string-literals with string-literal+--   Used to transform parsed output from fixpoint back into fq.+++encodeSymConst        :: SymConst -> Symbol+encodeSymConst (SL s) = stringSymbol $ litPrefix ++ s++sortSymConst          :: SymConst -> Sort+sortSymConst (SL _)   = strSort++decodeSymConst :: Symbol -> Maybe SymConst +decodeSymConst = fmap SL . stripPrefix litPrefix . symbolString++litPrefix    :: String+litPrefix    = "lit" ++ [symSepName]++strSort      :: Sort+strSort      = FApp strFTyCon []++class SymConsts a where +  symConsts :: a -> [SymConst]++instance SymConsts (FInfo a) where +  symConsts fi = sortNub $ csLits ++ bsLits ++ gsLits ++ qsLits+    where+      csLits   = concatMap symConsts                     $ M.elems  $  cm    fi+      bsLits   = concatMap symConsts $ map snd $ M.elems $ be_binds $  bs    fi+      gsLits   = concatMap symConsts $           M.elems $ se_binds $  gs    fi+      qsLits   = concatMap symConsts $                     q_body  <$> quals fi ++instance SymConsts (SubC a) where +  symConsts c  = symConsts (sgrd c) ++ +                 symConsts (slhs c) ++ +                 symConsts (srhs c) ++instance SymConsts SortedReft where+  symConsts = symConsts . sr_reft++instance SymConsts Reft where+  symConsts (Reft (_, ras)) = concatMap symConsts ras++instance SymConsts Refa where+  symConsts (RConc p)          = symConsts p+  symConsts (RKvar _ (Su xes)) = concatMap symConsts $ snd <$> xes ++instance SymConsts Expr where+  symConsts (ESym c)       = [c] +  symConsts (EApp _ es)    = concatMap symConsts es+  symConsts (EBin _ e e')  = concatMap symConsts [e, e']+  symConsts (EIte p e e')  = symConsts p ++ concatMap symConsts [e, e']+  symConsts (ECst e _)     = symConsts e+  symConsts _              = []+ +instance SymConsts Pred where+  symConsts (PNot p)       = symConsts p+  symConsts (PAnd ps)      = concatMap symConsts ps+  symConsts (POr ps)       = concatMap symConsts ps+  symConsts (PImp p q)     = concatMap symConsts [p, q]+  symConsts (PIff p q)     = concatMap symConsts [p, q]+  symConsts (PAll _ p)     = symConsts p+  symConsts (PBexp e)      = symConsts e+  symConsts (PAtom _ e e') = concatMap symConsts [e, e']+  symConsts _              = []++---------------------------------------------------------------+-- | Edit Distance --------------------------------------------+---------------------------------------------------------------+++editDistance :: Eq a => [a] -> [a] -> Int+editDistance xs ys = table ! (m,n)+    where+    (m,n) = (length xs, length ys)+    x     = array (1,m) (zip [1..] xs)+    y     = array (1,n) (zip [1..] ys)+ +    table :: Array (Int,Int) Int+    table = array bnds [(ij, dist ij) | ij <- range bnds]+    bnds  = ((0,0),(m,n))+ +    dist (0,j) = j+    dist (i,0) = i+    dist (i,j) = minimum [table ! (i-1,j) + 1, table ! (i,j-1) + 1,+        if x ! i == y ! j then table ! (i-1,j-1) else 1 + table ! (i-1,j-1)]