上下文

Question

上下文

我试图实现一个与IBM的OLP（线性编程的建模语言）非常相似的EDSL。

代码

Haskell EDSL代码

{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}

-- Numbers at the type level
data Peano = Zero | Successor Peano

-- Counting Vector Type. Type information contains current length
data Vector peanoNum someType where
    Nil :: Vector Zero someType
    (:+) :: someType 
            -> Vector num someType 
            -> Vector (Successor num) someType
infixr 5 :+ 

-- Generate Num-th nested types
-- For example: Iterate (S (S Z)) [] Double => [[Double]]
type family Iterate peanoNum constructor someType where
    Iterate Zero cons typ = typ
    Iterate (Successor pn) cons typ = 
        cons (Iterate pn cons typ)

-- DSL spec

data Statement =
      DecisionVector [Double]
    | Minimize Statement
    | Iteration `Sum` Expression
    | Forall Iteration Statement
    | Statement :| Statement
    | Constraints Statement
infixl 8 `Sum`
infixl 3 :|

data Iteration =
      String `In` [Double]
    | String `Ins` [String]

data Expression where
    EString :: String -> Expression
    EFloat :: Double -> Expression
    (:?) :: Vector n Expression -> Iterate (n) [] Double -> Expression
    (:*) :: Expression -> Expression -> Expression
    Lt :: Expression -> Expression -> Expression
    Gt :: Expression -> Expression -> Expression
    Id :: String -> Expression
infixr 5 `Lt`
infixr 5 `Gt`
infixr 6 :*
infixr 7 :?

test :: Statement
test = 
    let rawMaterial = 205
        products = ["light", "medium", "heavy"]
        demand = [59, 12, 13]
        processes = [1, 2] 
        production = [[12,16], [1,7], [4,2]]
        consumption = [25, 30]
        -- foo = (EId "p" :+ EId "f" :+ Nil) `Subscript` production
        -- bar = (EId "p" :+ Nil) `Subscript` cost
        run = []
        cost = [300, 400]
    in  
        DecisionVector run :|
        Minimize 
            (Sum ("p" `In` processes) 
                 ((Id "p" :+ Nil) :? cost :*
                  (Id "p" :+ Nil) :? run)) :|
        Constraints 
            (Sum ("p" `In` processes)
                 ((Id "p" :+ Nil) :? consumption :*
                  (Id "p" :+ Nil) :? run `Lt` EFloat rawMaterial) :|
             Forall ("q" `Ins` products)
                    (Sum ("p" `In` processes)
                         ((Id "q" :+ Id "p" :+ Nil) :? production :*
                          (Id "p" :+ Nil) :? run `Gt` 
                          (Id "q" :+ Nil) :? demand)))

instance Show Statement where
    show (DecisionVector v) = show v
    show (Minimize s) = "(Minimize " ++ show s ++ ")"
    show (i `Sum` e) = "(" ++ show i ++ " `Sum` " ++ show e ++ ")"
    show (Forall i e) = "(Forall " ++ show i ++ show e ++ ")"
    show (sa :| sb) = "(" ++ show sa ++ show sb ++ ")"
    show (Constraints s) = "(Constraints " ++ show s  ++ ")"

instance Show Iteration where
    show (str `In` d) = "(" ++ show str ++ " `In` " ++ show d ++ ")"
    show (str `Ins` d) = "(" ++ show str ++ " `Ins` " ++ show d ++ ")"

instance Show Expression where
    show (EString s) = "(EString " ++ show s ++ ")"
    show (EFloat f) = "(EFloat " ++ show f ++ ")"
    show (Lt ea eb) = "(" ++ show ea ++ " `Lt` " ++ show eb ++ ")"
    show (Gt ea eb) = "(" ++ show ea ++ " `Gt` " ++ show eb ++ ")"
    show (ea :* eb) = "(" ++ show ea ++ " :* " ++ show eb ++ ")"
    show (Id s) = "(Id " ++ show s ++ ")"
    show (vec :? dbl) = "(" ++ show vec ++ " :? " ++ "dbl" ++ ")"

instance Show (Vector p Expression) where
    show (Nil) = "Nil"
    show (e :+ v) = "(" ++ show e ++ " :+ " ++ show v ++ ")"

-- eval_opl :: Statement -> [Double]

