Read .8pus files

This commit is contained in:
augustin64 2024-05-14 11:43:57 +02:00
parent 3bb8efcb8f
commit a42a34d307
4 changed files with 53 additions and 36 deletions

View File

@ -12,8 +12,7 @@ let var_id = lowercase lowercase* digit*
let ty_id = uppercase uppercase* digit* let ty_id = uppercase uppercase* digit*
rule token = parse rule token = parse
| [' ' '\t'] { token lexbuf } | [' ' '\t' '\n'] { token lexbuf }
| '\n' { EOL }
| '.' { DOT } | '.' { DOT }
| '+' { PLUS } | '+' { PLUS }
| '*' { TIMES } | '*' { TIMES }
@ -45,4 +44,4 @@ rule token = parse
| var_id as s { VARID(s) } | var_id as s { VARID(s) }
| ty_id as s { TYID(s) } | ty_id as s { TYID(s) }
| eof { raise Eof } | eof { EOF }

75
main.ml
View File

@ -1,11 +1,10 @@
open Parser_entry open Parser_entry
open Affichage open Affichage
open Typing
open Proof open Proof
open Types open Types
type entry = type entry =
Simple of Lam.lam Simple of (unit -> cmd)
| Reduce of Lam.lam | Reduce of Lam.lam
| AlphaEquiv of Lam.lam * Lam.lam | AlphaEquiv of Lam.lam * Lam.lam
@ -60,7 +59,7 @@ let alpha_get_lam where_from =
- g, gs : next goals - g, gs : next goals
- sq : previous states of the interactive loop - sq : previous states of the interactive loop
*) *)
let rec interactive (sl : (interactive_state) list) : proof = let rec interactive (get_cmd : unit -> cmd) (sl : (interactive_state) list) : proof =
let (cg, (g, gs)), sq = match sl with let (cg, (g, gs)), sq = match sl with
[] -> (None, (None, [])), [] [] -> (None, (None, [])), []
| s::sq -> s, sq | s::sq -> s, sq
@ -72,60 +71,48 @@ let rec interactive (sl : (interactive_state) list) : proof =
in in
try try
match parse_cmd (Lexing.from_string ((read_line ())^"\n")) with match get_cmd () with
Goal ty -> Goal ty ->
let rh = Ref (ref Hole) in let rh = Ref (ref Hole) in
interactive [Some (rh, ty), (Some (rh, ty, []), [])] [Some (rh, ty), (Some (rh, ty, []), [])] |> interactive get_cmd
| Undo -> interactive sq | Undo -> interactive get_cmd sq
| Qed -> begin match cg with | Qed -> begin match cg with
None -> None ->
print_error "No current goal" ""; print_error "No current goal" "";
(cg, (g, gs))::sq |> interactive (cg, (g, gs))::sq |> interactive get_cmd
| Some (h, t) -> | Some (h, t) ->
let l = lam_of_hlam h let l = lam_of_hlam h
|> beta_reduce in |> beta_reduce in
if Typing.typecheck [] l t then begin if Typing.typecheck [] l t then begin
print_string "Ok"; print_string "Ok";
interactive [None, (None, [])] [None, (None, [])] |> interactive get_cmd
end else begin end else begin
print_error "Typing failed" ""; print_error "Typing failed" "";
(* print_expr l; (* print_expr l;
print_newline (); print_newline ();
print_ty t; *) print_ty t; *)
(cg, (g, gs))::sq |> interactive (cg, (g, gs))::sq |> interactive get_cmd
end end
end end
| Tact t -> | Tact t ->
(cg, (apply_tactic (g, gs) t))::(clean_state (cg, (g, gs)))::sq |> interactive (cg, (apply_tactic (g, gs) t))::(clean_state (cg, (g, gs)))::sq |> interactive get_cmd
with with
Parser.Error -> Parser.Error ->
print_error "Invalid input" ""; print_error "Invalid input" "";
(cg, (g, gs))::sq |> interactive (cg, (g, gs))::sq |> interactive get_cmd
| TacticFailed arg -> | TacticFailed arg ->
print_error "Tactic failed" arg; print_error "Tactic failed" arg;
(cg, (g, gs))::sq |> interactive (cg, (g, gs))::sq |> interactive get_cmd
| End_of_file -> | End_of_file | Lexer.Eof ->
print_string "Bye!\n"; print_string "Bye!\n";
(g, gs) (g, gs)
end end
let interpret e =
begin
print_expr e;
print_newline();
print_ty (typeinfer [] e);
print_newline();
let _ = interactive [None, (None, [])] in ()
end
let nom_fichier = ref "" let nom_fichier = ref ""
let reduce = ref false let reduce = ref false
let alpha = ref false let alpha = ref false
let equiv_fichier = ref "" let equiv_fichier = ref ""
let parse_channel_lam c =
let lexbuf = Lexing.from_channel c in
parse_lam lexbuf
let recupere_entree () = let recupere_entree () =
let optlist = [ let optlist = [
@ -152,16 +139,46 @@ let recupere_entree () =
if !alpha if !alpha
then alpha_get_lam where_from then alpha_get_lam where_from
else if !reduce else if !reduce
then Reduce (parse_channel_lam where_from) then Reduce (Lexing.from_channel where_from |> parse_lam)
else Simple (parse_channel_lam where_from) else Simple begin
let cmd_buff = ref [] in
if !nom_fichier = "" then
(
fun () ->
match !cmd_buff with
| [] ->
begin match (read_line ())^"\n"
|> Lexing.from_string
|> parse_cmd with
[] -> raise Parser.Error
| e::q -> cmd_buff := q; e
end
| e::q -> cmd_buff := q; e
)
else
(
fun () ->
match !cmd_buff with
| [] ->
begin match (input_line where_from)^"\n"
|> Lexing.from_string
|> parse_cmd with
[] -> raise End_of_file
| e::q -> cmd_buff := q; e
end
| e::q -> cmd_buff := q; e
)
end
with e -> (print_error "problème de saisie" ""; raise e) with e -> (print_error "problème de saisie" ""; raise e)
(* la fonction principale *) (* la fonction principale *)
let run () = let run () =
try try
match recupere_entree () with match recupere_entree () with
Simple l -> let _ = interpret l in () Simple get_cmd ->
| Reduce l -> let _ = show_beta_reduction l in () let _ = interactive get_cmd [None, (None, [])] in ()
| Reduce l ->
let _ = show_beta_reduction l in ()
| AlphaEquiv (l1, l2) -> begin | AlphaEquiv (l1, l2) -> begin
if ((Lam.(=~)) l1 l2) then if ((Lam.(=~)) l1 l2) then
print_string "true\n" print_string "true\n"

View File

@ -5,6 +5,8 @@ open Proof
open Parser_entry open Parser_entry
%} %}
%token EOF
%token DOT %token DOT
%token PLUS TIMES %token PLUS TIMES
%token TOP BOT EXFALSO TILDE %token TOP BOT EXFALSO TILDE
@ -18,7 +20,6 @@ open Parser_entry
%token EXACT ASSUMPTION INTRO INTROS CUT APPLY %token EXACT ASSUMPTION INTRO INTROS CUT APPLY
%token LEFT RIGHT SPLIT %token LEFT RIGHT SPLIT
%token EOL
%right TARR %right TARR
%right OR %right OR
%right AND %right AND
@ -29,8 +30,8 @@ open Parser_entry
%% %%
main: main:
| e=expression EOL { Lam e } | e=expression EOF { Lam e }
| t=tactic EOL { Cmd t } | ts=nonempty_list(tactic) EOF { Cmd ts }
tactic: tactic:
| c=command DOT { c } | c=command DOT { c }

View File

@ -10,4 +10,4 @@ type cmd =
type parser_entry = type parser_entry =
| Lam of lam | Lam of lam
| Cmd of cmd | Cmd of cmd list