- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
在上一个问题中SystemT Compiler and dealing with Infinite Types in Haskell我询问如何将 SystemT Lambda Calculus 解析为 SystemT Combinators。我决定使用普通代数数据类型来编码 SystemT Lambda 演算和 SystemT Combinator 演算(基于评论:SystemT Compiler and dealing with Infinite Types in Haskell)。
SystemTCombinator.hs:
module SystemTCombinator where
data THom = Id
| Unit
| Zero
| Succ
| Compose THom THom
| Pair THom THom
| Fst
| Snd
| Curry THom
| Eval
| Iter THom THom
deriving (Show)
SystemTLambda.hs:
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeSynonymInstances #-}
module SystemTLambda where
import Control.Monad.Catch
import Data.Either (fromRight)
import qualified SystemTCombinator as SystemTC
type TVar = String
data TType = One | Prod TType TType | Arrow TType TType | Nat deriving (Eq)
instance Show TType where
show ttype = case ttype of
One -> "'Unit"
Nat -> "'Nat"
Prod ttype1 ttype2 ->
"(" ++ show ttype1 ++ " * " ++ show ttype2 ++ ")"
Arrow ttype1@(Arrow _ _) ttype2 ->
"(" ++ show ttype1 ++ ") -> " ++ show ttype2
Arrow ttype1 ttype2 -> show ttype1 ++ " -> " ++ show ttype2
data TTerm = Var TVar
| Let TVar TTerm TTerm
| Lam TVar TTerm
| App TTerm TTerm
| Unit
| Pair TTerm TTerm
| Fst TTerm
| Snd TTerm
| Zero
| Succ TTerm
| Iter TTerm TTerm TVar TTerm
| Annot TTerm TType
deriving (Show)
-- a context is a list of hypotheses/judgements
type TContext = [(TVar, TType)]
-- our exceptions for SystemT
data TException = TypeCheckException String
| BindingException String
deriving (Show)
instance Exception TException
newtype Parser a = Parser { run :: TContext -> Either SomeException a }
instance Functor Parser where
fmap f xs = Parser $ \ctx ->
either Left (\v -> Right $ f v) $ run xs ctx
instance Applicative Parser where
pure a = Parser $ \ctx -> Right a
fs <*> xs = Parser $ \ctx ->
either Left (\f -> fmap f $ run xs ctx) (run fs ctx)
instance Monad Parser where
xs >>= f = Parser $ \ctx ->
either Left (\v -> run (f v) ctx) $ run xs ctx
instance MonadThrow Parser where
throwM e = Parser (const $ Left $ toException e)
instance MonadCatch Parser where
catch p f = Parser $ \ctx ->
either
(\e -> case fromException e of
Just e' -> run (f e') ctx -- this handles the exception
Nothing -> Left e) -- this propagates it upwards
Right
$ run p ctx
withHypothesis :: (TVar, TType) -> Parser a -> Parser a
withHypothesis hyp cmd = Parser $ \ctx -> run cmd (hyp : ctx)
tvarToHom :: TVar -> Parser (SystemTC.THom, TType)
tvarToHom var = Parser $ \ctx ->
case foldr transform Nothing ctx of
Just x -> Right x
Nothing -> throwM $ BindingException ("unbound variable " ++ show var)
where
transform (var', varType) homAndType =
if var == var'
then Just (SystemTC.Snd, varType)
else homAndType >>= (\(varHom, varType) -> Just (SystemTC.Compose SystemTC.Fst varHom, varType))
check :: TTerm -> TType -> Parser SystemTC.THom
-- check a lambda
check (Lam var bodyTerm) (Arrow varType bodyType) =
withHypothesis (var, varType) $
check bodyTerm bodyType >>= (\bodyHom -> return $ SystemTC.Curry bodyHom)
check (Lam _ _ ) ttype = throwM
$ TypeCheckException ("expected function type, got '" ++ show ttype ++ "'")
-- check unit
check Unit One = return SystemTC.Unit
check Unit ttype =
throwM $ TypeCheckException ("expected unit type, got '" ++ show ttype ++ "'")
-- check products
check (Pair term1 term2) (Prod ttype1 ttype2) = do
hom1 <- check term1 ttype1
hom2 <- check term2 ttype2
return $ SystemTC.Pair hom1 hom2
check (Pair _ _ ) ttype = throwM
$ TypeCheckException ("expected product type, got '" ++ show ttype ++ "'")
-- check primitive recursion
check (Iter baseTerm inductTerm tvar numTerm) ttype = do
baseHom <- check baseTerm ttype
inductHom <- withHypothesis (tvar, ttype) (check inductTerm ttype)
numHom <- check numTerm Nat
return $ SystemTC.Compose (SystemTC.Pair SystemTC.Id numHom)
(SystemTC.Iter baseHom inductHom)
-- check let bindings
check (Let var valueTerm exprTerm) exprType = do
(valueHom, valueType) <- synth valueTerm
exprHom <- withHypothesis (var, valueType) (check exprTerm exprType)
return $ SystemTC.Compose (SystemTC.Pair SystemTC.Id valueHom) exprHom
check tterm ttype = do
(thom, ttype') <- synth tterm
if ttype == ttype'
then return thom
else throwM $ TypeCheckException
( "expected type '"
++ show ttype
++ "', inferred type '"
++ show ttype'
++ "'"
)
synth :: TTerm -> Parser (SystemTC.THom, TType)
synth (Var tvar) = tvarToHom tvar
synth (Let var valueTerm exprTerm) = do
(valueHom, valueType) <- synth valueTerm
(exprHom, exprType) <- withHypothesis (var, valueType) (synth exprTerm)
return (SystemTC.Compose (SystemTC.Pair SystemTC.Id valueHom) exprHom, exprType)
synth (App functionTerm valueTerm) = do
(functionHom, functionType) <- synth functionTerm
case functionType of
Arrow headType bodyType -> do
valueHom <- check valueTerm headType
return (SystemTC.Compose (SystemTC.Pair functionHom valueHom) SystemTC.Eval, bodyType)
_ -> throwM $ TypeCheckException ("expected function, got '" ++ show functionType ++ "'")
synth (Fst pairTerm) = do
(pairHom, pairType) <- synth pairTerm
case pairType of
Prod fstType sndType -> return (SystemTC.Compose pairHom SystemTC.Fst, fstType)
_ -> throwM $ TypeCheckException ("expected product, got '" ++ show pairType ++ "'")
synth (Snd pairTerm) = do
(pairHom, pairType) <- synth pairTerm
case pairType of
Prod fstType sndType -> return (SystemTC.Compose pairHom SystemTC.Snd, sndType)
_ -> throwM $ TypeCheckException ("expected product, got '" ++ show pairType ++ "'")
synth Zero = return (SystemTC.Compose SystemTC.Unit SystemTC.Zero, Nat)
synth (Succ numTerm) = do
numHom <- check numTerm Nat
return (SystemTC.Compose numHom SystemTC.Succ, Nat)
synth (Annot term ttype) = do
hom <- check term ttype
return (hom, ttype)
synth _ = throwM $ TypeCheckException "unknown synthesis"
我使用上述双向类型检查器将 SystemTLambda.TTerm
解析为 SystemTCombinator.THom
。
systemTLambda :: TTerm
systemTLambda =
Let "sum"
(Annot
(Lam "x" $ Lam "y" $
Iter (Var "y") (Succ $ Var "n") "n" (Var "x"))
(Arrow Nat $ Arrow Nat Nat))
(App
(App
(Var "sum")
(Succ $ Succ Zero))
(Succ $ Succ $ Succ Zero))
systemTCombinator :: Either SomeException (SystemTC.THom, SystemTC.TType)
systemTCombinator = fromRight Unit $ run (synth result) []
组合子表达式为:
Compose (Pair Id (Curry (Curry (Compose (Pair Id (Compose Fst Snd)) (Iter Snd (Compose Snd Succ)))))) (Compose (Pair (Compose (Pair Snd (Compose (Compose (Compose Unit Zero) Succ) Succ)) Eval) (Compose (Compose (Compose (Compose Unit Zero) Succ) Succ) Succ)) Eval)
我现在遇到的问题是如何解释这个组合子表达式。我知道所有组合器表达式都应该被解释为函数。问题是我不知道这个函数的输入和输出类型,并且我期望“解释器”函数将是部分的,因为如果它尝试错误地解释某些内容,它应该会导致 RuntimeException
因为组合器表达式是无类型的,所以可能会出现错误的组合器表达式。然而,我的类型检查器应该确保一旦到达解释器,组合器就应该已经被正确键入。
根据原始博客文章,http://semantic-domain.blogspot.com/2012/12/total-functional-programming-in-partial.html组合器具有所有功能等效项。像这样的东西:
evaluate Id = id
evaluate Unit = const ()
evaluate Zero = \() -> Z
evaluate (Succ n) = S n
evaluate (Compose f g) = (evaluate g) . (evaluate f)
evaluate (Pair l r) = (evaluate l, evaluate r)
evaluate Fst = fst
evaluate Snd = snd
evaluate (Curry h) = curry (evaluate h)
evaluate Eval = \(f, v) -> f v
evaluate (Iter base recurse) = \(a, n) ->
case n of
Z -> evaluate base a
S n -> evaluate recurse (a, evaluate (Iter base recurse) (a, n))
但显然这是行不通的。看来必须有某种方法来解释 THom
树,这样我就能得到某种可以以部分方式执行的函数。
最佳答案
要以保证类型正确的方式解释 THom
,您需要向 Haskell 类型检查器“解释”其类型。我看到您已经考虑过 THom
的 GADT 版本,这将是进行此解释的传统方法,而且我仍然会采用这种方法。如果我理解正确的话,您面临的麻烦是 synth
的逻辑太复杂,无法证明它总是会产生类型良好的 THom
,这就是不足为奇。
我认为你可以保持你的synth
(粗略地)不变,如果你添加一个简单的传递,将生成的非类型化THom
检查到类型化的GADT中,比如说StrongTHom a b
。返回存在似乎有风险,最好为其提供传入上下文:
checkTHom :: THom -> TType a -> TType b -> Maybe (StrongTHom a b)
(其中 TType
是 previous answer 中的单例形式)。它只需要您在顶层知道您的输入和输出类型是什么。这通常很好,因为为了实际使用结果,您最终必须知道实例化它的类型。 (您可能必须将此预期类型信息向外推几个级别,直到知 Prop 体类型为止)
如果您绝对必须能够推断输入和输出类型,那么我想除了返回存在性之外别无选择。这只是意味着您的类型检查器将包含更多类型相等性检查(参见下面的 typeEq
),并且无类型的 THom
可能还需要包含更多类型信息。
无论哪种情况,THom
肯定都必须包含它删除的任何类型。例如,在 Compose::THom a b -> THom b c -> THom a c
中,b
被删除,checkTHom
必须重建它。因此,Compose
需要包含足够的信息才能实现这一点。此时,存在主义(上一个答案中的 SomeType
)可能没问题,因为您必须使用它的唯一方法是解开它并递归地传递它。
为了编写这个检查器,我有一种感觉,你需要一个强大的相等性检查:
typeEq :: TType a -> TType b -> Maybe (a :~: b)
(其中 :~:
是 standard type equality ),很容易编写;我只是确保您了解这项技术。
一旦你有了这个,那么 eval::StrongTHom a b -> a -> b
应该像热黄油一样经历。祝你好运!
关于System T Combinator 语言的 Haskell 解释器,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53996638/
我有一个带有帮助页面的 Web API 2 项目,该项目在本地运行良好,但当我将其推送到 Azure 时抛出此错误: Method not found: 'System.String System.S
我有两台服务器,但通常运行相同的设置 - IIS、SQL Server 等。一台给我这个错误,另一台没有。我从 Visual Studio 向两者发布相同的代码。 它们都在运行 .NET CLR Ve
System.out声明为 public static final PrintStream out。 但是你可以调用System.setOut()重新分配它。 嗯?如果它是 final,这怎么可能?
System.out被声明为 public static final PrintStream out。 但是您可以调用System.setOut()重新分配它。 嗯?如果是 final,这怎么可能?
我有这个 linq 查询: private void GetReceivedInvoiceTasks(User user, List tasks) { var areaIds = user.A
我有一个 MonoTouch 应用程序,当我为设备编译它时,出现以下错误: Error MT2002: Can not resolve reference: System.Boolean System
您好,我有一个名为 DailyVisitReport 的 View 。在该 View 中,我有两个名为 FromDate 和 toDate 的字段。如果我选择 FromDate 和 ToDate 取决
是否可以从 ObjectContext 对象中读取元组列表? 我在存储过程中有类似这样的数据库查询 SELECT T.Id as Item1, -- this is guid T.Wo
我正在尝试创建 Odata 端点,但每当我尝试执行任何涉及日期的查询时都会收到此错误。 我在下面的非常简单示例中重新创建了它。 数据库表 EDMX(片段)
我正在尝试创建 Odata 端点,但每当我尝试执行任何涉及日期的查询时都会收到此错误。 我在下面的非常简单示例中重新创建了它。 数据库表 EDMX(片段)
我有一个方法可以从数据读取器的数据中生成类类型列表。 if (datareader != null && datareader .HasRows) { Dictionary pDict= GetP
我有一些旧的 C++ 代码,它们使用 stdio 进行输入和输出。该代码还通过 fork 生成新进程。它将 stdio 重新映射到每个新进程,以便每个 session 获取其各自的数据。 我正在考虑使
我的应用程序可以很好地构建/链接/部署到模拟器,但我只是第一次尝试将应用程序构建/部署到真实设备,并且链接器失败。 我不使用 System.Console或 ConsoleColor在我的应用程序的任
主要是我很好奇。 我们有一个名为 Unit 的对象在我们的代码库中 - 代表桥梁或道路的组件。在我们的例子中,看到带有 Unit 的 ReactiveUI 命令可能会模棱两可。作为声明中的泛型之一。
我试图将Object变量转换为StreamWriter。但是,它不起作用。有什么错? StreamWriter file = (StreamWriter) myObject; 最佳答案 myObjec
为什么以下不编译? using System; using System.Linq; using System.Linq.Expressions; public static class Extens
我正在使用 Visual Studio Community 2015 开发面向 .NET 4.5 的 Visual Basic 应用程序.我没有编写应用程序,所以我使用 NuGet 添加了所有缺失的依
我刚刚开始使用 powershell,我正在制作一个非常简单的加密功能。我想获取字符串中的每个字符,将其转换为 int 并添加一个选定的数字,然后将其转换回一个字符。 这工作正常: function
一些使用我的应用程序的人似乎变得越来越 System.MissingMethodException: Method not found: 'System.Object System.Windows.T
我是 C# 和实体的新手 我想知道是否有人在这里帮助我。我选择了哪个返回我的 customerid,所以我想将它作为参数传递给我的构造函数,我的构造函数参数类型是 guid 但我的选择类型不同,我不知
我是一名优秀的程序员,十分优秀!