(*============================================================================
             Bibliotheque de fonctions pour l'enseignement 
                    "EXPRESSION FONCTIONNELLE"
==============================================================================
Version 1.3 :	22 jan 02	puitg@imag.fr
  ajout de la fonction charlist_of_string pour un traitement unifié des string
  comme séquences de caractères

Version 1.2 :	08 dec 99	jmfavre@imag.fr
  ajout de la fonction  puissance
  (elle existe sur les reels maisi avec deux parametres) 

Version 1.1 :	04 dec 99	jmfavre@imag.fr   
  reorganisation du fichier
  ajout du traitement des exceptions dans certaines fonctions
  les accents posent des problemes, ils ont ete enleves.

Version 1.0 :	20 nov 99	Pierre-Claude.Scholl@imag.fr   
  version initiale
============================================================================*)

(*----------------------------------------------------------------------------
                      FONCTIONS SUR LES ENTIERS
----------------------------------------------------------------------------*)

(* puissance : un entier, un entier positif ou nul -> un entier *)
let rec (puissance : int * int -> int) = function
   (x,n) ->
     if n<0 then 
        failwith "puissance : le deuxieme parametre doit etre positif ou nul"
     else if n=0 then 1
     else (puissance(x,n-1))*x ;;


(*----------------------------------------------------------------------------
                      FONCTIONS SUR LES SEQUENCES
----------------------------------------------------------------------------*)

