Add alpha_equiv

This commit is contained in:
augustin64 2024-04-16 10:23:44 +02:00
parent 0b67d9a5eb
commit d299e38fe0
2 changed files with 34 additions and 44 deletions

44
:
View File

@ -1,44 +0,0 @@
%{
open Expr
%}
%token PLUS TIMES
%token TOP BOTTOM EXFALSO
%token LPAREN RPAREN
%token FUN ARR COLON
%token <string> VARID
%token <string> TYID
%token EOL
%left ARR
%start main
%type <Expr.expr> main
%%
main:
e=expression EOL { e }
ty_annot:
| id=VARID COLON t=ty { (id, t) }
ty:
| id=TYID { id }
| LPAREN t=ty RPAREN { ty }
| t1=ty ARR t2=ty {
expression:
| FUN LPAREN annot=ty_annot RPAREN ARR e=expression
{ Fun (annot, e) }
| e=app_expr { e }
app_expr:
| e=app_expr a=atomic { App (e, a) }
| a=atomic { a }
atomic:
| id=VARID { Var id }
| LPAREN e=expression RPAREN
{ e }

34
expr.ml
View File

@ -7,3 +7,37 @@ type expr =
| App of expr * expr
| Var of id
| Exf of expr * string
(** alpha renaming in a deterministic way *)
let alpha_convert (e : expr) : expr =
let cpt_ty = ref 0 in (* id cpt for type variables *)
let cpt_var = ref 0 in (* id cpt for variables *)
let generator (cpt : int ref) : id = (* id generator *)
let v = string_of_int !cpt
in incr cpt; v
in let renamed = ref []
in let rename (cpt : int ref) (var : id) : id = (* checks if a variable already has a new id, or generates one *)
match List.assoc_opt var !renamed with
| Some var' -> var'
| None -> let var' = generator cpt in (
renamed := (var, var')::!renamed;
var')
in let rec alpha_ty (t : Types.ty) : Types.ty = match t with
Arr (t1, t2) -> Arr (alpha_ty t1, alpha_ty t2)
| TVar (v) -> TVar (rename cpt_ty v)
| Bot -> Bot
in let rec alpha_aux (e : expr) : expr = match e with (* actual renaming *)
Fun ((v, t), e) -> Fun ((rename cpt_var v, alpha_ty t), alpha_aux e)
| App (e1, e2) -> App (alpha_aux e1, alpha_aux e2)
| Var v -> Var (rename cpt_var v)
| Exf (e, s) -> Exf (alpha_aux e, s)
in alpha_aux e
(** alpha equivalence *)
let (=~) (e1 : expr) (e2 : expr) : bool =
alpha_convert e1 = alpha_convert e2