OldLexer.x

{
{-# OPTIONS_GHC -w #-}
module HyLo.InputFile.OldLexer (alexScanTokens, Token(..),
                                FilePos, line, col)

where

import Data.Char ( isSpace )

import HyLo.Signature.Simple ( PropSymbol(..),
                               NomSymbol(..),
                               RelSymbol(..) )
}

%wrapper "posn"

$digit = [0-9]                  -- digits
$alpha = [a-zA-Z]               -- alphabetic characters
$alphaNum = [$alpha$digit]

@int = \-?$digit+
@rel = [Rr]@int

hyloTokens :-
  $white+                   ;       -- strip whitspaces
  \%.*                      ;       -- strip comments
  \{ (~\} | \n)* \}         ;       -- strip multiple line comments

  begin                     { discardValue TokenBegin }
  end                       { discardValue TokenEnd   }

  true                      { discardValue TokenTrue  }
  false                     { discardValue TokenFalse }
  [Pp]@int                  { storeValue (TokenProp . prop  . tail) }
  [Nn]@int                  { storeValue (TokenNom  . nom   . tail) }
  [Xx]@int                  { storeValue (TokenVar  . var   . tail) }

  \<$white*@rel?$white*\>   { storeValue (TokenDia . rel . dropEnds) }
  dia                       { discardValue (TokenDia defaultRel)     }

  \<$white*\-@rel?$white*\> { storeValue (TokenIDia . rel . tail . dropEnds) }

  \[$white*@rel?$white*\]   { storeValue (TokenBox . rel . dropEnds) }
  box                       { discardValue (TokenBox defaultRel)     }

  \[$white*\-@rel?$white*\] { storeValue (TokenIBox . rel . tail . dropEnds) }

  \:                        { discardValue TokenAt  }
  \@                        { discardValue TokenAt2 }

  A                         { discardValue TokenUBox }
  E                         { discardValue TokenUDia }

  D                         { discardValue TokenDDia }
  B                         { discardValue TokenDBox }

  down                      { discardValue TokenDown }

  [v\|]                     { discardValue TokenOr   }
  [&\^]                     { discardValue TokenAnd  }
  [\!\-\~]                  { discardValue TokenNeg  }
  "<-->"                    { discardValue TokenDimp }
  "-->"                     { discardValue TokenImp  }
  "->"                      { discardValue TokenImp  }

  "("                       { discardValue TokenOB }
  ")"                       { discardValue TokenCB }

  \.                        { discardValue TokenDot }
  \;                        { discardValue TokenSC }

{
data Token = TokenBegin           | TokenEnd
           | TokenTrue            | TokenFalse
           | TokenProp PropSymbol | TokenNom NomSymbol  | TokenVar NomSymbol
           | TokenNeg             | TokenAnd            | TokenOr
           | TokenAt              | TokenAt2            | TokenDown
           | TokenBox  RelSymbol  | TokenDia  RelSymbol
           | TokenIBox RelSymbol  | TokenIDia RelSymbol
           | TokenImp             | TokenDimp
           | TokenUBox            | TokenUDia
           | TokenDBox            | TokenDDia
           | TokenOB              | TokenCB
           | TokenDot             | TokenSC
  deriving (Eq, Show, Read)

data FilePos = FP{line :: Int, col :: Int} deriving (Eq, Show)

makeFilePos (AlexPn _ l c) = FP{line = l, col = c}

-- for building tokens which hold a value
storeValue     mkToken alexPos v = (mkToken v, makeFilePos alexPos)

-- for building tokens which discard the parsed string
discardValue   token alexPos _ = (token, makeFilePos alexPos)

dropEnds = init . tail

prop   = PropSymbol . read
nom    = N . read
var    = X . read
rel  r
  | null r    = defaultRel
  | otherwise =  RelSymbol (read . tail . dropWhile isSpace $ r)
defaultRel = RelSymbol 1
}