mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
feat: New format and parser for cpp
This commit is contained in:
parent
056889ce23
commit
1a38c0bba2
36 changed files with 127 additions and 88 deletions
|
|
@ -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 ()
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue