Permalink
Browse files

[fix] recval: Added warning set for recursive values compilation + un…

…activate it with js-like syntax (No syntaxic difference beetween recursive lambda and value)
  • Loading branch information...
1 parent 2f28a77 commit f30a1b1f1be70a71c3189d1287a20d4734740ba0 @BourgerieQuentin BourgerieQuentin committed Jan 9, 2012
Showing with 35 additions and 6 deletions.
  1. +2 −0 opa/s3Passes.ml
  2. +2 −0 opa/s3Warnings.ml
  3. +23 −6 qmlpasses/pass_CompileRecursiveValues.ml
  4. +8 −0 qmlpasses/pass_CompileRecursiveValues.mli
View
@@ -987,6 +987,8 @@ let pass_CompileRecursiveValues =
let annotmap = typerEnv.QmlTypes.annotmap in
let code = env.Passes.qmlAst in
let val_ = OpaMapToIdent.val_ in
+ if !(OpaSyntax.Args.r).OpaSyntax.Args.parser == OpaSyntax.Js then
+ WarningClass.set_warn Pass_CompileRecursiveValues.Warning.recval_lambda false;
let gamma, annotmap, code = Pass_CompileRecursiveValues.process_code ~val_ gamma annotmap code in
let typerEnv = {typerEnv with QmlTypes.gamma; annotmap} in
let env = {env with P.typerEnv; qmlAst = code} in
View
@@ -60,5 +60,7 @@ let warning_set =
!++ Pass_InstrumentForClosureSerialization.warning_set;
+ !++ Pass_CompileRecursiveValues.Warning.set;
+
(* finally return the global warning_set *)
s
@@ -22,6 +22,24 @@ module IdentAssoc = List.MakeAssoc(Ident)
exception InvalidRecursion
+module Warning = struct
+
+ let recval =
+ let doc = "Recursive values" in
+ WarningClass.create ~name:"recval" ~doc ~err:true ~enable:true ()
+
+ let recval_lambda =
+ let doc = "Recursive value as a lambda - deprecated in js-like syntax (S4)" in
+ WarningClass.create ~parent:recval ~name:"lambda" ~doc ~err:true ~enable:true ()
+
+ let set = WarningClass.Set.create_from_list [
+ recval;
+ recval_lambda;
+ ]
+end
+
+let warning_set = Warning.set
+
let map_intersection merge_value map1 map2 =
IdentMap.fold
(fun k v1 acc ->
@@ -70,13 +88,12 @@ let is_a_val_binding idents (_i, e) =
(* checking that you don't put a val rec on a function *)
(try match is_a_val e with
| None ->
- (* FIXME: should be a warning *)
let context = QmlError.Context.expr e in
- QmlError.error context
- "This expression is a function, it can be recursive without being tagged with 'val'."
- | Some _ -> () (* could be an assert failure? *)
- with InvalidRecursion -> ());
- Some (find_deps e)
+ QmlError.warning ~wclass:Warning.recval_lambda context
+ "This expression is a function, it can be recursive without being tagged with 'val'.";
+ Some (find_deps e)
+ | Some _ -> Some (find_deps e)
+ with InvalidRecursion -> Some (find_deps e));
| Q.Directive (_, `recval, _, _) -> assert false
| Q.Coerce (_, e, _)
(* BEWARE before editing: keep this set of directive in sync with the one
@@ -22,6 +22,14 @@
Post condition: all recursive bindings contains only lambdas
*)
+module Warning : sig
+ val recval : WarningClass.wclass
+
+ val recval_lambda : WarningClass.wclass
+
+ val set : WarningClass.Set.t
+end
+
val process_code :
val_ : (string -> Ident.t) ->
QmlTypes.gamma ->

0 comments on commit f30a1b1

Please sign in to comment.