changeset 1:6f01428aaf2d

fix
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 26 Mar 2019 18:02:06 +0900
parents 776f851a03a3
children 27e2035653ce
files reflection-ex.agda
diffstat 1 files changed, 61 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/reflection-ex.agda	Fri Mar 15 17:35:46 2019 +0900
+++ b/reflection-ex.agda	Tue Mar 26 18:02:06 2019 +0900
@@ -19,6 +19,10 @@
 isNat (quote ℕ) = true
 isNat _           = false
 
+lemma1 = isNat (quote ℕ)
+lemma10 = isNat (quote isNat)
+--  quote Set is not work
+
 postulate Meta : Set
 {-# BUILTIN AGDAMETA Meta #-}
 
@@ -49,6 +53,9 @@
 {-# BUILTIN AGDALITQNAME  name    #-}
 {-# BUILTIN AGDALITMETA   meta    #-}
 
+lemma11 : ℕ -> Literal 
+lemma11 n = nat n
+
 data Visibility : Set where
   visible hidden instance′ : Visibility
 
@@ -322,6 +329,58 @@
 thm : (a b : ℕ) → plus-to-times (a + b) ≡ a * b
 thm a b = refl
 
+to-term : List ℕ → Term
+to-term [] = con (quote List.[]) []
+to-term (h ∷ t) = con (quote List._∷_)
+                 ( arg (arg-info visible relevant ) (lit (nat h ))
+              ∷  ( arg (arg-info visible relevant ) (to-term t) )
+              ∷ []  )
+      
+varlistArgs : List (Arg Term ) → List ℕ → List ℕ 
+
+varlistPattern : List (Arg Pattern ) → ℕ → List ℕ → List ℕ 
+varlistPattern [] n vars = vars
+varlistPattern (arg i (con c ps) ∷ t) n vars = varlistPattern t n (varlistPattern ps n vars)
+varlistPattern (arg i dot ∷ t) n vars =  varlistPattern t n vars
+varlistPattern (arg i (var s) ∷ t) n vars = varlistPattern t (suc n) vars
+varlistPattern (arg i (lit l) ∷ t) n vars = varlistPattern t n vars
+varlistPattern (arg i (proj f) ∷ t) n vars = varlistPattern t n vars
+varlistPattern (arg i absurd ∷ t) n vars = varlistPattern t n vars
+
+varlist1 : Term → List ℕ → List ℕ 
+varlist1 (var n args ) vars =  ( n  ∷ vars )
+varlist1 (con c args) vars =   varlistArgs args vars
+varlist1 (def f args) vars =  varlistArgs args ( 11 ∷  vars )
+varlist1 (lam v (abs s x)) vars = varlist1 x vars
+varlist1 (pat-lam cs args) vars = varlistArgs args vars
+varlist1 (pi a b) vars =  vars  
+varlist1 (agda-sort s) vars =  vars  
+varlist1 (lit l) vars = vars 
+varlist1 (meta x args) vars =  varlistArgs args vars 
+varlist1 unknown vars =  vars 
+
+varlistArgs [] vars = vars
+varlistArgs (arg i x ∷ rest) vars =
+    varlistArgs rest ( varlist1 x vars )
+
+macro
+    varlist : Term → Term → TC ⊤
+    varlist term hole =
+       unify hole ( to-term ( varlist1 term [] ) )
+
+t0 = varlist ℕ
+t1 = \ x y -> varlist ( varlist1 x y ) 
+t2 = varlist ( \ (x : Term ) (y : List ℕ ) ->  varlist1 x y )  --   is normalized as varlist1 which has no variables
+t3 = varlist ( \ ( x y : ℕ ) ->  (x , y) ) 
+t4 = \{A : Set} -> \ (x  y : A ) ->  varlist (\ (z : A -> A )  -> z y) 
+-- t4' = \{A : Set} -> \ (x  y : A ) ->  varlist (\ z  -> z y)
+t5 = \ (x  y :  ℕ )->  varlist ( x , y )
+
+-- copy_term : Set → Set
+-- copy_term = ?
+
+-- lemma : {A : Set} -> (x y : A) -> (p : A -> A ) -> copy_term ( p x ) ≡  p y
+
 postulate magic : Type → Term
 
 macro
@@ -374,7 +433,7 @@
         ( λ ty → bindTC (declareDef (arg (arg-info visible relevant) id-name) ty )
         ( λ _ → defId id-name) )
 
-lemma1 : ( x : Name  ) → mkId x ≡ mkId' x
-lemma1 x = refl
+lemma2 : ( x : Name  ) → mkId x ≡ mkId' x
+lemma2 x = refl
 
 unquoteDecl id′ = mkId id′