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 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 lines_of_file fn =
|
||||||
let ic = open_in fn in
|
let rec loop ic acc =
|
||||||
let rec loop acc =
|
|
||||||
match input_line ic with
|
match input_line ic with
|
||||||
| exception End_of_file -> close_in ic; List.rev acc
|
| exception End_of_file -> List.rev acc
|
||||||
| line -> loop (line :: acc)
|
| line -> loop ic (line :: acc)
|
||||||
in
|
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
|
close_out oc
|
||||||
|
|
||||||
let load kind ~filename =
|
let load kind ~filename =
|
||||||
let ic = open_in filename in
|
let sexp, _locs =
|
||||||
let sexp, _locs = Sexp_lexer.single (Lexing.from_channel ic) in
|
with_lexbuf_from_file filename ~f:Sexp_lexer.single lb
|
||||||
close_in ic;
|
in
|
||||||
of_sexp kind sexp
|
of_sexp kind sexp
|
||||||
|
|
100
src/meta.ml
100
src/meta.ml
|
@ -1,20 +1,96 @@
|
||||||
(** META file representation *)
|
open Import
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ name : string
|
||||||
; sub : t list
|
; entries : entry list
|
||||||
; defs : def list
|
|
||||||
}
|
}
|
||||||
|
|
||||||
and kind = Set | Add
|
and entry =
|
||||||
|
| Comment of string
|
||||||
|
| Var of string * predicate list * action * string
|
||||||
|
| Package of t
|
||||||
|
|
||||||
and def =
|
and action = Set | Add
|
||||||
{ kind : kind
|
|
||||||
; var : string
|
|
||||||
; predicates : predicate list
|
|
||||||
}
|
|
||||||
|
|
||||||
and predicate =
|
and predicate =
|
||||||
| Pos of string
|
| P of string (* Present *)
|
||||||
| Neg of string
|
| 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
|
rule token = parse
|
||||||
| [' ' '\t']* { token lexbuf }
|
| [' ' '\t' '\r']* { token lexbuf }
|
||||||
| '#' [^ '\r' '\n']* { token lexbuf }
|
| '#' [^ '\n']* { token lexbuf }
|
||||||
| ("\n" | "\r\n") { Lexing.new_line lexbuf; token lexbuf }
|
| '\n' { Lexing.new_line lexbuf; token lexbuf }
|
||||||
|
|
||||||
| ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']+ as s { NAME s }
|
| ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']+ as s { Name s }
|
||||||
| '"' ([^'"']* as s) '"' { STRING s }
|
| '"' ([^ '\\' '"']* ( '\\' ['\\' '"'] [^ '\\' '"']* )* as s) '"'
|
||||||
| '-' { MINUS }
|
{ let len = String.length s in
|
||||||
| '(' { LPAREN }
|
let buf = Buffer.create len in
|
||||||
| ')' { RPAREN }
|
let rec loop i =
|
||||||
| ',' { COMMA }
|
if i = len then
|
||||||
| '=' { EQUAL }
|
Buffer.contents buf
|
||||||
| "+=" { PLUS_EQUAL }
|
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