(** * print.ml * ColorML_v2 project * (C) Lilian Besson, 2014 *) open Types;; open Parser;; open Lexer;; let string_of_char = String.make 1 and char_of_string s = s.[0] ;; (** {6 On donne une première version du module Print, sans ANSITerminal.} *) (** {5 Pour faire des statistiques.} *) let __nb_espace_blanc__ = ref 0 and __nb_tabulation__ = ref 0 and __nb_espace__ = ref 0 and __nb_nouvelle_ligne__ = ref 0 and __nb_entites_ocaml__ = ref 0 and __nb_rien_de_special__ = ref 0 and __nb_commentaire_odoc__ = ref 0 and __nb_commentaire_simple__ = ref 0 and __nb_preprocesseur__ = ref 0 and __nb_chaine_de_caracteres__ = ref 0 and __nb_constantes__ = ref 0 and __nb_types_de_bases__ = ref 0 and __nb_exception_et_modules__ = ref 0 and __nb_statement__ = ref 0 and __nb_statement2__ = ref 0 and __nb_nombres__ = ref 0 and __nb_operateurs__ = ref 0 and __nb_parentheses__ = ref 0 and __nb_modules_standards__ = ref 0 and __nb_mots_cles_function_like__ = ref 0 ;; (** Des compteurs de chaque genres d'entités trouvées. *) let initialise_compteurs () = __nb_espace_blanc__ := 0; __nb_tabulation__ := 0; __nb_espace__ := 0; __nb_nouvelle_ligne__ := 0; __nb_entites_ocaml__ := 0; __nb_rien_de_special__ := 0; __nb_commentaire_odoc__ := 0; __nb_commentaire_simple__ := 0; __nb_preprocesseur__ := 0; __nb_chaine_de_caracteres__ := 0; __nb_constantes__ := 0; __nb_types_de_bases__ := 0; __nb_exception_et_modules__ := 0; __nb_statement__ := 0; __nb_statement2__ := 0; __nb_nombres__ := 0; __nb_operateurs__ := 0; __nb_parentheses__ := 0; __nb_modules_standards__ := 0; __nb_mots_cles_function_like__ := 0; ;; (** Réinitialise les compteurs de stats'. *) let soir i = string_of_int (!i);; let etat_compteurs nomfichiers () = (" [Print MOcaml] Etats des compteurs : _________________________ Nombre d'Espaces blancs = "^(soir __nb_espace_blanc__)^" dont Nombre d'Espaces = "^(soir __nb_espace__)^" Nombre de Tabulations = "^(soir __nb_tabulation__)^" Nombre de Nouvelles lignes = "^(soir __nb_nouvelle_ligne__)^" _________________________ Nombre d'entites Ocaml = "^(soir __nb_entites_ocaml__)^" dont Nombre de Rien de spécial = "^(soir __nb_rien_de_special__)^" Nombre de Commentaire ODoc = "^(soir __nb_commentaire_odoc__)^" Nombre de Commentaire simple = "^(soir __nb_commentaire_simple__)^" Nombre de Préprocesseur = "^(soir __nb_preprocesseur__)^" Nombre de Chaine de caracteres = "^(soir __nb_chaine_de_caracteres__)^" Nombre de Constantes = "^(soir __nb_constantes__)^" Nombre de Types de bases = "^(soir __nb_types_de_bases__)^" Nombre de Exceptions et Modules = "^(soir __nb_exception_et_modules__)^" Nombre de Statement Fun = "^(soir __nb_statement__)^" Nombre de Statement Obj = "^(soir __nb_statement2__)^" Nombre de Nombres = "^(soir __nb_nombres__)^" Nombre de Opérateurs = "^(soir __nb_operateurs__)^" Nombre de Parentheses = "^(soir __nb_parentheses__)^" Nombre de Modules Standars = "^(soir __nb_modules_standards__)^" Nombre de Mots Clés Bis = "^(soir __nb_mots_cles_function_like__)^" Statistiques pour les codes sources suivants : ["^nomfichiers^"] Ces chiffres ont été obtenus par un programme OCaml écrit par Lilian Besson. Projet MOcaml (c) 2012 Naereen Corp. ");; let ecrire_sortie monoutchanel machaine = output monoutchanel machaine 0 (String.length machaine); flush monoutchanel;; (** Fonction ecrire_sortie : plus pratique que output. *) let ecrit_string ?(ext = false) ?(adresse = "") chaine = try( if not(ext) then ( print_string chaine; flush_all (); ) else ( if not(Sys.file_exists adresse) then failwith ("[Print MOcaml] Erreur : le fichier demandé n'existe pas, ou ne peut être lu.") else ( let p = (open_out adresse) in ecrire_sortie p chaine; close_out p; ) ) ) with _ -> failwith ("[Print MOcaml] Erreur : l'écriture n'a pas pu être faite.");; (** Ecrit en instantanné. *) (** {5 Les méthodes pour écrire les éléments de types décrits dans [Types].} *) let print_espace_blanc ?(ext = false) ?(adresse = "") s = incr __nb_espace_blanc__; match s with | Espace(n) -> incr __nb_espace__; ecrit_string ~ext:ext ~adresse:adresse (String.make n ' ') | Tabulation(n) -> incr __nb_tabulation__; ecrit_string ~ext:ext ~adresse:adresse (String.make n '\t') | Nouvelle_ligne(n) -> incr __nb_nouvelle_ligne__; ecrit_string ~ext:ext ~adresse:adresse (String.make n '\n') ;; (** Affiche un espace blanc. *) let print_entites_Ocaml ?(ext = false) ?(adresse = "") s = incr __nb_entites_ocaml__; match s with | Espace_blanc(b) -> print_espace_blanc ~ext:ext ~adresse:adresse b | Rien_de_special(u) -> incr __nb_rien_de_special__; ecrit_string ~ext:ext ~adresse:adresse u | Commentaire_simple(u) -> incr __nb_commentaire_simple__; ecrit_string ~ext:ext ~adresse:adresse u | Commentaire_odoc(u) -> incr __nb_commentaire_odoc__; ecrit_string ~ext:ext ~adresse:adresse u | Preprocesseur(u) -> incr __nb_preprocesseur__; ecrit_string ~ext:ext ~adresse:adresse u | Chaine_de_caracteres(u) -> incr __nb_chaine_de_caracteres__; ecrit_string ~ext:ext ~adresse:adresse u | Constantes(u) -> incr __nb_constantes__; ecrit_string ~ext:ext ~adresse:adresse u | Constantes_spec(u) -> incr __nb_constantes__; ecrit_string ~ext:ext ~adresse:adresse u | Types_de_bases(u) -> incr __nb_types_de_bases__; if u.[0] = ' ' || u.[0] = ':' then ecrit_string ~ext:ext ~adresse:adresse (String.sub u 1 ((String.length u)-1)) else ecrit_string ~ext:ext ~adresse:adresse u | Exception_et_modules(u) -> incr __nb_exception_et_modules__; ecrit_string ~ext:ext ~adresse:adresse u | Statement(u) -> incr __nb_statement__; ecrit_string ~ext:ext ~adresse:adresse u | Statement2(u) -> incr __nb_statement2__; ecrit_string ~ext:ext ~adresse:adresse u | Nombres(u) -> incr __nb_nombres__; ecrit_string ~ext:ext ~adresse:adresse u | Operateurs(u) -> incr __nb_operateurs__; ecrit_string ~ext:ext ~adresse:adresse u | Parentheses(u) -> incr __nb_parentheses__; ecrit_string ~ext:ext ~adresse:adresse u | Modules_standards(u) -> incr __nb_modules_standards__; ecrit_string ~ext:ext ~adresse:adresse u | Mot_cles_function_like(u) -> incr __nb_mots_cles_function_like__; ecrit_string ~ext:ext ~adresse:adresse u ;; (** Affiche une entité Ocaml. *) let print_texte_ocaml ?(ext = false) ?(adresse = "") s = (* ecrit_string ~ext:ext ~adresse:adresse "\n";*) List.iter (print_entites_Ocaml ~ext:ext ~adresse:adresse) s; ecrit_string ~ext:ext ~adresse:adresse "";; (** Affiche un texte Ocaml en entier. *) (** {6 Avec le module ANSITerminal.} *) open ANSITerminal;; let print_string = Pervasives.print_string;; ANSITerminal.set_autoreset (true);; let ecritC_string ?(style = []) ?(ext = false) ?(adresse = "") chaine = try( if not(ext) then ( ANSITerminal.print_string style chaine; flush_all (); ) else ( if not(Sys.file_exists adresse) then failwith ("[Print MOcaml] Erreur : le fichier demandé n'existe pas, ou ne peut être lu.") else ( let p = (open_out adresse) in ecrire_sortie p chaine; close_out p; ) ) ) with _ -> failwith ("[Print MOcaml] Erreur : l'écriture n'a pas pu être faite.");; (** Ecrit en instantanné. Et en couleurs. *) (** Les méthodes pour écrire les éléments de types décrits dans [Types]. *) let printC_espace_blanc ?(ext = false) ?(adresse = "") s = incr __nb_espace_blanc__; match s with | Espace(n) -> incr __nb_espace__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (String.make n ' ') | Tabulation(n) -> incr __nb_tabulation__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (String.make n '\t') | Nouvelle_ligne(n) -> incr __nb_nouvelle_ligne__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (String.make n '\n') ;; (** Affiche un espace blanc. *) let printC_entites_Ocaml ?(ext = false) ?(adresse = "") s = incr __nb_entites_ocaml__; match s with | Espace_blanc(b) -> printC_espace_blanc ~ext:ext ~adresse:adresse b | Rien_de_special(u) -> incr __nb_rien_de_special__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse u | Commentaire_simple(u) -> incr __nb_commentaire_simple__; ecritC_string ~style:[on_black; blue] ~ext:ext ~adresse:adresse u | Commentaire_odoc(u) -> incr __nb_commentaire_odoc__; ecritC_string ~style:[on_black; blue; Underlined] ~ext:ext ~adresse:adresse u | Preprocesseur(u) -> incr __nb_preprocesseur__; ecritC_string ~style:[on_black; Bold; red] ~ext:ext ~adresse:adresse u | Chaine_de_caracteres(u) -> incr __nb_chaine_de_caracteres__; ecritC_string ~style:[on_black; white] ~ext:ext ~adresse:adresse u (* { CONSTANTES((StringLabels.sub k ~pos:1 ~len:((String.length k) - 2))); token (Lexing.from_string (string_of_char (k.[(String.length k) - 1]))) }*) | Constantes_specg(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Inverse] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 1)) | Constantes_specd(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black; Inverse] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:0 ~len:((String.length k) - 1)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Constantes_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Inverse] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Constantes(u) -> incr __nb_constantes__; ecritC_string ~style:[on_black; Inverse] ~ext:ext ~adresse:adresse u | Types_de_bases(u) -> incr __nb_types_de_bases__; ecritC_string ~style:[on_black; Underlined; yellow] ~ext:ext ~adresse:adresse u | Types_de_bases_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Underlined; yellow] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Exception_et_modules(u) -> incr __nb_exception_et_modules__; ecritC_string ~style:[on_black; cyan] ~ext:ext ~adresse:adresse u | Exception_et_modules_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; cyan] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Statement(u) -> incr __nb_statement__; ecritC_string ~style:[on_black; Bold; magenta] ~ext:ext ~adresse:adresse u | Statement_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Bold; magenta] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Statement2(u) -> incr __nb_statement2__; ecritC_string ~style:[on_black; Bold; on_black] ~ext:ext ~adresse:adresse u | Statement_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Bold; on_black] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Nombres(u) -> incr __nb_nombres__; ecritC_string ~style:[on_black; white] ~ext:ext ~adresse:adresse u | Nombres_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; white] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Operateurs(u) -> incr __nb_operateurs__; ecritC_string ~style:[on_black; Bold; red] ~ext:ext ~adresse:adresse u | Operateurs_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Bold; red] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Parentheses(u) -> incr __nb_parentheses__; ecritC_string ~style:[on_black; Bold; cyan] ~ext:ext ~adresse:adresse u | Parentheses_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Bold; cyan] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Modules_standards(u) -> incr __nb_modules_standards__; ecritC_string ~style:[on_black; Underlined; yellow] ~ext:ext ~adresse:adresse u | Modules_standards_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; Underlined; yellow] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) | Mot_cles_function_like(u) -> incr __nb_mots_cles_function_like__; ecritC_string ~style:[on_black; red] ~ext:ext ~adresse:adresse u | Mot_cles_function_like_spec(k) -> incr __nb_constantes__; ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[0])); ecritC_string ~style:[on_black; red] ~ext:ext ~adresse:adresse (StringLabels.sub k ~pos:1 ~len:((String.length k) - 2)); ecritC_string ~style:[on_black] ~ext:ext ~adresse:adresse (string_of_char (k.[(String.length k) - 1])) ;; (** Affiche une entité Ocaml. *) let printC_texte_ocaml ?(ext = false) ?(adresse = "") s = (* ecritC_string ~style:[on_black; on_red] ~ext:ext ~adresse:adresse "\n";*) ecritC_string ""; List.iter (printC_entites_Ocaml ~ext:ext ~adresse:adresse) s; ecritC_string "";; (** Affiche un texte Ocaml en entier. *) (* TODO *) (*let printC_text_ocaml = print_texte_ocaml;;*) (* TODO : intégrer ANSITerminal. *) (** Méthode générale pour afficher du code, selon qu'on le veut en couleur ou pas. *) (** {6 Utilisation} *) let print_final ~color = if color then printC_texte_ocaml else print_texte_ocaml;; (** Choisit seul avec ou sans couleur selon : @param color Ce paramètre détermine si on utilise ou non la couleur. *) (** On lexe (luthor), on parse, et on affiche. Depuis une chaine interne. *) let affiche_string mastring ?(adresse_out = "stdout") ?(stat = false) ?(color = true) () = initialise_compteurs (); let ext = ref false and adresse = ref "" in let lexbuf = Lexing.from_string mastring in (* ecrit_string ("ColorML : Lexing : ok\n");*) let result = Parser.texte_complet Lexer.token lexbuf in (* ecrit_string ("ColorML : Parsing : ok\n");*) let mon_out_channel = match adresse_out with | "stdout" -> stdout; | "" -> stdout; | _ -> ext := true; adresse := adresse_out; (open_out adresse_out); in (* print_string ("ColorML : ecriture du résultat (statistiques) dans le fichier : "^adresse_out^"\n");*) print_final ~color:color ~ext:(false) result; (* ecrit_string ("ColorML : Printing : ok\n");*) if stat then ecrit_string (etat_compteurs "stdin" ());; (** On lexe (luthor), on parse, et on affiche. Depuis un fichier externe. *) let affiche_fichier ?(adresse_in = "stdin") ?(adresse_out = "stdout") ?(stat = false) ?(adresse_stat = "stdout") ?(color = false) () = initialise_compteurs (); let ext = ref false and adresse = ref "" in let mon_in_channel = match adresse_in with | "stdin" -> stdin; | _ -> (open_in adresse_in); in ecrit_string ("ColorML : traitement du code dans le fichier : "^adresse_in^"\n"); let lexbuf = Lexing.from_channel mon_in_channel in ecrit_string ("ColorML : Lexing : ok\n"); let result = Parser.texte_complet Lexer.token lexbuf in ecrit_string ("ColorML : Parsing : ok\n"); let mon_out_channel = match adresse_out with | "stdout" -> stdout; | "" -> stdout; | _ -> ext := true; adresse := adresse_out; (open_out adresse_out); in print_string ("ColorML : ecriture du résultat (statistiques) dans le fichier : "^adresse_out^"\n"); print_final ~color:color ~ext:(!ext) ~adresse:(!adresse) result; ecrit_string ("ColorML : Printing : ok\n"); if stat then ( let stats = (etat_compteurs adresse_in ()) in let mon_out_channel2 = match adresse_stat with | "stdout" -> stdout; | "" -> stdout; | _ -> (open_out adresse_stat); in ecrire_sortie mon_out_channel2 "\n"; ecrire_sortie mon_out_channel2 (stats^"\n"); ecrit_string ("ColorML : Stats : ok\n"); );; (** On lexe (luthor), on parse, et on affiche. Depuis un fichier externe. *) let affiche_fichierquiet ?(adresse_in = "stdin") ?(adresse_out = "stdout") ?(stat = false) ?(adresse_stat = "stdout") ?(color = false) () = initialise_compteurs (); let ext = ref false and adresse = ref "" in let mon_in_channel = match adresse_in with | "stdin" -> stdin; | _ -> (open_in adresse_in); in (* ecrit_string ("ColorML : traitement du code dans le fichier : "^adresse_in^"\n");*) let lexbuf = Lexing.from_channel mon_in_channel in (* ecrit_string ("ColorML : Lexing : ok\n");*) let result = Parser.texte_complet Lexer.token lexbuf in (* ecrit_string ("ColorML : Parsing : ok\n");*) let mon_out_channel = match adresse_out with | "stdout" -> stdout; | "" -> stdout; | _ -> ext := true; adresse := adresse_out; (open_out adresse_out); in (* print_string ("ColorML : ecriture du résultat (statistiques) dans le fichier : "^adresse_out^"\n");*) print_final ~color:color ~ext:(!ext) ~adresse:(!adresse) result; (* ecrit_string ("ColorML : Printing : ok\n");*) if stat then ( let stats = (etat_compteurs adresse_in ()) in let mon_out_channel2 = match adresse_stat with | "stdout" -> stdout; | "" -> stdout; | _ -> (open_out adresse_stat); in ecrire_sortie mon_out_channel2 "\n"; ecrire_sortie mon_out_channel2 (stats^"\n"); ecrit_string ("ColorML : Stats : ok\n"); );;