(* Copyright (C) 1999-2000 Samuel Thibault This program is free software : you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation ; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY ; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with the program ; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. This License should be available in the same directory as this program, in a file called COPYING. If not, you may ask the webmaster or ftpmaster *) type expr= Symbole of char | Alternative of expr * expr | Sequence of expr * expr | Etoile of expr;; let a=Etoile(Alternative(Symbole `a`, Symbole `b`));; let rec print_expr=function Symbole c->print_char c |Alternative (e1,e2)->print_char `(`; print_expr e1; print_char `|`; print_expr e2; print_char `)` |Sequence (e1,e2)->print_char `(`; print_expr e1; print_char `:`; print_expr e2; print_char `)` |Etoile e->print_expr e; print_char `*`;; let rec format_print_expr=function Symbole c->format__print_char c |Alternative (e1,e2)->format__print_char `(`; format_print_expr e1; format__print_char `|`; format_print_expr e2; format__print_char `)` |Sequence (e1,e2)->format__print_char `(`; format_print_expr e1; format__print_char `:`; format_print_expr e2; format__print_char `)` |Etoile e->format_print_expr e; format__print_char `*`;; install_printer "format_print_expr";; exception SyntaxError;; let convert s= let rec expression i j= match j-i with -1->raise SyntaxError |0->(match s.[i] with `(` | `)` | `:` | `|` | `*` -> raise SyntaxError |c->Symbole c) |_-> let pos=ref (-1) and numpar=ref 0 and alter=ref false and k=ref (i-1) in while !kincr numpar |`)`->decr numpar |`|`->if !numpar=0 then (alter:=true;pos:=!k) |`:`->if !numpar=0 then pos:=!k |_->() done; if !pos>=0 then ( let e1,e2=expression i (!pos-1),expression (!pos+1) j in if !alter then Alternative (e1,e2) else Sequence (e1,e2) ) else if s.[j]=`*` then Etoile (expression i (j-1)) else if s.[i]=`(` & s.[j]=`)` then expression (i+1) (j-1) else raise SyntaxError in expression 0 (string_length s - 1 );; let pars s= let rec parss i j= match j-i with -1->raise SyntaxError |0->(match s.[i] with `(` | `)` | `:` | `|` | `*` -> raise SyntaxError |c->string_of_char c) |_-> let pos=ref (-1) and numpar=ref 0 and alter=ref false and k=ref (i-1) in while !kincr numpar |`)`->decr numpar |`|`->if !numpar=0 then (alter:=true;pos:=!k) |`:`->if !numpar=0 then pos:=!k |_->() done; if !pos >= 0 then ( "(" ^ parss i (!pos-1) ^ (if !alter then "|" else ":") ^ parss (!pos+1) j ^ ")" ) else if s.[j]=`*` then parss i (j-1) ^ "*" else if s.[i]=`(` & s.[j]=`)` then parss (i+1) (j-1) else raise SyntaxError in parss 0 (string_length s-1);; let conv s= try let pileop=ref [] and pileexpr=ref [] and numpar=ref 0 in let empile a p= p:=a::!p and depile p=let a=hd !p in p:= tl !p ; a in for i=0 to string_length s-1 do match s.[i] with `(`->incr numpar |`|`|`:` as c->empile c pileop |`)`->decr numpar; let c=depile pileop and e2=depile pileexpr and e1=depile pileexpr in if c=`|` then empile (Alternative (e1,e2)) pileexpr else empile (Sequence (e1,e2)) pileexpr |`*`->let e1=depile pileexpr in empile (Etoile e1) pileexpr |c->empile (Symbole c) pileexpr done; if !pileop<>[] then raise SyntaxError; if !numpar<>0 then raise SyntaxError; match !pileexpr with [e]->e with Failure "hd"|Failure "tl"|Match_failure _->raise SyntaxError ;; let convert2 s= conv (pars s);; convert2 "(a|b)";;