l4/pkg/ocaml/contrib/ocamlbuild/lexers.mll

   1 (***********************************************************************)
   2 (*                             ocamlbuild                              *)
   3 (*                                                                     *)
   4 (*  Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
   5 (*                                                                     *)
   6 (*  Copyright 2007 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12
  13 (* Original author: Nicolas Pouillard *)
  14 {
  15 exception Error of string
  16 open Glob_ast
  17
  18 type conf_values =
  19   { plus_tags   : string list;
  20     minus_tags  : string list;
  21     plus_flags  : (string * string) list;
  22     minus_flags : (string * string) list }
  23
  24 type conf = (Glob.globber * conf_values) list
  25
  26 let empty = { plus_flags = []; minus_flags = []; plus_tags = []; minus_tags = [] }
  27 }
  28
  29 let newline = ('\n' | '\r' | "\r\n")
  30 let space = [' ' '\t' '\012']
  31 let space_or_esc_nl = (space | '\\' newline)
  32 let blank = newline | space
  33 let not_blank = [^' ' '\t' '\012' '\n' '\r']
  34 let not_space_nor_comma = [^' ' '\t' '\012' ',']
  35 let not_newline = [^ '\n' '\r' ]
  36 let not_newline_nor_colon = [^ '\n' '\r' ':' ]
  37 let normal_flag_value = [^ '(' ')' '\n' '\r']
  38 let normal = [^ ':' ',' '(' ')' ''' ' ' '\n' '\r']
  39 let tag = normal+ | ( normal+ ':' normal+ )
  40 let flag_name = normal+
  41 let flag_value = normal_flag_value+
  42 let variable = [ 'a'-'z' 'A'-'Z' '_' '-' '0'-'9' ]*
  43 let pattern = ([^ '(' ')' '\\' ] | '\\' [ '(' ')' ])*
  44
  45 rule ocamldep_output = parse
  46   | ([^ ':' '\n' '\r' ]+ as k) ':' { let x = (k, space_sep_strings_nl lexbuf) in x :: ocamldep_output lexbuf }
  47   | eof { [] }
  48   | _ { raise (Error "Expecting colon followed by space-separated module name list") }
  49
  50 and space_sep_strings_nl = parse
  51   | space* (not_blank+ as word) { word :: space_sep_strings_nl lexbuf }
  52   | space* newline { [] }
  53   | _ { raise (Error "Expecting space-separated strings terminated with newline") }
  54
  55 and space_sep_strings = parse
  56   | space* (not_blank+ as word) { word :: space_sep_strings lexbuf }
  57   | space* newline? eof { [] }
  58   | _ { raise (Error "Expecting space-separated strings") }
  59
  60 and blank_sep_strings = parse
  61   | blank* '#' not_newline* newline { blank_sep_strings lexbuf }
  62   | blank* '#' not_newline* eof { [] }
  63   | blank* (not_blank+ as word) { word :: blank_sep_strings lexbuf }
  64   | blank* eof { [] }
  65   | _ { raise (Error "Expecting blank-separated strings") }
  66
  67 and comma_sep_strings = parse
  68   | space* (not_space_nor_comma+ as word) space* eof { [word] }
  69   | space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf }
  70   | space* eof { [] }
  71   | _ { raise (Error "Expecting comma-separated strings (1)") }
  72 and comma_sep_strings_aux = parse
  73   | space* ',' space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf }
  74   | space* eof { [] }
  75   | _ { raise (Error "Expecting comma-separated strings (2)") }
  76
  77 and comma_or_blank_sep_strings = parse
  78   | space* (not_space_nor_comma+ as word) space* eof { [word] }
  79   | space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
  80   | space* eof { [] }
  81   | _ { raise (Error "Expecting (comma|blank)-separated strings (1)") }
  82 and comma_or_blank_sep_strings_aux = parse
  83   | space* ',' space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
  84   | space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
  85   | space* eof { [] }
  86   | _ { raise (Error "Expecting (comma|blank)-separated strings (2)") }
  87
  88 and colon_sep_strings = parse
  89   | ([^ ':']+ as word) eof { [word] }
  90   | ([^ ':']+ as word) { word :: colon_sep_strings_aux lexbuf }
  91   | eof { [] }
  92   | _ { raise (Error "Expecting colon-separated strings (1)") }
  93 and colon_sep_strings_aux = parse
  94   | ':'+ ([^ ':']+ as word) { word :: colon_sep_strings_aux lexbuf }
  95   | eof { [] }
  96   | _ { raise (Error "Expecting colon-separated strings (2)") }
  97
  98 and conf_lines dir pos err = parse
  99   | space* '#' not_newline* newline { conf_lines dir (pos + 1) err lexbuf }
 100   | space* '#' not_newline* eof { [] }
 101   | space* newline { conf_lines dir (pos + 1) err lexbuf }
 102   | space* eof { [] }
 103   | space* (not_newline_nor_colon+ as k) space* ':' space*
 104       {
 105         let bexpr = Glob.parse ?dir k in
 106         let v1 = conf_value pos err empty lexbuf in
 107         let v2 = conf_values pos err v1 lexbuf in
 108         let rest = conf_lines dir (pos + 1) err lexbuf in (bexpr, v2) :: rest
 109       }
 110   | _ { raise (Error(Printf.sprintf "Bad key in configuration line at line %d (from %s)" pos err)) }
 111
 112 and conf_value pos err x = parse
 113   | '-'  (flag_name as t1) '(' (flag_value as t2) ')' { { (x) with minus_flags = (t1, t2) :: x.minus_flags } }
 114   | '+'? (flag_name as t1) '(' (flag_value as t2) ')' { { (x) with plus_flags = (t1, t2) :: x.plus_flags } }
 115   | '-'  (tag as tag) { { (x) with minus_tags = tag :: x.minus_tags } }
 116   | '+'? (tag as tag) { { (x) with plus_tags = tag :: x.plus_tags } }
 117   | (_ | eof) { raise (Error(Printf.sprintf "Bad value in configuration line at line %d (from %s)" pos err)) }
 118
 119 and conf_values pos err x = parse
 120   | space_or_esc_nl* ',' space_or_esc_nl* { conf_values pos err (conf_value pos err x lexbuf) lexbuf }
 121   | (newline | eof) { x }
 122   | (_ | eof) { raise (Error(Printf.sprintf "Bad values in configuration line at line %d (from %s)" pos err)) }
 123
 124 and path_scheme patt_allowed = parse
 125   | ([^ '%' ]+ as prefix)
 126       { `Word prefix :: path_scheme patt_allowed lexbuf }
 127   | "%(" (variable as var) ')'
 128       { `Var (var, Bool.True) :: path_scheme patt_allowed lexbuf }
 129   | "%(" (variable as var) ':' (pattern as patt) ')'
 130       { if patt_allowed then
 131           let patt = My_std.String.implode (unescape (Lexing.from_string patt)) in
 132           `Var (var, Glob.parse patt) :: path_scheme patt_allowed lexbuf
 133         else raise (Error(
 134           Printf.sprintf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)"
 135             var patt)) }
 136   | '%'
 137       { `Var ("", Bool.True) :: path_scheme patt_allowed lexbuf }
 138   | eof
 139       { [] }
 140   | _ { raise (Error("Bad pathanme scheme")) }
 141
 142 and unescape = parse
 143   | '\\' (['(' ')'] as c)        { c :: unescape lexbuf }
 144   | _ as c                       { c :: unescape lexbuf }
 145   | eof                          { [] }