В качестве лексера и грамматического анализатора я использовал alex и happy соответственно, которые входят в состав Haskell Platform; alex анализирует исходный код лексера (с расширением .x), а happy анализирует исходный код грамматики (с расширением .y). Обе программы генерируют соответствующие файлы с расширением .hs. Фактически, исходные коды лексера и грамматики состоят по большей части из кода на Haskell (все, что находится в этих файлах в фигурных скобках, является валидным кодом Haskell), и лишь небольшое количество мета-объявлений предназначено для предварительной обработки alex и happy.
Описание грамматики языка для happy совместимо с описанием для boost::spirit несмотря на то, что внутренне эти два генератора парсеров реализованы по-разному (happy генерирует LALR парсер, а spirit - парсер с рекурсивным спуском). Хотя проблема левой рекурсии в happy исчезает, и, кроме того, happy предоставляет дополнительные возможности вроде указания приоритета операторов, я не стал изменять реализацию грамматики по сравнению с версией для boost::spirit.
Итак, грамматика нашего пользовательского языка в версии haskell / happy выглядит следующим образом:
Statement : Action Condition { ParseResult $1 $2 } Action : keep tpt { KeepTpt } | keep edt { KeepEdt } | delete tpt { DeleteTpt } | delete edt { DeleteEdt } Condition :: { Subtree } Condition : if Expression { buildTopTree $2 } Expression :: { Node } Expression : OrExpression { $1 } PrimaryExpression : Function1 { buildFunction1Subtree $1 } | '(' Expression ')' { setPriorityInOperatorTree 0 $2 } | LeafOperand { Leaf $1 } LeafOperand : Constant { Constant $1 } | Variable { Variable $1 } Constant : double { DoubleValue $1 } | integer { IntegerValue $1 } Variable : identifier '[' integer ',' integer ']' { Vector2 $1 $3 $5 } | identifier '[' integer ']' { Vector1 $1 $3 } | identifier { Scalar $1 } Function1 : identifier '(' Expression ')' { Function1 $1 $3 } OrExpression : AndExpression '|' OrExpression { buildOperatorSubtree ( Op ( LogOp Or ) 1 False ) $1 $3 } | AndExpression { $1 } AndExpression : Relation '&' AndExpression { buildOperatorSubtree ( Op ( LogOp And ) 2 False ) $1 $3 } | Relation { $1 } Relation : Addition RelOperator Addition { buildOperatorSubtree ( Op ( RelOp $2 ) 3 False ) $1 $3 } | Addition { $1 } Addition : Multiplication AddOperator Addition { buildOperatorSubtree ( Op ( AddOp $2 ) 4 False ) $1 $3 } | Multiplication { $1 } Multiplication : UnaryExpression MultOperator Multiplication { buildOperatorSubtree ( Op ( MultOp $2 ) 5 False ) $1 $3 } | UnaryExpression { $1 } UnaryExpression : UnaryOperator PrimaryExpression { buildUnaryOperatorSubtree ( Op ( UnaryOp $1 ) 6 True ) $2 } | PrimaryExpression { $1 } UnaryOperator : '-' { UMinus } | '!' { Not } MultOperator : '*' { Mult } | '/' { Div } AddOperator : '+' { Plus } | '-' { Minus } RelOperator : "<=" { LessEqual } | ">=" { MoreEqual } | "!=" { NotEqual } | "<" { Less } | ">" { More } | "=" { Equal }
happy пользуется определениями токенов из лексера, импортируя его модуль CfLexer. Эти токены (keep, delete, tpt, edt, if, арифметические операторы) сопоставляются с типами лексера и перечислены в секции %token. В фигурных скобках описания грамматики указываются семантические действия, которые должны соответствовать построению объекта необходимого типа, как это сделано и в boost::spirit. Поскольку в Haskell реализован автоматический вывод типов на основе модели Хиндли-Милнера, то формально указывать типы выражений нет необходимости, хотя в двух случаях, для наглядности, я определил типы выражений Condition :: { Subtree } и Expression :: { Node }. Типы выражений определены ниже в этом же файле:
data Statement = ParseResult { action :: Action, condition :: Subtree } data Action = KeepTpt | KeepEdt | DeleteTpt | DeleteEdt deriving Show data Node = Tree Subtree | Leaf LeafOperand deriving Show data Subtree = Subtree { nodeType :: NodeType, children :: [ Node ] } deriving Show data NodeType = Operator Operator | Function Function deriving Show data Operator = Op { op :: OperatorType, priority :: Int, hasRLAssoc :: Bool } data OperatorType = Uninitialized | Top | UnaryOp UnaryOperator | MultOp MultOperator | AddOp AddOperator | RelOp RelOperator | LogOp LogOperator data UnaryOperator = UMinus | Not data MultOperator = Mult | Div data AddOperator = Plus | Minus data RelOperator = LessEqual | MoreEqual | NotEqual | Less | More | Equal data LogOperator = And | Or data Function = FunctionName String data LeafOperand = Variable Variable | Constant Constant deriving Show data Constant = DoubleValue Double | IntegerValue Int data Variable = Scalar String | Vector1 String Int | Vector2 String Int Int data Function1 = Function1 { fName :: String, fExpr :: Node }
Все типы являются алгебраическими в понятии Haskell, то есть создаются с использованием ключевого слова data и могут иметь один и более конструкторов. Некоторые из типов наследуют определения класса Show, что позволит выводить их на экран компьютера. Поскольку дефолтный вывод некоторых типов на экран меня не удовлетворил, я переопределил для них функцию show:
instance Show Operator where show = showOperator showOperator ( Op a _ _ ) = "-op- " ++ case a of Uninitialized -> "UNINITIALIZED" Top -> "Top" UnaryOp UMinus -> "u -" UnaryOp Not -> "!" MultOp Mult -> "*" MultOp Div -> "/" AddOp Plus -> "+" AddOp Minus -> "-" RelOp LessEqual -> "<=" RelOp MoreEqual -> ">=" RelOp NotEqual -> "!=" RelOp Less -> "<" RelOp More -> ">" RelOp Equal -> "=" LogOp And -> "&" LogOp Or -> "|" instance Show Function where show = showFunction showFunction ( FunctionName a ) = "-fun- " ++ a instance Show Variable where show = showVariable showVariable ( Scalar a ) = a showVariable ( Vector1 a b ) = a ++ "[" ++ show b ++ "]" showVariable ( Vector2 a b c ) = a ++ "[" ++ show b ++ "," ++ show c ++ "]" instance Show Constant where show = showConstant showConstant ( DoubleValue a ) = show a showConstant ( IntegerValue a ) = show a
Окончательный вывод на экран дерева для отдельной инструкции будет осуществляться с помощью функции printResult и ее вспомогательными функциями:
printResult :: Statement -> IO () printResult x = do putStrLn $ "Result: action = " ++ show ( action x ) ++ ", parsed tree = " putStrLn "" printSubtree ( condition x ) "" printSubtree :: Subtree -> String -> IO () printSubtree ( Subtree a b ) is = do putStrLn $ is ++ case a of Operator aa -> show aa Function aa -> show aa printChildren b $ is ++ " " printChildren :: [ Node ] -> String -> IO () printChildren [] _ = return () printChildren ( Tree x : xs ) is = do printSubtree x is printChildren xs is printChildren ( Leaf x : xs ) is = do putStrLn $ is ++ printLeaf x printChildren xs is printLeaf :: LeafOperand -> String printLeaf a = case a of Variable aa -> show aa Constant aa -> show aa
При построении AST использовались вспомогательные функции:
buildTopTree :: Node -> Subtree buildTopTree ( Tree x ) = x buildTopTree x@( Leaf _ ) = Subtree ( Operator $ Op Top 0 False ) [ x ] buildFunction1Subtree :: Function1 -> Node buildFunction1Subtree x = Tree $ Subtree ( Function . FunctionName $ fName x ) [ fExpr x ] buildOperatorSubtree :: Operator -> Node -> Node -> Node buildOperatorSubtree a@( Op _ _ True ) nl nr = Tree $ Subtree ( Operator a ) [ nl, nr ] buildOperatorSubtree a nl nr@( Tree sr@( Subtree ( Operator b ) ( cnrl : _ ) ) ) | p == priority b = Tree $ moveDownLeft ( Subtree ( Operator a ) $ nl : [ getDeepestLeft cnrl p ] ) sr | otherwise = Tree $ Subtree ( Operator a ) [ nl, nr ] where p = priority a buildOperatorSubtree a nl nr = Tree $ Subtree ( Operator a ) [ nl, nr ] getDeepestLeft :: Node -> Int -> Node getDeepestLeft x@( Leaf _ ) _ = x getDeepestLeft x@( Tree ( Subtree ( Operator b ) ( cnl : _ ) ) ) p | p == priority b = getDeepestLeft cnl p | otherwise = x getDeepestLeft x _ = x moveDownLeft :: Subtree -> Subtree -> Subtree moveDownLeft sl ( Subtree b@( Operator _ ) ( ( Leaf _ ) : cnrr ) ) = Subtree b $ Tree sl : cnrr moveDownLeft sl@( Subtree ( Operator _ ) _ ) ( Subtree b@( Operator _ ) ( ( Tree ( Subtree ( Function _ ) _ ) ) : cnrr ) ) = Subtree b $ Tree sl : cnrr moveDownLeft sl@( Subtree ( Operator a ) _ ) ( Subtree b@( Operator _ ) ( ( Tree csrl@( Subtree ( Operator c ) _ ) ) : cnrr ) ) | priority a == priority c = Subtree b $ Tree ( moveDownLeft sl csrl ) : cnrr | otherwise = Subtree b $ Tree sl : cnrr moveDownLeft sl _ = sl buildUnaryOperatorSubtree :: Operator -> Node -> Node buildUnaryOperatorSubtree a x = Tree $ Subtree ( Operator a ) [ x ] setPriorityInOperatorTree :: Int -> Node -> Node setPriorityInOperatorTree i ( Tree ( Subtree ( Operator ( Op a _ x ) ) y ) ) = Tree $ Subtree ( Operator $ Op a i x ) y setPriorityInOperatorTree _ x = x
Функция buildTopTree проверяет, является ли ее аргумент, представленный типом Node, листом, если это так, то она возвращает простое поддерево (Subtree) с корнем - оператором типа Top и единственным листом - переданным ей аргументом, если же аргумент - дерево, то buildTopTree возвращает его представление типа Subtree. Функция buildOperatorSubtree и вспомогательные функции getDeepestLeft и moveDownLeft строят поддерево для бинарных операторов и сдвигают лево-ассоциативные операторы (т.е. все бинарные операторы) вправо (т.е. вглубь дерева) относительно операторов с таким же приоритетом: это позволяет исправить правоассоциативные правила грамматики для левоассоциативных операторов. Функция setPriorityInOperatorTree позволяет избежать порчи дерева при сдвиге левоассоциативных операторов для выражений, содержащихся в скобках. Функции buildFunction1Subtree и buildUnaryOperatorSubtree довольно простые и делают то, что от них требует их название.
Это практически все. Осталось упомянуть, что тестовые примеры я поместил в файл cf.hs, а компиляция программы основана на использовании Makefile, поэтому достаточно только распаковать пример и запустить команду make.
Кроме того, хотелось бы сказать несколько слов о сравнительной производительности программ, написанных с использованием boost::spirit и haskell / happy. Я промолчу о скорости компиляции: итак всем понятно, насколько долго будет компилироваться код на C++, использующий шаблонные объявления из boost::spirit. Меня намного больше удивила разница в скорости выполнения откомпилированных программ. Для корректности сравнения я убрал эвалюацию синтаксических деревьев из кода на boost::spirit. Так вот, код на haskell / happy выполнялся на моем компьютере (двухъядерный AMD 64) в среднем порядка 0.04 секунды, код на boost::spirit с включенной оптимизацией -O2: порядка 0.35 сек. (в 10 раз дольше!), а без оптимизации - вообще 3.4 сек., т.е. примерно в 100 раз дольше!
Исходный код примера можно взять здесь.