matita/matita/contribs/lambdadelta/bin/recomm/recommLexer.mll

   1 {
   2   module EP = RecommParser
   3
   4   let debug = ref false
   5
   6   let keys = [|
   7     "Note";
   8   |]
   9
  10   let heads = [|
  11     "Advanved";
  12     "Basic";
  13     "Forward";
  14     "Destructions";
  15     "Eliminations";
  16     "Eliminators";
  17     "Inversion";
  18     "Inversions";
  19     "Main";
  20     "Properties";
  21   |]
  22
  23   let str c = String.make 1 c
  24
  25   let nl lexbuf = Lexing.new_line lexbuf
  26
  27   let is_uppercase_ascii s =
  28     let rec aux i =
  29        if i < 0 then true else
  30        if 'a' <= s.[i] && s.[i] <= 'z' then false else
  31        aux (pred i)
  32     in
  33     aux (String.length s - 1)
  34
  35   let disambiguate_word s =
  36     if is_uppercase_ascii s then EP.CW s else
  37     if Array.mem s keys then EP.KW s else
  38     if Array.mem s heads then EP.HW s else
  39     EP.SW s
  40
  41   let log s =
  42     if !debug then Printf.eprintf "lezer: %s\n" s
  43
  44   let log_s s =
  45     if !debug then Printf.eprintf "lexer: %S\n" s
  46
  47   let log_c c =
  48     if !debug then Printf.eprintf "lexer: %C\n" c
  49 }
  50
  51 let CR = "\r"
  52 let SP = " "
  53 let NL = "\n"
  54 let SR = "*"
  55 let OP = "(*" SP*
  56 let CP = SR* "*)"
  57 let PP = CP SP* OP
  58 let WF = ['A'-'Z' 'a'-'z']
  59 let WB = ['A'-'Z' 'a'-'z' '_' '-']*
  60 let WD = WF WB
  61
  62 rule src_token = parse
  63   | CR       { src_token lexbuf                   }
  64   | NL  as c { log "NL"; nl lexbuf; EP.NL (str c) }
  65   | SP+ as s { log "SP"; EP.SP s                  }
  66   | PP  as s { log "PP"; EP.PP s                  }
  67   | OP  as s { log "OP"; EP.OP s                  }
  68   | CP  as s { log "CP"; EP.CP s                  }
  69   | SR  as c { log "SR"; EP.SR (str c)            }
  70   | WD  as s { log_s s ; disambiguate_word s      }
  71   | _   as c { log_c c ; EP.OT (str c)            }
  72   | eof      { log "EF"; EP.EF                    }