Haskell 本原递归函数的指称语义表示

有没有一种方法可以在Haskell中表示原始递归函数（PRF）的指称语义？

之类的。我们可以使用Haskell类或GADT对基本递归函数进行编码。然后我们可以考虑原始递归函数是数据类型的等价类。最简单的等价是对PRF解释的Haskell表示语义。由于Haskell的指称语义，这种表示最终将是不精确的，但让我们来探讨我们能达到的程度

本原递归函数 我们将使用。A

prfa

是一个具有arity A的基本递归函数，其中A是一个自然数

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}

data PRF (a :: Nat) where
    Const ::                             PRF 'Z
    Succ  ::                             PRF ('S 'Z)
    Proj  :: BNat n                   -> PRF n
    Comp  :: PRF k  -> List k (PRF m) -> PRF m
    PRec  :: PRF k  -> PRF (S (S k))  -> PRF (S k)

Const

构造始终返回0的常量函数或算术零

Succ

是arity one的后续函数

Proj

构造投影函数族，每个投影函数在跳过提供的参数数量后选择一个参数

Comp

将函数与提供其参数的其他函数列表组合

PRec

构建模式与第一个参数匹配的函数<如果第一个参数为零，则code>PRec将第一个函数应用于其余参数。如果第一个参数不是零，它将以第一个参数的前一个作为第一个参数递归到自身中，并返回应用于第一个参数前一个的第二个函数的结果、递归的结果以及其余参数。从

PRF

到Haskell函数的编译器定义中更容易看出这一点

compile :: PRF n -> List n Nat -> Nat
compile Const = const Z
compile Succ  = \(Cons n Nil) -> S n
compile (Proj n) = go n
    where
        go :: BNat n -> List n a -> a
        go BZero     (Cons h _) = h
        go (BSucc n) (Cons _ t) = go n t
compile (Comp f gs) = \ns -> f' . fmap ($ ns) $ gs'
    where
        gs' = fmap compile gs
        f'  = compile f
compile (PRec f g) = h
    where
        h (Cons Z t)     = f' t
        h (Cons (S n) t) = g' (Cons n (Cons (h (Cons n t)) t))
        f' = compile f
        g' = compile g

上述要求定义自然数

Nat

、以类型级自然数

BNat

为边界的自然数，以及具有类型级已知长度的列表

list

import qualified Data.Foldable as Foldable
import System.IO

data Nat = Z | S Nat
    deriving (Eq, Show, Read, Ord)

