Mysaa/pieuvre
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Typecheck

Browse Source
This commit is contained in:
Adrien Vannson 2022-05-17 11:23:54 +02:00
parent d15da6c958
commit 425951b1b9
No known key found for this signature in database
GPG Key ID: FE2E66FD978C1A55
5 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lexer.mll
View File

@ -27,7 +27,7 @@ rule token = parse
| "fun" { FUN } | "fun" { FUN }
| "=>" { MAPS_TO } | "=>" { MAPS_TO }
| ':' { VDOTS } | ':' { COLON }
| "exf" { EXF } | "exf" { EXF }
| "fst" { FST } | "fst" { FST }
| "snd" { SND } | "snd" { SND }

20
main.ml
View File

@ -77,28 +77,27 @@ if !alpha_option then (
exit 0 exit 0
); );
(*if !typecheck_option then ( if !typecheck_option then (
let lexbuf = Lexing.from_channel (match file with let lexbuf = Lexing.from_channel (match file with
| None -> stdin | None -> stdin
| Some file -> file | Some file -> file
) )
in in
let lambda_term = let lambda_term, ty =
try try
Parser.main_lambda Lexer.token lexbuf Parser.main_typed_lambda Lexer.token lexbuf
with e -> ( with e -> (
Printf.printf "Can't read lambda term\n"; Printf.printf "Can't read typed lambda term\n";
raise e raise e
) )
in in
Printf.printf "The type of %s is " (string_of_lam lambda_term); Printf.printf "The type of %s is " (string_of_lam lambda_term);
if typecheck [] lambda_term then ( if not (typecheck [] lambda_term ty) then (
Printf.printf "correct\n" Printf.printf "not "
) else (
Printf.printf "incorrect\n"
); );
Printf.printf "%s.\n" (string_of_ty ty);
exit 0 exit 0
);*) );
(* Show a message only if the input is read from stdin *) (* Show a message only if the input is read from stdin *)
let show s = match file with let show s = match file with
@ -137,7 +136,6 @@ while !subgoals <> [] do
explore hyps explore hyps
in in
if is_interactive then ( if is_interactive then (
(* Nettoyage du terminal *) (* Nettoyage du terminal *)
let _ = Sys.command("clear -x") in let _ = Sys.command("clear -x") in
@ -267,7 +265,7 @@ done;
let finalLam = !fill_holes [] in let finalLam = !fill_holes [] in
if (typecheck [] finalLam ty) then ( if (typecheck [] finalLam ty) then (
Printf.printf "Final proof :\n"; Printf.printf "Final proof :\n";
reduce finalLam reduce finalLam;
) )
else ( else (
Printf.printf "Invalid proof constructed!\n"; Printf.printf "Invalid proof constructed!\n";

16
parser.mly
View File

@ -11,7 +11,7 @@
%token <string> TYPE_NAME %token <string> TYPE_NAME
%token DOT INTRO ASSUMPTION APPLY ELIM CUT SPLIT LEFT RIGHT FST SND IG ID CASE %token DOT INTRO ASSUMPTION APPLY ELIM CUT SPLIT LEFT RIGHT FST SND IG ID CASE
%token FUN MAPS_TO VDOTS EXF %token FUN MAPS_TO COLON EXF
%token AMPERSAND %token AMPERSAND
@ -33,6 +33,9 @@
%start main_two_lambda %start main_two_lambda
%type <Structs.lam * Structs.lam> main_two_lambda %type <Structs.lam * Structs.lam> main_two_lambda
%start main_typed_lambda
%type <Structs.lam * Structs.ty> main_typed_lambda
%% %%
main_type: main_type:
| ty EOF { $1 } | ty EOF { $1 }
@ -44,7 +47,10 @@ main_lambda:
| lambda EOF { $1 } | lambda EOF { $1 }
main_two_lambda: main_two_lambda:
| lambda AMPERSAND lambda { $1, $3 } | lambda AMPERSAND lambda EOF { $1, $3 }
main_typed_lambda:
| lambda COLON ty EOF { $1, $3 }
/* Types */ /* Types */
ty: ty:
@ -81,7 +87,7 @@ lambda_app:
lambda: lambda:
| lambda_app { $1 } | lambda_app { $1 }
| FUN VAR_NAME VDOTS ty MAPS_TO lambda { LFun ($2, $4, $6) } | FUN VAR_NAME COLON ty MAPS_TO lambda { LFun ($2, $4, $6) }
| FUN LPAREN VAR_NAME VDOTS ty RPAREN MAPS_TO lambda | FUN LPAREN VAR_NAME COLON ty RPAREN MAPS_TO lambda
{ LFun ($3, $5, $8) } { LFun ($3, $5, $8) }
| EXF LPAREN VAR_NAME VDOTS ty RPAREN { LExf (LVar $3, $5) } | EXF LPAREN VAR_NAME COLON ty RPAREN { LExf (LVar $3, $5) }

1
tests/typecheck/right-type Normal file
View File

@ -0,0 +1 @@
fun x: A => fun f: A -> False => f x : A -> ~~A

1
tests/typecheck/wrong-type Normal file
View File

@ -0,0 +1 @@
(fun x: A -> A => x x) : A -> A