Commits

Paweł Wieczorek  committed 8f8a982

adding logs

  • Participants
  • Parent commits 08e89ce
  • Branches 2014_03_16_cleaning

Comments (0)

Files changed (8)

File source/Bin/Opifex/Main.ml

         execute_command_tree_v (Command.Top.get_top_commands ()) Sys.argv
     with
         | Invalid_usage (lazyUsage, NoCommand) ->
-            Printf.eprintf "%s\n%s\n"
+            Printf.eprintf "%s\n%s\n%!"
                 Predefined.build_header
                 (Lazy.force lazyUsage);
             0
 
         | Invalid_usage (lazyUsage, UnknownCommand command_name) ->
-            Printf.eprintf "error: unknown command: %s\n" command_name;
+            Printf.eprintf "error: unknown command: %s\n%!" command_name;
             -1
 
         | Invalid_usage (lazyUsage, GetOptError message) ->
-            Printf.eprintf "error: %s\n" message;
+            Printf.eprintf "error: %s\n%!" message;
             print_endline (Lazy.force lazyUsage);
             -1
 
         | Error.Failed msgs ->
             let msg = String.concat " " msgs in
-            Printf.eprintf "Failed.\n%s\n" msg;
+            Printf.eprintf "Failed.\n%s\n%!" msg;
             -1
 
         | Error.Internal_error msg ->
-            Printf.eprintf "Internal error: %s\n" msg;
+            Printf.eprintf "Internal error: %s\n%!" msg;
             -1
 
 let _ =

File source/Command/EvalCommandMaker.ml

     val paint_eval_result       : eval_result -> painter
 end
 
+
 module Make (M:Signature) : Command = struct
 
     module Eval = EvalWrap.Make(M)
             0
 
         | _ ->
-            print_endline "invalid usage";
-            -1
+            raise (CommandTree.GetOpt.Invalid_option "one file only")
             
 
 end

File source/Command/MiniML_Commands.ml

 
 end
 
+module TypeCommand = struct
+
+
+end
+
 module CwcpsCommand = struct
 
     type flag

File source/Command/ParserCommandMaker.ml

 
     let description = "Parses files and prints ASTs"
 
-    let handle_file extra_prints file : unit = 
-        if extra_prints then
-            print_endline ("- parsing... " ^ file);
+    let handle_file file : unit = 
         let ast = Parser.parse file in
         print_painter_nl Pervasives.stdout (M.paint_ast ast)
 
     let action _ args =
-        List.iter (handle_file true) args;
+        List.iter handle_file args;
         0
 
 end

File source/Lang/Common/Wrap/EvalWrap.ml

     let eval file =
         try
             let ast = Parser.parse file in
+            Log.debug "Evaluating %s" file;
             M.eval ast
         with Eval_error(error_reason) ->
             Error.failed 

File source/Lang/Common/Wrap/ParserWrap.ml

 
 module Make (M:Signature) = struct
 
-
     let alter_lexbuf path lexbuf = 
         let alter_lexpos position =
             {position with
 
     let parse path =
         try
+            Log.debug "Parsing %s" path;
             let file   = open_in path in
             let lexbuf = Lexing.from_channel file in
             alter_lexbuf path lexbuf;

File source/Util/Error.ml

 
 exception Failed of string list
 
+
 (*********************************************************************************************************************
  * Helpers
  ********************************************************************************************************************)
 
 let failed msgs =
     Raise.raise_exception_with_debug_info  (Failed msgs)
+
+
+(*********************************************************************************************************************
+ * Printer
+ ********************************************************************************************************************)
+
+module ExceptionPrinter = struct
+
+    let unpack_exception = function
+        | Not_yet_implemented msg -> ("Error.Not_yet_implemented", msg)
+        | Internal_error msg -> ("Error.Internal_error", msg)
+        | Command_failed msg -> ("Error.Command_failed", msg)
+        | Failed msgs -> ("Error.Failed", String.concat " " msgs)
+        | _ ->
+            raise Exit
+
+    let exception_printer exn =
+        try
+            let (name, msg) = unpack_exception exn in
+            Some (Printf.sprintf "%s(%S)" name msg)
+        with Exit ->
+            None
+
+    let _ =
+        Printexc.register_printer exception_printer
+
+end

File source/Util/Log.ml

  * Log-device
  ********************************************************************************************************************)
 
+let log_level  = DEBUG
+
 let string_of_level = function
-    | DEBUG -> "DEBUG"
-    | INFO -> "INFO"
-    | WARNING -> "WARNING"
-    | ERROR -> "ERROR"
+    | DEBUG     -> "DEBUG"
+    | INFO      -> "INFO"
+    | WARNING   -> "WARNING"
+    | ERROR     -> "ERROR"
+
+let ansi_esc_of_level = function
+    | DEBUG     -> "\x1b[30;45m"
+    | INFO      -> "\x1b[30;47m"
+    | WARNING   -> "\x1b[30;43m"
+    | ERROR     -> "\x1b[30;41m"
 
 (*********************************************************************************************************************
  *
  ********************************************************************************************************************)
 
 let log_output level message =
-    Printf.eprintf "[%7s] %s\n" (string_of_level level) message
+    if log_level <= level then
+    Printf.eprintf "%s[%7s]%s %s\n%!"
+        (ansi_esc_of_level level)
+        (string_of_level level)
+        "\x1b[0m"
+        message
 
 (*********************************************************************************************************************
  *