Phân tích Cú pháp dựa trên thụt đầu dòng trong Parsec của Haskell

Question

Tôi đang cố gắng phân tích ngôn ngữ dựa trên thụt đầu dòng (nghĩ Python, Haskell, Boo, YAML) trong Haskell bằng Parsec. Tôi đã nhìn thấy thư viện IndentParser, và có vẻ như đó là sự kết hợp hoàn hảo, nhưng những gì tôi không thể tìm ra là làm thế nào để biến số TokenParser thành một trình phân tích cú pháp thụt đầu dòng. Dưới đây là đoạn code tôi có cho đến nay:

import qualified Text.ParserCombinators.Parsec.Token as T 
import qualified Text.ParserCombinators.Parsec.IndentParser.Token as IT 

lexer = T.makeTokenParser mylangDef 
ident = IT.identifier lexer 

này ném lỗi:

parser2.hs:29:28: 
    Couldn't match expected type `IT.TokenParser st' 
      against inferred type `T.GenTokenParser s u m' 
    In the first argument of `IT.identifier', namely `lexer' 
    In the expression: IT.identifier lexer 
    In the definition of `ident': ident = IT.identifier lexer 

Tôi đang làm gì sai? Tôi nên tạo một số IT.TokenParser như thế nào? Hoặc là IndentParser bị hỏng và phải tránh?

Answer 1

Dường như bạn đang sử dụng Parsec 3 ở đây, trong khi IndentParser hy vọng Parsec 2. Ví dụ bạn biên dịch cho tôi với -package parsec-2.1.0.1.

Vì vậy, IndentParser không nhất thiết phải bị hỏng, nhưng tác giả phải rõ ràng hơn về các phiên bản trong danh sách phụ thuộc. Có thể có cả hai phiên bản của Parsec được cài đặt, vì vậy không có lý do gì bạn không nên sử dụng IndentParser trừ khi bạn cam kết sử dụng Parsec 3 vì các lý do khác.

---

UPDATE: Trên thực tế không có thay đổi đối với nguồn là cần thiết để có được IdentParser làm việc với Parsec 3. Vấn đề mà cả hai chúng tôi đều có dường như được gây ra bởi thực tế là cabal-install có "soft preference" cho Parsec 2 . bạn chỉ có thể cài đặt IndentParser với một hạn chế rõ ràng trên phiên bản Parsec:

cabal install IndentParser --reinstall --constraint="parsec >= 3" 

Hoặc bạn có thể tải về source và build and install in the normal way.

Answer 2

Dưới đây là tập hợp các trình kết hợp phân tích cú pháp mà tôi đã đặt cùng nhau cho Parsec 3 có thể được sử dụng cho bố cục kiểu Haskell, có thể được sử dụng cho bạn. Những cân nhắc chính là laidout bắt đầu và chạy quy tắc bố cục và bạn nên sử dụng các bộ phối hợp space và spaced được cung cấp thay vì bộ tổ hợp chứng khoán Parsec cho cùng một mục đích. Do sự tương tác giữa bố cục và nhận xét, tôi phải hợp nhất phân tích nhận xét vào trình mã thông báo.

{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} 
module Text.Parsec.Layout 
    (laidout   -- repeat a parser in layout, separated by (virtual) semicolons 
    , space   -- consumes one or more spaces, comments, and onside newlines in a layout rule 
    , maybeFollowedBy 
    , spaced   -- (`maybeFollowedBy` space) 
    , LayoutEnv  -- type needed to describe parsers 
    , defaultLayoutEnv -- a fresh layout 
    , semi    -- semicolon or virtual semicolon 
    ) where 

import Control.Applicative ((<$>)) 
import Control.Monad (guard) 

import Data.Char (isSpace) 

import Text.Parsec.Combinator 
import Text.Parsec.Pos 
import Text.Parsec.Prim hiding (State) 
import Text.Parsec.Char hiding (space) 

data LayoutContext = NoLayout | Layout Int deriving (Eq,Ord,Show) 

data LayoutEnv = Env 
    { envLayout :: [LayoutContext] 
    , envBol :: Bool -- if true, must run offside calculation 
    } 

defaultLayoutEnv :: LayoutEnv 
defaultLayoutEnv = Env [] True 

pushContext :: Stream s m c => LayoutContext -> ParsecT s LayoutEnv m() 
pushContext ctx = modifyState $ \env -> env { envLayout = ctx:envLayout env } 

popContext :: Stream s m c => String -> ParsecT s LayoutEnv m() 
popContext loc = do 
    (_:xs) <- envLayout <$> getState 
    modifyState $ \env' -> env' { envLayout = xs } 
    <|> unexpected ("empty context for " ++ loc) 

getIndentation :: Stream s m c => ParsecT s LayoutEnv m Int 
getIndentation = depth . envLayout <$> getState where 
    depth :: [LayoutContext] -> Int 
    depth (Layout n:_) = n 
    depth _ = 0 

pushCurrentContext :: Stream s m c => ParsecT s LayoutEnv m() 
pushCurrentContext = do 
    indent <- getIndentation 
    col <- sourceColumn <$> getPosition 
    pushContext . Layout $ max (indent+1) col 

maybeFollowedBy :: Stream s m c => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a 
t `maybeFollowedBy` x = do t' <- t; optional x; return t' 

spaced :: Stream s m Char => ParsecT s LayoutEnv m a -> ParsecT s LayoutEnv m a 
spaced t = t `maybeFollowedBy` space 

data Layout = VSemi | VBrace | Other Char deriving (Eq,Ord,Show) 

-- TODO: Parse C-style #line pragmas out here 
layout :: Stream s m Char => ParsecT s LayoutEnv m Layout 
layout = try $ do 
    bol <- envBol <$> getState 
    whitespace False (cont bol) 
    where 
    cont :: Stream s m Char => Bool -> Bool -> ParsecT s LayoutEnv m Layout 
    cont True = offside 
    cont False = onside 

    -- TODO: Parse nestable {-# LINE ... #-} pragmas in here 
    whitespace :: Stream s m Char => 
     Bool -> (Bool -> ParsecT s LayoutEnv m Layout) -> ParsecT s LayoutEnv m Layout 
    whitespace x k = 
      try (string "{-" >> nested k >>= whitespace True) 
     <|> try comment 
     <|> do newline; whitespace True offside 
     <|> do tab; whitespace True k 
     <|> do (satisfy isSpace <?> "space"); whitespace True k 
     <|> k x 

    comment :: Stream s m Char => ParsecT s LayoutEnv m Layout 
    comment = do 
     string "--" 
     many (satisfy ('\n'/=)) 
     newline 
     whitespace True offside 

    nested :: Stream s m Char => 
     (Bool -> ParsecT s LayoutEnv m Layout) -> 
     ParsecT s LayoutEnv m (Bool -> ParsecT s LayoutEnv m Layout) 
    nested k = 
      try (do string "-}"; return k) 
     <|> try (do string "{-"; k' <- nested k; nested k') 
     <|> do newline; nested offside 
     <|> do anyChar; nested k 

    offside :: Stream s m Char => Bool -> ParsecT s LayoutEnv m Layout 
    offside x = do 
     p <- getPosition 
     pos <- compare (sourceColumn p) <$> getIndentation 
     case pos of 
      LT -> do 
       popContext "the offside rule" 
       modifyState $ \env -> env { envBol = True } 
       return VBrace 
      EQ -> return VSemi 
      GT -> onside x 

    -- we remained onside. 
    -- If we skipped any comments, or moved to a new line and stayed onside, we return a single a ' ', 
    -- otherwise we provide the next char 
    onside :: Stream s m Char => Bool -> ParsecT s LayoutEnv m Layout 
    onside True = return $ Other ' ' 
    onside False = do 
     modifyState $ \env -> env { envBol = False } 
     Other <$> anyChar 

layoutSatisfies :: Stream s m Char => (Layout -> Bool) -> ParsecT s LayoutEnv m() 
layoutSatisfies p = guard . p =<< layout 

virtual_lbrace :: Stream s m Char => ParsecT s LayoutEnv m() 
virtual_lbrace = pushCurrentContext 

virtual_rbrace :: Stream s m Char => ParsecT s LayoutEnv m() 
virtual_rbrace = try (layoutSatisfies (VBrace ==) <?> "outdent") 

-- recognize a run of one or more spaces including onside carriage returns in layout 
space :: Stream s m Char => ParsecT s LayoutEnv m String 
space = do 
    try $ layoutSatisfies (Other ' ' ==) 
    return " " 
    <?> "space" 

-- recognize a semicolon including a virtual semicolon in layout 
semi :: Stream s m Char => ParsecT s LayoutEnv m String 
semi = do 
    try $ layoutSatisfies p 
    return ";" 
    <?> "semi-colon" 
    where 
     p VSemi = True 
     p (Other ';') = True 
     p _ = False 

lbrace :: Stream s m Char => ParsecT s LayoutEnv m String 
lbrace = do 
    char '{' 
    pushContext NoLayout 
    return "{" 

rbrace :: Stream s m Char => ParsecT s LayoutEnv m String 
rbrace = do 
    char '}' 
    popContext "a right brace" 
    return "}" 

laidout :: Stream s m Char => ParsecT s LayoutEnv m a -> ParsecT s LayoutEnv m [a] 
laidout p = try (braced statements) <|> vbraced statements where 
    braced = between (spaced lbrace) (spaced rbrace) 
    vbraced = between (spaced virtual_lbrace) (spaced virtual_rbrace) 
    statements = p `sepBy` spaced semi