Làm cách nào để diễn giải lại thuật ngữ DSL trong cách tiếp cận không có thẻ cuối cùng?

Question

Chúc mọi người ngày tốt lành.

Ứng dụng của chúng tôi sử dụng DSL được nhập để mô tả logic kinh doanh nhất định. DSL đi kèm với một vài thông dịch viên không có thẻ.

Sau đây là cách điều khoản của nó được khai báo: sau đó

{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE EmptyDataDecls #-} 

class Ctl impl where 
    -- Lift constants. 
    cnst :: Show t => t -> impl t 
    -- Obtain the state. 
    state :: impl (Maybe Int) 

    -- Test for equality. 
    eq :: impl Int -> impl Int -> impl Bool 
    -- If-then-else. 
    ite :: impl Bool -> impl t -> impl t -> impl t 

    -- Processing outcomes. 
    retry :: impl Outcome 
    finish :: impl Outcome 

    -- Require a value. 
    req :: impl (Maybe t) -> impl t 

Kinh doanh logic được mô tả sử dụng khối mã trong DSL này:

proc1 :: Ctl impl => impl Outcome 
proc1 = ite (req state `eq` cnst 5) finish retry 

Những định nghĩa cao cấp được đưa vào sử dụng với thông dịch viên. Tôi có một thông dịch văn bản để có được một mô tả văn bản có thể đọc về cách quy trình kinh doanh được định nghĩa:

newtype TextE t = TextE { evalText :: String } 

instance Ctl TextE where 
    cnst v = TextE $ show v 
    state = TextE "My current state" 
    eq v1 v2 = TextE $ concat [evalText v1, " equals ", evalText v2] 
    ite cond t e = 
    TextE $ 
    concat ["If ", evalText cond, ", then ", evalText t, ", else ", evalText e] 
    retry = TextE "Retry processing" 
    finish = TextE "Finish" 
    req v = TextE $ concat ["(", evalText v, ")*"] 

Giải thích DSL với Texte tạo ra một chuỗi:

λ> (evalText proc1) :: String 
"If (My current state)* equals 5, then Finish, else Retry processing" 

mô tả như vậy được sử dụng như một tài liệu tham khảo cho người dùng/nhà phân tích.

Tôi cũng có thể đánh giá một thuật ngữ DSL với meta-ngôn ngữ (Haskell) với phiên dịch khác, đó là cách ứng dụng thực sự theo quy tắc:

newtype HaskellE t = HaskellE { evalHaskell :: HaskellType t } 

-- Interface between types of DSL and Haskell. 
type family HaskellType t 

instance Ctl HaskellE where 
    cnst v = HaskellE v 
    state = HaskellE dummyState 
    eq v1 v2 = HaskellE $ evalHaskell v1 == evalHaskell v2 
    ite cond t e = 
    HaskellE $ 
    if (evalHaskell cond) 
    then (evalHaskell t) 
    else (evalHaskell e) 
    retry = HaskellE $ print "Retrying..." 
    finish = HaskellE $ print "Done!" 
    req term@(HaskellE v) = 
    case v of 
     Just v' -> HaskellE v' 
     Nothing -> 
     HaskellE (error $ 
        "Could not obtain required value from ") -- ++ evalText term) 

-- Dummy implementations so that this post may be evaluated 
dummyState = Just 5 
type Outcome = IO() 
type instance HaskellType t = t 

phiên dịch này tạo ra mã Haskell Runnable:

λ> (evalHaskell proc1) :: IO() 
"Done!" 

Hiện tại vấn đề của tôi: Tôi muốn sử dụng trình thông dịch TextE từ thông dịch viên HaskellE . Ví dụ, tôi muốn xác định chi nhánh thất bại của req theo cách bao gồm văn bản đại diện của thuật ngữ lồng nhau (thường thu được bởi evalText term) trong thông báo lỗi. Mã số có liên quan được nhận xét trong việc thực hiện req cho HaskellE ở trên. Nếu nhận xét được khôi phục, mã trông giống như

HaskellE (error $ 
       "Could not obtain required value from " ++ evalText term) 

