feat: New format and parser for cpp

src/core/cpp/cpp.ml

@@ -1,12 +1,8 @@
 module C = Configurator.V1
 
 type conf = { os_type: string; major: int; minor: int }
-
-type op = Le | Ge
-
-type condition =
-  | Version of op * int * int
-  | Os_type of string
+type comp = Le | Ge
+type condition = Version of comp * int * int | Os_type of string
 
 type line =
   | If of condition
@@ -14,6 +10,7 @@ type line =
   | Else
   | Endif
   | Raw of string
+  | Eol
   | Eof
 
 let prefix ~pre s =
@@ -32,13 +29,34 @@ let prefix ~pre s =
     check 0
   )
 
+let get_tag_from_opt s pos =
+  let rec get_start pos =
+    let p = String.index_from s pos '[' in
+    if p > String.length s - 5 then
+      raise_notrace Not_found
+    else if s.[p + 1] = '@' && s.[p + 2] = '@' && s.[p + 3] = '@' then
+      p
+    else
+      get_start (p + 1)
+  in
+  try
+    let start = get_start pos in
+    Some (get_start pos, String.index_from s (start + 4) ']')
+  with Not_found -> None
+
+let split_trim s c =
+  try
+    let p = String.index s c in
+    ( String.trim (String.sub s 0 p),
+      String.trim (String.sub s (p + 1) (String.length s - p - 1)) )
+  with Not_found -> s, ""
+
 let eval ~conf = function
   | Os_type ty -> conf.os_type = ty
   | Version (op, i, j) ->
-    match op with
+    (match op with
     | Le -> (conf.major, conf.minor) <= (i, j)
-    | Ge -> (conf.major, conf.minor) >= (i, j)
-
+    | Ge -> (conf.major, conf.minor) >= (i, j))
 
 let preproc_lines ~file ~conf (ic : in_channel) : unit =
   let pos = ref 0 in
@@ -47,40 +65,54 @@ let preproc_lines ~file ~conf (ic : in_channel) : unit =
   in
   let pp_pos () = Printf.printf "#%d %S\n" !pos file in
 
-  let parse_line () : line =
+  let parse_condition condition =
+    flush_all ();
+    match split_trim condition ' ' with
+    | "le", value -> Scanf.sscanf value "%d.%d" (fun x y -> Version (Le, x, y))
+    | "ge", value -> Scanf.sscanf value "%d.%d" (fun x y -> Version (Ge, x, y))
+    | "os", value -> Os_type (String.lowercase_ascii value)
+    | _ -> failwith (Printf.sprintf "Syntax error condition: %s" condition)
+  in
+
+  let rec parse_from line pos =
+    match get_tag_from_opt line pos with
+    | None -> [ Raw (String.sub line pos (String.length line - pos)); Eol ]
+    | Some (s, e) ->
+      let tag = String.sub line (s + 4) (e - s - 4) |> String.trim in
+      flush_all ();
+      let op, rest = split_trim tag ' ' in
+      let next_token =
+        match op with
+        | "if" -> If (parse_condition rest)
+        | "elif" -> Elseif (parse_condition rest)
+        | "else_" -> Else
+        | "endif" -> Endif
+        | _ -> Raw (String.sub line s (e - s + 1))
+      in
+      if s = 0 && s = String.length line then
+        [ next_token ]
+      else
+        next_token :: parse_from line (e + 1)
+  in
+
+  let parse_line () : line list =
     match input_line ic with
-    | exception End_of_file -> Eof
-    | line ->
-      let line' = String.trim line in
-      incr pos;
-      if line' <> "" && line'.[0] = '[' then
-        if prefix line' ~pre:"[@@@ifle" then
-          Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If (Version (Le, x, y)))
-        else if prefix line' ~pre:"[@@@ifge" then
-          Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If (Version (Ge, x, y)))
-        else if prefix line' ~pre:"[@@@elifle" then
-          Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif (Version (Le, x, y)))
-        else if prefix line' ~pre:"[@@@elifge" then
-          Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif (Version (Ge, x, y)))
-        else if prefix line' ~pre:"[@@@ifos" then
-          Scanf.sscanf line' "[@@@ifos %s@]" (fun os_type ->
-              If (Os_type (String.lowercase_ascii os_type)))
-        else if prefix line' ~pre:"[@@@elifos" then
-          Scanf.sscanf line' "[@@@elifos %s@]" (fun os_type ->
-              Elseif (Os_type (String.lowercase_ascii os_type)))
-        else if line' = "[@@@else_]" then
-          Else
-        else if line' = "[@@@endif]" then
-          Endif
-        else
-          Raw line
-      else
-        Raw line
+    | exception End_of_file -> [ Eof ]
+    | line -> parse_from line 0
+  in
+
+  let get_next =
+    let q = Queue.create () in
+    fun () ->
+      try Queue.pop q
+      with Queue.Empty ->
+        List.iter (fun x -> Queue.push x q) (parse_line ());
+        Queue.pop q
   in
 
   (* entry point *)
   let rec top () =
-    match parse_line () with
+    match get_next () with
     | Eof -> ()
     | If condition ->
       if eval ~conf condition then (
@@ -89,28 +121,35 @@ let preproc_lines ~file ~conf (ic : in_channel) : unit =
       ) else
         skip_block ~elseok:true ()
     | Raw s ->
-      print_endline s;
+      print_string s;
+      top ()
+    | Eol ->
+      print_newline ();
       top ()
     | Elseif _ | Else | Endif -> fail "unexpected elseif|else|endif"
   (* current block is the valid one *)
   and cat_block () =
-    match parse_line () with
+    match get_next () with
     | Eof -> fail "unexpected EOF"
     | If _ -> fail "nested if not supported"
     | Raw s ->
-      print_endline s;
+      print_string s;
+      cat_block ()
+    | Eol ->
+      print_newline ();
       cat_block ()
     | Endif ->
+      flush_all ();
       pp_pos ();
       top ()
     | Elseif _ | Else -> skip_block ~elseok:false ()
   (* skip current block.
      @param elseok if true, we should evaluate "elseif" *)
   and skip_block ~elseok () =
-    match parse_line () with
+    match get_next () with
     | Eof -> fail "unexpected EOF"
     | If _ -> fail "nested if not supported"
-    | Raw _ -> skip_block ~elseok ()
+    | Raw _ | Eol -> skip_block ~elseok ()
     | Endif ->
       pp_pos ();
       top ()