Question

在阅读出色的《类型驱动开发》书并尝试对其中的任务进行一些小的修改时，面对了下一个问题。

module Main

import Data.Vect

%default total

data Forever = More Forever

partial
forever : Forever
forever = More forever

data StackCmd : Type -> (inputHeight : Nat) -> (outputHeight : Nat) -> Type where
  Push : Integer -> StackCmd () height (S height)
  Pop : StackCmd Integer (S height) height
  Top : StackCmd Integer (S height) (S height)

  PutStr : String -> StackCmd () h h
  PutStrLn : String -> StackCmd () h h
  GetStr : StackCmd String h h

  Pure : a -> StackCmd a h h
  (>>=) : StackCmd a h1 h2 -> (a -> StackCmd b h2 h3) -> StackCmd b h1 h3


runStack : (stck : Vect inH Integer) -> StackCmd ty inH outH -> IO (ty, Vect outH Integer)
runStack stck (Push x) = pure ((), x :: stck)
runStack (x :: xs) Pop = pure (x, xs)
runStack (x :: xs) Top = pure (x, x :: xs)
runStack xs (PutStr str) = do putStr str; pure ((), xs)
runStack xs (PutStrLn str) = do putStrLn str; pure ((), xs)
runStack xs (GetStr) = do str <- getLine; pure (str, xs)
runStack stck (Pure x) = pure (x, stck)
runStack stck (x >>= f) = do (x', stck') <- runStack stck x 
                             runStack stck' (f x')

data StackIO : Nat -> Type where
  Do :    StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
  QuitCmd : (a : Nat) -> StackIO a

namespace StackDo
  (>>=) : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
  (>>=) = Do

data Input : Type where
  INumber : Integer -> Input
  IAdd : Input
  IDuplicate : Input
  IDiscard : Input

parseInput : String -> Maybe Input
parseInput str = 
  case str of
    "" => Nothing
    "add" => Just IAdd
    "duplicte" => Just IDuplicate
    "discard" => Just IDiscard
    _      => if all isDigit $ unpack str then Just (INumber $ cast str) else Nothing


run : Forever -> Vect n Integer -> StackIO n -> IO ()
run _          _    (QuitCmd a) = pure ()
run (More far) stck (Do sa f)   = do (a', stck') <- runStack stck sa 
                                     run far stck' (f a')

biOp : (Integer -> Integer -> Integer) -> StackCmd String (S (S height)) (S height)
biOp op = do a <- Pop 
             b <- Pop
             let res = a `op` b
             Push res
             Pure $ show res

discardUnOp : StackCmd String (S height) height
discardUnOp = do v <- Pop
                 Pure $ "Discarded: " ++ show v

duplicateUnOp : StackCmd String (S height) (S (S height))
duplicateUnOp = do v <- Top
                   Push v
                   Pure $ "Duplicated: " ++ show v

mutual
  tryBiOp : String -> (Integer -> Integer -> Integer) -> StackIO hin
  tryBiOp _      op {hin=S (S k)} = do res <- biOp op
                                       PutStrLn res
                                       stackCalc
  tryBiOp opName _                = do PutStrLn $
                                         "Unable to execute operation " ++ opName ++ ": fewer then two items on stack."
                                       stackCalc

  tryUnOp : Show a => String -> StackCmd a hIn hOut -> StackIO hIn
  tryUnOp _ op   {hIn=S h} = do res <- op
                                PutStrLn $ show res
                                stackCalc
  tryUnOp opName _         = do PutStrLn $ 
                                  "Unable to execute " ++ opName ++ " operation: no elements on stack."
                                stackCalc

  stackCalc : StackIO height
  stackCalc = do PutStr "> "
                 inp <- GetStr
                 case parseInput inp of
                   Nothing => do PutStrLn "invalid input"; stackCalc
                   (Just (INumber x)) => do Push x; stackCalc
                   (Just IAdd) => tryBiOp "add" (+)
                   (Just IDuplicate) => ?holedup
                   (Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp

partial
main : IO ()
main = run forever [] stackCalc

上面给出的代码主要来自TDD书。抱歉，它有点长：可以编译。该代码非常简单：这是在vector之上实现的堆栈。然后，用户可以在命令提示符下键入数字（每行一个），然后程序将数字压入堆栈。用户也可以调用操作，即add。 add从堆栈中弹出两个元素，添加它们并将结果推回堆栈中。因此，add至少需要两个数字才能被堆栈。

请查看tryBiOp函数。它以Integer -> Integer -> Integer（即(+)或(-)）操作作为参数，并返回执行所需操作的StackCmd操作序列。结果，程序员可以在(Just IAdd) => tryBiOp "add" (+)内编写stackCalc。这与我想要的东西非常接近。

问题。接下来，我要做的事情是为需要堆栈上一个元素的操作使用相同的包装器（名为tryUnOp）。并且由于这些操作不是在整数上，而是在堆栈本身上（即“堆栈顶部重复”或“丢弃顶部元素”），我想将StackCmd操作的序列而不是{{1 }}。所以，我想获得的是

Integer -> Integer -> Integer

问题。。如果取消注释字符串(Just IDuplicate) => tryUnOp "duplicate" $ (do v <- Top Push v Pure $ "Duplicated: " ++ show v)中的代码（并删除孔），则会看到无法编译代码。我所看到的问题是，当我打电话给(Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp时，Idris会发现tryUnOp "discard" discardUnOp的{{1}}的形式必须为（S k），因为它遵循tryUnOp的类型。但是hIn不提供这种保证。

有效的解决方案。它可以工作，但一元运算和二进制运算本质上是相同的。因此，这并不是我想要的。有一个函数可以将操作名称转换为堆栈命令序列：

discardUnOp

任何想法/评论都很好！

从TDD书中堆叠代码：尝试删除重复的代码

0 个答案: