home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / grep / expr.ml < prev    next >
Encoding:
Text File  |  1995-06-01  |  1.9 KB  |  62 lines  |  [TEXT/MPS ]
  1. let intervalle c1 c2 =
  2.   let rec interv n1 n2 =
  3.     if n1 > n2 then [] else char_of_int n1 :: interv (n1 + 1) n2 in
  4.   interv (int_of_char c1) (int_of_char c2);;
  5.  
  6. let tous_car = intervalle `\000` `\255`;;
  7. let rec lire_expr = function
  8.     [< lire_séq r1; (lire_alternative r1) r2 >] -> r2
  9.  
  10. and lire_alternative r1 = function
  11.     [< '`|`; lire_expr r2 >] -> Alternative(r1,r2)
  12.   | [< >] -> r1
  13.  
  14. and lire_séq = function
  15.     [< lire_répét r1; (lire_fin_séq r1) r2 >] -> r2
  16.  
  17. and lire_fin_séq r1 = function
  18.     [< lire_séq r2 >] -> Séquence(r1,r2)
  19.   | [< >] -> r1
  20.  
  21. and lire_répét = function
  22.     [< lire_simple r1; (lire_fin_répét r1) r2 >] -> r2
  23.  
  24. and lire_fin_répét r1 = function
  25.     [< '`*` >] -> Répétition r1
  26.   | [< '`+` >] -> Séquence(r1, Répétition r1)
  27.   | [< '`?` >] -> Alternative(r1, Epsilon)
  28.   | [< >] -> r1
  29.  
  30. and lire_simple = function
  31.     [< '`.` >] -> Caractères tous_car
  32.   | [< '`[`; lire_classe cl >] -> Caractères cl
  33.   | [< '`(`; lire_expr r; '`)` >] -> r
  34.   | [< '`\\`; 'c >] -> Caractères [c]
  35.   | [< (stream_check (function c -> c<>`|` & c<>`)` & c<>`$`)) c >] ->
  36.       Caractères [c]
  37.  
  38. and lire_classe = function
  39.       [< '`^`; lire_ensemble cl >] -> subtract tous_car cl
  40.     | [< lire_ensemble cl >] -> cl
  41.  
  42. and lire_ensemble = function
  43.     [< '`]` >] -> []
  44.   | [< lire_car c1; (lire_intervalle c1) c2 >] -> c2
  45.  
  46. and lire_intervalle c1 = function
  47.     [< '`-`; lire_car c2; lire_ensemble reste >] ->
  48.         union (intervalle c1 c2) reste
  49.   | [< lire_ensemble reste >] -> union [c1] reste
  50.  
  51. and lire_car = function
  52.     [< '`\\`; 'c >] -> c
  53.   | [< 'c >] -> c;;
  54. let lire = function
  55.   [< (function [< '`^` >] -> true | [< >] -> false) chapeau;
  56.      lire_expr r;
  57.      (function [< '`$` >] -> true | [< >] -> false) dollar >] ->
  58.   let r1 = if dollar then r else
  59.              Séquence(r, Répétition(Caractères tous_car)) in
  60.   if chapeau then r1 else
  61.     Séquence(Répétition(Caractères tous_car), r1);;
  62.