feat: New format and parser for cpp

This commit is contained in:
Fardale 2022-09-30 20:53:40 +02:00
parent 056889ce23
commit 1a38c0bba2
36 changed files with 127 additions and 88 deletions

View file

@ -1,12 +1,8 @@
module C = Configurator.V1 module C = Configurator.V1
type conf = { os_type: string; major: int; minor: int } type conf = { os_type: string; major: int; minor: int }
type comp = Le | Ge
type op = Le | Ge type condition = Version of comp * int * int | Os_type of string
type condition =
| Version of op * int * int
| Os_type of string
type line = type line =
| If of condition | If of condition
@ -14,6 +10,7 @@ type line =
| Else | Else
| Endif | Endif
| Raw of string | Raw of string
| Eol
| Eof | Eof
let prefix ~pre s = let prefix ~pre s =
@ -32,13 +29,34 @@ let prefix ~pre s =
check 0 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 let eval ~conf = function
| Os_type ty -> conf.os_type = ty | Os_type ty -> conf.os_type = ty
| Version (op, i, j) -> | Version (op, i, j) ->
match op with (match op with
| Le -> (conf.major, conf.minor) <= (i, j) | 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 preproc_lines ~file ~conf (ic : in_channel) : unit =
let pos = ref 0 in let pos = ref 0 in
@ -47,40 +65,54 @@ let preproc_lines ~file ~conf (ic : in_channel) : unit =
in in
let pp_pos () = Printf.printf "#%d %S\n" !pos file 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 match input_line ic with
| exception End_of_file -> Eof | exception End_of_file -> [ Eof ]
| line -> | line -> parse_from line 0
let line' = String.trim line in in
incr pos;
if line' <> "" && line'.[0] = '[' then let get_next =
if prefix line' ~pre:"[@@@ifle" then let q = Queue.create () in
Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If (Version (Le, x, y))) fun () ->
else if prefix line' ~pre:"[@@@ifge" then try Queue.pop q
Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If (Version (Ge, x, y))) with Queue.Empty ->
else if prefix line' ~pre:"[@@@elifle" then List.iter (fun x -> Queue.push x q) (parse_line ());
Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif (Version (Le, x, y))) Queue.pop q
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
in in
(* entry point *) (* entry point *)
let rec top () = let rec top () =
match parse_line () with match get_next () with
| Eof -> () | Eof -> ()
| If condition -> | If condition ->
if eval ~conf condition then ( if eval ~conf condition then (
@ -89,28 +121,35 @@ let preproc_lines ~file ~conf (ic : in_channel) : unit =
) else ) else
skip_block ~elseok:true () skip_block ~elseok:true ()
| Raw s -> | Raw s ->
print_endline s; print_string s;
top ()
| Eol ->
print_newline ();
top () top ()
| Elseif _ | Else | Endif -> fail "unexpected elseif|else|endif" | Elseif _ | Else | Endif -> fail "unexpected elseif|else|endif"
(* current block is the valid one *) (* current block is the valid one *)
and cat_block () = and cat_block () =
match parse_line () with match get_next () with
| Eof -> fail "unexpected EOF" | Eof -> fail "unexpected EOF"
| If _ -> fail "nested if not supported" | If _ -> fail "nested if not supported"
| Raw s -> | Raw s ->
print_endline s; print_string s;
cat_block ()
| Eol ->
print_newline ();
cat_block () cat_block ()
| Endif -> | Endif ->
flush_all ();
pp_pos (); pp_pos ();
top () top ()
| Elseif _ | Else -> skip_block ~elseok:false () | Elseif _ | Else -> skip_block ~elseok:false ()
(* skip current block. (* skip current block.
@param elseok if true, we should evaluate "elseif" *) @param elseok if true, we should evaluate "elseif" *)
and skip_block ~elseok () = and skip_block ~elseok () =
match parse_line () with match get_next () with
| Eof -> fail "unexpected EOF" | Eof -> fail "unexpected EOF"
| If _ -> fail "nested if not supported" | If _ -> fail "nested if not supported"
| Raw _ -> skip_block ~elseok () | Raw _ | Eol -> skip_block ~elseok ()
| Endif -> | Endif ->
pp_pos (); pp_pos ();
top () top ()