Imported opam-file-format
This commit is contained in:
parent
5f7d0b1093
commit
62334a1f0a
|
@ -0,0 +1,113 @@
|
||||||
|
/**************************************************************************/
|
||||||
|
/* */
|
||||||
|
/* Copyright 2012-2015 OCamlPro */
|
||||||
|
/* Copyright 2012 INRIA */
|
||||||
|
/* */
|
||||||
|
/* All rights reserved. This file is distributed under the terms of the */
|
||||||
|
/* GNU Lesser General Public License version 2.1, with the special */
|
||||||
|
/* exception on linking described in the file LICENSE. */
|
||||||
|
/* */
|
||||||
|
/**************************************************************************/
|
||||||
|
|
||||||
|
%{
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
|
||||||
|
(** OPAM config file generic type parser *)
|
||||||
|
|
||||||
|
let get_pos n =
|
||||||
|
let pos = Parsing.rhs_start_pos n in
|
||||||
|
Lexing.(pos.pos_fname,
|
||||||
|
pos.pos_lnum,
|
||||||
|
pos.pos_cnum - pos.pos_bol)
|
||||||
|
|
||||||
|
%}
|
||||||
|
|
||||||
|
%token <string> STRING IDENT
|
||||||
|
%token <bool> BOOL
|
||||||
|
%token EOF
|
||||||
|
%token LBRACKET RBRACKET
|
||||||
|
%token LPAR RPAR
|
||||||
|
%token LBRACE RBRACE
|
||||||
|
%token COLON
|
||||||
|
%token <int> INT
|
||||||
|
%token <OpamParserTypes.relop> RELOP
|
||||||
|
%token AND
|
||||||
|
%token OR
|
||||||
|
%token <OpamParserTypes.pfxop> PFXOP
|
||||||
|
%token <OpamParserTypes.env_update_op> ENVOP
|
||||||
|
|
||||||
|
%left COLON
|
||||||
|
%left ATOM
|
||||||
|
%left AND
|
||||||
|
%left OR
|
||||||
|
%nonassoc ENVOP
|
||||||
|
%nonassoc PFXOP
|
||||||
|
%left LBRACE RBRACE
|
||||||
|
%nonassoc RELOP
|
||||||
|
%nonassoc URELOP
|
||||||
|
|
||||||
|
%start main value
|
||||||
|
%type <string -> OpamParserTypes.opamfile> main
|
||||||
|
%type <OpamParserTypes.value> value
|
||||||
|
|
||||||
|
%%
|
||||||
|
|
||||||
|
main:
|
||||||
|
| items EOF { fun file_name ->
|
||||||
|
{ file_contents = $1; file_name } }
|
||||||
|
;
|
||||||
|
|
||||||
|
items:
|
||||||
|
| item items { $1 :: $2 }
|
||||||
|
| { [] }
|
||||||
|
;
|
||||||
|
|
||||||
|
item:
|
||||||
|
| IDENT COLON value { Variable (get_pos 1, $1, $3) }
|
||||||
|
| IDENT LBRACE items RBRACE {
|
||||||
|
Section (get_pos 1,
|
||||||
|
{section_kind=$1; section_name=None; section_items= $3})
|
||||||
|
}
|
||||||
|
| IDENT STRING LBRACE items RBRACE {
|
||||||
|
Section (get_pos 1,
|
||||||
|
{section_kind=$1; section_name=Some $2; section_items= $4})
|
||||||
|
}
|
||||||
|
;
|
||||||
|
|
||||||
|
value:
|
||||||
|
| atom %prec ATOM { $1 }
|
||||||
|
| LPAR values RPAR { Group (get_pos 1,$2) }
|
||||||
|
| LBRACKET values RBRACKET { List (get_pos 1,$2) }
|
||||||
|
| value LBRACE values RBRACE { Option (get_pos 2,$1, $3) }
|
||||||
|
| value AND value { Logop (get_pos 2,`And,$1,$3) }
|
||||||
|
| value OR value { Logop (get_pos 2,`Or,$1,$3) }
|
||||||
|
| atom RELOP atom { Relop (get_pos 2,$2,$1,$3) }
|
||||||
|
| atom ENVOP atom { Env_binding (get_pos 1,$1,$2,$3) }
|
||||||
|
| PFXOP value { Pfxop (get_pos 1,$1,$2) }
|
||||||
|
| RELOP atom { Prefix_relop (get_pos 1,$1,$2) }
|
||||||
|
;
|
||||||
|
|
||||||
|
values:
|
||||||
|
| { [] }
|
||||||
|
| value values { $1 :: $2 }
|
||||||
|
;
|
||||||
|
|
||||||
|
atom:
|
||||||
|
| IDENT { Ident (get_pos 1,$1) }
|
||||||
|
| BOOL { Bool (get_pos 1,$1) }
|
||||||
|
| INT { Int (get_pos 1,$1) }
|
||||||
|
| STRING { String (get_pos 1,$1) }
|
||||||
|
;
|
||||||
|
|
||||||
|
%%
|
||||||
|
|
||||||
|
let main t l f =
|
||||||
|
try
|
||||||
|
let r = main t l f in
|
||||||
|
Parsing.clear_parser ();
|
||||||
|
r
|
||||||
|
with
|
||||||
|
| e ->
|
||||||
|
Parsing.clear_parser ();
|
||||||
|
raise e
|
|
@ -0,0 +1,27 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2012-2015 OCamlPro *)
|
||||||
|
(* Copyright 2012 INRIA *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
(** OPAM config file lexer *)
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
|
||||||
|
exception Error of string
|
||||||
|
|
||||||
|
val relop: string -> relop
|
||||||
|
|
||||||
|
val logop: string -> logop
|
||||||
|
|
||||||
|
val pfxop: string -> pfxop
|
||||||
|
|
||||||
|
val env_update_op: string -> env_update_op
|
||||||
|
|
||||||
|
|
||||||
|
val token: Lexing.lexbuf -> OpamBaseParser.token
|
|
@ -0,0 +1,165 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2012-2015 OCamlPro *)
|
||||||
|
(* Copyright 2012 INRIA *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
{
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
open OpamBaseParser
|
||||||
|
|
||||||
|
exception Error of string
|
||||||
|
|
||||||
|
let newline lexbuf = Lexing.new_line lexbuf
|
||||||
|
let error fmt =
|
||||||
|
Printf.kprintf (fun msg -> raise (Error msg)) fmt
|
||||||
|
|
||||||
|
let relop = function
|
||||||
|
| "=" -> `Eq
|
||||||
|
| "!=" -> `Neq
|
||||||
|
| ">=" -> `Geq
|
||||||
|
| ">" -> `Gt
|
||||||
|
| "<=" -> `Leq
|
||||||
|
| "<" -> `Lt
|
||||||
|
| x -> error "%S is not a valid comparison operator" x
|
||||||
|
|
||||||
|
let logop = function
|
||||||
|
| "&" -> `And
|
||||||
|
| "|" -> `Or
|
||||||
|
| x -> error "%S is not a valid logical operator" x
|
||||||
|
|
||||||
|
let pfxop = function
|
||||||
|
| "!" -> `Not
|
||||||
|
| x -> error "%S is not a valid prefix operator" x
|
||||||
|
|
||||||
|
let env_update_op = function
|
||||||
|
| "=" -> Eq
|
||||||
|
| "+=" -> PlusEq
|
||||||
|
| "=+" -> EqPlus
|
||||||
|
| "=+=" -> EqPlusEq
|
||||||
|
| ":=" -> ColonEq
|
||||||
|
| "=:" -> EqColon
|
||||||
|
| x -> error "%S is not a valid environment update operator" x
|
||||||
|
|
||||||
|
let char_for_backslash = function
|
||||||
|
| 'n' -> '\010'
|
||||||
|
| 'r' -> '\013'
|
||||||
|
| 'b' -> '\008'
|
||||||
|
| 't' -> '\009'
|
||||||
|
| c -> c
|
||||||
|
|
||||||
|
let char_for_decimal_code lexbuf i =
|
||||||
|
let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
|
||||||
|
10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
|
||||||
|
(Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
|
||||||
|
if (c < 0 || c > 255) then error "illegal escape sequence" ;
|
||||||
|
Char.chr c
|
||||||
|
|
||||||
|
let char_for_hexadecimal_code lexbuf i =
|
||||||
|
let d1 = Char.code (Lexing.lexeme_char lexbuf i) in
|
||||||
|
let val1 = if d1 >= 97 then d1 - 87
|
||||||
|
else if d1 >= 65 then d1 - 55
|
||||||
|
else d1 - 48 in
|
||||||
|
let d2 = Char.code (Lexing.lexeme_char lexbuf (i+1)) in
|
||||||
|
let val2 = if d2 >= 97 then d2 - 87
|
||||||
|
else if d2 >= 65 then d2 - 55
|
||||||
|
else d2 - 48 in
|
||||||
|
Char.chr (val1 * 16 + val2)
|
||||||
|
|
||||||
|
let buffer_rule r lb =
|
||||||
|
let b = Buffer.create 64 in
|
||||||
|
r b lb ;
|
||||||
|
Buffer.contents b
|
||||||
|
}
|
||||||
|
|
||||||
|
let space = [' ' '\t' '\r']
|
||||||
|
|
||||||
|
let alpha = ['a'-'z' 'A'-'Z']
|
||||||
|
let digit = ['0'-'9']
|
||||||
|
|
||||||
|
let ichar = alpha | digit | ['_' '-']
|
||||||
|
let id = ichar* alpha ichar*
|
||||||
|
let ident = (id | '_') ('+' (id | '_'))* (':' id)?
|
||||||
|
|
||||||
|
let relop = ('!'? '=' | [ '<' '>' ] '='?)
|
||||||
|
let pfxop = '!'
|
||||||
|
let envop_char = [ '+' ':' ]
|
||||||
|
let envop = (envop_char '=' | '=' envop_char '='?)
|
||||||
|
let int = ('-'? ['0'-'9' '_']+)
|
||||||
|
|
||||||
|
rule token = parse
|
||||||
|
| space { token lexbuf }
|
||||||
|
| '\n' { newline lexbuf; token lexbuf }
|
||||||
|
| ":" { COLON }
|
||||||
|
| "{" { LBRACE }
|
||||||
|
| "}" { RBRACE }
|
||||||
|
| "[" { LBRACKET }
|
||||||
|
| "]" { RBRACKET }
|
||||||
|
| "(" { LPAR }
|
||||||
|
| ")" { RPAR }
|
||||||
|
| '\"' { STRING (buffer_rule string lexbuf) }
|
||||||
|
| "\"\"\"" { STRING (buffer_rule string_triple lexbuf) }
|
||||||
|
| "(*" { comment 1 lexbuf; token lexbuf }
|
||||||
|
| "#" { comment_line lexbuf; token lexbuf }
|
||||||
|
| "true" { BOOL true }
|
||||||
|
| "false"{ BOOL false }
|
||||||
|
| int { INT (int_of_string (Lexing.lexeme lexbuf)) }
|
||||||
|
| ident { IDENT (Lexing.lexeme lexbuf) }
|
||||||
|
| relop { RELOP (relop (Lexing.lexeme lexbuf)) }
|
||||||
|
| '&' { AND }
|
||||||
|
| '|' { OR }
|
||||||
|
| pfxop { PFXOP (pfxop (Lexing.lexeme lexbuf)) }
|
||||||
|
| envop { ENVOP (env_update_op (Lexing.lexeme lexbuf)) }
|
||||||
|
| eof { EOF }
|
||||||
|
| _ { let token = Lexing.lexeme lexbuf in
|
||||||
|
error "'%s' is not a valid token" token }
|
||||||
|
|
||||||
|
and string b = parse
|
||||||
|
| '\"' { () }
|
||||||
|
| '\n' { newline lexbuf ;
|
||||||
|
Buffer.add_char b '\n' ; string b lexbuf }
|
||||||
|
| '\\' { (match escape lexbuf with
|
||||||
|
| Some c -> Buffer.add_char b c
|
||||||
|
| None -> ());
|
||||||
|
string b lexbuf }
|
||||||
|
| _ as c { Buffer.add_char b c ; string b lexbuf }
|
||||||
|
| eof { error "unterminated string" }
|
||||||
|
|
||||||
|
and string_triple b = parse
|
||||||
|
| "\"\"\"" { () }
|
||||||
|
| '\n' { newline lexbuf ;
|
||||||
|
Buffer.add_char b '\n' ; string_triple b lexbuf }
|
||||||
|
| '\\' { (match escape lexbuf with
|
||||||
|
| Some c -> Buffer.add_char b c
|
||||||
|
| None -> ());
|
||||||
|
string_triple b lexbuf }
|
||||||
|
| _ as c { Buffer.add_char b c ; string_triple b lexbuf }
|
||||||
|
| eof { error "unterminated string" }
|
||||||
|
|
||||||
|
and escape = parse
|
||||||
|
| '\n' space *
|
||||||
|
{ newline lexbuf; None }
|
||||||
|
| ['\\' '\"' ''' 'n' 'r' 't' 'b' ' '] as c
|
||||||
|
{ Some (char_for_backslash c) }
|
||||||
|
| digit digit digit
|
||||||
|
{ Some (char_for_decimal_code lexbuf 0) }
|
||||||
|
| 'x' ['0'-'9''a'-'f''A'-'F'] ['0'-'9''a'-'f''A'-'F']
|
||||||
|
{ Some (char_for_hexadecimal_code lexbuf 1) }
|
||||||
|
| "" { error "illegal escape sequence" }
|
||||||
|
|
||||||
|
and comment n = parse
|
||||||
|
| "*)" { if n > 1 then comment (n-1) lexbuf }
|
||||||
|
| "(*" { comment (n+1)lexbuf }
|
||||||
|
| eof { error "unterminated comment" }
|
||||||
|
| '\n' { newline lexbuf; comment n lexbuf }
|
||||||
|
| _ { comment n lexbuf }
|
||||||
|
|
||||||
|
and comment_line = parse
|
||||||
|
| [^'\n']* '\n' { newline lexbuf }
|
||||||
|
| [^'\n'] { () }
|
|
@ -0,0 +1,28 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2016 OCamlPro *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
let main = OpamBaseParser.main
|
||||||
|
|
||||||
|
let string str filename =
|
||||||
|
let lexbuf = Lexing.from_string str in
|
||||||
|
lexbuf.Lexing.lex_curr_p <-
|
||||||
|
{ lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename };
|
||||||
|
OpamBaseParser.main OpamLexer.token lexbuf filename
|
||||||
|
|
||||||
|
let channel ic filename =
|
||||||
|
let lexbuf = Lexing.from_channel ic in
|
||||||
|
lexbuf.Lexing.lex_curr_p <-
|
||||||
|
{ lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename };
|
||||||
|
OpamBaseParser.main OpamLexer.token lexbuf filename
|
||||||
|
|
||||||
|
let file filename =
|
||||||
|
let ic = open_in filename in
|
||||||
|
try channel ic filename
|
||||||
|
with e -> close_in ic; raise e
|
|
@ -0,0 +1,22 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2016 OCamlPro *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
|
||||||
|
(** Raw OpamBaseParser main entry point *)
|
||||||
|
val main:
|
||||||
|
(Lexing.lexbuf -> OpamBaseParser.token) ->
|
||||||
|
Lexing.lexbuf -> file_name -> opamfile
|
||||||
|
|
||||||
|
val string: string -> file_name -> opamfile
|
||||||
|
|
||||||
|
val channel: in_channel -> file_name -> opamfile
|
||||||
|
|
||||||
|
val file: file_name -> opamfile
|
|
@ -0,0 +1,54 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2012-2015 OCamlPro *)
|
||||||
|
(* Copyright 2012 INRIA *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
type relop = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ]
|
||||||
|
type logop = [ `And | `Or ]
|
||||||
|
type pfxop = [ `Not ]
|
||||||
|
|
||||||
|
type file_name = string
|
||||||
|
|
||||||
|
(** Source file positions: filename, line, column *)
|
||||||
|
type pos = file_name * int * int
|
||||||
|
|
||||||
|
type env_update_op = Eq | PlusEq | EqPlus | ColonEq | EqColon | EqPlusEq
|
||||||
|
|
||||||
|
(** Base values *)
|
||||||
|
type value =
|
||||||
|
| Bool of pos * bool
|
||||||
|
| Int of pos * int
|
||||||
|
| String of pos * string
|
||||||
|
| Relop of pos * relop * value * value
|
||||||
|
| Prefix_relop of pos * relop * value
|
||||||
|
| Logop of pos * logop * value * value
|
||||||
|
| Pfxop of pos * pfxop * value
|
||||||
|
| Ident of pos * string
|
||||||
|
| List of pos * value list
|
||||||
|
| Group of pos * value list
|
||||||
|
| Option of pos * value * value list
|
||||||
|
| Env_binding of pos * value * env_update_op * value
|
||||||
|
|
||||||
|
(** An opamfile section *)
|
||||||
|
type opamfile_section = {
|
||||||
|
section_kind : string;
|
||||||
|
section_name : string option;
|
||||||
|
section_items : opamfile_item list;
|
||||||
|
}
|
||||||
|
|
||||||
|
(** An opamfile is composed of sections and variable definitions *)
|
||||||
|
and opamfile_item =
|
||||||
|
| Section of pos * opamfile_section
|
||||||
|
| Variable of pos * string * value
|
||||||
|
|
||||||
|
(** A file is a list of items and the filename *)
|
||||||
|
type opamfile = {
|
||||||
|
file_contents: opamfile_item list;
|
||||||
|
file_name : file_name;
|
||||||
|
}
|
|
@ -0,0 +1,214 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2012-2016 OCamlPro *)
|
||||||
|
(* Copyright 2012 INRIA *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
|
||||||
|
let relop = function
|
||||||
|
| `Eq -> "="
|
||||||
|
| `Neq -> "!="
|
||||||
|
| `Geq -> ">="
|
||||||
|
| `Gt -> ">"
|
||||||
|
| `Leq -> "<="
|
||||||
|
| `Lt -> "<"
|
||||||
|
|
||||||
|
let logop = function
|
||||||
|
| `And -> "&"
|
||||||
|
| `Or -> "|"
|
||||||
|
|
||||||
|
let pfxop = function
|
||||||
|
| `Not -> "!"
|
||||||
|
|
||||||
|
let env_update_op = function
|
||||||
|
| Eq -> "="
|
||||||
|
| PlusEq -> "+="
|
||||||
|
| EqPlus -> "=+"
|
||||||
|
| EqPlusEq -> "=+="
|
||||||
|
| ColonEq -> ":="
|
||||||
|
| EqColon -> "=:"
|
||||||
|
|
||||||
|
let escape_string ?(triple=false) s =
|
||||||
|
let len = String.length s in
|
||||||
|
let buf = Buffer.create (len * 2) in
|
||||||
|
for i = 0 to len -1 do
|
||||||
|
let c = s.[i] in
|
||||||
|
(match c with
|
||||||
|
| '"'
|
||||||
|
when not triple
|
||||||
|
|| (i < len - 2 && s.[i+1] = '"' && s.[i+2] = '"')
|
||||||
|
|| i = len - 1 ->
|
||||||
|
Buffer.add_char buf '\\'
|
||||||
|
| '\\' -> Buffer.add_char buf '\\'
|
||||||
|
| _ -> ());
|
||||||
|
Buffer.add_char buf c
|
||||||
|
done;
|
||||||
|
Buffer.contents buf
|
||||||
|
|
||||||
|
let rec format_value fmt = function
|
||||||
|
| Relop (_,op,l,r) ->
|
||||||
|
Format.fprintf fmt "@[<h>%a %s@ %a@]"
|
||||||
|
format_value l (relop op) format_value r
|
||||||
|
| Logop (_,op,l,r) ->
|
||||||
|
Format.fprintf fmt "@[<hv>%a %s@ %a@]"
|
||||||
|
format_value l (logop op) format_value r
|
||||||
|
| Pfxop (_,op,r) ->
|
||||||
|
Format.fprintf fmt "@[<h>%s%a@]" (pfxop op) format_value r
|
||||||
|
| Prefix_relop (_,op,r) ->
|
||||||
|
Format.fprintf fmt "@[<h>%s@ %a@]"
|
||||||
|
(relop op) format_value r
|
||||||
|
| Ident (_,s) -> Format.fprintf fmt "%s" s
|
||||||
|
| Int (_,i) -> Format.fprintf fmt "%d" i
|
||||||
|
| Bool (_,b) -> Format.fprintf fmt "%b" b
|
||||||
|
| String (_,s) ->
|
||||||
|
if String.contains s '\n'
|
||||||
|
then Format.fprintf fmt "\"\"\"\n%s\"\"\""
|
||||||
|
(escape_string ~triple:true s)
|
||||||
|
else Format.fprintf fmt "\"%s\"" (escape_string s)
|
||||||
|
| List (_, l) ->
|
||||||
|
Format.fprintf fmt "@[<hv>[@;<0 2>@[<hv>%a@]@,]@]" format_values l
|
||||||
|
| Group (_,g) -> Format.fprintf fmt "@[<hv>(%a)@]" format_values g
|
||||||
|
| Option(_,v,l) -> Format.fprintf fmt "@[<hov 2>%a@ {@[<hv>%a@]}@]"
|
||||||
|
format_value v format_values l
|
||||||
|
| Env_binding (_,id,op,v) ->
|
||||||
|
Format.fprintf fmt "@[<h>%a %s@ %a@]"
|
||||||
|
format_value id (env_update_op op) format_value v
|
||||||
|
|
||||||
|
and format_values fmt = function
|
||||||
|
| [] -> ()
|
||||||
|
| [v] -> format_value fmt v
|
||||||
|
| v::r ->
|
||||||
|
format_value fmt v;
|
||||||
|
Format.pp_print_space fmt ();
|
||||||
|
format_values fmt r
|
||||||
|
|
||||||
|
let value v =
|
||||||
|
format_value Format.str_formatter v; Format.flush_str_formatter ()
|
||||||
|
|
||||||
|
let value_list vl =
|
||||||
|
Format.fprintf Format.str_formatter "@[<hv>%a@]" format_values vl;
|
||||||
|
Format.flush_str_formatter ()
|
||||||
|
|
||||||
|
let rec format_item fmt = function
|
||||||
|
| Variable (_, _, List (_,[])) -> ()
|
||||||
|
| Variable (_, _, List (_,[List(_,[])])) -> ()
|
||||||
|
| Variable (_, i, List (_,l)) ->
|
||||||
|
if List.exists
|
||||||
|
(function List _ | Option (_,_,_::_) -> true | _ -> false)
|
||||||
|
l
|
||||||
|
then Format.fprintf fmt "@[<v>%s: [@;<0 2>@[<v>%a@]@,]@]"
|
||||||
|
i format_values l
|
||||||
|
else Format.fprintf fmt "@[<hv>%s: [@;<0 2>@[<hv>%a@]@,]@]"
|
||||||
|
i format_values l
|
||||||
|
| Variable (_, i, (String (_,s) as v)) when String.contains s '\n' ->
|
||||||
|
Format.fprintf fmt "@[<hov 0>%s: %a@]" i format_value v
|
||||||
|
| Variable (_, i, v) ->
|
||||||
|
Format.fprintf fmt "@[<hov 2>%s:@ %a@]" i format_value v
|
||||||
|
| Section (_,s) ->
|
||||||
|
Format.fprintf fmt "@[<v 0>%s %s{@;<0 2>@[<v>%a@]@,}@]"
|
||||||
|
s.section_kind
|
||||||
|
(match s.section_name with
|
||||||
|
| Some s -> Printf.sprintf "\"%s\" " (escape_string s)
|
||||||
|
| None -> "")
|
||||||
|
format_items s.section_items
|
||||||
|
and format_items fmt is =
|
||||||
|
Format.pp_open_vbox fmt 0;
|
||||||
|
(match is with
|
||||||
|
| [] -> ()
|
||||||
|
| i::r ->
|
||||||
|
format_item fmt i;
|
||||||
|
List.iter (fun i -> Format.pp_print_cut fmt (); format_item fmt i) r);
|
||||||
|
Format.pp_close_box fmt ()
|
||||||
|
|
||||||
|
let format_opamfile fmt f =
|
||||||
|
format_items fmt f.file_contents;
|
||||||
|
Format.pp_print_newline fmt ()
|
||||||
|
|
||||||
|
let items l =
|
||||||
|
format_items Format.str_formatter l; Format.flush_str_formatter ()
|
||||||
|
|
||||||
|
let opamfile f =
|
||||||
|
items f.file_contents
|
||||||
|
|
||||||
|
module Normalise = struct
|
||||||
|
(** OPAM normalised file format, for signatures:
|
||||||
|
- each top-level field on a single line
|
||||||
|
- file ends with a newline
|
||||||
|
- spaces only after [fieldname:], between elements in lists, before braced
|
||||||
|
options, between operators and their operands
|
||||||
|
- fields are sorted lexicographically by field name (using [String.compare])
|
||||||
|
- newlines in strings turned to ['\n'], backslashes and double quotes
|
||||||
|
escaped
|
||||||
|
- no comments (they don't appear in the internal file format anyway)
|
||||||
|
- fields containing an empty list, or a singleton list containing an empty
|
||||||
|
list, are not printed at all
|
||||||
|
*)
|
||||||
|
|
||||||
|
let escape_string s =
|
||||||
|
let len = String.length s in
|
||||||
|
let buf = Buffer.create (len * 2) in
|
||||||
|
Buffer.add_char buf '"';
|
||||||
|
for i = 0 to len -1 do
|
||||||
|
match s.[i] with
|
||||||
|
| '\\' | '"' as c -> Buffer.add_char buf '\\'; Buffer.add_char buf c
|
||||||
|
| '\n' -> Buffer.add_string buf "\\n"
|
||||||
|
| c -> Buffer.add_char buf c
|
||||||
|
done;
|
||||||
|
Buffer.add_char buf '"';
|
||||||
|
Buffer.contents buf
|
||||||
|
|
||||||
|
let rec value = function
|
||||||
|
| Relop (_,op,l,r) ->
|
||||||
|
String.concat " " [value l; relop op; value r]
|
||||||
|
| Logop (_,op,l,r) ->
|
||||||
|
String.concat " " [value l; logop op; value r]
|
||||||
|
| Pfxop (_,op,r) ->
|
||||||
|
String.concat " " [pfxop op; value r]
|
||||||
|
| Prefix_relop (_,op,r) ->
|
||||||
|
String.concat " " [relop op; value r]
|
||||||
|
| Ident (_,s) -> s
|
||||||
|
| Int (_,i) -> string_of_int i
|
||||||
|
| Bool (_,b) -> string_of_bool b
|
||||||
|
| String (_,s) -> escape_string s
|
||||||
|
| List (_, l) -> Printf.sprintf "[%s]" (String.concat " " (List.map value l))
|
||||||
|
| Group (_,g) -> Printf.sprintf "(%s)" (String.concat " " (List.map value g))
|
||||||
|
| Option(_,v,l) ->
|
||||||
|
Printf.sprintf "%s {%s}" (value v) (String.concat " " (List.map value l))
|
||||||
|
| Env_binding (_,id,op,v) ->
|
||||||
|
String.concat " "
|
||||||
|
[value id; env_update_op op; value v]
|
||||||
|
|
||||||
|
let rec item = function
|
||||||
|
| Variable (_, _, List (_,([]|[List(_,[])]))) -> ""
|
||||||
|
| Variable (_, i, List (_,l)) ->
|
||||||
|
Printf.sprintf "%s: [%s]" i (String.concat " " (List.map value l))
|
||||||
|
| Variable (_, i, v) -> String.concat ": " [i; value v]
|
||||||
|
| Section (_,s) ->
|
||||||
|
Printf.sprintf "%s %s{\n%s\n}"
|
||||||
|
s.section_kind
|
||||||
|
(match s.section_name with
|
||||||
|
| Some s -> escape_string s ^ " "
|
||||||
|
| None -> "")
|
||||||
|
(String.concat "\n" (List.map item s.section_items))
|
||||||
|
|
||||||
|
let item_order a b = match a,b with
|
||||||
|
| Section _, Variable _ -> 1
|
||||||
|
| Variable _, Section _ -> -1
|
||||||
|
| Variable (_,i,_), Variable (_,j,_) -> String.compare i j
|
||||||
|
| Section (_,s), Section (_,t) ->
|
||||||
|
let r = String.compare s.section_kind t.section_kind in
|
||||||
|
if r <> 0 then r
|
||||||
|
else compare s.section_name t.section_name
|
||||||
|
|
||||||
|
let items its =
|
||||||
|
let its = List.sort item_order its in
|
||||||
|
String.concat "\n" (List.map item its) ^ "\n"
|
||||||
|
|
||||||
|
let opamfile f = items f.file_contents
|
||||||
|
end
|
|
@ -0,0 +1,44 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2012-2015 OCamlPro *)
|
||||||
|
(* Copyright 2012 INRIA *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of the *)
|
||||||
|
(* GNU Lesser General Public License version 2.1, with the special *)
|
||||||
|
(* exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
(** {2 Printers for the [value] and [opamfile] formats} *)
|
||||||
|
|
||||||
|
open OpamParserTypes
|
||||||
|
|
||||||
|
val relop: relop -> string
|
||||||
|
|
||||||
|
val logop: logop -> string
|
||||||
|
|
||||||
|
val pfxop: pfxop -> string
|
||||||
|
|
||||||
|
val env_update_op: env_update_op -> string
|
||||||
|
|
||||||
|
val value : value -> string
|
||||||
|
|
||||||
|
val value_list: value list -> string
|
||||||
|
|
||||||
|
val items: opamfile_item list -> string
|
||||||
|
|
||||||
|
val opamfile: opamfile -> string
|
||||||
|
|
||||||
|
val format_opamfile: Format.formatter -> opamfile -> unit
|
||||||
|
|
||||||
|
(** {2 Normalised output for opam syntax files} *)
|
||||||
|
|
||||||
|
module Normalise : sig
|
||||||
|
val escape_string : string -> string
|
||||||
|
val value : value -> string
|
||||||
|
val item : opamfile_item -> string
|
||||||
|
val item_order : opamfile_item -> opamfile_item -> int
|
||||||
|
val items : opamfile_item list -> string
|
||||||
|
val opamfile : opamfile -> string
|
||||||
|
end
|
||||||
|
|
|
@ -0,0 +1,20 @@
|
||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
version=2.0.0~beta
|
||||||
|
|
||||||
|
set -e -o pipefail
|
||||||
|
|
||||||
|
TMP="$(mktemp -d)"
|
||||||
|
trap "rm -rf $TMP" EXIT
|
||||||
|
|
||||||
|
rm -rf opam-file-format
|
||||||
|
mkdir -p opam-file-format/src
|
||||||
|
|
||||||
|
(cd $TMP && opam source opam-file-format.$version)
|
||||||
|
|
||||||
|
SRC=$TMP/opam-file-format.$version
|
||||||
|
|
||||||
|
cp -v $SRC/src/*.{ml,mli,mll,mly} opam-file-format/src
|
||||||
|
|
||||||
|
git checkout opam-file-format/src/jbuild
|
||||||
|
git add -A .
|
Loading…
Reference in New Issue