(********************************************************) (* chapitre 5 de Programmation fonctionnelle, générique et objet (Une introduction avec le langage OCaml) Ph. Narbel, Vuibert, 2005 Ces programmes ont pour but d'illustrer les sujets traités dans le livre. Il n'est donné aucune garantie quant à leur utilisation dans le cadre d'une activité professionnelle ou commerciale. Ces programmes peuvent être copiés sous reserve que leur provenance soit citée et que cet avertissement soit inclus. These programs are provided without warranty of any kind. Their purpose is just to serve as illustrations in the book. Permission to copy is granted provided that citation and this disclaimer of warranty are included. *) type complex = { re: float; im: float; plus: complex -> complex; mult: complex -> complex };; let rec new_complex r i = { re = r; im = i; plus = (fun z -> new_complex (r +. z.re) (i +. z.im)); mult = (fun z -> new_complex (r *. z.re -. i *. z.im) (i *. z.re +. r *. z.im)) };; let rec new_complex = let plus = (fun r i z -> new_complex (r +. z.re) (i +. z.im)) in let mult = (fun r i z -> new_complex (r *. z.re -. i *. z.im) (i *. z.re +. r *. z.im)) in fun r i -> { re = r; im = i; plus = plus r i; mult = mult r i };; type non_float_value = Int of int | Ratio of int * int;; let ( ++ ) x y = match (x, y) with | Ratio (a, b), Ratio (c, d) -> Ratio (a*d + c*b, b*d) | Int x, Int y -> Int (x + y) | Int x, Ratio (c, d) -> Ratio (x*d + c, d) | Ratio (a, b), Int y -> Ratio (a + y*b, b);; let ( ++ ) x y = match x with | Ratio (a, b) -> (match y with | Ratio (c, d) -> Ratio (a*d + c*b, b*d) | Int y -> Ratio (a + y*b, b)) | Int x -> (match y with | Ratio (c, d) -> Ratio (x*d + c, d) | Int y -> Int (x + y));; type value = | Float of float | Complex of float * float;; type solution = | Single of value | Float_Pair of value * value | Conjugates of value * value;; type order = Less | Equal | Greater;; let less_or_equal x y = if x < y then Less else if x = y then Equal else Greater;; let poly2 a b c = let disc = b *. b -. 4.0 *. a *.c in let inv2a = 1.0 /. (2.0 *. a) in match (less_or_equal disc 0.) with | Equal -> Single (Float (-.b *. inv2a)) | Greater -> let sqrtdisc = sqrt disc in Float_Pair (Float ((-.b +. sqrt disc) *. inv2a), Float ((-.b -. sqrt disc) *. inv2a)) | Less -> let sqrtdisc = sqrt (-.disc) in Conjugates (Complex (-.b *. inv2a, sqrtdisc *. inv2a), Complex (-.b *. inv2a, -.sqrtdisc *. inv2a));; open Num;; let fib_num n = let rec fib_aux m acc1 acc2 = if m =/ n then acc2 else fib_aux (m +/ (Int 1)) acc2 (acc1 +/ acc2) in if n >/ (Int 0) then fib_aux (Int 1) (Int 0) (Int 1) else (Int 0);; type zero = Zero and un = Un type palindrom = | Pal0 of zero * palindrom * zero | Pal1 of un * palindrom * un | Central_Zero | Central_Un | Empty;; let rec string_of_pal p = let t0 Zero = "0" and t1 Un = "1" in match p with | Pal0(x, y, z) -> (t0 x) ^ (string_of_pal y) ^ (t0 z) | Pal1(x, y, z) -> (t1 x) ^ (string_of_pal y) ^ (t1 z) | Central_Zero -> "0" | Central_Un -> "1" | Empty -> "";; type expr = Expr of term | Plus of expr * term and term = Term of factor | Mult of term * factor and factor = Const of float | Factor of expr;; let code_generator source = let rec expr e code = match e with | Expr t -> term t code | Plus (e, t) -> expr e (term t ("ADD; " ^ code)) and term t code = match t with | Term f -> fact f code | Mult (t, f) -> term t (fact f ("MUL; " ^ code)) and fact f code = match f with | Factor e -> expr e code | Const x -> "CST " ^ string_of_float x ^ "; " ^ code in expr source "";; type charac = Char of char and text = Empty_text | Text of charac * text and olistitem = Item of doc and olist = Empty_olist | OList of olistitem * olist and element = El_Text of text | Emphas of doc | Ordered_List of olist and doc = Empty_doc | Doc of element * doc and htmldoc = Html of doc;; let to_kilo x = match x with | `Kilo x -> x | `Pound x -> 0.4536 *. x | `Carat x -> 0.0002 *. x;; let to_pennies x = match x with | `Penny x -> x | `Shilling x -> 12 * x | `Pound x -> 240 * x;; type value = [ `Int of int | `Float of float ];; let int_of_value v = match v with | `Int x -> x | `Float y -> int_of_float y;; let extended_int_of_value v = match v with | #value as v -> int_of_value v | `Ratio (a, b) -> a / b;;