* tests/ml/visual/ref.ml: better display of globals vs constants

facebookarchive · Feb 26, 2014 · e724ed3 · e724ed3
1 parent 0b78c5c
commit e724ed3
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 19 deletions.
diff --git a/lang_ml/analyze/visual/highlight_ml.ml b/lang_ml/analyze/visual/highlight_ml.ml
@@ -71,10 +71,12 @@ let disable_token_phase2 = false
 
 
 (* val is_function_body: Ast_ml.seq_expr -> bool *)
-let is_function_body x = 
+let kind_of_body x =
+  let def2 = Def2 fake_no_def2 in
   match Ast.uncomma x with
-  | (Ast.Fun _ | Ast.Function _)::_xs -> true
-  | _ -> false
+  | (Ast.Fun _ | Ast.Function _)::_xs -> Function def2
+  | Ast.FunCallSimple (([], Name("ref", _)), _)::_xs -> Global def2
+  | _ -> Constant def2
 
 
 (*****************************************************************************)
@@ -163,29 +165,23 @@ let visit_program
           let name = let_def.l_name in
           let info = Ast.info_of_name name in
 
-          if not !in_let then begin
-            if List.length let_def.l_params > 0 || 
-              is_function_body let_def.l_body
-            then tag info (Function (Def2 NoUse))
-            else tag info (Global (Def2 NoUse))
-          end else begin
-            tag info (Local (Def))
-          end;
+          (if not !in_let 
+           then
+              if List.length let_def.l_params > 0
+              then tag info (Function (Def2 NoUse))
+              else tag info (kind_of_body let_def.l_body)
+           else tag info (Local (Def))
+          );
           Common.save_excursion in_let true (fun () ->
             k x
           )
       | LetPattern (pat, _tok, body) ->
           (match pat with
           | PatTyped (_, PatVar name, _, _ty, _) ->
               let info = Ast.info_of_name name in
-
-              if not !in_let then begin
-                if is_function_body body
-                then tag info (Function (Def2 NoUse))
-                else tag info (Global (Def2 NoUse))
-              end else begin
-                tag info (Local (Def))
-          end;
+              if not !in_let 
+              then tag info (kind_of_body body)
+              else tag info (Local (Def))
           | _ -> ()
           );
           Common.save_excursion in_let true (fun () ->

diff --git a/tests/ml/visual/ref.ml b/tests/ml/visual/ref.ml
@@ -0,0 +1,8 @@
+
+let x = 1
+
+
+let y = ref 1
+
+
+let z = Hashtbl.create 101