EDSL与OPL比较

    let rawMaterial = 205
        products = ["light", "medium", "heavy"]
        demand = [59, 12, 13]
        processes = [1, 2] 
        production = [[12,16], [1,7], [4,2]]
        consumption = [25, 30]
        -- foo = (EId "p" :+ EId "f" :+ Nil) `Subscript` production
        -- bar = (EId "p" :+ Nil) `Subscript` cost
        run = []
        cost = [300, 400]
    in  
        DecisionVector run :|
        Minimize 
            (Sum ("p" `In` processes) 
                 ((Id "p" :+ Nil) :? cost :*
                  (Id "p" :+ Nil) :? run)) :|
        Constraints 
            (Sum ("p" `In` processes)
                 ((Id "p" :+ Nil) :? consumption :*
                  (Id "p" :+ Nil) :? run `Lt` EFloat rawMaterial) :|
             Forall ("q" `Ins` products)
                    (Sum ("p" `In` processes)
                         ((Id "q" :+ Id "p" :+ Nil) :? production :*
                          (Id "p" :+ Nil) :? run `Gt` 
                          (Id "q" :+ Nil) :? demand)))

对应于opl代码

float rawMaterial                     = 205;
{string} products                     = {"light","medium","heavy"};
float demand[products]                = [59,12,13];
{string} processes                    = {"1","2"};
float production[products][processes] = [[12,16],[1,7],[4,2]];
float consumption[processes]          = [25,30];
float cost[processes]                 = [300,400];

dvar float+ run[processes];

minimize sum (p in processes) cost[p] * run[p];

constraints {
  sum (p in processes) consumption[p] * run[p] <= rawMaterial;
  forall (q in products)
    sum (p in processes) production[q][p] * run[p] >= demand[q];
}

问题描述

OPL使用括号进行数组订阅，我尝试映射订阅使用以下符号

到我的EDSL

((Id "p" :+ Id "f" :+ Nil) :? consumption

对应于以下意义上的OPL：

consumption[p][f]

前者中的

（Id＆＃34; p＆＃34;：+ Id＆＃34; f＆＃34;：+ Nil）构造Vector类型的值，其包含关于所述向量的长度的类型级别信息。根据构造函数的定义：？，你可以看到， Iterate（n）[] Double因此会扩展为[[Double]]。这整齐地按预期工作。但是，反过来使用生成的语法树，我需要模式匹配实际值。

show (vec :? dbl) = "(" ++ show vec ++ " :? " ++ "dbl" ++ ")"

问题：以上行有效，但我不知道如何使用实际数据。我如何模式匹配？甚至可以使用数据吗？通过明显的

替换dbl

(Iterate (Successor (Successor Zero)) [] Double)

不起作用。我也尝试构建一个数据系列，但我无法找到一种方法来递归创建所有任意嵌套的Double列表：

Double
[Double]
[[Double]]
[[[Double]]]
...

Answer 1

为了了解Iterate n [] Double实际存储的值，您必须了解有关n的一些信息。此信息通常由某些GADT的索引给出，这些索引对应于索引本身的归纳结构（通常称为singleton）。

但幸运的是，您已将Nat索引存储在Vector的结构中。您已经拥有了手头所需的所有信息，您只需要模式匹配！例如

instance Show Expression where
    ...
    show (vec :? dbl) = "(" ++ show vec ++ go vec dbl ++ ")" where 
      go :: Vector n x -> Iterate n [] Double -> String 
      go Nil a = show a 
      go (_ :+ n) a = "[" ++ intercalate "," (map (go n) a) ++ "]"

请注意，在第一种模式中，Nil的类型会为您提供n ~ 0，而Iterate 0 [] Double ~ Double会为您提供n ~ k + 1（根据定义）。在第二种模式中，某些k和Iterate n [] Double ~ [ Iterate k [] Double ]有Nat。 Iterate上的模式匹配允许您查看类型族的归纳结构。

您在foo :: forall n . Vector n () -> Iterate n F X -> Y -- for some X,Y上撰写的每个功能都会显示为

Iterate

因为你必须有这样的价值级证明才能在class KnownNat n where isNat :: Vector n () instance KnownNat 'Z where isNat = Nil instance KnownNat n => KnownNat ('S n) where isNat = () :+ isNat上写任何归纳函数。如果你不喜欢随身携带这些＆＃34;假的＆＃34;值，您可以使用类隐含它们：

