Commit c39371c4 by Zachary Snow

simplify and optimize lexing

parent 370e5e9e
...@@ -783,6 +783,41 @@ Dependency: pretty-1.1.3.6 ...@@ -783,6 +783,41 @@ Dependency: pretty-1.1.3.6
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
================================================================================ ================================================================================
Dependency: primitive-0.7.0.1
================================================================================
Copyright (c) 2008-2009, Roman Leshchinskiy
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
================================================================================
Dependency: process-1.6.9.0 Dependency: process-1.6.9.0
================================================================================ ================================================================================
...@@ -1006,3 +1041,38 @@ Dependency: unix-2.7.2.2 ...@@ -1006,3 +1041,38 @@ Dependency: unix-2.7.2.2
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE. DAMAGE.
================================================================================
Dependency: vector-0.12.1.2
================================================================================
Copyright (c) 2008-2012, Roman Leshchinskiy
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
...@@ -36,8 +36,7 @@ parseFile' includePaths env skipPreprocessor path = do ...@@ -36,8 +36,7 @@ parseFile' includePaths env skipPreprocessor path = do
let runner = if skipPreprocessor then annotate else preprocess let runner = if skipPreprocessor then annotate else preprocess
preResult <- liftIO $ runner includePaths env path preResult <- liftIO $ runner includePaths env path
(contents, env') <- liftEither preResult (contents, env') <- liftEither preResult
result <- liftIO $ uncurry lexStr $ unzip contents tokens <- liftEither $ uncurry lexStr $ unzip contents
tokens <- liftEither result
let position = let position =
if null tokens if null tokens
then Position path 1 1 then Position path 1 1
......
...@@ -10,9 +10,6 @@ ...@@ -10,9 +10,6 @@
- `begin_keywords` and `end_keywords` lexer directives are handled here. - `begin_keywords` and `end_keywords` lexer directives are handled here.
-} -}
-- This pragma gets rid of a warning caused by alex 3.2.5.
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Language.SystemVerilog.Parser.Lex module Language.SystemVerilog.Parser.Lex
( lexStr ( lexStr
) where ) where
...@@ -20,12 +17,13 @@ module Language.SystemVerilog.Parser.Lex ...@@ -20,12 +17,13 @@ module Language.SystemVerilog.Parser.Lex
import Control.Monad.Except import Control.Monad.Except
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Vector as Vector
import Language.SystemVerilog.Parser.Keywords (specMap) import Language.SystemVerilog.Parser.Keywords (specMap)
import Language.SystemVerilog.Parser.Tokens import Language.SystemVerilog.Parser.Tokens
} }
%wrapper "monadUserState" %wrapper "posn"
-- Numbers -- Numbers
...@@ -472,28 +470,14 @@ tokens :- ...@@ -472,28 +470,14 @@ tokens :-
. { tok Unknown } . { tok Unknown }
{ {
-- our custom lexer state
data AlexUserState = LS
{ lsToks :: [Token] -- tokens read so far, *in reverse order* for efficiency
, lsPositions :: [Position] -- character positions
} deriving (Eq, Show)
-- this initial user state does not contain the initial token positions; alex
-- requires that this be defined; we override it before we begin the actual
-- lexing procedure
alexInitUserState :: AlexUserState
alexInitUserState = LS [] []
-- lexer entrypoint -- lexer entrypoint
lexStr :: String -> [Position] -> IO (Either String [Token]) lexStr :: String -> [Position] -> Either String [Token]
lexStr chars positions = do lexStr chars positions =
let setEnv = modify $ \s -> s { lsPositions = positions } runExcept $ postProcess [] tokens
let result = runAlex chars $ setEnv >> alexMonadScan >> get where
return $ case result of tokensRaw = alexScanTokens chars
Left msg -> Left msg positionsVec = Vector.fromList positions
Right finalState -> tokens = map (\tkf -> tkf positionsVec) tokensRaw
runExcept $ postProcess [] tokens
where tokens = reverse $ lsToks finalState
-- process begin/end keywords directives -- process begin/end keywords directives
postProcess :: [Set.Set TokenName] -> [Token] -> Except String [Token] postProcess :: [Set.Set TokenName] -> [Token] -> Except String [Token]
...@@ -526,25 +510,8 @@ postProcess stack (t : ts) = do ...@@ -526,25 +510,8 @@ postProcess stack (t : ts) = do
then Token Id_simple ('_' : str) pos then Token Id_simple ('_' : str) pos
else t else t
-- invoked by alexMonadScan tok :: TokenName -> AlexPosn -> String -> Vector.Vector Position -> Token
alexEOF :: Alex () tok tokId (AlexPn charPos _ _) tokStr positions =
alexEOF = return () Token tokId tokStr tokPos
where tokPos = positions Vector.! charPos
-- get the current user state
get :: Alex AlexUserState
get = Alex $ \s -> Right (s, alex_ust s)
-- apply a transformation to the current user state
modify :: (AlexUserState -> AlexUserState) -> Alex ()
modify f = Alex func
where func s = Right (s { alex_ust = new }, ())
where new = f (alex_ust s)
tok :: TokenName -> AlexInput -> Int -> Alex ()
tok tokId (AlexPn pos _ _, _, _, input) len = do
let tokStr = take len input
tokPos <- get >>= return . (!! pos) . lsPositions
let t = Token tokId tokStr tokPos
modify $ \s -> s { lsToks = t : (lsToks s) }
alexMonadScan
} }
...@@ -32,6 +32,7 @@ executable sv2v ...@@ -32,6 +32,7 @@ executable sv2v
, githash , githash
, hashable , hashable
, mtl , mtl
, vector
other-modules: other-modules:
-- SystemVerilog modules -- SystemVerilog modules
Language.SystemVerilog Language.SystemVerilog
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment