(* /!\ Code écrit par Lilian BESSON - LSV & CMLA & ENS de Cachan. Par respect des droits de propriétés intellectuelles, conservez ce bordereau si vous utilisez tout ou une partie de ce fichier. *) (* *) (* Plot : MOcaml *) (* *) (** {7 PlotSurcharge : code ml pour ocamlc} *) (** *) (** Plot : Projet MOcaml *)(** ENS de Cachan - 2012 L3 Informatique Projet MOcaml v1.0.4 *)(** Besson Lilian. Inspiré de l'article de Romain Vernoux sur la surcharge des opérateurs en OCaml. Inspiré de 'meta_plot.c' et 'script_metaplot.sh' écrits par Lilian Besson en Février 2012. (c) Naereen Corp. *) (* * Ce module fait partis du projet MOcaml, et utilise les modules ANSITerminal, et . * Pour plus de détails, voir la documentation du projet MOcaml, en ligne ou dans les README. *) (* Implémente une surcharge des opérateurs permettants d'avoir une fonction eval : string -> float -> float. *) (* ******************************************************************** *) (** {6 Surcharge des opérateurs} *) open Pervasives;; (** Fonction de typage *) let typage x = let tag_x = Obj.tag (Obj.repr x) in if tag_x = Obj.int_tag then "int" else if tag_x = Obj.string_tag then "string" else if tag_x = Obj.double_tag then "float" (*/!\*) else if tag_x = Obj.tag (Obj.repr [||]) then "array" else "unknown";; let rec dump r = if Obj.is_int r then string_of_int (Obj.magic r : int) else (* Block. *) let rec get_fields acc = function | 0 -> acc | n -> let n = n-1 in get_fields (Obj.field r n :: acc) n in let rec is_list r = if Obj.is_int r then r = Obj.repr 0 (* [] *) else let s = Obj.size r and t = Obj.tag r in t = 0 && s = 2 && is_list (Obj.field r 1) (* h :: t *) in let rec get_list r = if Obj.is_int r then [] else let h = Obj.field r 0 and t = get_list (Obj.field r 1) in h :: t in let opaque name = (* XXX In future, print the address of value 'r'. Not possible in * pure OCaml at the moment. *) "<" ^ name ^ ">" in let s = Obj.size r and t = Obj.tag r in (* From the tag, determine the type of block. *) match t with | _ when is_list r -> let fields = get_list r in "[" ^ String.concat "; " (List.map dump fields) ^ "]" | 0 -> let fields = get_fields [] s in "(" ^ String.concat ", " (List.map dump fields) ^ ")" | x when x = Obj.lazy_tag -> (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not * clear if very large constructed values could have the same * tag. XXX *) opaque "lazy" | x when x = Obj.closure_tag -> opaque "closure" | x when x = Obj.object_tag -> let fields = get_fields [] s in let clasz, id, slots = match fields with | h::h'::t -> h, h', t | _ -> assert false in (* No information on decoding the class (first field). So just print * out the ID and the slots. *) "Object #" ^ dump id ^ " (" ^ String.concat ", " (List.map dump slots) ^ ")" | x when x = Obj.infix_tag -> opaque "infix" | x when x = Obj.forward_tag -> opaque "forward" | x when x < Obj.no_scan_tag -> let fields = get_fields [] s in "Tag" ^ string_of_int t ^ " (" ^ String.concat ", " (List.map dump fields) ^ ")" | x when x = Obj.string_tag -> "\"" ^ String.escaped (Obj.magic r : string) ^ "\"" | x when x = Obj.double_tag -> string_of_float (Obj.magic r : float) | x when x = Obj.abstract_tag -> opaque "abstract" | x when x = Obj.custom_tag -> opaque "custom" | x when x = Obj.final_tag -> opaque "final" | _ -> failwith ("Std.dump: impossible tag (" ^ string_of_int t ^ ")") let dump v = dump (Obj.repr v) (** represent a runtime value as a string. Since types are lost at compile time, the representation might not match your type. For example, None will be printed 0 since they share the same runtime representation. *) (** Fonctions intermédiaires *) (** Addition générique *) let plus x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped + y_untyped) | ("float","float") -> Obj.magic (x_untyped +. y_untyped) | ("int","float") -> Obj.magic (float_of_int(x_untyped) +. y_untyped) | ("float","int") -> Obj.magic (float_of_int(y_untyped) +. x_untyped) | ("string","string") -> Obj.magic (x_untyped ^ y_untyped) | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas additionner ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (** Multiplication générique *) let fois x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped * y_untyped) | ("float","float") -> Obj.magic (x_untyped *. y_untyped) | ("int","float") -> Obj.magic (float_of_int(x_untyped) *. y_untyped) | ("float","int") -> Obj.magic (float_of_int(y_untyped) *. x_untyped) | ("string","string") -> failwith "Je ne sais pas multiplier des chaines de caracteres !" | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas multiplier ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (** Soustraction générique *) let moins x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped - y_untyped) | ("float","float") -> Obj.magic (x_untyped -. y_untyped) | ("int","float") -> Obj.magic (float_of_int(x_untyped) -. y_untyped) | ("float","int") -> Obj.magic (float_of_int(y_untyped) -. x_untyped) | ("string","string") -> failwith "Je ne sais pas soustraire des chaines de caracteres !" | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas multiplier ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (** Puissance générique *) (** Modification de ( ** ) : pour les entiers. Nouvelle fonctions ( **. ) pour les flottants. *) let ( **. ) = Pervasives.( ** );; let ( ** ) x y = int_of_float (Pervasives.( ** ) (float_of_int x) (float_of_int y));; let puis x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped ** y_untyped) | ("float","float") -> Obj.magic (x_untyped ** y_untyped) | ("int","float") -> Obj.magic (float_of_int(x_untyped) **. y_untyped) | ("float","int") -> Obj.magic (float_of_int(y_untyped) **. x_untyped) | ("string","string") -> failwith "Je ne sais pas faire des puissances de chaines de caracteres !" | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas multiplier ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (** Division générique *) let div x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped / y_untyped) | ("float","float") -> Obj.magic (x_untyped /. y_untyped) | ("int","float") -> Obj.magic (float_of_int(x_untyped) +. y_untyped) | ("float","int") -> Obj.magic (float_of_int(y_untyped) /. x_untyped) | ("string","string") -> failwith "Je ne sais pas faire des divisions de chaines de caracteres !" | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas diviser ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (** Modulo générique *) let modulo x y = let x_untyped = Obj.magic x and y_untyped = Obj.magic y and type_x = typage x and type_y = typage y in match (type_x, type_y) with | ("int","int") -> Obj.magic (x_untyped mod y_untyped) | ("float","float") -> Obj.magic 0. | ("string","string") -> failwith "Je ne sais pas faire des modulo de chaines de caracteres !" | ("unknown", _) | (_, "unknown") -> failwith "Je ne sais pas calculer le reste avec ca !" | (_,_) -> failwith "Faut pas abuser..." ;; (* ******************************************************************** *) let bool_of_int i = (i = 1) and int_of_bool = function | true -> 1 | false -> 0;; (** Conversions entiers et booléens. *) let bool_of_float i = (i = 1.0) and float_of_bool = function | true -> 1.0 | false -> 0.0;; (** Conversions entiers et flottants. *) let to_float x = let x_untyped = Obj.magic x and type_x = typage x in match type_x with | "int" -> float_of_int (Obj.magic (x_untyped)) | "float" -> 1.0 *. (Obj.magic (x_untyped)) | _ -> 0.0;; (** Converti vers les flottants. Marche bien pour les booléens aussi. *) let ( ^= ) r a = r := !r ^ a;; (** Actualise une référence string. *) (** Affichage générique *) let rec to_string x = let x_untyped = Obj.magic x and type_x = typage x in let rec string_of_array = function | [||] -> "[||]" | a -> ( let res = ref "[|" in res ^= (to_string a.(0)); Array.iter (fun i -> (res ^= ("; "^(to_string i)))) (Array.sub a 1 (-1 + Array.length a)); res ^= "|]"; !res; ) in match type_x with | "int" -> string_of_int x_untyped | "float" -> string_of_float x_untyped | "string" -> (x_untyped) (* | "string" -> ("\""^x_untyped^"\"")*) | "array" -> string_of_array x_untyped | _ -> failwith "Je ne sais pas imprimer ca !";; let print x = print_string (to_string x);; let rec fact = function | 0 -> 1 | n -> n * fact(n-1) ;; (** Redéfinition des opérations de OCaml *) let ( + ) = plus;; let ( * ) = fois;; let ( - ) = moins;; let ( ^ ) = puis;; let ( / ) = div;; let ( mod ) = modulo;; let ( +. ) = plus;; let ( *. ) = fois;; let ( -. ) = moins;; let ( ^. ) = puis;; let ( /. ) = div;; let ( mod ) = modulo;; let ( ** ) = ( ^ );; let ( && ) x y = match (to_float x, to_float y) with | _, 0.0 | 0.0, _ -> 0.0 | _,_ -> 1.0;; let ( || ) x y = match (to_float x, to_float y) with | 0.0, 0.0 -> 0.0 | _,_ -> 1.0;; let ( += ) re va = re := !re + va and ( -= ) re va = re := !re - va and ( *= ) re va = re := !re * va and ( /= ) re va = re := !re / va and ( &= ) re va = re := !re && va and ( |= ) re va = re := !re || va and ( ^= ) re va = re := !re ^ va and ( != ) re va = to_float (re <> va) and ( = ) re va = to_float (re = va) and ( =< ) re va = to_float (re <= va) and ( >= ) re va = to_float (re >= va) and ( < ) re va = to_float (re < va) and ( > ) re va = to_float (re > va) and ( <> ) re va = to_float (re <> va) ;; let sqrt x = sqrt (to_float x) and exp x = exp (to_float x) and log x = log (to_float x) and log10 x = log10 (to_float x) and cos x = cos (to_float x) and sin x = sin (to_float x) and tan x = tan (to_float x) and acos x = acos (to_float x) and asin x = asin (to_float x) and atan x = atan (to_float x) and cosh x = cosh (to_float x) and sinh x = sinh (to_float x) and tanh x = tanh (to_float x) and ceil x = ceil (to_float x) and floor x = floor (to_float x) ;; (*let ( ! ) x y = float_of_int (fact (int_of_float (to_float x)) (int_of_float (to_float y)));;*) (* ******************************************************************** *) (* /!\ Code écrit par Lilian BESSON - LSV & CMLA & ENS de Cachan. Par respect des droits de propriétés intellectuelles, conservez ce bordereau si vous utilisez tout ou une partie de ce fichier. *)