Skip to content
Browse files

[cleanup] Unused code: Annotmaps et QmlpAst stuff.

  • Loading branch information...
1 parent 9cc8cd7 commit d132a773aed9e62ab916bb3e010f6afc5abc90d4 @fpessaux fpessaux committed Jul 28, 2011
View
1 libqmlcompil.mllib
@@ -2,7 +2,6 @@ libqmlcompil/QmlLoc
libqmlcompil/QmlTypeVars
libqmlcompil/QmlTypeVarsScope
libqmlcompil/QmlAst
-libqmlcompil/QmlpAst
libqmlcompil/QmlAstSort
libqmlcompil/QmlAstCons
libqmlcompil/QmlAstWalk
View
12 libqmlcompil/qmlAnnotMap.ml
@@ -96,18 +96,13 @@ let unsafe_overwrite annotmap1 annotmap2 =
let f _ _ y = y in
merge_i f annotmap1 annotmap2
-let unsafe_mixed_overwrite annotmap1 annotmap2 =
- let f _ _ y = y in
- merge_i (annot_merge f f) annotmap1 annotmap2
-
let find_opt i annotmap = AnnotMap.find_opt i annotmap
let find_opt_label label = find_opt (!! label)
let find i annotmap = Option.get_exn (AnnotNotFound ("annot", i)) (find_opt i annotmap)
let find_label label = find (!! label)
let add i annot annotmap = AnnotMap.add i annot annotmap
let add_label label = add (!! label)
let remove i annotmap = AnnotMap.remove i annotmap
-let remove_label label = remove (!! label)
let find_opt_factory _name accessor i annotmap =
Option.join (Option.map accessor (find_opt i annotmap))
@@ -139,13 +134,6 @@ let add_ty i t annotmap =
let add_ty_label label = add_ty (!! label)
-let remove_ty i annotmap =
- match find_opt i annotmap with
- | None -> annotmap
- | Some annot -> add i { annot with a_ty = None } annotmap
-
-let remove_ty_label label = remove_ty (!! label)
-
let find_tsc_opt i annotmap =
find_opt_factory "tsc"
(fun x -> x.a_tsc)
View
5 libqmlcompil/qmlAnnotMap.mli
@@ -54,7 +54,6 @@ val size : 'a gen_annotmap -> int
val merge : ?no_conflict_if_equal:bool -> 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
val overwrite : 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
val unsafe_overwrite : 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
-val unsafe_mixed_overwrite : 'a gen_annotmap -> 'a gen_annotmap -> 'a gen_annotmap
(** {6 Add} *)
(** *)
@@ -121,10 +120,6 @@ val find_tsc_inst_opt_label : Annot.label -> 'a gen_annotmap -> ('a, unit) QmlGe
(** {6 Remove} *)
(** *)
val remove : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
-val remove_ty : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
-
-val remove_label : Annot.label -> 'a gen_annotmap -> 'a gen_annotmap
-val remove_ty_label : Annot.label -> 'a gen_annotmap -> 'a gen_annotmap
val remove_tsc : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
val remove_tsc_inst : Annot.t -> 'a gen_annotmap -> 'a gen_annotmap
View
32 libqmlcompil/qmlAstSort.ml
@@ -19,7 +19,6 @@
(* shorthands *)
module Q = QmlAst
-module Qp = QmlpAst
(* -- *)
type t =
@@ -28,41 +27,25 @@ type t =
new_type : Q.code_elt list;
new_db_value : Q.code_elt list;
new_val : Q.code_elt list;
- new_prop : Qp.pcode_elt list;
- new_pre : Qp.pcode_elt list;
- new_post : Qp.pcode_elt list
}
-let empty =
+let empty =
{
database = [];
new_type = [];
new_db_value = [];
new_val = [];
- new_prop = [];
- new_pre = [];
- new_post = [];
}
let add_elt env elt = match elt with
| Q.Database _ -> { env with database = elt::env.database }
| Q.NewDbValue _ -> { env with new_db_value = elt::env.new_db_value }
| Q.NewType _ -> { env with new_type = elt::env.new_type }
-| Q.NewVal _
+| Q.NewVal _
| Q.NewValRec _ -> { env with new_val = elt::env.new_val }
let add = List.fold_left add_elt
-let add_pcode_elt env elt =
- match elt with
- | Qp.Code_elt elt -> add_elt env elt
- | Qp.Precondition _ -> { env with new_pre = elt::env.new_pre }
- | Qp.Postcondition _ -> { env with new_post = elt::env.new_post }
- | Qp.Property _
- | Qp.Invariant _ -> { env with new_prop = elt::env.new_prop }
-
-let add_pcode = List.fold_left add_pcode_elt
-
let get t = (* tail without @ *)
let rec rev acc = function
| [] -> acc
@@ -73,23 +56,20 @@ let get t = (* tail without @ *)
let acc = rev acc t.new_type in
rev acc t.database
-module Get =
+module Get =
struct
let all = get
let database t = List.rev t.database
let new_type t = List.rev t.new_type
let new_db_value t = List.rev t.new_db_value
let new_val t = List.rev t.new_val
- let new_prop t = List.rev t.new_prop
- let new_pre t = List.rev t.new_pre
- let new_post t = List.rev t.new_post
-end
+end
(** need a Rev-Get for custom concat (e.g. in a filter Ast) *)
-module RevGet =
+module RevGet =
struct
let database t = t.database
let new_type t = t.new_type
let new_db_value t = t.new_db_value
let new_val t = t.new_val
-end
+end
View
5 libqmlcompil/qmlAstSort.mli
@@ -27,8 +27,6 @@ type t
val empty : t
val add_elt : t -> QmlAst.code_elt -> t
val add : t -> QmlAst.code -> t
-val add_pcode_elt : t -> QmlpAst.pcode_elt -> t
-val add_pcode : t -> QmlpAst.pcode -> t
val get : t -> QmlAst.code
module Get :
@@ -38,9 +36,6 @@ sig
val new_type : t -> QmlAst.code
val new_db_value : t -> QmlAst.code
val new_val : t -> QmlAst.code
- val new_prop : t -> QmlpAst.pcode
- val new_pre : t -> QmlpAst.pcode
- val new_post : t -> QmlpAst.pcode
end
module RevGet : (** custom tail append need a RevGet *)
View
86 libqmlcompil/qmlpAst.ml
@@ -1,86 +0,0 @@
-(*
- Copyright © 2011 MLstate
-
- This file is part of OPA.
-
- OPA is free software: you can redistribute it and/or modify it under the
- terms of the GNU Affero General Public License, version 3, as published by
- the Free Software Foundation.
-
- OPA 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. See the GNU Affero General Public License for
- more details.
-
- You should have received a copy of the GNU Affero General Public License
- along with OPA. If not, see <http://www.gnu.org/licenses/>.
-*)
-(*
- Authors: 2009, Vincent Benayoun <Vincent.Benayoun@mlstate.com>
-*)
-
-type ident = string
-
-type hoop =
- | HOAdd
- | HOSubs
- | HOMult
- | HODiv
- (* TODO : extend with mult, minus, ... *)
-
-let hoop_arity o =
- match o with
- | HOAdd -> 2
- | HOSubs -> 2
- | HOMult -> 2
- | HODiv -> 2
-
-type hopred =
- | HOEq
- | HONeq
- | HOLe
- | HOLt
-
-
-(* implicit database properties *)
-type hoterm =
- (* basic terms *)
- | HO_Const of QmlAst.const_expr
- | HO_ApplyOp of hoop * (hoterm list)
- (* variables : term, property or predicate *)
- | HO_Var of ident
- (* predifined predicates *)
- | HO_Pred of hopred * (hoterm list)
- (* abstraction and application *)
- | HO_Lambda of ident * hoterm
- | HO_Apply of hoterm * hoterm
- (* logical connectives *)
- | HO_True
- | HO_Not of hoterm
- | HO_And of hoterm * hoterm
- | HO_Or of hoterm * hoterm
- | HO_Implies of hoterm * hoterm
- | HO_Forall of ident * hoterm
- | HO_Exists of ident * hoterm
- (* property on evaluation of possibly impure qml expression
- in which database is implicit *)
- | HO_Exec of QmlAst.expr * (QmlAst.expr option) * hoterm (* exec e1 [returns e2] -> f *)
- (* if [e1] is evaluated (in the value [e2]), the property [f] is true *)
-
-type pcode_elt =
- | Code_elt of QmlAst.code_elt
- | Precondition of string * string * hoterm
- | Postcondition of string * string * string * hoterm
- | Property of string * hoterm
- | Invariant of hoterm
-
-type pcode = pcode_elt list
-
-
-(* let pcode_to_code l = *)
-(* let fold_fun acc c = *)
-(* match c with *)
-(* | Code_elt c -> c::acc *)
-(* | _ -> acc *)
-(* in *)
-(* List.fold_left fold_fun [] l *)
View
2 libqmlcompil/typer_w.ml
@@ -156,7 +156,7 @@ let type_of_expr ?options:_ ?annotmap ~bypass_typer ~gamma expr =
keep the types of the second and the positions of the first.*)
let result_qml_annotmap =
(match annotmap with
- | Some ann -> QmlAnnotMap.unsafe_mixed_overwrite ann qml_infered_annotmap
+ | Some ann -> QmlAnnotMap.overwrite ann qml_infered_annotmap
| None ->
(* No initially provided annotation map, hence the result is simply
the one we obtained after the inference. *)

0 comments on commit d132a77

Please sign in to comment.
Something went wrong with that request. Please try again.