fibonacci.hs

fibs10 :: [NUI]
fibs10 = take 10 fibs

fibs :: [NUI]
fibs = unPolynomial $ star (Polynomial [NUI 0, NUI 1, NUI 1])

-- | \mathbb{N} \bigcup \infty
data NUI = NUI Word | Inf                                                                                                                      
  deriving (Eq, Show)                                                                                                                          
                                                                                                                                               
instance Semiring NUI where                                                                                                                    
  zero = NUI 0                                                                                                                                 
  one = NUI 1
  plus Inf _ = Inf                                                                                                                             
  plus _ Inf = Inf                                                                                                                             
  plus (NUI x) (NUI y) = NUI (x `plus` y)                                                                                                      
  times Inf _ = Inf                                                                                                                            
  times _ Inf = Inf                                                                                                                            
  times (NUI x) (NUI y) = NUI (x `times` y)                                                                                                    
                                                                                                                                               
instance Star NUI where                                                                                                                        
  star (NUI 0) = NUI 1                                                                                                                         
  star _ = Inf                                                                                                                                 
                                                                                                                                                                                                                      
                                                                                                                                               
newtype Polynomial a = Polynomial { unPolynomial :: [a] }                                                                                      
  deriving (Eq, Show)                                                                                                                          
                                                                                                                                               
instance Semiring a => Semiring (Polynomial a) where                                                                                           
  zero = Polynomial []                                                                                                                         
  one = Polynomial [one]                                                                                                                       
  Polynomial [] `plus` y = y                                                                                                                   
  x `plus` Polynomial [] = x                                                                                                                   
  Polynomial (x:xs) `plus` Polynomial (y:ys) = Polynomial $ (x `plus` y) : unPolynomial (Polynomial xs `plus` Polynomial ys)                   
  Polynomial [] `times` _ = Polynomial []                                                                                                      
  _ `times` Polynomial [] = Polynomial []                                                                                                      
  Polynomial (a:p) `times` Polynomial (b:q) = Polynomial $ ((a `times` b) :) $                                                                 
    unPolynomial $                                                                                                                             
      ( Polynomial (map (a `times`) q) `plus` Polynomial (map (`times` b) p) `plus` Polynomial ((zero : (p `times` q)))                        
      )                                                                                                                                        
                                                                                                                                               
instance Star a => Star (Polynomial a) where                                                                                                   
  star (Polynomial []) = one                                                                                                                   
  star (Polynomial (a:p)) = r                                                                                                                  
    where                                                                                                                                      
      r = times                                                                                                                                
        (Polynomial [star a])                                                                                                                  
        (Polynomial $ (one :) $ unPolynomial $ Polynomial p `times` r)