diff --git a/.gitignore b/.gitignore index db94d825037..5cccefa7c8d 100644 --- a/.gitignore +++ b/.gitignore @@ -10,6 +10,7 @@ src_ext/cmdliner/ src_ext/extlib/ src_ext/re/ src_ext/graph/ +src_ext/opam-file-format/ src_ext/*.stamp src_ext/*.tbz src_ext/*.tar.gz diff --git a/.travis-ci.sh b/.travis-ci.sh index 8c1b44619a7..1456efbf67d 100755 --- a/.travis-ci.sh +++ b/.travis-ci.sh @@ -16,10 +16,14 @@ case "$TARGET" in ;; install) # Note: this part is cached, and must be idempotent - opam init --root=$OPAMBSROOT --yes --no-setup --compiler=$OCAML_VERSION + if [ -d "$OPAMBSROOT" ]; then + opam update --root=$OPAMBSROOT + else + opam init --root=$OPAMBSROOT --yes --no-setup --compiler=$OCAML_VERSION + fi eval $(opam config env --root=$OPAMBSROOT) if [ "$OPAM_TEST" = "1" ]; then - opam install ocamlfind lwt.2.5.2 cohttp.0.20.2 ssl cmdliner dose3 jsonm --yes + opam install ocamlfind lwt.2.5.2 cohttp.0.20.2 ssl cmdliner dose3 jsonm opam-file-format --yes # Allow use of ocamlfind packages in ~/local/lib FINDCONF=$(ocamlfind printconf conf) sed "s%^path=.*%path=\"$HOME/local/lib:$(opam config var lib)\"%" $FINDCONF >$FINDCONF.1 diff --git a/META.in b/META.in deleted file mode 100644 index 61042fa4454..00000000000 --- a/META.in +++ /dev/null @@ -1,40 +0,0 @@ -version = "@PACKAGE_VERSION@" -description = "OCaml Package Manager base API" -requires = "ocamlgraph, unix, re, re.str, jsonm" -archive(byte) = "opam-core.cma" -archive(native) = "opam-core.cmxa" - -package "format" ( - version = "@PACKAGE_VERSION@" - archive(byte) = "opam-format.cma" - archive(native) = "opam-format.cmxa" - requires = "re.pcre, opam-lib" -) - -package "repository" ( - version = "@PACKAGE_VERSION@" - archive(byte) = "opam-repository.cma" - archive(native) = "opam-repository.cmxa" - requires = "opam-lib, opam-lib.format" -) - -package "solver" ( - version = "@PACKAGE_VERSION@" - archive(byte) = "opam-solver.cma" - archive(native) = "opam-solver.cmxa" - requires = "cudf, dose3.common, dose3.algo, opam-lib, opam-lib.format" -) - -package "state" ( - version = "@PACKAGE_VERSION@" - archive(byte) = "opam-state.cma" - archive(native) = "opam-state.cmxa" - requires = "opam-lib, opam-lib.format, opam-lib.solver, opam-lib.repository" -) - -package "client" ( - version = "@PACKAGE_VERSION@" - archive(byte) = "opam-client.cma" - archive(native) = "opam-client.cmxa" - requires = "cmdliner, re.glob, opam-lib, opam-lib.format, opam-lib.solver, opam-lib.repository, opam-lib.state" -) diff --git a/Makefile b/Makefile index ac9861aba3b..45a137afe20 100644 --- a/Makefile +++ b/Makefile @@ -34,10 +34,15 @@ download-ext: clean-ext: $(MAKE) -C src_ext distclean -clean: +clean: fastclean $(MAKE) -C src $@ $(MAKE) -C doc $@ - rm -f META *.install *.env *.err *.info *.out + rm -f *.install *.env *.err *.info *.out + +distclean: clean + rm -f Makefile.config + rm -f src/*.META + rm -f src/core/opamVersion.ml OPAMINSTALLER_FLAGS = --prefix $(DESTDIR)$(prefix) OPAMINSTALLER_FLAGS += --mandir $(DESTDIR)$(mandir) @@ -80,9 +85,16 @@ opam-devel.install: @echo ' "_obuild/opam-installer/opam-installer.asm" {"opam-installer"}' >>$@ @echo ']' >>$@ -libinstall: opam-lib.install opam-admin.top - $(if $(wildcard src_ext/lib/*),$(error Installing the opam libraries is incompatible with embedding the dependencies. Run 'make clean-ext' and try again)) - src/opam-installer $(OPAMINSTALLER_FLAGS) opam-lib.install +OPAMLIBS = core format solver repository state client + +installlib-%: opam-installer opam-%.install src/opam-%$(LIBEXT) + $(if $(wildcard src_ext/lib/*),\ + $(error Installing the opam libraries is incompatible with embedding \ + the dependencies. Run 'make clean-ext' and try again)) + src/opam-installer $(OPAMINSTALLER_FLAGS) opam-$*.install + +libinstall: opam-admin.top $(OPAMLIBS:%=installlib-%) + @ install: opam.install src/opam-installer $(OPAMINSTALLER_FLAGS) $< diff --git a/Makefile.config.in b/Makefile.config.in index 1824462c07f..714deaa6ac8 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -8,8 +8,9 @@ version = @PACKAGE_VERSION@ FETCH = @fetch@ HAS_PACKAGES = @hasalldeps@ USE_BYTE := $(if $(subst no,,@OCAMLOPT@),,true) +LIBEXT := $(if $(USE_BYTE),.cma,.cmxa) -PACKS = @OCAML_PKG_unix@ @OCAML_PKG_bigarray@ @OCAML_PKG_extlib@ @OCAML_PKG_re@ @OCAML_PKG_re_str@ @OCAML_PKG_re_pcre@ @OCAML_PKG_re_glob@ @OCAML_PKG_cmdliner@ @OCAML_PKG_ocamlgraph@ @OCAML_PKG_cudf@ @OCAML_PKG_dose3_common@ @OCAML_PKG_dose3_algo@ @OCAML_PKG_jsonm@ +PACKS = @OCAML_PKG_unix@ @OCAML_PKG_bigarray@ @OCAML_PKG_extlib@ @OCAML_PKG_re@ @OCAML_PKG_re_str@ @OCAML_PKG_re_pcre@ @OCAML_PKG_re_glob@ @OCAML_PKG_cmdliner@ @OCAML_PKG_ocamlgraph@ @OCAML_PKG_cudf@ @OCAML_PKG_dose3_common@ @OCAML_PKG_dose3_algo@ @OCAML_PKG_jsonm@ @OCAML_PKG_opam_file_format@ OCAMLFIND = @OCAMLFIND@ OCAML = @OCAML@ diff --git a/README.md b/README.md index 3c3fb9fc1c0..bdcc60b388f 100644 --- a/README.md +++ b/README.md @@ -28,7 +28,7 @@ easier to already have a working opam installation in this case, so you can do it as a second step. * Make sure to have ocamlfind, ocamlgraph, cmdliner >= 0.9.8, jsonm, cudf, - dose3 and re >= 1.2.0 installed. Or run `opam install + dose3, re >= 1.2.0, opam-file-format installed. Or run `opam install opam-lib --deps-only` if you already have a working instance. Re-run `./configure` once done * Run `make libinstall` at the end diff --git a/configure b/configure index 1f369d26c9b..7582131b5f6 100755 --- a/configure +++ b/configure @@ -586,6 +586,7 @@ PACKAGE_URL='' ac_subst_vars='LTLIBOBJS LIBOBJS hasalldeps +OCAML_PKG_opam_file_format OCAML_PKG_jsonm OCAML_PKG_dose3_algo OCAML_PKG_dose3_common @@ -4509,6 +4510,30 @@ $as_echo "not found" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCaml findlib package opam-file-format" >&5 +$as_echo_n "checking for OCaml findlib package opam-file-format... " >&6; } + + unset found + unset pkg + found=no + for pkg in opam-file-format ; do + if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } + OCAML_PKG_opam_file_format=$pkg + found=yes + break + fi + done + if test "$found" = "no" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +$as_echo "not found" >&6; } + OCAML_PKG_opam_file_format=no + fi + + + + echo @@ -4540,7 +4565,7 @@ if test "x$prefix" = "xNONE"; then prefix=$ac_default_prefix fi -ac_config_files="$ac_config_files Makefile.config src/core/opamVersion.ml META src/core.META src/format.META src/repository.META src/solver.META src/state.META src/client.META src/admin.META" +ac_config_files="$ac_config_files Makefile.config src/core/opamVersion.ml src/core.META src/format.META src/repository.META src/solver.META src/state.META src/client.META src/admin.META" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -5250,7 +5275,6 @@ do case $ac_config_target in "Makefile.config") CONFIG_FILES="$CONFIG_FILES Makefile.config" ;; "src/core/opamVersion.ml") CONFIG_FILES="$CONFIG_FILES src/core/opamVersion.ml" ;; - "META") CONFIG_FILES="$CONFIG_FILES META" ;; "src/core.META") CONFIG_FILES="$CONFIG_FILES src/core.META" ;; "src/format.META") CONFIG_FILES="$CONFIG_FILES src/format.META" ;; "src/repository.META") CONFIG_FILES="$CONFIG_FILES src/repository.META" ;; diff --git a/configure.ac b/configure.ac index b5041c972f6..be78132b949 100644 --- a/configure.ac +++ b/configure.ac @@ -70,6 +70,7 @@ AC_CHECK_OCAML_PKG([cudf]) AC_CHECK_OCAML_PKG(dose3.common,dose.common) AC_CHECK_OCAML_PKG(dose3.algo,dose.algo) AC_CHECK_OCAML_PKG([jsonm]) +AC_CHECK_OCAML_PKG([opam-file-format]) dnl echo dnl echo "extlib........................ ${OCAML_PKG_extlib}" @@ -107,7 +108,6 @@ fi AC_CONFIG_FILES( Makefile.config src/core/opamVersion.ml - META src/core.META src/format.META src/repository.META diff --git a/doc/index.html b/doc/index.html index 2ddd0da3706..7e8cd5f9fd2 100644 --- a/doc/index.html +++ b/doc/index.html @@ -84,19 +84,6 @@

OPAM %{OPAMVERSION}% API and libraries documentation

opam-format library - - Lexer, parser and printer for the base opam syntax - - -opamParserTypes.mli - Basic value and file structure types -opamLexer.mll - OPAM config file lexer -opamParser.mly - OPAM config file generic type parser -opamPrinter.ml - Printer for the generic opam file format - Definition of OPAM datastructures and its file interface diff --git a/opam-format.opam b/opam-format.opam index c5d53f82e17..ec3bcafaeed 100644 --- a/opam-format.opam +++ b/opam-format.opam @@ -21,5 +21,6 @@ build: [ ] depends: [ "opam-core" {= "2.0~alpha4"} + "opam-file-format" {>= "2.0~alpha4"} ] available: ocaml-version >= "4.01.0" diff --git a/src/Makefile b/src/Makefile index 43359d61e1b..ae7a857f487 100644 --- a/src/Makefile +++ b/src/Makefile @@ -25,8 +25,6 @@ endif export OCAMLFLAGS OCAMLLDFLAGS -USE_BYTE ?= -LIBEXT = $(if $(USE_BYTE),.cma,.cmxa) BINTARGET = $(if $(USE_BYTE),byte-code,native-code) # -- @@ -37,7 +35,7 @@ endif ifneq ($(HAS_LIBEXT),) EXT_INCDIRS = ../src_ext/lib - LIBS = unix bigarray extlib re cmdliner graph cudf dose_common dose_algo uutf jsonm + LIBS = unix bigarray extlib re cmdliner graph cudf dose_common dose_algo uutf jsonm opam-file-format else ifeq ($(HAS_PACKAGES),) $(error Dependencies missing. Either run 'make lib-ext' or install them and re-run './configure') @@ -63,10 +61,10 @@ INCDIRS = $(EXT_INCDIRS) $(SUBS) export INCDIRS -opam-lib.byte: client/opamGitVersion.ml +opam-lib.byte: $(MAKE) $(OPAMLIB:=.cma) -opam-lib.native: client/opamGitVersion.ml +opam-lib.native: $(MAKE) $(OPAMLIB:=.cmxa) opam-lib: opam-lib.byte $(if $(USE_BYTE),,opam-lib.native) opam-admin.top @@ -133,10 +131,6 @@ opam-repository.cma: opam-core.cma opam-format.cma ALWAYS opam-repository.cmxa: opam-core.cmxa opam-format.cmxa ALWAYS SRC_format = \ - opamParserTypes.mli \ - opamParser.mly \ - opamLexer.mll \ - opamPrinter.ml \ opamFormatConfig.ml \ opamLineLexer.mll \ opamRepositoryName.ml \ @@ -296,7 +290,7 @@ export PROJ_opam-admin define PROJ_opam-installer SOURCES = tools/opam_installer.ml RESULT = opam-installer - LIBS = $(LIBS) $(OPAMLIB) + LIBS = $(LIBS) opam-core opam-format opam-state endef export PROJ_opam-installer @@ -333,7 +327,7 @@ define lib_inst_files .cma .cmxa .a .cmi .cmo .cmx .cmxs .cmti)) endef -../opam-%.install: +../opam-%.install: opam-%$(LIBEXT) @echo 'lib: [' >$@ @echo ' "src/$*.META" {"META"}' >>$@ @{ $(patsubst %,echo ' "src/'%'"';,$(call lib_inst_files,$*)) } >>$@ @@ -349,8 +343,7 @@ endef @echo ' "src/opam-admin.top"' >>$@ @echo ']' >>$@ -# Older, all-inclusive opam-lib with ocamlfind sub-packages (still used by 'make -# libinstall') +# Older, all-inclusive opam-lib with ocamlfind sub-packages ../opam-lib.install: $(OPAMLIB:=.cma) @echo 'lib: [' >$@ @echo ' "META"' >>$@ @@ -387,7 +380,6 @@ clean-aux: rm -f client/opamGitVersion.ml state/opamScript.ml core/opamCompat.ml core/opamCompat.mli ../opam-lib.install rm -f */*Parser.ml */*Parser.mli */*Lexer.ml rm -f $(foreach e,o cmo cmx cmxs cmi cmt cmti,$(wildcard */*.$e)) - rm -f *.META clean: clean-aux diff --git a/src/format/opamLexer.mli b/src/core/opamSHA.mli similarity index 61% rename from src/format/opamLexer.mli rename to src/core/opamSHA.mli index 9e659973abe..7b4929b13b4 100644 --- a/src/format/opamLexer.mli +++ b/src/core/opamSHA.mli @@ -1,7 +1,6 @@ (**************************************************************************) (* *) -(* Copyright 2012-2015 OCamlPro *) -(* Copyright 2012 INRIA *) +(* 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 *) @@ -9,19 +8,11 @@ (* *) (**************************************************************************) -(** OPAM config file lexer *) +(** Pure OCaml implementation of SHA256/512 hashing functions. Functions take a + filename and return the hash as an hex string. *) -open OpamParserTypes +val sha256: string -> string -exception Error of string +val sha512: string -> 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 -> OpamParser.token +val hash: [< `SHA256 | `SHA512 ] -> string -> string diff --git a/src/format.META.in b/src/format.META.in index 7f0387ca911..780011e7059 100644 --- a/src/format.META.in +++ b/src/format.META.in @@ -2,4 +2,4 @@ version = "@PACKAGE_VERSION@" description = "OCaml Package Manager file format handling library" archive(byte) = "opam-format.cma" archive(native) = "opam-format.cmxa" -requires = "re.pcre, opam-core" +requires = "re.pcre, opam-core, opam-file-format" diff --git a/src/format/format.ocp b/src/format/format.ocp index 335497377b7..2750091489f 100644 --- a/src/format/format.ocp +++ b/src/format/format.ocp @@ -5,10 +5,6 @@ then { begin library "opam-format" sort = false files = [ - "opamParserTypes.mli" - "opamParser.mly" - "opamLexer.mll" - "opamPrinter.ml" "opamFormatConfig.ml" "opamSwitch.ml" "opamPackage.ml" @@ -25,6 +21,7 @@ begin library "opam-format" ] requires = [ + "opam-file-format" "opam-core" "re.pcre" ] diff --git a/src/format/opamLexer.mll b/src/format/opamLexer.mll deleted file mode 100644 index 69bcfd2801d..00000000000 --- a/src/format/opamLexer.mll +++ /dev/null @@ -1,165 +0,0 @@ -(**************************************************************************) -(* *) -(* 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 OpamParser - -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'] { () } diff --git a/src/format/opamParser.mly b/src/format/opamParser.mly deleted file mode 100644 index afe686abe94..00000000000 --- a/src/format/opamParser.mly +++ /dev/null @@ -1,113 +0,0 @@ -/**************************************************************************/ -/* */ -/* 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 IDENT -%token BOOL -%token EOF -%token LBRACKET RBRACKET -%token LPAR RPAR -%token LBRACE RBRACE -%token COLON -%token INT -%token RELOP -%token AND -%token OR -%token PFXOP -%token ENVOP - -%left COLON -%left ATOM -%left AND -%left OR -%nonassoc ENVOP -%nonassoc PFXOP -%left LBRACE RBRACE -%nonassoc RELOP -%nonassoc URELOP - -%start main value -%type OpamParserTypes.opamfile> main -%type 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 diff --git a/src/format/opamParserTypes.mli b/src/format/opamParserTypes.mli deleted file mode 100644 index bc5466dcaac..00000000000 --- a/src/format/opamParserTypes.mli +++ /dev/null @@ -1,53 +0,0 @@ -(**************************************************************************) -(* *) -(* 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 ] - -(** Source file positions: filename, line, column *) -type pos = string * 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 : string; -} - diff --git a/src/format/opamPrinter.ml b/src/format/opamPrinter.ml deleted file mode 100644 index 7027b085ce2..00000000000 --- a/src/format/opamPrinter.ml +++ /dev/null @@ -1,213 +0,0 @@ -(**************************************************************************) -(* *) -(* 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 "@[%a %s@ %a@]" - format_value l (relop op) format_value r - | Logop (_,op,l,r) -> - Format.fprintf fmt "@[%a %s@ %a@]" - format_value l (logop op) format_value r - | Pfxop (_,op,r) -> - Format.fprintf fmt "@[%s%a@]" (pfxop op) format_value r - | Prefix_relop (_,op,r) -> - Format.fprintf fmt "@[%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 "@[[@;<0 2>@[%a@]@,]@]" format_values l - | Group (_,g) -> Format.fprintf fmt "@[(%a)@]" format_values g - | Option(_,v,l) -> Format.fprintf fmt "@[%a@ {@[%a@]}@]" - format_value v format_values l - | Env_binding (_,id,op,v) -> - Format.fprintf fmt "@[%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 "@[%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 "@[%s: [@;<0 2>@[%a@]@,]@]" - i format_values l - else Format.fprintf fmt "@[%s: [@;<0 2>@[%a@]@,]@]" - i format_values l - | Variable (_, i, (String (_,s) as v)) when String.contains s '\n' -> - Format.fprintf fmt "@[%s: %a@]" i format_value v - | Variable (_, i, v) -> - Format.fprintf fmt "@[%s:@ %a@]" i format_value v - | Section (_,s) -> - Format.fprintf fmt "@[%s %s{@;<0 2>@[%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" -end - diff --git a/src/format/opamPrinter.mli b/src/format/opamPrinter.mli deleted file mode 100644 index 33264d5c9ff..00000000000 --- a/src/format/opamPrinter.mli +++ /dev/null @@ -1,43 +0,0 @@ -(**************************************************************************) -(* *) -(* 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 : OpamTypes.value -> string - val item : OpamTypes.opamfile_item -> string - val item_order : OpamTypes.opamfile_item -> OpamTypes.opamfile_item -> int - val items : OpamTypes.opamfile_item list -> string -end - diff --git a/src_ext/Makefile b/src_ext/Makefile index ef9ad0e5ebb..5ea2e3bb098 100644 --- a/src_ext/Makefile +++ b/src_ext/Makefile @@ -1,6 +1,6 @@ -include ../Makefile.config -SRC_EXTS = cppo extlib re cmdliner graph cudf dose uutf jsonm +SRC_EXTS = cppo extlib re cmdliner graph cudf dose uutf jsonm opam-file-format URL_cppo = http://mjambon.com/releases/cppo/cppo-1.1.2.tar.gz MD5_cppo = f1a551639c0c667ee8840d95ea5b2ab7 @@ -29,6 +29,9 @@ MD5_uutf = 708c0421e158b390c7cc341f37b40add URL_jsonm = http://erratique.ch/software/jsonm/releases/jsonm-0.9.1.tbz MD5_jsonm = 631a5dabdada83236c83056f60e42685 +URL_opam-file-format = https://github.com/ocaml/opam-file-format/archive/2.0-alpha5.tar.gz +MD5_opam-file-format = 2ccdf87e2bd8ed8541dda1d3369b3199 + ARCHIVES = $(foreach lib,$(SRC_EXTS),$(notdir $(URL_$(lib)))) lib_of = $(foreach lib,$(SRC_EXTS),$(if $(findstring $(1),$(URL_$(lib))),$(lib),,)) @@ -105,13 +108,13 @@ clean: $(MAKE) -f $(OCAMLMAKEFILE) subprojs SUBTARGET=cleanup distclean: - rm -rf cudf extlib re graph dose cmdliner uutf jsonm + rm -rf cudf extlib re graph dose cmdliner uutf jsonm opam-file-format rm -f depends.ocp rm -f *.tar.gz *.tbz *.stamp rm -f *.cm* *.o *.a *.lib rm -rf lib -LIB_EXTS = extlib re cmdliner graph cudf dose_common dose_versioning dose_pef dose_opam dose_algo uutf jsonm +LIB_EXTS = extlib re cmdliner graph cudf dose_common dose_versioning dose_pef dose_opam dose_algo uutf jsonm opam-file-format inst_objs = cp $(1)/*.cm*i lib @@ -129,6 +132,7 @@ copy: build $(call inst_objs,dose/algo) $(call inst_objs,uutf/src) $(call inst_objs,jsonm/src) + $(call inst_objs,opam-file-format/src) $(call inst_objs,.) # -- @@ -267,6 +271,19 @@ define PROJ_jsonm endef export PROJ_jsonm +SRC_opam-file-format = \ + opamParserTypes.mli \ + opamLexer.mli opamLexer.mll \ + opamParser.mly \ + opamPrinter.mli opamPrinter.ml + +define PROJ_opam-file-format + SOURCES = $(call addmli,opam-file-format/src,$(SRC_opam-file-format)) + RESULT = opam-file-format + LIB_PACK_NAME = +endef +export PROJ_opam-file-format + # -- ifndef SUBROJS