beluga-lang / beluga Goto Github PK
View Code? Open in Web Editor NEWContextual types meet mechanized metatheory!
Home Page: http://complogic.cs.mcgill.ca/beluga/
License: GNU General Public License v3.0
beluga's People
Stargazers
Watchers
Forkers
kristofferrose niols cartazio haselwarter adhameer gndowns szilviagyapay fuath gelisam hannelita blaisorblade martyo256 yyamada151 valensara45 dzackon costinbadescubeluga's Issues
Error in type checking rule for If Statement
Currently, in check.ml, in the case for If (e, e1, e2), we type check e1 twice rather than checking e1 and e2. Correcting this causes an error to arise in two of the test cases, examples/freshML/cconv.bel and examples/freshML/term-crec.bel. Considering the way the errors arise, there's probably an error in the else branch of some if statement in the two test cases (in the case of cconv.bel, it's the last branch of genTVar, but I haven't looked into term-crec.bel)
Check constructor names for uniqueness
Constructor names should probably be unique at least within one type definition. I don't know how namespaces work in Beluga, but if they work then shadowing across different inductives should probably also be illegal.
This is accepted, and it doesn't seem like a good idea:
inductive MyBool : ctype =
| True : MyBool
| True : MyBool
;
let true = True ;
rec f : MyBool → Bool =
fn b =>
case b of
| True => ttrue
| True => ffalse
;
inductive NotBool : ctype =
| True : NotBool
;
let x : MyBool = true ;
let y = f x ;
The coverage checker seems to be buggy
The following code is accepted by Beluga f65d501:
inductive Empty : ctype =
;
LF unit : type =
| unit : unit
;
schema ctx = unit;
inductive Eq : (γ : ctx) [γ ⊢ unit] → [γ ⊢ unit] → ctype =
| Eq_var : Eq [γ ⊢ #p] [γ ⊢ #p]
;
rec lemma : Eq [γ ⊢ X] [γ ⊢ Y] → Empty =
/ total p (lemma γ x y p) /
fn p ⇒ impossible p
;
The last definition looks suspicious to me.
I can trigger an internal error by adding the following code:
let eq : Eq [x : unit ⊢ x] [x : unit ⊢ x] = Eq_var;
let bad : Empty = lemma eq;
Error message:
Internal error (please report as a bug):
Case {}-pattern -- coverage checking is off or broken
Case where both meta-substitutions associated with context variables are not pattern substitutions should not happen
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
/ total m (invRenStep g1 g2 a m) /
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
= invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = ih [g2 |- #R] [g2 |- S]
%% invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
Ugly %:split results
The %:split function in interactive mode (and then in emacs mode) returns quite ugly things.
Currently:
case t of
| [ |- thing] => ?
|
[ |- thang X Z] => ?
|
[ |- thong Y1] => ?
;
But it would be nice to have:
case t of
| [ |- thing] => ?
| [ |- thang X Z] => ?
| [ |- thong Y1] => ?
;
This come from the internal pretty printer, and, to be specific, from the fmt_ppr_cmp_branch_prefix (called by fmt_ppr_cmp_branch) that is using boxes and spaces even for empty prefixes.
I'll see if I can make it nicer without destroying the whole printer
Coverage checker should succeed ....
on the following example, the coverage checker should succeed.
LF term : type =
| lam : (term → term) → term
;
% subst T U T′ means that the result of substituting U for the free
% variable in T is T′.
LF subst : (term → term) → term → term → type =
| subst_lam :
({y : term} subst (\x. T x y) U (T′ y)) →
subst (\x. lam (\y. T x y)) U (lam T′)
| subst_var : subst (\x. x) U U
| subst_other : subst (\x. T) U T
;
schema ctx = term;
LF equal : term → term → type =
| refl : equal T T
;
rec subst_sound : (gamma : ctx)
[gamma ⊢ subst (\y. T) U[] T'] → [gamma |- equal T' T[..,U[]]] =
/ total p (subst_sound g t u t' p) /
fn p =>
(case p of
| [gamma |- subst_lam (\y. P)] =>
let [gamma, y:term |- E] = subst_sound [gamma, y:term ⊢ P] in
?
| [gamma |- subst_var ] => ?
| [gamma |- subst_other ] => ?
) ;
but it currently fails with the error message:
###### COVERAGE FAILURE: Case expression doesn't #####
CASE(S) NOT COVERED :
(1) ., {gamma : ctx}, {T : [gamma, z2 : term, x2 : term |- term]}*, {x1 : [ |- term]}*, {T′ : [gamma, y3 : term |- term]}*, {P : [gamma, y : term |- subst (\x. T[ y, x, ^2]) x1[e] T′]}*
.
|- [gamma, z10 |- Y]
##
Should this work? `context in the body appears to be more general than the context supplied`
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
schema cxt = tm A; % some [a : ty] block tm a;
inductive SN : (g : cxt) {M : [ g |- tm A ]} ctype =
| Acc : ({M' : [ g |- tm A ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Lemmata for fundamental theorem
rec fundVar : {g : cxt} {#p : [g |- tm A[]]}
RedS [g] [g' |- #S]
-> Red [|- A] [g' |- #p[#S]] =
mlam g, #p => fn s => case s of
| RNil => impossible [ |- #p ]
| RCons r s' => case [g |- #p] of
| [g, x : tm A[] |- x ] => r
| [g, x : tm A[] |- #q[..]] => fundVar [g] [g |- #q] s'
;
The external pretty printer poduces erroneous programs
The code produced by he pretty printer prettyext.ml is incorrect.
This impacts the +html feature.
Apxnorm could be removed
The apxnorm phase is complex and error-prone. We should be able to get rid of it by threading a refinement substitution through reconstruction like in the PPDP'14 paper. It also performs some re-indexing, which would be unnecessary if we were to perform indexing at the same time as reconstruction (see issue #5 )
Source location information is incorrect
Column information is sometimes incorrect when tab characters are present. For example:
LF tm: type =
| true: tm
| false: tm
| if_then_else: tm → tm → tm
;
rec f: [⊢ tm] → [⊢ tm] =
fn m ⇒ (case m of
| [ |- true] => ?
| [ |- false] => ?
| [ |- if_then_else X Z] => bad syntax
)
;
When compiling, the resulting syntax error points to characters 33-36 (" Z]") instead of characters 40-43 as it should. When indentation is removed and the file is recompiled, the location information is correct.
To have first class lets or not, that is the question
Sometimes, when unpacking the result of a function call to be able to use the result in an LF expression the program fails because this let when translated to a case hase some unresolved holes. However, if we had first-class lets (or something cleverer) it should work. (see the comments inline)
tp: type.
i : tp.
arr : tp -> tp -> tp.
tm : tp -> type.
c : tm i.
app : tm (arr T S) -> tm T -> tm S.
lam : (tm T -> tm S) -> tm (arr T S).
step : tm T -> tm T -> type.
s-a : step M M' -> step (app M N) (app M' N).
s-b : step (app (lam M) N) (M N).
mstep : tm T -> tm T -> type.
ms-refl : mstep M M.
ms-step : step M N' -> mstep N' N -> mstep M N.
rec mstep-app : [|- mstep M M'] -> [|- mstep (app M N) (app M' N)] =
fn d => case d of
| [|- ms-refl] => [|- ms-refl]
| [|- ms-step D Ds] =>
% This fails for reconstruction reasons :-( This should work. One
% option is to use 'first-class' lets with no pattern matching and
% the other is to be clever and carefully deal with what unification
% can solve and how can it be solved (no dependencies to refined
% variables and things like that)
case mstep-app [|- Ds] of
| [|- Ds'] => [|- ms-step (s-a D) Ds']
;
Interactive mode cannot split or introduce variables in functions with total declarations
A simple example case:
LF tp : type =
| nat : tp
| bool : tp;
rec f: [⊢ tp] → [⊢ tp] =
/ total t (f t) /
fn t ⇒ ?;
Splitting on hole 0, variable t gives the error message:
Uncaught exception.
Please report this as a bug.
- Error in split.
Failure("Found variable in gCtx, cannot split on t")
After removing the totality declaration, splitting on hole 0, variable t works as expected. For functions of multiple variables, this only seems to happen for the variable specified in the totality declaration.
There are similar problems with introducing variables, but they occur more sporadically and are more difficult to reproduce. Here is one example:
LF tp: type =
| bool: tp
| arr: tp → tp → tp
;
%name tp T.
LF tm: tp → type =
| true: tm bool
| false: tm bool
| if_then_else: tm bool → tm T → tm T → tm T
| lam: (tm S → tm T) → tm (arr S T)
| app: tm (arr S T) → tm S → tm T
;
%name tm M.
LF value: tm _ → type =
| v_true: value true
| v_false: value false
| v_lam: value (lam M)
;
%name value V.
LF step: tm A → tm A → type =
| e_if: step M N → step (if_then_else M M1 M2) (if_then_else N M1 M2)
| e_if_true: step (if_then_else true M1 M2) M1
| e_if_false: step (if_then_else false M1 M2) M2
| e_appl: step M M' → step (app M N) (app M' N)
| e_appr: value M → step N N' → step (app M N) (app M N')
| e_app: value N → step (app (lam M) N) (M N)
;
%name step S.
LF mstep: tm A → tm A → type =
| m_refl: mstep M M
| m_trans: mstep M N → mstep N M' → mstep M M'
| m_step: step M N → mstep M N
;
%name mstep MS.
schema ctx = tm T;
stratified Val: {A: [⊢ tp]} (g: ctx) {M: [g ⊢ tm A[]]} ctype =
| VTrue: Val [⊢ bool] [g ⊢ true]
| VFalse: Val [⊢ bool] [g ⊢ false]
| VLam: ({V: [g ⊢ tm S[]]} Safe [⊢ S] [g ⊢ V] → Safe [⊢ T] [g, x: tm S[] ⊢ M']) → Val [⊢ arr S T] [g ⊢ lam (\x.M')]
and
stratified Safe: {A: [⊢ tp]} (g: ctx) {M: [g ⊢ tm A[]]} ctype =
| SafeT: ({S: [g ⊢ tm A[]]} [g ⊢ mstep M S] → [g ⊢ value S] → Val [⊢ A] [g ⊢ S]) → Safe [⊢ A] [g ⊢ M]
;
inductive SafeSub: {g: ctx} (g': ctx) {#S: [g' ⊢ g]} ctype =
| SNil: SafeSub [] [g' ⊢ ^]
| SCons: SafeSub [g] [g' ⊢ #S] → Safe [⊢ A] [g' ⊢ M] → SafeSub [g, x: tm A[]] [g' ⊢ #S, M]
;
rec main_lemma: {g: ctx} {g': ctx} {A: [⊢ tp]} {M: [g ⊢ tm A[]]} {#S: [g' ⊢ g]} SafeSub [g] [g' ⊢ #S]
→ Safe [⊢ A] [g' ⊢ M[#S]] =
/ total a (main_lemma g g' a m s rs) /
?;
Attempting to introduce variables into hole 0 gives the message "Error in intro". When the total declaration is commented out, introducing variables into hole 0 works as expected.
Error message differs between normal execution and +htmltest flag
Commit e354987 introduces a failing test t/error/ctx-mismatch2.bel whose error message described in t/error/ctx-mismatch2.bel.out is the following.
Context mismatch
expected: [g, x : tm |- tm]
found object in context h, y
However, the output when using the +htmltest is
Context mismatch
expected: [g, x : tm |- tm]
found object in context h, x
which causes ./TEST -- +htmltest and the Travis-CI build to fail.
Internal error (indexed inductives)
inductive Flip : Bool → Bool → ctype =
| Flip0 : Flip ffalse ttrue
| Flip1 : Flip ttrue ffalse
;
yields
File "~/su/opsem/indexed/minimal_index.bel", line 1, characters 31-36:
Internal error (please report as a bug):
Can't unmix. At File "~/su/opsem/indexed/minimal_index.bel", line 1, characters 24-28
As far as I can tell from the userguide, my error is that I try to use index with a ctype while only LF types can serve as index.
Wrong contextual type for meta-variable (M)
In the example below Beluga provides the type of M is
{M : [g, x : tm, x : tm |- tm]}
Instead of the expected M with only one variable in the context.
tm : type.
lam : (tm -> tm) -> tm.
app : tm -> tm -> tm.
schema ctx = tm;
rec copy : (g : ctx) [g |- tm] -> [g |- tm] =
fn t => case t of
| [g |- lam M] => ?
;
Identitiy substitutions in blocks (new syntax)
This is an issue with the new syntax where we omit writing identity substitutions.
For example, the following works:
tm: type.
tp: type.
oft: tm -> tp -> type.
schema xtG = some [t:tp] block (x:tm, u:oft x t);
inductive Rxrt: {h:xtG} prop =
| Rxrt_nil : Rxrt []
| Rxrt_cons: Rxrt [h] ->
Rxrt [h, b:block(x:tm, v:oft x A[..])];
In this case it solves the unification problem: A[ ^1] =?= ?Y[ ^1 ] during schema checking
However, writing
inductive Rxrt: {h:xtG} prop =
| Rxrt_nil : Rxrt []
| Rxrt_cons: Rxrt [h] ->
Rxrt [h, b:block(x:tm, v:oft x A)];
does not work, since it tries to solve the unification problem: A[ ^0 ] =?= ?Y[ ^1 ].
Internal error: pattern match failure in index.ml
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
% / total m (invRenStep g1 g2 a m) / %% Totality checker does not see termination
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
% Cannot reconstruct type:
% let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
% ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
% = invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = % ih [g2 |- #R] [g2 |- S]
invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
inductive SN : (g : cxt) {M : [ g |- tm A[] ]} ctype =
| Acc : ({M' : [ g |- tm A[] ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
% Lemma: closure of SN under renaming.
%
% Let Γ₂ ⊢ ρ : Γ₁.
% If Γ₁ ⊢ M ∈ SN then Γ₂ ⊢ [ρ]M ∈ SN.
% By induction on M ∈ SN.
% We show [ρ]M ∈ SN by assuming [ρ]M ⇒ M' and proving M' ∈ SN.
% Assume [ρ]M ⇒ M'.
% Then M ⇒ N with M' = [ρ]N.
% By IH on N ∈ SN, [ρ]N ∈ SN, thus, M' ∈ SN.
% QED.
rec renSN : {g2 : cxt} {#R : [g2 |-# g1]} {M : [g1 |- tm A[]]}
SN [g1 |- M]
-> SN [g2 |- M[#R]] =
% / total s (renSN g1 g2 a r m s) / %% Totality checker not prepared for wf-induction.
mlam g2, #R, M => fn s => let s : SN [g1 |- M] = s in
case s of
| Acc f => Acc (mlam M' => fn r =>
let Ex [g1 |- S] = invRenStep [g1] [g1 |- M] [g2 |- #R] r
in renSN [g2] [g2 |- #R] [g1 |- _] (f [g1 |- _] [g1 |- S])
)
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Closure of Red under renaming
%% (uses closure of SN under renaming and Kripke definition)
rec renRed : {g2 : cxt} {#R : [g2 |-# g1]}
Red [|- A[]] [g1 |- M]
-> Red [|- A[]] [g2 |- M[#R]] =
mlam g2, #R => fn r =>
let r : Red [|- A[]] [g1 |- M] = r in
case r of
| RBase s => RBase (renSN [g2] [g2 |- #R] [g1 |- M] s)
| RArr f => RArr (mlam g', #R', N => fn r => f [g'] [g' |- #R[#R']] [g' |- N] r)
;
%% Closure of RedS under renaming (pointwise from Red)
rec renRedS : {g2 : cxt} {#R : [g2 |-# g1]}
RedS [g] [g1 |- #S ]
-> RedS [g] [g2 |- #S[#R]] =
mlam g2, #R => fn s => case s of
| RNil => RNil
| RCons r s' => RCons (renRed [g2] [g2 |- #R] r)
(renRedS [g2] [g2 |- #R] s')
;
% Applicative contexts
LF ecxt : (tm A -> tm B) -> type =
| eid : ecxt \ x. x
| eext : ecxt C -> ecxt \ x. app (C x) M
;
% Closure under weakhead expansion
rec whExp : {A : [|- ty]} {B : [|- ty]} {T : [|- ty]}
{C : [g, y : tm B[] |- tm T[]]}
{M : [g, x : tm A[] |- tm B[]]}
{N : [g |- tm A[]]}
[g |- SN N] ->
{E : [g |- ecxt \y.C]}
Red [|- T] [g |- C[.., M [.., N]] ]
-> Red [|- T] [g |- C[.., app (abs \ x. M) N] ] =
%% / total t (whExp g a b t) /
mlam A,B,T,C,M,N => fn sn => mlam E => fn r =>
case [|- T] of
| [|- base ] => let RBase s = r in ?
| [|- arr U V] => let RArr f = r in
RArr (mlam g', #S, N0 => fn s =>
whExp
[|- A]
[|- B]
[|- V]
[g', y : tm B[] |- app C[#S[..], y] N0[..]]
[g', x : tm A[] |- M[#S[..],x]]
[g' |- N[#S]]
sn
[g' |- eext E[#S]]
(f [g'] [g' |- #S] [g' |- N0] s)
)
;Reports
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: /home/abel/play/beluga/sn.bel ##
File "src/core/index.ml", line 173, characters 16-21: Pattern matching failed
Interactive mode: hole numbers don't start from 0 after split
Performing a split and then loading any file results in hole numbers that do not start from 0 and corrupts the location information for the previous holes:
# %:load test2.bel
tm : type.
true : tm.
false : tm.
if_then_else : tm -> tm -> tm.
rec f : [ |- tm] -> [ |- tm] =
fn m => ? %{ 0 }% ;
- The file test2.bel has been successfully loaded;
# %:split 0 m
case m of
| [ |- true] => ?
| [ |- false] => ?
| [ |- if_then_else X3 Z3] => ?
;
# %:load test2.bel
tm : type.
true : tm.
false : tm.
if_then_else : tm -> tm -> tm.
rec f : [ |- tm] -> [ |- tm] =
fn m =>
case m of
| ; . |- ([ |- true] : [ |- tm]) : =>
? %{ 3 }%
| ; . |- ([ |- false] : [ |- tm]) : =>
? %{ 4 }%
| {X : [ |- tm]} {Z : [ |- tm]}
; . |- ([ |- if_then_else X Z] : [ |- tm]) : =>
? %{ 5 }%
;
- The file test2.bel has been successfully loaded;
# %:lochole 3
("test2.bel" 9 117 136 9 117 137);
# %:lochole 4
("test2.bel" 10 137 157 10 137 158);
# %:lochole 5
("test2.bel" 11 158 189 11 158 190);
# %:lochole 0
("test2.bel" 8 -4611686018427387893 107 8 96 108);
#
Reloading the file fixes the problem and hole numbers start from 0 as expected.
# %:load test2.bel
tm : type.
true : tm.
false : tm.
if_then_else : tm -> tm -> tm.
rec f : [ |- tm] -> [ |- tm] =
fn m =>
case m of
| ; . |- ([ |- true] : [ |- tm]) : =>
? %{ 0 }%
| ; . |- ([ |- false] : [ |- tm]) : =>
? %{ 1 }%
| {X : [ |- tm]} {Z : [ |- tm]}
; . |- ([ |- if_then_else X Z] : [ |- tm]) : =>
? %{ 2 }%
;
- The file test2.bel has been successfully loaded;
This is a problem for emacs integration because reloading a file into the interpreter after splitting on a variable results in an error when beluga-mode attempts to highlight all of the holes, including holes 0-2 which have incorrect location information. Files need to be loaded twice after a split to get around this.
This also results in incorrect output from numholes, which returns 6 instead of 3.
Uncaught exception due to ?
The following code triggers an internal error in Beluga f65d501:
LF unit : type = unit : unit;
let x : [⊢ ?] = [⊢ unit];
Error message:
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: [...]/bug.bel ##
File "src/core/index.ml", line 176, characters 5-10: Pattern matching failed
Compilation exited abnormally with code 1 at [...]
Lowering of user-written metavariables is confusing
The following code gives confusing output (try in v0.8.1; currently in master this triggers also issue #10 , and I want to keep these two issues separate)
tm : type.
lam : (tm -> tm) -> tm.
c : tm.
rec foo : [ |- tm] -> [|- tm] =
fn d => case d of
| [|- lam M] => ?
;
The M is lowered, so the output is:
File "eg1.bel", line 6, characters 16-17
________________________________________________________________________________
- Meta-Context:
{M : [x : tm |- tm]}
________________________________________________________________________________
- Context:
...
which is inconsistent with what the user wrote. To be consistent with what the user wrote, it would have to say {M : [|- tm -> tm]}. (Compare with the type of lam).
I think that we simply shouldn't lower user-written metavariables and instead accept that they can have types like [g |- tm -> tm].
Internal error: Expected substitution variable
The following code triggers an internal error in Beluga f65d501:
LF unit : type =
| unit : unit
;
rec f : {#x : [⊢ unit]} [⊢ unit] =
mlam X ⇒ impossible [⊢ #X]
;
Error message:
Internal error (please report as a bug):
Expected substitution variable
(The code is accepted if X is replaced with x in the penultimate line.)
Coverage checking interacts badly with strengthening
(Applies to ctx-underscore branch)
The following code fails coverage checking because the underscore in the last case gets the strengthened (closed) term T[], but coverage checking tries to verify that this covers the open term g |- T, which is (ostensibly) more general
tp : type. % name tp T.
nat : tp.
exp : tp -> type. % name exp E x.
zero : exp nat.
s : exp nat -> exp nat.
schema expCtx = some [t:tp] exp t;
rec cntV : {g:expCtx} [g, xxx : exp (T[..]) |- exp (Sxx)] -> [ |- exp nat] =
/ total e (cntV _ _ _ e)/
mlam g =>
fn e =>
case e of % e : exp (S) [g, x:exp (T[..])]
| [g, xx: exp T |- zero] => [ |- zero]
| [g, xx : exp T |- #p[..]] => [ |- zero]
| [g,x : exp T |- x] => [ |- zero]
| [g,x : exp _ |- s W] => [ |- zero]
;
Similarly, (on master), if we explicitly write a pattern with a closed type: T[], coverage fails to perform the strengthening to see that this in fact covers g |- T
tp : type. % name tp T.
nat : tp.
exp : tp -> type. % name exp E x.
zero : exp nat.
s : exp nat -> exp nat.
schema expCtx = some [t:tp] exp t;
rec cntV : {g:expCtx} [g, xxx : exp (T[..]) |- exp (Sxx)] -> [ |- exp nat] =
/ total e (cntV _ _ _ e)/
mlam g =>
fn e =>
case e of % e : exp (S) [g, x:exp (T[..])]
| [g, xx: exp T |- zero] => [ |- zero]
| [g, xx : exp T |- #p[..]] => [ |- zero]
| [g,x : exp T |- x] => [ |- zero]
| [g,x : exp T[] |- s W] => [ |- zero]
;
Forgetting to say a type is closed gives confusing error messages
This code, where I forgot to say in Lam that S is closed:
tp: type.
i : tp.
arr : tp -> tp -> tp.
tm : tp -> type.
lam : (tm S -> tm T) -> tm (arr S T).
schema ctx = tm T;
inductive Tm : (g : ctx) [g |- tm T[]] -> ctype =
| Lam : Tm [g , x: tm S |- M] -> Tm [g |- lam (\x. M)]
;
gives a rather cryptic error message, instead of complaing about the context of S it talks about a substitution that the user did not write:
Ill-typed substitution.
Does not take context: g, x : tm FMV (S ..)
to context: g, z1 : tm ?Y[^0]
Pattern matching on index argument failed
The following code triggers an internal error in Beluga f65d501:
LF bool : type =
| true : bool
| false : bool
;
LF is_true : bool → type =
| is_true : is_true true
;
rec f : {B : [⊢ bool]} [⊢ is_true B] → [⊢ is_true B] =
/ total b (f b) /
mlam B ⇒ fn p ⇒ case p of
| [⊢ is_true] ⇒ case [⊢ B] of
| [⊢ true] ⇒ ?
| [⊢ false] ⇒ ?
;
Error message:
Internal error (please report as a bug):
Pattern matching on index argument failed
Bug in stratification checking
The following should fail stratification checking, but currently doesn't:
tp : type.
i : tp.
arr : tp -> tp -> tp.
stratified Foo : [|- tp] -> ctype =
| Base : Foo [ |- i]
| Arr : (Foo [ |- arr A B] -> Foo [|- B]) -> Foo [|- arr A B];
Similarly with:
stratified Foo : [|- tp] -> ctype =
| Base : Foo [ |- i]
| Arr : (Foo [ |- B] -> Foo [|- B]) -> Foo [|- B];
Non-pattern substitutions should be forbidden in patterns
The following code is accepted, but should be rejected because the substitution associated with M is non-linear; the operational behaviour is not well-defined.
tm : type.
suc : tm -> tm.
z : tm.
rec foo : [x:tm |- tm] -> [|- tm] =
fn d => case d of
| [x:tm |- M[x,x]] => ?
;
`error in intro`
C-c C-i fails on this goal:
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
schema cxt = tm A;
inductive SN : (g : cxt) {M : [ g |- tm A ]} ctype =
| Acc : ({M' : [ g |- tm A ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
%% Application
rec fundApp : %% {g : cxt} {M : [g |- tm (arr A[] B[])]} {N : [g |- tm A}
Red [|- arr A B ] [g |- M ]
-> Red [|- A] [g |- N ]
-> Red [|- B] [g |- app M N ] =
?
;
Constraint failure
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
schema cxt = tm A; % some [a : ty] block tm a;
inductive SN : (g : cxt) {M : [ g |- tm A ]} ctype =
| Acc : ({M' : [ g |- tm A ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
% Corollary: closure under weak head expansion
rec whExp : Red [|- A] [g |- M [.., N] ]
-> Red [|- A] [g |- (app (abs \ x. M) N)] =
?
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Lemmata for fundamental theorem
%% Variable case
rec fundVar : {g : cxt} {#p : [g |- tm A[]]}
RedS [g] [g' |- #S]
-> Red [|- A] [g' |- #p[#S]] =
/ total g (fundVar g) /
mlam g, #p => fn s => case [g] of
| [] => impossible [ |- #p ]
| [g, x : tm A[]] => case [g, x : tm _ |- #p] of
| [g, x : tm A[] |- x ] => let RCons r s' = s in r
| [g, x : tm A[] |- #q[..]] => let RCons r s' = s in fundVar [g] [g |- #q] s'
;
%% Application
rec fundApp : %% {g : cxt} {M : [g |- tm (arr A[] B[])]} {N : [g |- tm A}
Red [|- arr A B ] [g |- M ]
-> Red [|- A] [g |- N ]
-> Red [|- B] [g |- app M N ] =
fn r, s => let s : Red [|- B] [g |- N] = s in %% fake match to bind g and N
let RArr f = r in
f [g] [ g |- .. ] [g |- N] s
;
%% Abstraction
%% rec fundAbs : Red
%% Fundamental theorem
rec thm : {g : cxt} {M : [g |- tm A[]]}
RedS [g] [g' |- #S0]
-> Red [|- A] [g' |- M[#S0]] =
mlam g, M => fn s =>
case [g |- M ] of
| [g |- #p ] => fundVar [g] [g |- #p] s
| [g |- abs \ x. M ] => RArr (mlam g', #S, N => fn r => whExp (thm [g, x : tm _] [g, x : tm _ |- M] ?))
| [g |- app M N ] => fundApp (thm [g] [g |- M] s) (thm [g] [g |- N] s)
;
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: /home/abel/play/beluga/sn.bel ##
Unify.Make(T).GlobalCnstrFailure(_, "abs (\\x. M[ #S0[#S[..]], x]) =/= abs (\\x. M[ #S0[#S[..]], x])")
File "src/core/index.ml", line 956, characters 50-55: Pattern matching failed
The following file is working fine:
% file fail.bel
datatype foo : type =
| bar : foo
;
rec fail : [|- foo] -> [|- foo] =
/ total f (fail f) /
fn f => case f of
| [|- bar] => [|- bar]
;
but add a little v some where and beluga fails without catching the error.
The following code:
% file fail.bel
datatype foo : type =
| bar : foo
;
rec fail : [|- foo] -> [|- foo] =
/ total f (fail f) /
fn f => case f of
v % note the v here
| [|- bar] => [|- bar]
;
will produce:
Compilation started at Thu May 21 15:48:49
beluga /home/niols/Complogic/nicolas.jeannerod/articles/TAPL/fail.bel
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: /home/niols/Complogic/nicolas.jeannerod/articles/TAPL/fail.bel ##
File "src/core/index.ml", line 956, characters 50-55: Pattern matching failed
Compilation exited abnormally with code 1 at Thu May 21 15:48:49
Cannot split on renamed terms
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {#R : [g2 |-# g1]} {M : [g1 |- tm A[]]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
mlam #R, M => fn s => case s of
| [ g2 |- rbeta ] => ?
;
## Type Reconstruction: /home/abel/play/beluga/sn.bel ##
<unknown location>:
Leftover constraints during abstraction.
Indexing before reconstruction is unnecessarily complex
Currently we attempt to do indexing in a phase before type reconstruction, but this is only approximately correct: the indices must later be adjusted when doing reconstruction on patterns and inserting implicit arguments (see apxnorm.ml).
It seems that we should be able to do indexing while performing reconstruction, instead of in a phase before, and that this would simplify reconstruction and help to eliminate apxnorm.
The current indexing phase would just become a desugaring phase, which involves things like disambiguating infix operators.
Internal error in lfholes.ml
The following code triggers an internal error in Beluga f65d501:
LF t : type =
| c : t → t
;
inductive Empty : ctype =
;
LF p : t → type =
| d : p X → p (c X)
;
rec f : {X : [⊢ t]} ([⊢ p X] → Empty) → [⊢ t] =
/ total x (f x) /
mlam X ⇒ fn p ⇒ case [⊢ X] of
| [⊢ c X] ⇒ f [⊢ X] (fn r ⇒ p [⊢ d ?])
;
Error message:
Uncaught exception.
Please report this as a bug.
## LF Holes: [...]/bug.bel ##File "src/core/lfholes.ml", line 27, characters 6-11: Pattern matching failed
beluga-highlight-holes is suddenly slow
As of 8267b59, the beluga-highlight-holes command has become significantly slower. After getting the message that the file has successfully loaded, there's a noticeable delay before the holes are highlighted. When there's only one hole in the file, the delay is about one second. When I use the following file, the delay is more like 8 seconds (these are estimates; I haven't actually timed it).
LF term : type =
| true : term
| false : term
| if_then_else : term -> term -> term -> term
| z : term
| succ : term -> term
| pred : term -> term
| iszero : term -> term
;
LF value : term -> type =
| v_zero : value z
| v_succ : value V -> value (succ V)
| v_true : value true
| v_false : value false
;
let v : [|- value (succ (succ z))] = [|- v_succ (v_succ v_zero)];
let w : [x: term, v: value x |- value (succ (succ x))] =
[x: term, v: value x |- v_succ (v_succ v)];
LF step: term -> term -> type =
| e_if_true : step (if_then_else true M2 M3) M2
| e_if_false : step (if_then_else false M2 M3) M3
| e_pred_zero : step (pred z) z
| e_pred_succ : value V
-> step (pred (succ V)) V
| e_iszero_zero : step (iszero z) true
| e_iszero_succ : value V
-> step (iszero (succ V)) false
| e_if_then_else : step M1 M1'
-> step (if_then_else M1 M2 M3) (if_then_else M1' M2 M3)
| e_succ : step M N
-> step (succ M) (succ N)
| e_pred : step M N
-> step (pred M) (pred N)
| e_iszero : step M N
-> step (iszero M) (iszero N)
;
let e1 : [|- step (pred (succ (pred z))) (pred (succ z))] =
[|- e_pred (e_succ e_pred_zero)] ;
let e2 : [|- step (pred (succ z)) z] = [|- e_pred_succ v_zero] ;
LF tp : type =
| bool : tp
| nat : tp
;
LF hastype : term -> tp -> type =
| t_true : hastype true bool
| t_false : hastype false bool
| t_zero : hastype z nat
| t_if : hastype M1 bool -> hastype M2 T -> hastype M3 T
-> hastype (if_then_else M1 M2 M3) T
| t_succ : hastype M nat
-> hastype (succ M) nat
| t_pred : hastype M nat
-> hastype (pred M) nat
| t_iszero : hastype M nat
-> hastype (iszero M) bool
;
rec tps: [|- hastype M T] -> [|- step M N] -> [|- hastype N T] =
fn d => fn s => case s of
| [|- e_if_true] => ?
| [|- e_if_false] => ?
| [|- e_if_then_else S'] => ?
| [|- e_pred_zero] =>
let [|- t_pred _ ] = d in ?
| [|- e_pred_succ _] => ?
| [|- e_iszero_zero] => ?
| [|- e_iszero_succ _ ] => ?
| [|- e_pred S'] => ?
| [|- e_succ S'] => ?
| [|- e_iszero S'] => ?
;
The empty substitution in the empty contexts is the identity substitution
See the line with the BUG comment below:
tp: type.
i : tp.
arr : tp -> tp -> tp.
inductive Tp : [|- tp] -> ctype =
| I : Tp [|- i]
| Arr : Tp [|- S] -> Tp [|- T] -> Tp [|- arr S T]
;
tm : tp -> type.
c : tm i.
app : tm (arr T S) -> tm T -> tm S.
lam : (tm S -> tm T) -> tm (arr S T).
schema ctx = tm T;
inductive Tm-v : (g : ctx) {#p:[g |- tm T[]]} ctype =
| Tm-v-top : Tm-v [g, x : tm T[] |- x]
| Tm-v-pop : Tm-v [g |- #p] -> Tm-v [g, x : tm T[] |- #p[..]]
;
inductive Tm : (g : ctx) [g |- tm T[]] -> ctype =
| C : Tm [g |- c]
| App : Tm [g |- M] -> Tm [g |- N] -> Tm [g |- app M N]
| Lam : Tm [g , x: tm S[] |- M] -> Tm [g |- lam (\x. M)]
| V : Tm-v [g |- #p] -> Tm [g |- #p]
;
val : tm T -> type.
val-c : val c.
val-l : val (lam (\x. M x)).
inductive Val : [|- val M]-> ctype =
| Val-c : Val [|- val-c]
| Val-l : Val [|- val-l]
;
step : tm T -> tm T -> type.
step-a : step M M' -> step (app M N) (app M' N).
step-b : step (app (lam M) N) (M N).
inductive Step : [|- step M N] -> ctype =
| Step-a : Step [|- E] -> Step [|- step-a E]
| Step-b : Step [|- step-b]
;
step-or-val : tm T -> type.
v : val M -> step-or-val M.
s : step M M' -> step-or-val M.
inductive Step-or-Val : [|- step-or-val E]-> ctype =
| V : Val [|- V] -> Step-or-Val [|- v V]
| S : Step [|- E] -> Step-or-Val[|- s E]
;
inductive Ex-Step-or-Val : ctype =
% BUG: This M need to have the empty subst or otherwise it fails
| PackStep : {E : [|- step-or-val M]} Step-or-Val [|- E] -> Ex-Step-or-Val
;
rec progress :{M : [|- tm T]} [|- step-or-val M] =
/ total m (progress _ m) /
mlam M => case [|- M] of
| [|- c] => [|- v val-c]
| [|- lam (\x. F)] => [|- v val-l]
| [|- app M N] =>
(case progress [|- M] of
| [|- v val-l] => [|- s step-b]
| [|- s E] => [|- s (step-a E)]
)
;
rec prog-r : {M : [|- tm T]} Tm [|- M] -> Ex-Step-or-Val =
mlam M => fn m => case m of
| C => PackStep [|- v val-c] (V Val-c)
| Lam f => PackStep [|- v val-l] (V Val-l)
| App f n =>
let [|- app F N] = [|- M] in
(case prog-r [|- F] f of
% this next line triggers a unification error
| PackStep [|- v val-l] (V Val-l) => ?
)
;
Pattern matching failure in reconstruction
Beluga fails with:
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: /Users/fco/devel/beluga/examples/bugreport.bel ##
File "src/core/reconstruct.ml", line 1330, characters 10-15: Pattern matching failed
When running this file (rename to .bel):
Coverage fails, but maybe should not
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
/ total m (invRenStep g1 g2 a m) / %% Totality checker does not see termination
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
% Cannot reconstruct type:
% let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
% ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
% = invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] => ?
%% Totality checker complains here:
% let Ex [g1 |- S'] = % ih [g2 |- #R] [g2 |- S]
% invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
% in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] => ?
%% Totality checker complains here:
% let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
% in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
The two listed cases seem to be present:
###### COVERAGE FAILURE: Case expression doesn't cover: ######
## CASE(S) NOT COVERED :
(1) .
.
|- [g2 |- rappl Z]
(2) .
.
|- [g2 |- rbeta ]
Improvement for holes
Hole information is not printed when there are left over variables after reconstruction. Reconstruction should fail after printing the hole information.
For example with this program:
nat : type.
z : nat.
vec : nat -> type.
nil : vec z.
inductive Foo : ctype =
| C : [|- vec M] -> Foo
;
rec f : [|- nat] -> Foo =
fn n => C ? % reconstruction fails before printing the context for ?
;
let v = f [|- z];
Pretty printing of substitutions isn't updated to new syntax
Pretty printing still prints things like oft (M .. x) T (old syntax) when it should print something like oft M[..,x] T[] (new syntax)
Uncaught exception, possibly due to missing annotations in context
The following code triggers an internal error in Beluga f65d501:
LF term : type =
| lam : (term → term) → term
;
LF pred : (term → term) → type =
| pred_lam :
({y : term} pred (\x. T x y)) →
pred (\x. lam (\y. T x y))
;
schema ctx = term;
rec foo :
{γ : ctx}
{T : [γ, x : term ⊢ term]}
[γ ⊢ pred (\x. T)] → [⊢ term] =
mlam γ ⇒ mlam T ⇒ fn p ⇒ case p of
| [γ ⊢ pred_lam (\y. P)] ⇒ case [γ, x : term, y : term ⊢ T] of
| [γ, x, y ⊢ #p1[..]] ⇒ ?
;
Error message:
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: [...]/bug.bel ##
File "src/core/apxnorm.ml", line 458, characters 27-32: Pattern matching failed
De Bruijn index seems to be off in context display
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
% / total m (invRenStep g1 g2 a m) / %% Totality checker does not see termination
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
% Cannot reconstruct type:
% let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
% ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
% = invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = % ih [g2 |- #R] [g2 |- S]
invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
inductive SN : (g : cxt) {M : [ g |- tm A[] ]} ctype =
| Acc : ({M' : [ g |- tm A[] ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
% Lemma: closure of SN under renaming.
%
% Let Γ₂ ⊢ ρ : Γ₁.
% If Γ₁ ⊢ M ∈ SN then Γ₂ ⊢ [ρ]M ∈ SN.
% By induction on M ∈ SN.
% We show [ρ]M ∈ SN by assuming [ρ]M ⇒ M' and proving M' ∈ SN.
% Assume [ρ]M ⇒ M'.
% Then M ⇒ N with M' = [ρ]N.
% By IH on N ∈ SN, [ρ]N ∈ SN, thus, M' ∈ SN.
% QED.
rec renSN : {g2 : cxt} {#R : [g2 |-# g1]} {M : [g1 |- tm A[]]}
SN [g1 |- M]
-> SN [g2 |- M[#R]] =
% / total s (renSN g1 g2 a r m s) / %% Totality checker not prepared for wf-induction.
mlam g2, #R, M => fn s => let s : SN [g1 |- M] = s in
case s of
| Acc f => Acc (mlam M' => fn r =>
let Ex [g1 |- S] = invRenStep [g1] [g1 |- M] [g2 |- #R] r
in renSN [g2] [g2 |- #R] [g1 |- _] (f [g1 |- _] [g1 |- S])
)
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
% Corollary: closure under weak head expansion
rec whExp : Red [|- A] [g |- M [.., N] ]
-> Red [|- A] [g |- (app (abs \ x. M) N)] =
?
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Closure of Red under renaming
%% (uses closure of SN under renaming and Kripke definition)
rec renRed : {g2 : cxt} {#R : [g2 |-# g1]}
Red [|- A[]] [g1 |- M]
-> Red [|- A[]] [g2 |- M[#R]] =
mlam g2, #R => fn r =>
let r : Red [|- A[]] [g1 |- M] = r in
case r of
| RBase s => RBase (renSN [g2] [g2 |- #R] [g1 |- M] s)
| RArr f => RArr (mlam g', #R', N => fn r => f [g'] [g' |- #R[#R']] [g' |- N] r)
;
%% Closure of RedS under renaming (pointwise from Red)
rec renRedS : {g2 : cxt} {#R : [g2 |-# g1]}
RedS [g] [g1 |- #S ]
-> RedS [g] [g2 |- #S[#R]] =
mlam g2, #R => fn s => case s of
| RNil => RNil
| RCons r s' => RCons (renRed [g2] [g2 |- #R] r)
(renRedS [g2] [g2 |- #R] s')
;
%% Lemmata for fundamental theorem
%% Variable case
rec fundVar : {g : cxt} {#p : [g |- tm A[]]}
RedS [g] [g' |- #S]
-> Red [|- A] [g' |- #p[#S]] =
/ total g (fundVar g) /
mlam g, #p => fn s => case [g] of
| [] => impossible [ |- #p ]
| [g, x : tm A[]] => case [g, x : tm _ |- #p] of
| [g, x : tm A[] |- x ] => let RCons r s' = s in r
| [g, x : tm A[] |- #q[..]] => let RCons r s' = s in fundVar [g] [g |- #q] s'
;
%% Application
rec fundApp : %% {g : cxt} {M : [g |- tm (arr A[] B[])]} {N : [g |- tm A}
Red [|- arr A B ] [g |- M ]
-> Red [|- A] [g |- N ]
-> Red [|- B] [g |- app M N ] =
fn r, s => let s : Red [|- B] [g |- N] = s in %% fake match to bind g and N
let RArr f = r in
f [g] [ g |- .. ] [g |- N] s
;
%% Abstraction
%% rec fundAbs : Red
%% Fundamental theorem
rec thm : {g : cxt} {M : [g |- tm A[]]}
RedS [g] [g' |- #S0]
-> Red [|- A] [g' |- M[#S0]] =
mlam g, M => fn s =>
case [g |- M ] of
| [g |- #p ] => fundVar [g] [g |- #p] s
| {M : [g, x : tm A[] |- tm B[]]} [g |- abs \ x. M ] =>
RArr (mlam g', #S, N => fn r => ?)
% whExp ?) % (thm [g, x : tm A[]] [g, x : tm A[] |- M] (RCons r (renRedS [g'] [g' |- #S] s))))
| [g |- app M N ] => fundApp (thm [g] [g |- M] s) (thm [g] [g |- N] s)
;
Entry S displays B, but should display g as source context for the renaming.
Hole Number 1
File "/home/abel/play/beluga/sn.bel", line 208, characters 38-39
________________________________________________________________________________
- Meta-Context:
{g : cxt}
{A : [ |- ty]}
{B : [ |- ty]}
{M : [g, x : tm A |- tm B]}
{g' : cxt}
{S : [g' |- # B]}
{N : [g' |- tm A]}
_______________________________________
Debug printing fails
The following code (a very small fragment of cut-elim-crec-cover.bel) works when run with no options, +implicit or +print, but fails with a Match_failure when run with +d.
i : type. % individuals
%name i S.
o : type. % formulas
%name o A.
forall : (i -> o) -> o.
hyp : o -> type. % Hypotheses (left)
conc : o -> type. % Conclusion (right)
forallr : ({a:i} conc (A a)) -> conc (forall (\x. A x)).
schema ctx = some [a: o] hyp a + i + o;
ass: o -> o -> type.
assume: {A:o}conc A -> (hyp A -> conc C) -> ass A C.
rec ca : (g:ctx) [g |- ass (A[..]) (C[..])] -> [g |- conc (C[..])] =
fn e => case e of
| [g |- assume A D (\h. forallr (\a. E1[..,a,h]))] =>
let [g,a:i |- E1'] = ca [g,a:i |- assume A[..] D[..] (\h. E1[..,a,h])] in
[g |- forallr \a. E1']
;
Pretty printing misleading information
If you run this code:
tp: type.
i : tp.
arr : tp -> tp -> tp.
tm : tp -> type.
c : tm i.
app : tm (arr S T) -> tm S -> tm T.
lam : (tm S -> tm T) -> tm (arr S T).
schema ctx = tm T;
inductive Tm-v : (g : ctx) {#p:[g |- tm T[]]} ctype =
| Tm-top : Tm-v [g, x : tm T[] |- x]
| Tm-pop : Tm-v [g |- #p] -> Tm-v [g, x : tm T[] |- #p[..]]
;
inductive Tm : (g : ctx) [g |- tm T[]] -> ctype =
| C : Tm [g |- c]
% | App : Tm [g |- M] -> Tm [g |- N] -> Tm [g |- app M N]
% | Lam : Tm [g , x: tm S[] |- M] -> Tm [g |- lam (\x. M)]
| V : Tm-v [g |- #p] -> Tm [g |- #p]
;
rec wkn-tm : Tm [g |- N] -> Tm [g,x : tm W |- N[..]] =
fn m => case m of
| V v => V (Tm-pop v)
;
You get the following error message:
Ill-typed expression.
Expected type: Tm [g, x : tm (W ..)] [ |- T] [g, z2 |- #p ..]
Inferred type: Tm [g, x : tm ?Y[^0] ] [ |- T] [g, y3 |- #p ..]
Which looks like the two things should unify and the world just went crazy. However, there is a bug in my program here, and Beluga is right in rejecting it. However, the error message is misleading. ?Y is a meta-2 variable and the [^0] is its substitution, critically there is an empty substitution after it. So ?Y requires a closed variable and W might depend on the context. What is misleading is that this printing uses a mix of old vs new style when printing substitutions (it even mixes names a indices) so the empty substitution is not printed (as it used to be the default) instead of printing it
Totality Checker too conservative (recursive call not smaller)
In the code below, Beluga does not recognize (closure_var_SN [_ |- ] [ |- #p] sm') as being smaller.
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty T.
LF tm : ty -> type =
| abs : {A:ty}(tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs _ M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs _ M) (abs _ M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
inductive SN : (g : cxt) {M : [ g |- tm A[]] } ctype =
| SNeu : SNe [g |- R] -> SN [g |- R]
| SAbs : SN [g, x: tm A[] |- M] -> SN [g |- abs A[] \x.M]
| SRed : SNRed [g |- M] [g |- M'] -> SN [g |- M']
-> SN [g |- M]
and inductive SNe : (g : cxt) {M : [ g |- tm A[] ] } ctype =
| SVar : {#p:[g |- tm A[]]} SNe [g |- #p]
| SApp : SNe [g |- R] -> SN [g |- M] -> SNe [g |- app R M]
and inductive SNRed : (g : cxt) {M : [g |- tm A[]]} {M' : [g |- tm A[]]} ctype =
| SBeta : {M:[g, x:tm A[] |- tm B[]]} SN [g |- N]
-> SNRed [g |- app (abs A[] \x.M) N] [g |- M[..,N]]
| SAppl : SNRed [g |- R] [g |- R'] -> SNRed [g |- app R M] [g |- app R' M]
;
%{
Lemma 3.5: Renaming for SN
}%
rec renameSN : {g : cxt}{g' : cxt} {#R : [g' |-# g]}{M : [g |- tm A[]]}
SN [g |- M] -> SN [g' |- M[#R]] =
/ total s (renameSN g g' a r m s) /
mlam g, g', #R, M => fn s => case s of
| SNeu s' => SNeu (renameSNe [g' |- #R] [g |- M] s')
| SAbs s' => SAbs (renameSN [g, x:tm _] [g', x:tm _] [g', x:tm _ |- #R[..], x] [g, x:tm _ |- _] s')
| SRed r s' => SRed (renameSNRed [g' |- #R] [g |- M] r)
(renameSN [g] [g'] [g' |- #R] [g |- _ ] s')
and renameSNe : (g : cxt)(g' : cxt) {#R:[g' |-# g]}{M : [g |- tm A[]]}
SNe [g |- M] -> SNe [g' |- M[#R]] =
/ total s (renameSNe g g' a r m s) /
mlam #R, M => fn s => case s of
| SVar [g |- #p] => SVar [_ |- #p[#R]]
| SApp s1 s2 => SApp (renameSNe [_ |- #R] [_ |- _ ] s1)
(renameSN [_] [_] [_ |- #R] [_ |- _ ] s2)
and renameSNRed: (g : cxt)(g' : cxt) {#R:[g' |-# g]}{M : [g |- tm A[]]}
SNRed [g |- M] [g |- N] -> SNRed [g' |- M[#R]] [g' |- N[#R]]=
/ total s (renameSNRed g g' a r m s) /
mlam #R, M => fn s => case s of
| SBeta [g, x:tm A[] |- M] s' => SBeta [_, x:tm A[] |- M[#R[..], x]] (renameSN [_] [_] [_ |- #R] [_ |- _] s')
| SAppl s' => SAppl (renameSNRed [_ |- #R] [_ |- _ ] s')
;
%{
Lemma 3.7: SN is closded under application to variables
-- Seems not needed --
}%
rec closure_var_SN: {M:[g |- tm (arr A[] B[])]} {#p : [g |- tm A[]]} SN [g |- M] -> SN [g |- app M #p] =
/ total s (closure_var_SN g a b m p s) /
mlam M, #p => fn s => case s of
| SNeu sn => SNeu (SApp sn (SNeu (SVar [_ |- #p])))
| SRed r sm' =>
SRed (SAppl r) (closure_var_SN [_ |- _] [_ |- #p] sm')
| SAbs sn =>
let (sn : SN [g, x:tm A[] |- M']) = sn in
let sn' = renameSN [g, x:tm A[]] [g] [g |- .., #p] [g, x:tm _ |- M'] sn in
SRed (SBeta [g, x:tm A[] |- M'] (SNeu (SVar [g |- #p]))) sn'
;
`%:lochole n` for a bad `n` prints usage instead of error message
Steps to reproduce:
- load a file, with or without holes in it.
- perform
%:lochole 34(or some other bogus number)
Expected result:
No such hole 34
Actual result: the interactive mode usage message is printed.
[RFC] Capitalise ttrue and ffalse ?
The constructors for ctypes have to start with a capital letter. Shouldn't the constructors for Bool be capitalised as well, for consistency?
Meta-variable out of bounds
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
% / total m (invRenStep g1 g2 a m) / %% Totality checker does not see termination
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
% Cannot reconstruct type:
% let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
% ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
% = invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = % ih [g2 |- #R] [g2 |- S]
invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
inductive SN : (g : cxt) {M : [ g |- tm A[] ]} ctype =
| Acc : ({M' : [ g |- tm A[] ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
% Lemma: closure of SN under renaming.
%
% Let Γ₂ ⊢ ρ : Γ₁.
% If Γ₁ ⊢ M ∈ SN then Γ₂ ⊢ [ρ]M ∈ SN.
% By induction on M ∈ SN.
% We show [ρ]M ∈ SN by assuming [ρ]M ⇒ M' and proving M' ∈ SN.
% Assume [ρ]M ⇒ M'.
% Then M ⇒ N with M' = [ρ]N.
% By IH on N ∈ SN, [ρ]N ∈ SN, thus, M' ∈ SN.
% QED.
rec renSN : {g2 : cxt} {#R : [g2 |-# g1]} {M : [g1 |- tm A[]]}
SN [g1 |- M]
-> SN [g2 |- M[#R]] =
% / total s (renSN g1 g2 a r m s) / %% Totality checker not prepared for wf-induction.
mlam g2, #R, M => fn s => let s : SN [g1 |- M] = s in
case s of
| Acc f => Acc (mlam M' => fn r =>
let Ex [g1 |- S] = invRenStep [g1] [g1 |- M] [g2 |- #R] r
in renSN [g2] [g2 |- #R] [g1 |- _] (f [g1 |- _] [g1 |- S])
)
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Closure of Red under renaming
%% (uses closure of SN under renaming and Kripke definition)
rec renRed : {g2 : cxt} {#R : [g2 |-# g1]}
Red [|- A[]] [g1 |- M]
-> Red [|- A[]] [g2 |- M[#R]] =
mlam g2, #R => fn r =>
let r : Red [|- A[]] [g1 |- M] = r in
case r of
| RBase s => RBase (renSN [g2] [g2 |- #R] [g1 |- M] s)
| RArr f => RArr (mlam g', #R', N => fn r => f [g'] [g' |- #R[#R']] [g' |- N] r)
;
%% Closure of RedS under renaming (pointwise from Red)
rec renRedS : {g2 : cxt} {#R : [g2 |-# g1]}
RedS [g] [g1 |- #S ]
-> RedS [g] [g2 |- #S[#R]] =
mlam g2, #R => fn s => case s of
| RNil => RNil
| RCons r s' => RCons (renRed [g2] [g2 |- #R] r)
(renRedS [g2] [g2 |- #R] s')
;
% Applicative contexts
LF ecxt : (tm A -> tm B) -> type =
| eid : ecxt \ x. x
| eext : ecxt C -> ecxt \ x. app (C x) M
;
% Closure under weakhead expansion
rec betaExp : {T : [|- ty]} {M : [g, x: tm A[] |- tm B[]]} [g |- ecxt \x.C]
-> Red [|- T] [g |- C[.., M [.., N]] ]
-> Red [|- T] [g |- C[.., app (abs \ x. M) N] ] =
mlam A => fn e, r => ?
;
## Type Reconstruction: /home/abel/play/beluga/sn.bel ##
Internal error (please report as a bug):
Meta-variable out of bounds -- looking for 5in context
Error disappears if we give the type of C. But we can omit the type of M.
Pi syntax (Error: File "src/core/index.ml", line 164, characters 6-11: Pattern matching failed)
LF ty : type =
| base : ty
| arr : (a b : ty) -> ty
;
Uncaught exception.
Please report this as a bug.
- Error: File "src/core/index.ml", line 164, characters 6-11: Pattern matching failed;
beli query's arguments inverted
It looks like beli query's argument are not EXPECTED TRIES TYPE but TRIES EXPECTED TYPE.
For instance, after having defined:
nat : type.
z : nat.
s : nat -> nat.
I'm trying:
# %:query * 5 N : nat.
%query * 5
nat.
---------- Solution 1 ----------
[]
Empty substitution.
N = z.
...
---------- Solution 5 ----------
[]
Empty substitution.
N = s (s (s (s z))).
Done.
;
but:
# %:query * 5 N : nat.
%query * 5
nat.
---------- Solution 1 ----------
[]
Empty substitution.
N = z.
...
---------- Solution 322 ----------
[]
Empty substitution.
N = s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s (s z)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).
---------- Solution 323 ----------
[]
Empty substitution.
^C
;
I noticed it was the same for %query in files. I don't know where this is inverted, but it seems to be far in the code, since in Logic's more superficial functions this seems still to be the case…
Very conservative coverage checking?
The only instance of impossible in the code below triggers a coverage error:
inductive Empty : ctype =
;
rec f : Empty → Empty =
/ total x (f x) /
fn p ⇒ impossible p
;
Error message:
###### COVERAGE FAILURE: Case expression doesn't cover: ######
## CASE(S) NOT COVERED :
(1) .
., v1: Empty
|- v1
##
The code impossible p is generated by beluga-split-hole, so I assume that this code is intended to be correct.
Substitution.LF.Error("[frontSub] mmvar undefined ")
% Strong normalization for simply-typed lambda-calculus in Beluga
LF ty : type =
| base : ty
| arr : ty -> ty -> ty
;
%name ty A.
LF tm : ty -> type =
| abs : (tm A -> tm B) -> tm (arr A B)
| app : tm (arr A B) -> tm A -> tm B
;
%name tm M.
schema cxt = tm A; % some [a : ty] block tm a;
LF step : tm A -> tm A -> type =
| rbeta : step (app (abs M) N) (M N)
| rabs : ({x : tm A} step (M x) (M' x)) -> step (abs M) (abs M')
| rappl : step M M' -> step (app M N) (app M' N)
| rappr : step N N' -> step (app M N) (app M N')
;
% Lemma: If [ρ]M ⇒ M' then M ⇒ N and M' = [ρ]N.
inductive ExStep : (g1 : cxt) (g2 : cxt)
{M : [g1 |- tm A[]]} {#R : [g2 |-# g1]} {M' : [g2 |- tm A[]]} ctype =
| Ex : [g1 |- step M N] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- N[#R]]
;
rec invRenStep : {g1 : cxt} {M : [g1 |- tm A[]]} {#R : [g2 |-# g1]}
[g2 |- step M[#R] M'] -> ExStep [g1 |- M] [g2 |- #R] [g2 |- M'] =
% / total m (invRenStep g1 g2 a m) / %% Totality checker does not see termination
mlam g1, M, #R => fn s =>
%% We would like to split on s, but limitations of Beluga force us
%% to go the longer route and split on M, such that the renaming
%% is pushed inside.
case [ g1 |- M ] of
%% Case application
| [g1 |- app M1 M2] =>
% Cannot reconstruct type:
% let ih : {#R : [g2 |-# g1]} [g2 |- step (M1[#R]) M'] ->
% ExStep [g1 |- M] [g2 |- #R] [g2 |- M']
% = invRenStep [g1] [g1 |- M1] in
%% We case on the function part.
(case [g1 |- M1] of
%% Case beta-redex
| [g1 |- abs \ x. M1'] => (case s of
%% We either contract the beta-redex...
| [g2 |- rbeta] => Ex [g1 |- rbeta]
%% ... or reduce in the left or right subterm
| [g2 |- rappl S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = % ih [g2 |- #R] [g2 |- S]
invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
| [g2 |- rappr S] =>
%% Totality checker complains here:
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
%% Case not beta-redex
| [g1 |- M1] => (case s of
%% We either reduce in the left subterm ...
| [g2 |- rappl S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M1] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappl S' ]
%% ... or in the right subterm.
| [g2 |- rappr S] =>
let Ex [g1 |- S'] = invRenStep [g1] [g1 |- M2] [g2 |- #R] [g2 |- S]
in Ex [g1 |- rappr S' ]
)
)
%% Case abstraction: reduction is in function body.
| [g1 |- abs \x. M1] => let [g2 |- rabs \y. S] = s in
let Ex [g1, x : tm A[] |- S'] =
invRenStep [g1, x : tm _]
[g1, x : tm _ |- M1] [g2, x : tm _ |- #R[..], x] [g2, y : tm _ |- S ] in
Ex [g1 |- rabs \x. S']
% Case variable: does not reduce
| [g1 |- #p ] => impossible s
;
inductive SN : (g : cxt) {M : [ g |- tm A[] ]} ctype =
| Acc : ({M' : [ g |- tm A[] ]} [ g |- step M M' ] -> SN [ g |- M' ])
-> SN [ g |- M ]
;
% Lemma: closure of SN under renaming.
%
% Let Γ₂ ⊢ ρ : Γ₁.
% If Γ₁ ⊢ M ∈ SN then Γ₂ ⊢ [ρ]M ∈ SN.
% By induction on M ∈ SN.
% We show [ρ]M ∈ SN by assuming [ρ]M ⇒ M' and proving M' ∈ SN.
% Assume [ρ]M ⇒ M'.
% Then M ⇒ N with M' = [ρ]N.
% By IH on N ∈ SN, [ρ]N ∈ SN, thus, M' ∈ SN.
% QED.
rec renSN : {g2 : cxt} {#R : [g2 |-# g1]} {M : [g1 |- tm A[]]}
SN [g1 |- M]
-> SN [g2 |- M[#R]] =
% / total s (renSN g1 g2 a r m s) / %% Totality checker not prepared for wf-induction.
mlam g2, #R, M => fn s => let s : SN [g1 |- M] = s in
case s of
| Acc f => Acc (mlam M' => fn r =>
let Ex [g1 |- S] = invRenStep [g1] [g1 |- M] [g2 |- #R] r
in renSN [g2] [g2 |- #R] [g1 |- _] (f [g1 |- _] [g1 |- S])
)
;
stratified Red : {A : [ |- ty ]} (g : cxt) {M : [ g |- tm A[] ]} ctype =
| RBase : SN [g |- M] -> Red [ |- base ] [g |- M]
| RArr : ({g' : cxt} {#S : [g' |-# g]} {N : [g' |- tm A[]]}
Red [|- A] [g' |- N]
-> Red [|- B] [g' |- app M[#S] N])
-> Red [ |- arr A B ] [g |- M]
;
inductive RedS : {g : cxt} (g' : cxt) {#S : [g' |- g]} ctype =
| RNil : RedS [] [ g' |- ^ ]
| RCons : Red [|- A] [g' |- M]
-> RedS [g] [g' |- #S]
-> RedS [g, x : tm A[]] [g' |- #S, M]
;
%% Closure of Red under renaming
%% (uses closure of SN under renaming and Kripke definition)
rec renRed : {g2 : cxt} {#R : [g2 |-# g1]}
Red [|- A[]] [g1 |- M]
-> Red [|- A[]] [g2 |- M[#R]] =
mlam g2, #R => fn r =>
let r : Red [|- A[]] [g1 |- M] = r in
case r of
| RBase s => RBase (renSN [g2] [g2 |- #R] [g1 |- M] s)
| RArr f => RArr (mlam g', #R', N => fn r => f [g'] [g' |- #R[#R']] [g' |- N] r)
;
%% Closure of RedS under renaming (pointwise from Red)
rec renRedS : {g2 : cxt} {#R : [g2 |-# g1]}
RedS [g] [g1 |- #S ]
-> RedS [g] [g2 |- #S[#R]] =
mlam g2, #R => fn s => case s of
| RNil => RNil
| RCons r s' => RCons (renRed [g2] [g2 |- #R] r)
(renRedS [g2] [g2 |- #R] s')
;
% Applicative contexts
LF ecxt : (tm A -> tm B) -> type =
| eid : ecxt \ x. x
| eext : ecxt C -> ecxt \ x. app (C x) M
;
% Closure under weakhead expansion
rec whExp : {T : [|- ty]}
{C : [g, y : tm B[] |- tm T[]]}
%% {M : [g, x: tm A[] |- tm B[]]}
{N : [g |- tm A[]]}
[g |- ecxt \y.C]
-> Red [|- T] [g |- C[.., M [.., N]] ]
-> Red [|- T] [g |- C[.., app (abs \ x. M) N] ] =
mlam T,C,N => fn e, r =>
let [g |- E] = e in
case [|- T] of
| [|- base ] => ?
| [|- arr U V] => RArr (mlam g', #S, N0 => fn s =>
whExp
[|- V]
[g', x : tm _ |- app C[#S[..], x] N0[..]]
[g' |- N[#S]] [g' |- eext E[#S]]
?)
;
reports
Uncaught exception.
Please report this as a bug.
## Type Reconstruction: /home/abel/play/beluga/sn.bel ##
Substitution.LF.Error("[frontSub] mmvar undefined ")
Compilation exited abnormally with code 1 at Wed May 3 13:52:01
Recommend Projects
-
React
A declarative, efficient, and flexible JavaScript library for building user interfaces.
-
Vue.js
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
-
Typescript
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
-
TensorFlow
An Open Source Machine Learning Framework for Everyone
-
Django
The Web framework for perfectionists with deadlines.
-
Laravel
A PHP framework for web artisans
-
D3
Bring data to life with SVG, Canvas and HTML. 📊📈🎉
-
Recommend Topics
-
javascript
JavaScript (JS) is a lightweight interpreted programming language with first-class functions.
-
web
Some thing interesting about web. New door for the world.
-
server
A server is a program made to process requests and deliver data to clients.
-
Machine learning
Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.
-
Visualization
Some thing interesting about visualization, use data art
-
Game
Some thing interesting about game, make everyone happy.
Recommend Org
-
Facebook
We are working to build community through open source technology. NB: members must have two-factor auth.
-
Microsoft
Open source projects and samples from Microsoft.
-
Google
Google ❤️ Open Source for everyone.
-
Alibaba
Alibaba Open Source for everyone
-
D3
Data-Driven Documents codes.
-
Tencent
China tencent open source team.