Merge pull request #8 from aryx/use_logs_mk

Start to use Logs in mk/

.github/workflows/build-and-test.jsonnet

@@ -17,35 +17,35 @@ local job = {
     //'fail-fast': false,
     matrix: {
       os: [
-	'ubuntu-latest',
-	//TODO: 'macos-latest'
-	//TODO: 'windows-latest'
-	],
+        'ubuntu-latest',
+        //TODO: 'macos-latest'
+        //TODO: 'windows-latest'
+      ],
       'ocaml-compiler': [
-	// Old OCaml version where I ported ocamlrun to plan9
-	// This needs stdcompat so we can use |> and bytes type without issues.
-	// The |> operator was introduced in 4.02.0, that we could add in
-	// the matrix, but stdcompat does not compile with it.
-	'3.10.0',
-	// First OCaml version with a working ocamlformat OPAM package
-	'4.04.1',
-	// Current version I usually work with
-	'4.14.1',
-	// Why not, living on the edge!
-	'5.1.0',
-	],
-    }
+        // Old OCaml version where I ported ocamlrun to plan9
+        // This needs stdcompat so we can use |> and bytes type without issues.
+        // The |> operator was introduced in 4.02.0, that we could add in
+        // the matrix, but stdcompat does not compile with it.
+        '3.10.0',
+        // First OCaml version with a working ocamlformat OPAM package
+        '4.04.1',
+        // Current version I usually work with
+        '4.14.1',
+        // Why not, living on the edge!
+        '5.1.0',
+      ],
+    },
   },
   'runs-on': '${{ matrix.os }}',
   steps: [
     checkout,
     {
-      uses: "ocaml/setup-ocaml@v2",
+      uses: 'ocaml/setup-ocaml@v2',
       with: {
-	'ocaml-compiler': '${{ matrix.ocaml-compiler }}',
-	// available only for OCaml >= 4.0.0 and we want also 3.10.0
-	'opam-depext': false,
-      }
+        'ocaml-compiler': '${{ matrix.ocaml-compiler }}',
+        // available only for OCaml >= 4.0.0 and we want also 3.10.0
+        'opam-depext': false,
+      },
     },
     {
       name: 'Install dependencies',

Makefile

@@ -25,6 +25,9 @@ all:
 clean:
 	git clean -fX
 
+bootstrap:
+	./bootstrap-mk.sh
+
 ###############################################################################
 # Developer targets
 ###############################################################################

assembler/main.ml

@@ -12,6 +12,7 @@ open Common
  *  - no unicode support
  * 
  * todo:
+ *  - look at the 5a Go sources in the Golang source, maybe ideas to steal?
  *  - advanced instructions: floats, MULL, coprocessor, PSR, etc
  *  - make it a multi-archi assembler by following
  *    the new design by Rob Pike of Go assembler to factorize things

changes.txt

@@ -5,18 +5,18 @@
 ** rc/mk
 TODO Resume work and make it work again! Can build itself.
 
-Can use it on principia and build and syncweb as well Editor.nw
-(efuns), Codemap.nw
+TODO Can use rc/mk on principia and build and syncweb as well Editor.nw
+     (efuns), Codemap.nw
 
 ** internals
 TODO Renamed module to capitalized form (Common.ml), like in Semgrep
-(thx Martin)
+     (thx Martin)
 
-TODO Logging using poor's man Logs.ml
+Logging using poor's man Logs.ml
 
 TODO Testing library using Testo? (only built and run on 4.14.0)
 
-TODO Switch from Common.filelame to (our poor's man) Fpath.t
+TODO Switch from Common.filename to (our poor's man) Fpath.t
 
 ** devops
 
@@ -41,7 +41,7 @@ Github actions (GHA) checks to make sure xix compiles.
 At least it compiles with 3.10.0 (thx to stdcompat), 4.04.0, 4.14.0,
 and even 5.1.0!
 
-First semgrep checks in semgrep.jsonnet :)
+First semgrep checks in semgrep.jsonnet :) and semgrep GHA workflow.
 
 Some basic tests (also enforced in GHA) in test.sh
 

lib_core/commons/IO.ml

@@ -742,14 +742,15 @@ let rec read_bits b n =
 let drop_bits b =
   b.nbits <- 0
 
-let rec write_bits b ~nbits x =
+(* orig: was ~nbits *)
+let rec write_bits b nbits x =
   let n = nbits in
   if n + b.nbits >= 32 then begin
     if n > 31 then raise Bits_error;
     let n2 = 32 - b.nbits - 1 in
     let n3 = n - n2 in
-    write_bits b ~nbits:n2 (x asr n3);
-    write_bits b ~nbits:n3 (x land ((1 lsl n3) - 1));
+    write_bits b n2 (x asr n3);
+    write_bits b n3 (x land ((1 lsl n3) - 1));
   end else begin
     if n < 0 then raise Bits_error;
     if (x < 0 || x > (1 lsl n - 1)) && n <> 31 then raise Bits_error;

lib_core/commons/IO.mli

@@ -323,7 +323,8 @@ val output_bits : 'a output -> out_bits
 val read_bits : in_bits -> int -> int
 (** Read up to 31 bits, raise Bits_error if n < 0 or n > 31 *)
 
-val write_bits : out_bits -> nbits:int -> int -> unit
+(* orig: second param was ~nbit *)
+val write_bits : out_bits -> int -> int -> unit
 (** Write up to 31 bits represented as a value, raise Bits_error if nbits < 0
  or nbits > 31 or the value representation excess nbits. *)
 

lib_core/commons/Logs.ml

@@ -72,14 +72,15 @@ let header_string_of_level (lvl: level) : string =
 (* ANSI escape sequences for colored output, depending on log level
  * alt: use ANSIterminal.ml, but not worth it
  * LATER: make portable on plan9
+ * see https://en.wikipedia.org/wiki/ANSI_escape_code for the color codes
  *)
 let color level =
   match level with
   | App -> None
   | Warning -> Some "33" (*yellow*)
   | Error -> Some "31" (*red*)
+  | Info -> Some "34" (* blue *)
   | Debug -> Some "32" (* green *)
-  | Info -> Some "30" (* ?? *)
 
 (* pre/post escape sequence around the string we want colored *)
 let color_pre lvl =
@@ -96,7 +97,9 @@ let report (lvl : level) (msgf : 'a msgf) : unit =
   match lvl with
   | App -> 
       (* no header, no color *)
-      msgf Printf.eprintf
+      msgf Printf.eprintf;
+      (* %! is to flush the output *)
+      Printf.eprintf "\n%!"
   | Error
   | Warning
   | Info
@@ -108,7 +111,8 @@ let report (lvl : level) (msgf : 'a msgf) : unit =
         (color_pre lvl)
         (header_string_of_level lvl)
         (color_post lvl);
-      msgf Printf.eprintf
+      msgf Printf.eprintf;
+      Printf.eprintf "\n%!"
 
 let msg (lvl : level) (msgf : 'a msgf) : unit =
   match !current_level with

linker/main.ml

@@ -22,6 +22,7 @@ module T = Types
  *   update: actually I support it now no?
  * 
  * todo?:
+ *  - look at the 5l Go sources in the Golang source, maybe ideas to steal?
  *  - -v is quite useful to debug "redefinition" linking errors
  *    (see pb I had when linking bcm/ kernel)
  *  - when get undefined symbol, print function you are currently in!
@@ -35,6 +36,7 @@ module T = Types
  *  - symbol table
  *  - program counter line table
  *  - nice error reporting for signature conflict, conflicting objects
+
  *)
 
 let thechar = '5'

mk/ast.ml

@@ -1,4 +1,5 @@
 (* Copyright 2016 Yoann Padioleau, see copyright.txt *)
+open Stdcompat (* for |> *)
 
 (* for error reporting *)
 type loc = {
@@ -70,3 +71,9 @@ type instr = {
     (* stricter: no dynamic def like X=AVAR  $X=42 ... $AVAR, 
      * so 'string' below, not 'word' *)
     | Definition of string * words
+
+let dump_ast instrs =
+  Logs.debug (fun m -> m "AST = ");
+  instrs |> List.iter (fun instr -> 
+      Logs.debug (fun m -> m "%s" (Common.dump instr))
+  )

mk/env.ml

@@ -46,8 +46,7 @@ let add_var env s xs =
   match () with
   | _ when Hashtbl.mem env.vars_commandline s ->
     (* we do not override those vars *)
-    if !Flags.verbose
-    then pr2 (spf "ignoring definition of %s specified on the command-line" s);
+    Logs.info (fun m -> m "ignoring definition of %s specified on the command-line" s);
     ()
 
   (* stricter: forbid redefinitions.
@@ -62,16 +61,15 @@ let add_var env s xs =
   | _ ->
     Hashtbl.replace env.vars s xs
 
-
 (*****************************************************************************)
 (* Debug *)
 (*****************************************************************************)
 let dump_env env =
+  Logs.debug (fun m -> m "Dump_env:");
   env.vars |> Hashtbl.iter (fun k v ->
-    pr2 (spf "%s -> %s" k (Common.dump v));
+    Logs.debug (fun m -> m " %s -> %s" k (Common.dump v));
   )
 
-
 (*****************************************************************************)
 (* Functions *)
 (*****************************************************************************)

mk/eval.ml

@@ -17,12 +17,12 @@ module Set = Set_
 (* Error management *)
 (*****************************************************************************)
 
+(* TODO: use proper exn *)
 let error loc s =
   failwith (spf "%s:%d: Semantic error, %s" loc.A.file loc.A.line s)
 
 let warning loc s =
-  pr2 (spf "warning: %s (at %s:%d)" s loc.A.file loc.A.line)
-
+  Logs.warn (fun m -> m "warning: %s (at %s:%d)" s loc.A.file loc.A.line)
 
 (*****************************************************************************)
 (* Helpers *)
@@ -84,7 +84,7 @@ let rec (eval_word: Ast.loc -> Env.t -> Ast.word ->
                    ) |> List.flatten
                (* stricter? what does mk?*)
                | _ -> 
-                 pr2_gen subst;
+                 Logs.debug (fun m -> m "subst = %s" (Common.dump subst));
                  error loc 
                    "pattern or subst does not resolve to a single string"
                )

mk/flags.ml

@@ -1,15 +1,15 @@
 let dry_mode = ref false
+
+(* TODO? just use Logs.info for those? *)
 let explain_mode = ref false
 
 (* pad: I added this one *)
 let strict_mode = ref false
-let verbose = ref false
 
 let dump_tokens = ref false
 let dump_ast = ref false
 let dump_env = ref false
 let dump_graph = ref false
 let dump_jobs = ref false
 
-let trace = ref false
 let debugger = ref false

mk/graph.ml

@@ -87,9 +87,8 @@ let new_node target =
     probable = time <> None;
   }
   in
-  if !Flags.trace
-  then pr2 (spf "newnode(%s), time = %s" target (File.str_of_time node.time));
-
+  Logs.debug (fun m -> m "newnode(%s), time = %s" target 
+                (File.str_of_time node.time));
   Hashtbl.add hnodes target node;
   node
 
@@ -122,8 +121,7 @@ let rule_exec_meta (r: Percent.pattern Rules.rule) stem =
 
 (* todo: infinite rule detection *)
 let rec apply_rules target rules =
-  if !Flags.trace
-  then pr2 (spf "apply_rules('%s')" target);
+  Logs.debug (fun m -> m "apply_rules('%s')" target);
 
   (* the graph of dependency is a DAG, so we must look if node already there *)
   if Hashtbl.mem hnodes target
@@ -296,8 +294,8 @@ let rec vacuous node =
     | Some node2 -> 
         if vacuous node2 && R.is_meta arc.rule
         then begin
-          if !Flags.verbose
-          then pr2 (spf "vacuous arc detected: %s -> %s" node.name node2.name);
+          Logs.warn (fun m -> m "vacuous arc detected: %s -> %s" 
+                        node.name node2.name);
           true
         end else begin 
           vacuous_node := false; 
@@ -307,8 +305,8 @@ let rec vacuous node =
         vacuous_node := false;
         false
   );
-  if !vacuous_node && !Flags.verbose 
-  then pr2 (spf "vacuous node detected: %s" node.name);
+  if !vacuous_node
+  then Logs.warn (fun m -> m "vacuous node detected: %s" node.name);
   !vacuous_node
 
 
@@ -370,9 +368,8 @@ let build_graph target rules =
 (* update graph once a node has been built *)
 let update node =
   node.state <- Made;
-  if !Flags.trace
-  then pr2 (spf "update(): node %s time=%s" node.name 
-              (File.str_of_time node.time));
+  Logs.debug (fun m -> m "update(): node %s time=%s" node.name 
+                 (File.str_of_time node.time));
 
   if node.is_virtual
   then begin