(*----------------------------- Constructeurs ------------------------------*)
let rec (ajd : 'Elt list * 'Elt -> 'Elt list) = function
          ([],x) -> [x]
     |    (p::f,x) -> p::ajd(f,x);;

(*-------------------------------- Testeurs --------------------------------*)
let (EstVide : 'Elt list -> bool) = function
      s -> (s = []);;


(*-------------------------------- Selecteurs ------------------------------*)

(*--- Decoupage selon le premier element*)
let (premier : 'Elt list -> 'Elt) = function
      s -> if EstVide(s) 
           then failwith "premier : la sequence doit etre non vide"
           else hd(s) ;;
let (fin : 'Elt list -> 'Elt list) = function
      s -> if EstVide(s) 
           then failwith "fin : la sequence doit etre non vide"
           else tl(s) ;;

(*--- Decoupage selon le dernier element*)
let rec (dernier : 'Elt list -> 'Elt) = function
          [] -> failwith "dernier : la sequence doit etre non vide"
     |    [e] -> e
     |    p::f -> dernier(f);;
let rec (debut : 'Elt list -> 'Elt list) = function
          [] -> failwith "debut : la sequence doit etre non vide"
     |    [e] -> []
     |    p::f -> p::debut(f);;

(*----------------------------------------------------------------------------
                       FONCTIONS SUR LES TEXTES

Un texte est une séquence de caractères. On utilise donc les fonctions sur les
séquences. Comme il est assez pénible de saisir
[`u`;`n`;` `;`e`;`x`;`e`;`m`;`p`;`l`;`e`], on fournit la fonction utilitaire
suivante qui convertit une chaîne en séquence de caractères :
----------------------------------------------------------------------------*)

type texte == char list;;

(* conversion d'un texte en string *)
let rec (texte_vers_string : texte -> string) = function
    []   -> ""
  | c::s -> (string_of_char c) ^ texte_vers_string s
;;

(* synonyme plus rapide à taper *)
let tvs = texte_vers_string ;;

(* conversion d'une string en texte *)
let (string_vers_texte : string -> texte) =
  (* conversion un char stream en texte *)
  let rec (charstream_vers_texte : char stream -> texte) = function
      [< 'c ; charstream_vers_texte l >] -> c::l
    | [<  >]            -> []
  in
  function str -> charstream_vers_texte (stream_of_string str)
;;

(* synonyme plus rapide à taper *)
let svt = string_vers_texte ;;


(* pretty-printer pour les charlist
   pédagogiquement, vaut mieux ne pas le mettre
let (charlist_pp : texte -> unit) = function
    cl -> format__open_box 1;
          print_char `"` ; print_string(texte_vers_string cl) ; print_char `"` ;
          format__close_box();
          print_newline()
;;
*)

(*
#premier [`c`;`'`;`e`;`s`;`t`;` `;`b`;`e`;`a`;`u`];;
- : char = `c`
#fin [`c`;`'`;`e`;`s`;`t`;` `;`b`;`e`;`a`;`u`];;
- : char list = [`'`; `e`; `s`; `t`; ` `; `b`; `e`; `a`; `u`]
#premier (string_vers_texte "c'est beau");;
- : char = `c`
#fin (string_vers_texte "c'est beau");;
- : char list = [`'`; `e`; `s`; `t`; ` `; `b`; `e`; `a`; `u`]
#tvs(fin (string_vers_texte "c'est beau"));;
- : string = "'est beau"
#`c`::(string_vers_texte "'est beau");;
ajd(string_vers_texte "c'est bea",`u`);;
*)

    (*utilitaire prive*)
    let (ieme_tx : string * int -> char) = function
      (*precondition pour ieme_tx(t, n) : 1 <= n et n <= longueur(t)*)
      (t,n) ->  if n >= 1 && n <= string_length (t) then nth_char t (n-1)
                else failwith "ieme_tx : l'indice est hors des bornes" ;;

(*----------------------------- Constructeurs ------------------------------*)
(* texte vide*)
let txVide = "";;
(* singleton*)
let (txSingle : char -> string) = function
          c -> make_string 1 c;; (* ou let txSingle = string_of_char *)
(* ajout d'un caractere a droite ou a gauche *)
let (ajg_tx : char * string -> string)= function
          (c,t) -> txSingle(c)^t;;
let (ajd_tx : string * char -> string) = function
          (t,c) -> t^txSingle(c);;

(*-------------------------------- Testeurs --------------------------------*)
let (EstVide_tx : string -> bool) = function
          t -> (string_length(t) = 0);;

(*-------------------------------- Selecteurs ------------------------------*)

(* Decoupage selon le premier caractere*)
let (pre_tx  : string -> char) = function
(*precondition texte donne non vide*)
          t -> if not(EstVide_tx(t)) then ieme_tx(t,1)
                    else failwith "pre_tx : le texte doit etre non vide";;
let (fin_tx : string -> string) = function
(*precondition texte donne non vide*)
          t -> if not(EstVide_tx(t)) then sub_string t 1 (string_length(t)-1)
                    else failwith "fin_tx : le texte doit etre non vide";;

(*Decoupage selon le dernier caractere*)
let (der_tx : string -> char) = function
(*precondition texte donne non vide*)
          t -> if not EstVide_tx(t) then ieme_tx(t, string_length(t))
                    else failwith "der_tx : le texte doit etre non vide";;
let (deb_tx : string -> string) = function
          t -> if not EstVide_tx(t) then sub_string t 0 (string_length(t)-1)
                    else failwith "deb_tx : le texte doit etre non vide";;

(*----------------------------------------------------------------------------
                TYPE ET FONCTIONS SUR LES ARBRES BINAIRES
----------------------------------------------------------------------------*)

(*----------------------------- Constructeurs ------------------------------*)
type 'Elt ArBin =
       abV                                        (*arbre vide *)
     | abNV of ('Elt ArBin)*'Elt*('Elt ArBin);;   (*arbres non vides*)

let (abS : 'Elt -> 'Elt ArBin) = function
       r -> abNV(abV,r,abV);;
let (abG : 'Elt ArBin * 'Elt -> 'Elt ArBin) = function
       (g,r) -> abNV(g,r,abV);;
let (abD : 'Elt * 'Elt ArBin -> 'Elt ArBin) = function 
       (r,d) -> abNV(abV,r,d);;

(*-------------------------------- Selecteurs ------------------------------*)
let (Racine : 'Elt ArBin -> 'Elt) = function
       abNV(g,r,d) -> r
     | abV         -> failwith "Racine : l'arbre doit etre non vide";;
let (Gauche : 'Elt ArBin -> 'Elt ArBin) = function
       abNV(g,r,d) -> g
     | abV         -> failwith "Gauche : l'arbre doit etre non vide";;
let (Droit : 'Elt ArBin -> 'Elt ArBin) = function
       abNV(g,r,d) -> d
     | abV         -> failwith "Droit : l'arbre doit etre non vide";;


(*-------------------------------- Testeurs --------------------------------*)
let (EstVide_ab : 'Elt ArBin -> bool) = function
       abV        -> true 
     | abNV(g,r,d)-> false;;
let (Single_ab : 'Elt ArBin -> bool)= function
        a ->   not(EstVide_ab(a))
            && EstVide_ab(Gauche(a)) 
            && EstVide_ab(Droit(a));;
let (UnGauche_ab : 'Elt ArBin -> bool)= function
        a ->   not(EstVide_ab(a))
            && not(EstVide_ab(Gauche(a))) 
            && EstVide_ab(Droit(a));;
let (UnDroit_ab : 'Elt ArBin -> bool)= function
        a ->   not(EstVide_ab(a))
            && EstVide_ab(Gauche(a)) 
            && not(EstVide_ab(Droit(a))) ;;
let (Bin_ab : 'Elt ArBin -> bool)= function
        a ->   not(EstVide_ab(a))
            && not(EstVide_ab(Gauche(a)))
            && not(EstVide_ab(Droit(a)));;



(*----------------------------------------------------------------------------
       TYPES ET FONCTIONS SUR LES EXPRESSIONS ARITHMETIQUES BINAIRES
----------------------------------------------------------------------------*)


(*----------------------------- Constructeurs ------------------------------*)
type Operateur = Plus|Moins|Mult|Div;;
type abExpr =
       ExpS of int                         (*Expression simple*)
     | ExpB of abExpr*Operateur*abExpr;;  (*Expression composee "binaire"*)

(*-------------------------------- Testeurs --------------------------------*)
let (EstSingle_exp :abExpr -> bool)= function
       ExpS(e)     -> true
     | ExpB(g,r,d) -> false;;
let (EstBin_exp :abExpr -> bool) = function
       ExpB(g,r,d) -> true
     | ExpS(e)     -> false;;

(*-------------------------------- Selecteurs ------------------------------*)
let (Opg : abExpr  -> abExpr) = function
       ExpB(g,r,d) -> g 
     | ExpS(e)     -> failwith "Opg : l'expression doit etre binaire";;
let (Opd : abExpr  -> abExpr) = function
       ExpB(g,r,d) -> d 
     | ExpS(e)     -> failwith "Opd : l'expression doit etre binaire";;
let (Opr : abExpr  -> Operateur) = function
       ExpB(g,r,d) -> r 
     | ExpS(e)     -> failwith "Opr : l'expression doit etre binaire";;
let (ValOpd : abExpr -> int) = function
       ExpS(e)     -> e 
     | ExpB(g,r,d) -> failwith "ValOpd : expression simple";;
let (string_of_oper : Operateur -> string) = function
       Plus  -> " + "
     | Moins -> " - "
     | Mult  -> " * "
     | Div   -> " / " ;;