Lexer

Включаем все предупреждения компилятора

{-# OPTIONS_GHC -Wall -Wextra #-}

и расширение RecordWildCards

{-# LANGUAGE RecordWildCards #-}

Объявляем имя модуля

module Lexer where

Импортируем стандартные модули. Data.List содержит функции работы со списками (в данном случае нас интересует функция uncons), Data.Char – функции работы с символами, в частности функции классификации символов. Наконец, из Control.Applicative мы импортируем оператор <|>, который является оператором альтернативы для типов, для которых он определён. В частности, для Maybe a он определён как

Just x <|> y = Just x
Nothing <|> y = y

то есть возвращает первый аргумент, если он Just, в противном случае второй.

import Data.List (uncons)
import Data.Char (isDigit, isAsciiLower)
import Control.Applicative ((<|>))

Объявляем Enum-тип с именами (типами) токенов (лексем):

data TokenName =
    Number
  | Operator
  | Id
  | Lparen
  | Rparen
  | Comma
  deriving Show

deriving Show здесь позволяет использовать функцию show для отображения значений типа TokenName в строку.

Объявляем тип токена: токен состоит из идентификатора имени токена, TokenName, и атрибута. В данном случае атрибутом будет просто часть входной строки, которая совпала с шаблоном токена при лексическом анализе.

data Token = Token { tokenName :: TokenName, tokenStr :: String } deriving Show

Здесь используется синтаксис записей. Этот синтаксис в целом эквивалентен определению типа и вспомогательных функций из значений типа в значения полей:

data Token = Token TokenName String
tokenName :: Token -> TokenName
tokenName (Token x _) = x
tokenStr :: Token -> String
tokenStr  (Token _ x) = x

Кроме того, записи допускают свой синтаксис определения значений, например:

token :: Token
token = Token { tokenName = Number, tokenStr = "123" }

Объявляем синоним типа для номера состояния. Теоретически более корректным было бы объявить новый ограниченный тип, но для краткости мы используем просто машинное целое.

type StateNum = Int

Объявляем функцию переходов. Эта функция полностью соответствует таблице, определённой в https://wiki.livid.pp.ru/students/sp/labs/01.html. Функции isDigit и isAsciiLower определены в Data.Char.

transitionTable :: StateNum -> Char -> Maybe StateNum
transitionTable st c =
  case st of
    0 | isLetter' c              -> Just 7
      | c == '('                 -> Just 8
      | c == ')'                 -> Just 9
      | c == ','                 -> Just 10
      | c `elem` "+*/^%-"        -> Just 6
      | isDigit c                -> Just 1
      | c == ' '                 -> Just 0
    1 | isDigit c                -> Just 1
      | c == '.'                 -> Just 2
      | c `elem` "eE"            -> Just 3
    2 | isDigit c                -> Just 2
      | c `elem` "eE"            -> Just 3
    3 | c `elem` "+-"            -> Just 4
      | isDigit c                -> Just 5
    4 | isDigit c                -> Just 5
    5 | isDigit c                -> Just 5
    7 | isLetter' c || isDigit c -> Just 7
    _                            -> Nothing
  where
  isLetter' ch = isAsciiLower ch || ch == '_'

Определим принимающие состояния, и к каким токенам они относятся:

stateToTokenName :: StateNum -> Maybe TokenName
stateToTokenName st =
  case st of
    1  -> Just Number
    2  -> Just Number
    5  -> Just Number
    6  -> Just Operator
    7  -> Just Id
    8  -> Just Lparen
    9  -> Just Rparen
    10 -> Just Comma
    _  -> Nothing

Определим структуру, целиком описывающую текущее состояние системы: входную строку, текущий буфер выходной строки, и номер состояния самого автомата

data FullState = FullState { fsInput :: String
                           , fsOutput :: String
                           , fsCurrentState :: StateNum
                           }
data LastAcceptingState = LAState { lasInput :: String
                                  , lasToken :: Token
                                  }

Определим так же “багаж” информации, которую нам надо отслеживать. Поскольку нам необходимо возвращаться к прошлому полному состоянию системы, когда автомат последний раз находился в принимающем состоянии, нам надо кроме текущего состояния так же хранить последнее виденное принимающее. В начале работы автомата, никакого принимающего состояния нет.

data Baggage = Baggage { bagCurrentState :: FullState
                       , bagLastAccState :: Maybe LastAcceptingState
                       }

Наконец, в зависимости от поведения автомата, управляющая программа может:

  1. Продолжить работу автомата – передать автомату следующий входной символ
  2. Перезапустить автомат – откатить состояние к последнему принимающему и запустить автомат с начального состояния. При этом, текущее состояние можно отбросить.

Если перезапуск происходит при пустой входной строке, то алгоритм останавливается.

Определяем тип, кодирующий действие:

data Action = Continue Baggage | Restart (Maybe LastAcceptingState)

Определяем функцию, реализующую один шаг ДКА. На вход функция получает текущий “багаж”. На выходе – действие (остановка, перезапуск или продолжение) и новый “багаж”.

Основная рабочая функция здесь makeOneStep. Она принимает текущее состояние системы, берёт первый символ c входа fsInput (если есть), и если из текущего состояния fsCurrentState есть переход по текущему символу c, то переносит этот символ в fsOutput, и устанавливает новое состояние fsCurrentState в соответствии с таблицей переходов. Если эта операция успешна, то действие – Continue, поскольку автомат не зашёл в тупик.

Если же автомат заходит в тупик, то действие – Restart.

dfaStep :: Baggage -> Action
dfaStep b@Baggage{..} =
  case makeOneStep bagCurrentState of
    Nothing -> Restart newAccSt
    Just st -> Continue $ b{ bagCurrentState = st
                           , bagLastAccState = newAccSt }
 where
 -- если stateToToken bagCurrentState = Nothing, то newAccSt = bagLastAccState
 -- иначе, newAccSt = stateToToken bagCurrentState
 newAccSt = stateToToken bagCurrentState <|> bagLastAccState
 stateToToken FullState{..}
   = case stateToTokenName fsCurrentState of
       Just name -> Just $ LAState {
            lasInput=fsInput
          , lasToken =Token{tokenName=name, tokenStr=fsOutput}
          }
       Nothing -> Nothing
 makeOneStep FullState{..}
   = case uncons fsInput of
       Just (c, cs) -> case transitionTable fsCurrentState c of
         Just newSt -> Just FullState{
             fsInput = cs
           , fsOutput = if c == ' ' then fsOutput else fsOutput <> [c]
           , fsCurrentState = newSt
           }
         Nothing -> Nothing
       Nothing -> Nothing

Это функция, реализующая цикл ДКА. В зависимости результата dfaStep, функция либо делает рекурсивный вызов самой себя, либо останавливается. Каждый раз при команде Restart, возвращаемый токен сохраняется в списке. Если при получении команды Restart оказывается, что принимающего состояния не было, работа останавливается. По-хорошему, там должна быть обработка ошибок.

dfaRun :: Baggage -> [Token]
dfaRun b =
  case dfaStep b of
    Restart (Just LAState{..})
      -> lasToken : if null lasInput
                    then []
                    else dfaRun (initState lasInput)
    Continue bag
      -> dfaRun bag
    _ -> []

Это функция, создающее начальное состояние из входной строки: ДКА в состоянии 0, входная строка заполнена, выходная строка пуста, последнего принимающего состояния пока не было.

initState :: String -> Baggage
initState input = Baggage { bagCurrentState =FullState input "" 0
                          , bagLastAccState = Nothing}

Это основная функция входа: принимает строку, возвращает поток токенов.

lexer :: String -> [Token]
lexer input = dfaRun (initState input)

Упражнения:

  1. Реализуйте аналогичный лексический анализатор на любимом языке программирования.

  2. Добавьте обработку лексических ошибок в Ваш анализатор. Обратите внимание, что все лексические ошибки, которые могут происходить, здесь происходят во время работы функции dfaStep, точнее makeOneStep. Чтобы добавить обработку ошибок здесь, необходимо вместо Maybe возвращать из makeOneStep Either с диагностической информацией, и передавать её дальше как часть Restart.