data List (n :: Nat) a where
    Nil   ::                  List 'Z     a
    Cons  :: a -> List n a -> List ('S n) a

instance Functor (List n) where
    fmap f Nil        = Nil
    fmap f (Cons h t) = Cons (f h) (fmap f t)    

-- A natural number in the range [0, n-1]
data BNat (n :: Nat)  where
    BZero ::           BNat ('S n)
    BSucc :: BNat n -> BNat ('S n)

我们现在可以编写第一个基本递归函数了。我们将写两个恒等式和加法的例子

ident :: PRF (S Z)
ident = Proj BZero

add :: PRF (S (S Z))
add = PRec ident (Comp Succ (Cons (Proj (BSucc BZero)) Nil))

注意，我们在Haskell中使用声明来简化这些函数的编写；我们在

add

的定义中使用了

ident

。最终，使用Haskell声明的能力将允许我们创建无限或非完全递归结构，我们可以潜入

PRF

类型

我们可以编写一些示例代码来尝试我们的

add

函数。对于

seq

和

hFlush

的求值顺序，我们会有点偏执，这样我们可以在以后看到我们的表示有多错误

mseq :: Monad m => a -> m a
mseq a = a `seq` return a

runPRF :: PRF n -> List n Nat -> IO ()
runPRF f i = 
    do
        putStrLn "Compiling function"
        hFlush stdout
        f' <- mseq $ compile f
        putStrLn "Running function"
        hFlush stdout
        n <- mseq $ f' i
        print n

哈斯克尔声明 通过Haskell声明，我们可以做一些有趣且最终具有破坏性的事情。首先，我们将简化模式匹配。如果能够使用

PRec

中的模式匹配，而不提供使用递归结果的函数，那就太好了

match

将为我们添加额外的伪参数

match :: (Depths List k) => PRF k -> PRF (S k) -> PRF (S k)
match fz fs = PRec fz (addArgument (BSucc BZero) fs)

要做到这一点，它需要一个helper函数来添加参数，

addArgument

，以及一些其他实用程序来测量具有已知类型的列表的大小，

depts

，比较和转换

BNat

s，并证明递增的自然数仍在新的界限下

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}

class Depths f (n :: Nat) where
    depths :: f n (BNat n)

instance Depths List 'Z where
    depths = Nil

instance (Depths List n) => Depths List ('S n) where
    depths = Cons BZero (fmap BSucc depths)

deriving instance Eq (BNat n)
deriving instance Show (BNat n)
deriving instance Ord (BNat n)

bid :: BNat n -> BNat (S n)
bid BZero = BZero
bid (BSucc x) = BSucc (bid x)

addArgument :: (Depths List k) => BNat (S k) -> PRF k -> PRF (S k)
addArgument n f = Comp f . fmap p $ depths
    where
        p d =
            if d' >= n
            then Proj (BSucc d)
            else Proj d'
            where d' = bid d

当你写一些非常合理的东西，比如

nonZero :: PRF (S Z)
nonZero = match Const (Comp Succ (Cons (Comp Const Nil) Nil))

isZero :: PRF (S Z)
isZero = match (Comp Succ (Cons Const Nil)) (Comp Const Nil)

isOdd :: PRF (S Z)
isOdd = PRec Const (addArgument BZero isZero)

递归Haskell声明 我们还可以编写非常具有破坏性的东西，而不仅仅是

未定义的
。首先，我们将使用递归定义
while
构造。我们知道用
而
构建的东西不应该存在于原始递归函数的闭包中

while :: (Depths List k) => PRF (S k) -> PRF (S k) -> PRF (S k)
while test step = goTest
    where
        --goTest :: PRF (S k)
        goTest  = Comp goMatch (Cons test (fmap Proj depths))
        --goMatch :: PRF (S (S k))
        goMatch = match (Proj BZero) (addArgument BZero goStep)
        --goStep :: PRF (S k)
        goStep  = Comp goTest (Cons step (fmap (Proj . BSucc) depths))

这使我们可以编写一个仅对某些输入不终止的循环

infiniteLoop :: PRF (S Z)
infiniteLoop = while isOdd (Comp Succ (Cons Succ Nil))

如果我们对偶数运行此函数，如
Z
或
S（sz）
，它将终止返回输入。如果我们运行一个奇数，它永远不会结束

runPRF infiniteLoop (Cons (S Z) Nil)
Compiling function
Running function

因为我们对
seq
和
hFlush
非常小心，所以我们可以确定编译后的值以正常形式存在，它不是一个原始的递归函数，也不是简单的
未定义的
。这是因为
编译
步骤不严格，并且减少到week head范式不会导致减少到head范式。我们可以通过将
seq
s添加到
compile
来解决这个问题。我只改变了需要它的两种模式

compile (Comp f gs) = f' `seq` gs' `seq` go
    where
        go = \ns -> f' . fmap ($ ns) $ gs'
        gs' = fmap compile gs
        f'  = compile f
compile (PRec f g) = f' `seq` g' `seq` h
    where
        h (Cons Z t)     = f' t
        h (Cons (S n) t) = g' (Cons n (Cons (h (Cons n t)) t))
        f' = compile f
        g' = compile g

这将在编译时检查
PRF
是否有限

runPRF infiniteLoop (Cons Z Nil)
Compiling function
GHC stack-space overflow: current limit is 33632 bytes.
Use the `-K<size>' option to increase it.

runPRF infinitelop（Cons Z Nil）
编译功能
GHC堆栈空间溢出：当前限制为33632字节。
使用“-K”选项将其增加。

整理
我们所讨论的类型中没有一个真正代表一对一的原始递归函数
PRF a
由除上面定义的递归结构和
未定义的
之外的其他东西所占据。它还由相同的基本递归函数的多个表示形式所占据。例如，identity函数有其他定义，包括前置函数（我没有定义）与后继函数的组合。编译的结果，
listnat->Nat
，由任何具有相同类型的Haskell函数占据，该函数也将包括所有部分递归函数

要隐藏同一函数的多个表示形式，我们可以使用Haskell的相同技巧：隐藏函数的内部。如果有人能够检查
PRF
的唯一方法是严格编译它并将其应用于某个对象，那么没有人能够分辨出不同表示的相同基本递归函数之间的区别

将GADT转换为typeclass并仅导出类和编译就足以隐藏构造函数

如果我们把头转一转，注意到t，就可以找到出口
runPRF infiniteLoop (Cons Z Nil)
Compiling function
GHC stack-space overflow: current limit is 33632 bytes.
Use the `-K<size>' option to increase it.