+
+(* Uniques *)
+Variable UniqSupply : Type. Extract Inlined Constant UniqSupply => "UniqSupply.UniqSupply".
+Variable Unique : Type. Extract Inlined Constant Unique => "Unique.Unique".
+Variable uniqFromSupply : UniqSupply -> Unique. Extract Inlined Constant uniqFromSupply => "UniqSupply.uniqFromSupply".
+Variable splitUniqSupply : UniqSupply -> UniqSupply * UniqSupply.
+ Extract Inlined Constant splitUniqSupply => "UniqSupply.splitUniqSupply".
+Variable unique_eq : forall u1 u2:Unique, sumbool (u1=u2) (u1≠u2).
+ Extract Inlined Constant unique_eq => "(==)".
+Variable unique_toString : Unique -> string.
+ Extract Inlined Constant unique_toString => "show".
+Instance EqDecidableUnique : EqDecidable Unique :=
+ { eqd_dec := unique_eq }.
+Instance EqDecidableToString : ToString Unique :=
+ { toString := unique_toString }.
+
+Inductive UniqM {T:Type} : Type :=
+ | uniqM : (UniqSupply -> ???(UniqSupply * T)) -> UniqM.
+ Implicit Arguments UniqM [ ].
+
+Instance UniqMonad : Monad UniqM :=
+{ returnM := fun T (x:T) => uniqM (fun u => OK (u,x))
+; bindM := fun a b (x:UniqM a) (f:a->UniqM b) =>
+ uniqM (fun u =>
+ match x with
+ | uniqM fa =>
+ match fa u with
+ | Error s => Error s
+ | OK (u',va) => match f va with
+ | uniqM fb => fb u'
+ end
+ end
+ end)
+}.
+
+Definition getU : UniqM Unique :=
+ uniqM (fun us => let (us1,us2) := splitUniqSupply us in OK (us1,(uniqFromSupply us2))).
+
+Notation "'bind' x = e ; f" := (@bindM _ _ _ _ e (fun x => f)) (x ident, at level 60, right associativity).
+Notation "'return' x" := (returnM x) (at level 100).
+Notation "'failM' x" := (uniqM (fun _ => Error x)) (at level 100).
+
+
+
+
+
+
+Record FreshMonad {T:Type} :=
+{ FMT : Type -> Type
+; FMT_Monad :> Monad FMT
+; FMT_fresh : forall tl:list T, FMT { t:T & @In _ t tl -> False }
+}.
+Implicit Arguments FreshMonad [ ].
+Coercion FMT : FreshMonad >-> Funclass.
+
+
+
+Variable Prelude_error : forall {A}, string -> A. Extract Inlined Constant Prelude_error => "Prelude.error".
+
+
+
+
+Ltac eqd_dec_refl X :=
+ destruct (eqd_dec X X) as [eqd_dec1 | eqd_dec2];
+ [ clear eqd_dec1 | set (eqd_dec2 (refl_equal _)) as eqd_dec2'; inversion eqd_dec2' ].
+
+Lemma unleaves_injective : forall T (t1 t2:list T), unleaves t1 = unleaves t2 -> t1 = t2.
+ intros T.
+ induction t1; intros.
+ destruct t2.
+ auto.
+ inversion H.
+ destruct t2.
+ inversion H.
+ simpl in H.
+ inversion H.
+ set (IHt1 _ H2) as q.
+ rewrite q.
+ reflexivity.
+ Qed.
+
+Lemma fst_zip : forall T Q n (v1:vec T n)(v2:vec Q n), vec_map (@fst _ _) (vec_zip v1 v2) = v1.
+ admit.
+ Defined.
+
+Lemma snd_zip : forall T Q n (v1:vec T n)(v2:vec Q n), vec_map (@snd _ _) (vec_zip v1 v2) = v2.
+ admit.
+ Defined.
+
+(* escapifies any characters which might cause trouble for LaTeX *)
+Variable sanitizeForLatex : string -> string.
+ Extract Inlined Constant sanitizeForLatex => "sanitizeForLatex".
+Inductive Latex : Type := latex : string -> Latex.
+Instance LatexToString : ToString Latex := { toString := fun x => match x with latex s => s end }.
+Class ToLatex (T:Type) := { toLatex : T -> Latex }.
+Instance StringToLatex : ToLatex string := { toLatex := fun x => latex (sanitizeForLatex x) }.
+Instance LatexToLatex : ToLatex Latex := { toLatex := fun x => x }.
+Definition concatLatex {T1}{T2}(l1:T1)(l2:T2){L1:ToLatex T1}{L2:ToLatex T2} : Latex :=
+ match toLatex l1 with
+ latex s1 =>
+ match toLatex l2 with
+ latex s2 =>
+ latex (s1 +++ s2)
+ end
+ end.
+Notation "a +=+ b" := (concatLatex a b) (at level 60, right associativity).
+
+
+