open Affichage open Typing type entry = Simple of Lam.lam | Reduce of Lam.lam | AlphaEquiv of Lam.lam * Lam.lam let beta_reduce e = let rec aux = function Some e -> print_expr e; print_newline (); aux (Lam.betastep e); | None -> () in print_expr e; print_newline (); let e = Lam.alpha_convert e in print_expr e; print_newline (); aux (Lam.betastep e) let alpha_get_lam where_from = let input_str = In_channel.input_all where_from in match Str.split (Str.regexp "&") input_str with [s1; s2] -> AlphaEquiv ( Parser.main Lexer.token (Lexing.from_string (s1^"\n")), Parser.main Lexer.token (Lexing.from_string s2) ) | _ -> failwith "Alpha-equivalence: nombre de delimiteurs incorrect" let interpret e = begin print_expr e; print_newline(); print_ty (typeinfer [] e); print_newline() end let nom_fichier = ref "" let reduce = ref false let alpha = ref false let equiv_fichier = ref "" let parse_channel c = let lexbuf = Lexing.from_channel c in Parser.main Lexer.token lexbuf let recupere_entree () = let optlist = [ ("-alpha", Arg.Set alpha, "Vérifie l'alpha équivalence de deux termes séparés par &"); ("-reduce", Arg.Set reduce, "Affiche les réductions successives du lambda-terme") ] in let usage = "Bienvenue à bord." in (* message d'accueil, option -help *) Arg.parse (* ci-dessous les 3 arguments de Arg.parse : *) optlist (* la liste des options definie plus haut *) (fun s -> nom_fichier := s) (* la fonction a declencher lorsqu'on recupere un string qui n'est pas une option : ici c'est le nom du fichier, et on stocke cette information dans la reference nom_fichier *) usage; (* le message d'accueil *) try let where_from = match !nom_fichier with | "" -> stdin | s -> open_in s in if !alpha then alpha_get_lam where_from else if !reduce then Reduce (parse_channel where_from) else Simple (parse_channel where_from) with e -> (Printf.printf "problème de saisie\n"; raise e) (* la fonction principale *) let run () = try match recupere_entree () with Simple l -> let _ = interpret l in () | Reduce l -> let _ = beta_reduce l in () | AlphaEquiv (l1, l2) -> begin if ((Lam.(=~)) l1 l2) then print_string "true\n" else print_string "false\n" end; flush stdout with e -> raise e let _ = run ()