module Chapter2.IDesc.Examples.Vec where

open import Data.Unit
open import Data.Nat
open import Data.Fin
open import Data.Vec renaming (Vec to VecNative)
open import Data.Product

open import Relation.Binary.PropositionalEquality

open import Chapter2.IDesc
open import Chapter2.IDesc.Fixpoint
open import Chapter2.IDesc.Tagged

module Compute where
  
  VecD : (A : Set)  func  
  VecD A = func.mk  { zero  `1 
                      ; (suc n)   A λ _  `var n  `1 })

  Vec : (A : Set)    Set
  Vec A = μ (VecD A)

  nil : ∀{A}  Vec A 0
  nil =  tt 

  cons : ∀{A n}  A  Vec A n  Vec A (suc n)
  cons a xs =  a , xs , tt 

module Constraint where

  VecD : (A : Set)  func  
  VecD A = func.mk  n   (Fin 2) 
                          λ { zero   (n  0) λ _  `1  
                            ; (suc zero)   A λ _  
                                             λ m  
                                            (n  suc m) λ _  
                                           `var m  `1
                            ; (suc (suc ())) } )

  Vec : (A : Set)    Set
  Vec A = μ (VecD A)

  nil : ∀{A}  Vec A 0
  nil =  zero , refl , tt 

  cons : ∀{A n}  A  Vec A n  Vec A (suc n)
  cons a xs =  suc zero , a , _ , refl , xs , tt 

module TaggedCompute where

  VecD : (A : Set)  tagDesc 
  VecD A = (0 , λ n  []) ,
            { zero  1 
              ; (suc n)  1 }) ,
            { zero  `1  [] 
              ; (suc n)  ( A λ _  `var n  `1)  [] })

  Vec : (A : Set)    Set
  Vec A = μ (toDesc (VecD A))

  nil : ∀{A}  Vec A 0
  nil =  zero , tt 

  cons : ∀{A n}  A  Vec A n  Vec A (suc n)
  cons a xs =  zero , a , xs , tt 

module TaggedConstraint where

  VecD : (A : Set)  tagDesc 
  VecD A = (2 , λ n  
              ( (n  0) λ _  `1)  
              ( A λ _  
                 λ m  
                (n  suc m) λ _  
               `var m  `1)  []) ,
           ((λ n  0) , λ n  [])

  Vec : (A : Set)    Set
  Vec A = μ (toDesc (VecD A))

  nil : ∀{A}  Vec A 0
  nil =  zero , refl , tt 

  cons : ∀{A n}  A  Vec A n  Vec A (suc n)
  cons a xs =  suc zero , a , _ , refl , xs , tt