Vector

但在这种情况下，由于您的AST已经包含具体的PhoneLine，因此您无需进行任何额外的工作来访问索引的实际值 - 只需在向量上进行模式匹配。

Answer 2

您有几个选项，所有这些选项都相当于在值级别编码迭代深度，以便您可以对其进行模式匹配。

GADT

最简单的方法是创建一个GADT来表示类型构造函数的应用程序的迭代：

String confirm = s1.nextLine();
if (confirm.equalsIgnoreCase("Enter")) {
    //continue code
}

的Singleton

如果您与类型系列绑定，则可以使用单例。单例是一个由单个值居住的类型，您可以对其进行模式匹配，以向编译器介绍有关该类型的已知事实。以下是自然数的单例：

data IterateF peanoNum f a where
    ZeroF      :: a                   -> IterateF Zero           f a
    SuccessorF :: f (IterateF pn f a) -> IterateF (Successor pn) f a

instance Functor f => Functor (IterateF peanoNum f) where
    fmap f (ZeroF a)       = ZeroF $ f a
    fmap f (SuccessorF xs) = SuccessorF $ fmap (fmap f) xs

-- There's also an Applicative instance, see Data.Functor.Compose

没有{-# LANGUAGE FlexibleContexts #-} data SPeano pn where SZero :: SPeano Zero SSuccessor :: Singleton (SPeano pn) => SPeano pn -> SPeano (Successor pn) class Singleton a where singleton :: a instance Singleton (SPeano Zero) where singleton = SZero instance Singleton (SPeano s) => Singleton (SPeano (Successor s)) where singleton = SSuccessor singleton类型类的更简单的SPeano单例是等价的，但是这个版本不需要编写尽可能多的证明，而是在后续构造中捕获它们。

如果我们修改上一节中的Singleton GADT来捕获相同的证明（因为我很懒），只要我们有IterateF单身，我们就可以转换为GADT。无论如何，我们都可以轻松地从GADT转换。

SPeano

现在，我们可以轻松地为data IterateF peanoNum f a where ZeroF :: a -> IterateF Zero f a SuccessorF :: Singleton (SPeano pn) => f (IterateF pn f a) -> IterateF (Successor pn) f a toIterateF :: Functor f => SPeano pn -> Iterate pn f a -> IterateF pn f a toIterateF SZero a = ZeroF a toIterateF (SSuccessor pn) xs = SuccessorF $ fmap (toIterateF pn) xs getIterateF :: Functor f => IterateF pn f a -> Iterate pn f a getIterateF (ZeroF a) = a getIterateF (SuccessorF xs) = fmap getIterateF xs制作替代表示形式，它是IterateF类型系列的单例和应用程序。

Iterate

我很懒，不喜欢写GADT可以为我处理的证明，所以我只是保留data Iterated pn f a = Iterated (SPeano pn) (Iterate pn f a) IterateF并为{{1}编写函数就它而言。

GADT

Iterated中的模式匹配是为了介绍toIterated :: Functor f => IterateF pn f a -> Iterated pn f a toIterated xs@(ZeroF _) = Iterated singleton (getIterateF xs) toIterated xs@(SuccessorF _) = Iterated singleton (getIterateF xs) fromIterated :: Functor f => Iterated pn f a -> IterateF pn f a fromIterated (Iterated pn xs) = toIterateF pn xs instance Functor f => Functor (Iterated pn f) where fmap f = toIterated . fmap f . fromIterated构造中捕获的证明。如果我们有更复杂的事情要做，我们可能希望在Dict

中捕获它

使用任何其他编码

在

的特定情况下

toIterated

您有一个SuccessorF，它在值级别编码(:?) :: Vector n Expression -> Iterate (n) [] Double -> Expression的迭代深度。您可以在向量上进行模式匹配，即Vector n或Iterate n []，以证明Nil是(_ :+ xs)或列表。您可以将此用于简单的情况，例如showing the nested values，或者您可以将Iterate n []转换为另一个单例，以使用前一部分中更强大的表示之一。

Double

在Haskell中与EDSL相关的数组订阅实现的问题

上下文

代码