ocamlbuild/glob_lexer.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 (* $Id: glob_lexer.mll,v 1.1.4.3 2007-11-21 21:02:58 ertai Exp $ *)
  13 (* Original author: Berke Durak *)
  14 (* Glob *)
  15 {
  16 open Bool;;
  17 open Glob_ast;;
  18
  19 type token =
  20 | ATOM of pattern atom
  21 | AND
  22 | OR
  23 | NOT
  24 | LPAR
  25 | RPAR
  26 | TRUE
  27 | FALSE
  28 | EOF
  29 ;;
  30
  31 let sf = Printf.sprintf;;
  32
  33 let concat_patterns p1 p2 =
  34   match (p1,p2) with
  35   | (Epsilon,_) -> p2
  36   | (_,Epsilon) -> p1
  37   | (_,_)       -> Concat(p1,p2)
  38 ;;
  39
  40 let slash = Class(Atom('/','/'));;
  41 let not_slash = Class(Not(Atom('/','/')));;
  42 let any = Class True;;
  43 }
  44
  45 let pattern_chars = ['a'-'z']|['A'-'Z']|'_'|'-'|['0'-'9']|'.'
  46 let space_chars = [' ' '\t' '\n' '\r' '\012']
  47
  48 rule token = parse
  49 | '<'             { ATOM(Pattern(let (p,_) = parse_pattern ['>'] Epsilon lexbuf in p)) }
  50 | '"'             { ATOM(Constant(parse_string (Buffer.create 32) lexbuf)) }
  51 | "and"|"AND"|"&" { AND }
  52 | "or"|"OR"|"|"   { OR }
  53 | "not"|"NOT"|"~" { NOT }
  54 | "true"|"1"      { TRUE }
  55 | "false"|"0"     { FALSE }
  56 | "("             { LPAR }
  57 | ")"             { RPAR }
  58 | space_chars+    { token lexbuf }
  59 | eof             { EOF }
  60
  61 and parse_pattern eof_chars p = parse
  62 | (pattern_chars+ as u) { parse_pattern eof_chars (concat_patterns p (Word u)) lexbuf }
  63 | '{'
  64   {
  65     let rec loop pl =
  66       let (p',c) = parse_pattern ['}';','] Epsilon lexbuf in
  67       let pl = p' :: pl in
  68       if c = ',' then
  69         loop pl
  70       else
  71         parse_pattern eof_chars (concat_patterns p (Union pl)) lexbuf
  72     in
  73     loop []
  74   }
  75 | "[^"
  76   {
  77     let cl = Not(Or(parse_class [] lexbuf)) in
  78     parse_pattern eof_chars (concat_patterns p (Class cl)) lexbuf
  79   }
  80 | '['
  81   {
  82     let cl = Or(parse_class [] lexbuf) in
  83     parse_pattern eof_chars (concat_patterns p (Class cl)) lexbuf
  84   }
  85 (* Random thought... **/* seems to be equal to True *)
  86 | "/**/" (* / | /\Sigma^*/ *)
  87   { let q = Union[slash; Concat(slash, Concat(Star any, slash)) ] in
  88     parse_pattern eof_chars (concat_patterns p q) lexbuf }
  89 | "/**" (* \varepsilon | /\Sigma^* *)
  90   { let q = Union[Epsilon; Concat(slash, Star any)] in
  91     parse_pattern eof_chars (concat_patterns p q) lexbuf }
  92 | "**/" (* \varepsilon | \Sigma^*/ *)
  93   { let q = Union[Epsilon; Concat(Star any, slash)] in
  94     parse_pattern eof_chars (concat_patterns p q) lexbuf }
  95 | "**" { raise (Parse_error("Ambiguous ** pattern not allowed unless surrounded by one or more slashes")) }
  96 | '*' { parse_pattern eof_chars (concat_patterns p (Star not_slash)) lexbuf }
  97 | '/' { parse_pattern eof_chars (concat_patterns p slash) lexbuf }
  98 | '?' { parse_pattern eof_chars (concat_patterns p not_slash) lexbuf }
  99 | _ as c
 100   { if List.mem c eof_chars then
 101       (p,c)
 102     else
 103       raise (Parse_error(sf "Unexpected character %C in glob pattern" c))
 104   }
 105
 106 and parse_string b = parse
 107 | "\""                  { Buffer.contents b }
 108 | "\\\""                { Buffer.add_char b '"'; parse_string b lexbuf }
 109 | [^'"' '\\']+ as u     { Buffer.add_string b u; parse_string b lexbuf }
 110 | _ as c                { raise (Parse_error(sf "Unexpected character %C in string" c)) }
 111
 112 and parse_class cl = parse
 113 | ']'                     { cl }
 114 | "-]"                    { ((Atom('-','-'))::cl) }
 115 | (_ as c1) '-' (_ as c2) { parse_class ((Atom(c1,c2))::cl) lexbuf }
 116 | _ as c                  { parse_class ((Atom(c,c))::cl) lexbuf }