meta parser
This commit is contained in:
parent
6039e16258
commit
c9fddcbb77
|
@ -0,0 +1,2 @@
|
|||
jbuild
|
||||
jbuild.*
|
|
@ -28,13 +28,39 @@ let (^/) a b = a ^ "/" ^ b
|
|||
|
||||
let sprintf = Printf.sprintf
|
||||
|
||||
let protectx x ~finally ~f =
|
||||
match f x with
|
||||
| y -> finally x; y
|
||||
| exception e -> finally x; raise e
|
||||
|
||||
let with_file_in fn ~f =
|
||||
protectx (open_in fn) ~finally:close_in ~f
|
||||
|
||||
let with_lexbuf_from_file fn ~f =
|
||||
with_file_in fn ~f:(fun ic -> f (Lexing.from_channel ic))
|
||||
|
||||
let lines_of_file fn =
|
||||
let ic = open_in fn in
|
||||
let rec loop acc =
|
||||
let rec loop ic acc =
|
||||
match input_line ic with
|
||||
| exception End_of_file -> close_in ic; List.rev acc
|
||||
| line -> loop (line :: acc)
|
||||
| exception End_of_file -> List.rev acc
|
||||
| line -> loop ic (line :: acc)
|
||||
in
|
||||
loop []
|
||||
with_file_in fn ~f:(fun ic -> loop ic [])
|
||||
|
||||
type location =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
let lexeme_loc lb =
|
||||
{ start = Lexing.lexeme_start lb
|
||||
; stop = Lexing.lexeme_stop lb
|
||||
}
|
||||
|
||||
exception File_error of location * string
|
||||
|
||||
let file_error ~loc fmt =
|
||||
Printf.ksprintf (fun msg -> raise (File_error (loc, msg))) fmt
|
||||
|
||||
let lex_error lb fmt =
|
||||
file_error ~loc:(lexeme_loc lb) fmt
|
||||
|
|
|
@ -44,7 +44,7 @@ let save kind ~filename x =
|
|||
close_out oc
|
||||
|
||||
let load kind ~filename =
|
||||
let ic = open_in filename in
|
||||
let sexp, _locs = Sexp_lexer.single (Lexing.from_channel ic) in
|
||||
close_in ic;
|
||||
let sexp, _locs =
|
||||
with_lexbuf_from_file filename ~f:Sexp_lexer.single lb
|
||||
in
|
||||
of_sexp kind sexp
|
||||
|
|
100
src/meta.ml
100
src/meta.ml
|
@ -1,20 +1,96 @@
|
|||
(** META file representation *)
|
||||
open Import
|
||||
|
||||
type t =
|
||||
{ name : string
|
||||
; sub : t list
|
||||
; defs : def list
|
||||
{ name : string
|
||||
; entries : entry list
|
||||
}
|
||||
|
||||
and kind = Set | Add
|
||||
and entry =
|
||||
| Comment of string
|
||||
| Var of string * predicate list * action * string
|
||||
| Package of t
|
||||
|
||||
and def =
|
||||
{ kind : kind
|
||||
; var : string
|
||||
; predicates : predicate list
|
||||
}
|
||||
and action = Set | Add
|
||||
|
||||
and predicate =
|
||||
| Pos of string
|
||||
| Neg of string
|
||||
| P of string (* Present *)
|
||||
| A of string (* Absent *)
|
||||
|
||||
|
||||
module Parse = struct
|
||||
let error = lex_error
|
||||
|
||||
let next = Meta_lexer.token
|
||||
|
||||
let package_name lb =
|
||||
match next lb with
|
||||
| String s ->
|
||||
if String.contains s '.' then
|
||||
error lb "'.' not allowed in sub-package names";
|
||||
s
|
||||
| _ -> error lb "package name expected"
|
||||
|
||||
let string lb =
|
||||
match lb with
|
||||
| String s -> s
|
||||
| _ -> error lb "string expected"
|
||||
|
||||
let lparen lb =
|
||||
match next lb with
|
||||
| Lparen -> ()
|
||||
| _ -> error lb "'(' expected"
|
||||
|
||||
let action lb =
|
||||
match next lb with
|
||||
| Equal -> Set
|
||||
| Plus_equal -> Add
|
||||
| _ -> error lb "'=' or '+=' expected"
|
||||
|
||||
let comma lb =
|
||||
match next lb with
|
||||
| Comma -> ()
|
||||
| _ -> error lb "',' expected"
|
||||
|
||||
let rec predicates_and_action lb acc =
|
||||
match next lb with
|
||||
| Rparen -> (List.rev acc, action lb)
|
||||
| Name n -> comma lb; predicates_and_action lb (P n :: acc)
|
||||
| Minus ->
|
||||
let n =
|
||||
match next lb with
|
||||
| Name p -> p
|
||||
| _ -> error lb "name expected"
|
||||
in
|
||||
comma lb;
|
||||
predicates_and_action lb (A n :: acc)
|
||||
| _ -> error lb "name, '-' or ')' expected"
|
||||
|
||||
let rec entries lb depth acc =
|
||||
match next lb with
|
||||
| Rparen ->
|
||||
if depth > 0 then
|
||||
List.rev acc
|
||||
else
|
||||
error lb "closing parenthesis without matching opening one"
|
||||
| Name "package" ->
|
||||
let name = package_name lb in
|
||||
lparen lb;
|
||||
let entries = entries lb (depth + 1) [] in
|
||||
entries lb depth (Package { name; entries } :: acc)
|
||||
| Name var ->
|
||||
let preds, action =
|
||||
match next lb with
|
||||
| Equal -> ([], Set)
|
||||
| Plus_equal -> ([], Add)
|
||||
| Lparen -> predicates_and_action lb []
|
||||
| _ -> error lb "'=', '+=' or '(' expected"
|
||||
in
|
||||
let value = string lb in
|
||||
Var (var, preds, action, value)
|
||||
| _ ->
|
||||
error lb "'package' or variable name expected"
|
||||
end
|
||||
|
||||
let parse fn =
|
||||
with_lexbuf_from_file fn ~f:(fun lb ->
|
||||
Parse.entries lb 0 [])
|
||||
|
|
|
@ -0,0 +1,12 @@
|
|||
type token =
|
||||
| Name of string
|
||||
| String of string
|
||||
| Minus
|
||||
| Lparen
|
||||
| Rparen
|
||||
| Comma
|
||||
| Equal
|
||||
| Plus_equal
|
||||
| Eof
|
||||
|
||||
val token : Lexing.lexbuf -> token
|
|
@ -1,15 +1,39 @@
|
|||
{ open Meta_parser }
|
||||
{
|
||||
type token =
|
||||
| Name of string
|
||||
| String of string
|
||||
| Minus
|
||||
| Lparen
|
||||
| Rparen
|
||||
| Comma
|
||||
| Equal
|
||||
| Plus_equal
|
||||
| Eof
|
||||
}
|
||||
|
||||
rule token = parse
|
||||
| [' ' '\t']* { token lexbuf }
|
||||
| '#' [^ '\r' '\n']* { token lexbuf }
|
||||
| ("\n" | "\r\n") { Lexing.new_line lexbuf; token lexbuf }
|
||||
| [' ' '\t' '\r']* { token lexbuf }
|
||||
| '#' [^ '\n']* { token lexbuf }
|
||||
| '\n' { Lexing.new_line lexbuf; token lexbuf }
|
||||
|
||||
| ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']+ as s { NAME s }
|
||||
| '"' ([^'"']* as s) '"' { STRING s }
|
||||
| '-' { MINUS }
|
||||
| '(' { LPAREN }
|
||||
| ')' { RPAREN }
|
||||
| ',' { COMMA }
|
||||
| '=' { EQUAL }
|
||||
| "+=" { PLUS_EQUAL }
|
||||
| ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']+ as s { Name s }
|
||||
| '"' ([^ '\\' '"']* ( '\\' ['\\' '"'] [^ '\\' '"']* )* as s) '"'
|
||||
{ let len = String.length s in
|
||||
let buf = Buffer.create len in
|
||||
let rec loop i =
|
||||
if i = len then
|
||||
Buffer.contents buf
|
||||
else
|
||||
match s.[i] with
|
||||
| '\\' -> Buffer.add_char s.[i + 1]; loop (i + 2)
|
||||
| _ -> Buffer.add_char s.[i ]; loop (i + 1)
|
||||
in
|
||||
String (loop 0) }
|
||||
| '-' { Minus }
|
||||
| '(' { Lparen }
|
||||
| ')' { Rparen }
|
||||
| ',' { Comma }
|
||||
| '=' { Equal }
|
||||
| "+=" { Plus_equal }
|
||||
| eof { Eof }
|
||||
| _ { lex_error lexbuf "invalid character" }
|
||||
|
|
Loading…
Reference in New Issue