haskell中原始递归函数的良好表示

Cir*_*dec 4 recursion haskell

在前一个问题答案中争论说,可以在Haskell中表示原始递归函数(PRF)和single或的单个额外值的并集undefined.这个论点是基于原始递归函数的公理结构的直接翻译; 它需要一些语言扩展和关于函数arity的类型级推理.是否有可能在更惯用的Haskell中表示一组等效的原始递归函数?

理想情况下,PRF的惯用语表示应能满足以下所有条件:

  • 提供一个Category实例
  • 关于函数arity的类型级推理不需要乱七八糟

除了原始递归的要求

  • 任何undefined输入功能都undefined适用于所有输入.这将PRF集限制为单个不可避免的额外值⊥,而不是包含多个部分递归函数.这意味着while循环或类似的部分递归函数的任何定义都应该是undefined.

我注意到原始递归函数的公理就像Category法则一样,Arrow没有arr(实际上它与之相反arr),而且只有自然数才有效的有限形式的循环.

Cir*_*dec 8

在Haskell中有一个非常简单的原始递归函数表示.它是一个newtype函数,我们将断言是一个正构构造的原始递归函数.我们不导出构造函数以防止构造可能部分递归的任意函数.这种技术称为智能构造函数.

module Data.PRF (
    -- We don't export the PRF constructor
    PRF (runPRF),
) where

newtype PRF b c = PRF {runPRF :: b -> c}
Run Code Online (Sandbox Code Playgroud)

我们还需要提供一个构建PRFs 的接口.甲Category实例将提供的PRF所需的扩展的组合物的组成部分.

import Prelude hiding (id, (.), fst, snd, succ)
import Control.Category

instance Category PRF where
    id = PRF id
    PRF f . PRF g = PRF $ f `seq` g `seq` (f . g)
Run Code Online (Sandbox Code Playgroud)

在得到任何结果之前,seqs要求f并且g处于弱头正常形式; 如果任何一个功能,undefined那么组合undefined也是如此.

原始递归函数还需要投影从多个中选择一个参数.我们将此视为从数据结构中选择一条数据.如果我们使用元组而不是已知长度的列表,则投影函数变为fstsnd.再加上类似Arrow(&&&)建立,我们可以覆盖所有的扩展投影要求的元组.PRF就像"没有箭头arr"; arr将允许任意部分递归函数PRFs.我们将定义ArrowLike类别类.

class Category a => ArrowLike a where
    fst   :: a (b, d) b
    snd   :: a (d, b) b
    (&&&) :: a b c -> a b c' -> a b (c,c')

    first :: a b c -> a (b, d) (c, d)
    first = (*** id)

    second :: a b c -> a (d,b) (d,c)
    second = (id ***)

    (***) :: a b c -> a b' c' -> a (b,b') (c,c')
    f *** g = (f . fst) &&& (g . snd)
Run Code Online (Sandbox Code Playgroud)

投影功能fstsnd利用的地方arr.它们是ArrowLike与扇出结合时描述行为所需的唯一功能(&&&).

在我们提供ArrowLike实例之前,PRF我们将说明普通函数(->)是如何实现的ArrowLike

import qualified Prelude (fst, snd)

instance ArrowLike (->) where
    fst = Prelude.fst
    snd = Prelude.snd
    f &&& g = \b -> (f b, g b)
Run Code Online (Sandbox Code Playgroud)

对于PRF小号我们将使用我们的定义中使用的相同的归纳步(.)Category实例和需求这两个功能是弱头部正常形态.

instance ArrowLike PRF where
    fst = PRF fst
    snd = PRF snd
    PRF f &&& PRF g = PRF $ f `seq` g `seq` (f &&& g)
Run Code Online (Sandbox Code Playgroud)

最后,我们将提供原始递归本身.我们将使用元组直接从公理定义转换原始递归,而不是增加函数arities.

class ArrowLike a => PrimRec a where
    zero :: a b   Nat
    succ :: a Nat Nat
    prec :: a e c -> a (c, (Nat,e)) c -> a (Nat, e) c
Run Code Online (Sandbox Code Playgroud)

Nat是一个自然数data Nat = Z | S Nat.我选择将常量函数zero和后继函数视为原始递归的一部分,Nat它们构造的值可以解构或检查的唯一方法是使用prec.这是很有诱惑力的替代zeroconst :: c -> a b c; 这将是一个致命的缺陷,因为有人可以介绍infinity = S infinityconstprec进入一个无限循环.

部分递归函数(->)支持原始递归.

instance PrimRec (->) where
    zero = const Z
    succ = S
    prec f g = go
        where
            go (Z, d) = f d
            go (S n, d) = g (go (n, d), (n, d))
Run Code Online (Sandbox Code Playgroud)

我们将定义原始递归PRF使用我们用于相同感应伎俩(.)(&&&).

instance PrimRec PRF where
    zero = PRF zero
    succ = PRF succ
    prec (PRF f) (PRF g) = PRF $ f `seq` g `seq` prec f g
Run Code Online (Sandbox Code Playgroud)

原始递归函数Category具有构造和解构元组和自然数的能力.

例子

add使用此接口更容易定义原始递归函数.

import Prelude hiding (id, (.), fst, snd, succ)

import Control.Category
import Data.PRF

add :: PrimRec a => a (Nat, Nat) Nat
add = prec id (succ . fst)
Run Code Online (Sandbox Code Playgroud)

我们仍然可以定义有用的函数match,这些函数有助于构建原始递归函数,这些函数分支自然是否为零.

match :: PrimRec a => a b c -> a (Nat, b) c -> a (Nat, b) c
match fz fs = prec fz (fs . snd)
Run Code Online (Sandbox Code Playgroud)

使用match我们可以很容易地快速测试一个值Z是否是最终是否是奇数

one :: PrimRec a => a b Nat
one = succ . zero

nonZero :: PrimRec a => a Nat Nat
nonZero = match zero one . (id &&& id)

isZero :: PrimRec a => a Nat Nat
isZero = match one zero . (id &&& id)

isOdd :: PrimRec a => a Nat Nat
isOdd = prec zero (isZero . fst) . (id &&& id)
Run Code Online (Sandbox Code Playgroud)

我们仍然可以编写通常递归的Haskell声明,但所有PRF以这种方式构建的声明都将是undefined.

while :: PrimRec a => a s Nat -> a s s -> a s s
while test step = goTest
    where
        goTest = goMatch . (test &&& id)
        goMatch = match id (goStep . snd)
        goStep = goTest . step
Run Code Online (Sandbox Code Playgroud)

此函数infiniteLoop将无法仅针对奇数输入终止.

infiniteLoop :: PrimRec a => a Nat Nat
infiniteLoop = while isOdd (succ . succ)
Run Code Online (Sandbox Code Playgroud)

在运行我们的示例时,我们会像上一个答案一样小心评估顺序.

import System.IO

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

run :: Show b => PRF a b -> a -> IO ()
run f i = 
    do
        putStrLn "Compiling function"
        hFlush stdout
        f' <- mseq $ runPRF f
        putStrLn "Running function"
        hFlush stdout
        n <- mseq $ f' i
        print n
Run Code Online (Sandbox Code Playgroud)

我们可以评估PRF方便定义的s match.

run isOdd (S $ S $ S Z)

Compiling function
Running function
S Z
Run Code Online (Sandbox Code Playgroud)

但是,所定义的函数infiniteLoopundefined在一般情况下,不只是为奇数值.

run infiniteLoop (Z)

Compiling function
Run Code Online (Sandbox Code Playgroud)