Tuy nhiên, hệ thống kiểu ngăn cản tôi từ làm điều này:

tagless.lhs:90:71: Couldn't match expected type ‘TextE t0’ … 
       with actual type ‘HaskellE (Maybe t)’ 
    Relevant bindings include 
     v :: HaskellType (Maybe t) 
     (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:22) 
     term :: HaskellE (Maybe t) 
     (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:7) 
     req :: HaskellE (Maybe t) -> HaskellE t 
     (bound at /home/dzhus/projects/hs-archive/tagless.lhs:85:3) 
    In the first argument of ‘evalText’, namely ‘term’ 
    In the second argument of ‘(++)’, namely ‘evalText term’ 
Compilation failed. 

Thông điệp cơ bản nói rằng người phiên dịch HaskellE đã được chọn khi loại biến impl được khởi tạo và tôi không thể sử dụng trình thông dịch TextE từ bên trong HaskellE.

Điều tôi không thể làm được với đầu của tôi là: làm cách nào để diễn giải lại cụm từ từ HaskellE sang TextE?

Nếu tôi hoàn toàn sai ở đây, làm cách nào để định hình lại cách tiếp cận của mình để tôi có thể thực sự sử dụng trình thông dịch văn bản từ Haskell mà không cần thực hiện lại nó bên trong HaskellE? Có vẻ như nó khá khả thi với phương pháp tiếp cận ban đầu thay vì cuối cùng.

Tôi đã loại bỏ DSL thực tế của mình và đơn giản hóa các loại và thông dịch viên vì mục đích của sự đồng nhất.

Answer 1

Bạn có thể theo dõi cả giá trị và thông tin về biểu thức đã tạo giá trị. Nếu bạn làm như vậy bạn sẽ mất một số lợi ích hiệu suất của đại diện không có thẻ cuối cùng của bạn.

data Traced t a = Traced {evalTraced :: HaskellType a, trace :: t a} 

Chúng tôi hy vọng sẽ sử dụng nó với một dấu vết TextE, vì vậy chúng tôi sẽ xác định những điều sau để thuận tiện

evalTextTraced :: Traced TextE a -> HaskellType a 
evalTextTraced = evalTraced 

Lớp này cho phép chúng ta khôi phục lại các thông báo lỗi từ một trace

class Show1 f where 
    show1 :: f a -> String 

instance Show1 TextE where 
    show1 = evalText 

instance (Show1 t) => Show1 (Traced t) where 
    show1 = show1 . trace 

Thông dịch viên này giữ dấu vết của bất kỳ thông dịch viên Ctl t nào khác mà chúng tôi có thể khôi phục thông báo lỗi từ khi giải thích Traced t.

instance (Show1 t, Ctl t) => Ctl (Traced t) where 
    cnst v = Traced v (cnst v) 
    state = Traced dummyState state 
    eq (Traced v1 t1) (Traced v2 t2) = Traced (v1 == v2) (eq t1 t2) 
    ite (Traced vc tc) (Traced vt tt) (Traced ve te) = Traced (if vc then vt else ve) (ite tc tt te) 
    retry = Traced (print "Retrying...") retry 
    finish = Traced (print "Done!") finish 
    req (Traced v t) = 
     case v of 
      Just v' -> Traced v' rt 
      Nothing -> Traced (error ("Could not obtain required value from " ++ show1 rt)) rt 
     where rt = req t 

dụ của bạn cư xử như mong đợi

print . evalText . trace $ proc1 
evalTextTraced proc1 

"If (My current state)* equals 5, then Finish, else Retry processing" 
"Done!" 

Chúng tôi vẫn có thể evalText một ví dụ với một yêu cầu thất bại, nhưng cố gắng chạy nó tạo ra một thông báo lỗi thông tin

proc2 :: Ctl impl => impl Outcome 
proc2 = ite (req (cnst Nothing) `eq` cnst 5) finish retry 

print . evalText . trace $ proc2 
evalTextTraced proc2 

"If (Nothing)* equals 5, then Finish, else Retry processing" 
finaltagless.hs: Could not obtain required value from (Nothing)*