antlrc (empty) → 0.0.1
raw patch · 9 files changed
+762/−0 lines, 9 filesdep +basedep +bytestringdep +enumeratorsetup-changed
Dependencies added: base, bytestring, enumerator, haskell98, regex-posix
Files
- LICENSE +30/−0
- README +65/−0
- Setup.hs +29/−0
- antlrc.cabal +84/−0
- cbits/lexerc.c +13/−0
- src/C2HS.hs +220/−0
- src/Text/Antlrc.hs +9/−0
- src/Text/Antlrc/Lexer.chs +184/−0
- utils/antlrcmkenums/Main.hs +128/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010-2011, Mark Wright++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 the name of Mark Wright nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER OR 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.
+ README view
@@ -0,0 +1,65 @@+Haskell binding to the ANTLR parser generator C runtime library++http://www.antlr.org/wiki/display/ANTLR3/ANTLR3+Code+Generation+-+C++ANTLR is a LL(*) parser generator that supports semantic predicates,+syntax predicates and backtracking. antlrc provides a Haskell interface+to the ANTLR C runtime. ANTLR generates the lexer and/or parser C+code, which can call Haskell code for things such as: semantic predicates+which may look up entries in the symbol table, creating symbol table entries,+type checking, creating abstract syntax trees, etc.++The C source code for the lexer and/or parser are generated from the+ANTLR grammar file, which by convention has a .g filename extension.++The generated C files can be compiled as C or C++.++The main entry point to the program can be written in C or C++, which+calls the generated parser and lexer. The parser can make calls to+Haskell to build the AST and symbol table, and to implement+dis-ambiguating semantic predicates if necessary (for context sensitive+languages).++The ANTLR parser generator is written in Java. It is necessary to use+the same ANTLR parser generator version as the ANTLR C runtime version.+antlrc is tested with ANTLR 3.2 and libantlr3c 3.2.++In addition to creating the GrammarLexer.c and GrammarParser.c files,+the antlr parser generator creates a Grammar.tokens file which contains+a list of lexer token identifier numbers and any associated name that is+is specified in the tokens section of the Grammar.g file. The+antlrcmkenums is run specifying the input Grammar.tokens file, and generates+a GrammarTokens.h C/C++ header file containing an enum with enum members for+those tokens that have user specified names. This enum is then processed by+c2hs to create a Haskell enum for the token identifiers.++Examples are provided on github:++https://github.com/markwright/antlrc-examples++Documentation for the ANTLR C runtime library is at:++http://www.antlr.org/wiki/display/ANTLR3/ANTLR3+Code+Generation+-+C++Documentation for the ANTLR parser generator is at:++http://www.antlr.org/wiki/display/ANTLR3/ANTLR+v3+documentation++ANTLR C runtime library dependency:+-----------------------------------++The latest released libanltr3c run-time library should work+(libantlr3c 3.2 at the time of writing):++http://antlr.org/download/C++ANTLR Java parser generator+---------------------------++This Haskell antlrc package does not depend on the ANTLR Java parser generator.++The ANTLR Java parser generator is required to build examples+and programs that use the ANTLR C runtime and the Haskell antlrc+binding to the ANTLR C runtime.++http://antlr.org/download.html
+ Setup.hs view
@@ -0,0 +1,29 @@+-- Workaround around http://hackage.haskell.org/trac/hackage/ticket/48+-- 2. The .chi files need to be installed++import Distribution.Simple+import Distribution.Simple.Setup+import Distribution.PackageDescription+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Utils+import Distribution.Verbosity+import System.FilePath++main = defaultMainWithHooks $ simpleUserHooks+ { postCopy = postCopyChi,+ postInst = postInstChi+ }++getLibDir :: PackageDescription -> LocalBuildInfo -> String+getLibDir pd lbi = libdir (absoluteInstallDirs pd lbi NoCopyDest)++copyChiFiles :: String -> LocalBuildInfo -> IO ()+copyChiFiles destLibDir lbi =+ installOrdinaryFiles deafening destLibDir [(buildDir lbi, "Text/Antlrc/Lexer.chi")]+ +postCopyChi :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()+postCopyChi _ cflags pd lbi =+ copyChiFiles ((\(CopyTo copyDest) -> copyDest) (fromFlag (copyDest cflags)) ++ tail (getLibDir pd lbi)) lbi++postInstChi :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()+postInstChi _ _ pd lbi = copyChiFiles (getLibDir pd lbi) lbi
+ antlrc.cabal view
@@ -0,0 +1,84 @@+Name: antlrc+Version: 0.0.1+Synopsis: Haskell binding to the ANTLR parser generator C runtime library.+Description: ANTLR is a LL(*) parser generator that supports semantic predicates,+ syntax predicates and backtracking. antlrc provides a Haskell interface+ to the ANTLR C runtime. ANTLR generates the lexer and/or parser C+ code, which can call Haskell code for things such as: semantic predicates+ which may look up entries in the symbol table, creating symbol table entries,+ type checking, creating abstract syntax trees, etc.+ .+ The C source code for the lexer and/or parser are generated from the+ ANTLR grammar file, which by convention has a .g filename extension.+ .+ The generated C files can be compiled as C or C++.+ .+ The main entry point to the program can be written in C or C++, which+ calls the generated parser and lexer. The parser can make calls to+ Haskell to build the AST and symbol table, and to implement+ dis-ambiguating semantic predicates if necessary (for context sensitive+ languages).+ .+ The ANTLR parser generator is written in Java. It is necessary to use+ the same ANTLR parser generator version as the ANTLR C runtime version.+ antlrc is tested with ANTLR 3.2 and libantlr3c 3.2.+ .+ In addition to creating the GrammarLexer.c and GrammarParser.c files,+ the antlr parser generator creates a Grammar.tokens file which contains+ a list of lexer token identifier numbers and any associated name that is+ is specified in the tokens section of the Grammar.g file. The+ antlrcmkenums is run specifying the input Grammar.tokens file, and generates+ a GrammarTokens.h C/C++ header file containing an enum with enum members for+ those tokens that have user specified names. This enum is then processed by+ c2hs to create a Haskell enum for the token identifiers.+ .+ Examples are provided on github:+ .+ <https://github.com/markwright/antlrc-examples>+ .+ Documentation for the ANTLR C runtime library is at:+ .+ <http://www.antlr.org/wiki/display/ANTLR3/ANTLR3+Code+Generation+-+C>+ .+ Documentation for the ANTLR parser generator is at:+ .+ <http://www.antlr.org/wiki/display/ANTLR3/ANTLR+v3+documentation>+ .+Homepage: https://github.com/markwright/antlrc+License: BSD3+License-file: LICENSE+Author: Mark Wright+Maintainer: markwright@internode.on.net+Stability: experimental+Copyright: Copyright (c) Mark Wright 2010-2011. All rights reserved.+Category: Parsing+Build-type: Simple+Extra-source-files: README+Cabal-version: >= 1.8.0.4+build-depends: base >= 3 && <5,+ c2hs >= 0.16+source-repository head+ type: git+ location: git://github.com/markwright/antlrc.git++Library+ Build-tools: c2hs >= 0.16+ Hs-Source-Dirs: src+ Extensions: ForeignFunctionInterface+ Extra-libraries: antlr3c+ Build-depends: base >= 3 && <5,+ haskell98+ Other-modules: C2HS+ Exposed-modules: Text.Antlrc,+ Text.Antlrc.Lexer+ Exposed: True+ c-sources: cbits/lexerc.c++Executable antlrcmkenums+ hs-source-dirs: utils/antlrcmkenums+ main-is: Main.hs+ Build-depends: base >= 3 && <5,+ bytestring,+ enumerator,+ haskell98,+ regex-posix
+ cbits/lexerc.c view
@@ -0,0 +1,13 @@+#include "antlr3lexer.h"++/* The function prototypes are in Lexer.chs */++ANTLR3_COMMON_TOKEN *LT(ANTLR3_INPUT_STREAM *input, int lti)+{+ return input->_LT(input, (ANTLR3_INT32)lti);+}++ANTLR3_STRING *tokenGetAntlrString(ANTLR3_COMMON_TOKEN *token)+{+ return token->getText(token);+}
+ src/C2HS.hs view
@@ -0,0 +1,220 @@+-- C->Haskell Compiler: Marshalling library+--+-- Copyright (c) [1999...2005] Manuel M T Chakravarty+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+-- +-- 1. Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer. +-- 2. 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. +-- 3. The name of the author may not be used to endorse or promote products+-- derived from this software without specific prior written permission. +--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--+-- This module provides the marshaling routines for Haskell files produced by +-- C->Haskell for binding to C library interfaces. It exports all of the+-- low-level FFI (language-independent plus the C-specific parts) together+-- with the C->HS-specific higher-level marshalling routines.+--++module C2HS (++ -- * Re-export the language-independent component of the FFI + module Foreign,++ -- * Re-export the C language component of the FFI+ module CForeign,++ -- * Composite marshalling functions+ withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,+ peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,++ -- * Conditional results using 'Maybe'+ nothingIf, nothingIfNull,++ -- * Bit masks+ combineBitMasks, containsBitMask, extractBitMasks,++ -- * Conversion between C and Haskell types+ cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum+) where +++import Foreign+ hiding (Word)+ -- Should also hide the Foreign.Marshal.Pool exports in+ -- compilers that export them+import CForeign++import Monad (when, liftM)+++-- Composite marshalling functions+-- -------------------------------++-- Strings with explicit length+--+withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)++-- Marshalling of numerals+--++withIntConv :: (Storable b, Integral a, Integral b) + => a -> (Ptr b -> IO c) -> IO c+withIntConv = with . cIntConv++withFloatConv :: (Storable b, RealFloat a, RealFloat b) + => a -> (Ptr b -> IO c) -> IO c+withFloatConv = with . cFloatConv++peekIntConv :: (Storable a, Integral a, Integral b) + => Ptr a -> IO b+peekIntConv = liftM cIntConv . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) + => Ptr a -> IO b+peekFloatConv = liftM cFloatConv . peek++-- Passing Booleans by reference+--++withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b+withBool = with . fromBool++peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool+peekBool = liftM toBool . peek+++-- Passing enums by reference+--++withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c+withEnum = with . cFromEnum++peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a+peekEnum = liftM cToEnum . peek+++-- Storing of 'Maybe' values+-- -------------------------++instance Storable a => Storable (Maybe a) where+ sizeOf _ = sizeOf (undefined :: Ptr ())+ alignment _ = alignment (undefined :: Ptr ())++ peek p = do+ ptr <- peek (castPtr p)+ if ptr == nullPtr+ then return Nothing+ else liftM Just $ peek ptr++ poke p v = do+ ptr <- case v of+ Nothing -> return nullPtr+ Just v' -> new v'+ poke (castPtr p) ptr+++-- Conditional results using 'Maybe'+-- ---------------------------------++-- Wrap the result into a 'Maybe' type.+--+-- * the predicate determines when the result is considered to be non-existing,+-- ie, it is represented by `Nothing'+--+-- * the second argument allows to map a result wrapped into `Just' to some+-- other domain+--+nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b+nothingIf p f x = if p x then Nothing else Just $ f x++-- |Instance for special casing null pointers.+--+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b+nothingIfNull = nothingIf (== nullPtr)+++-- Support for bit masks+-- ---------------------++-- Given a list of enumeration values that represent bit masks, combine these+-- masks using bitwise disjunction.+--+combineBitMasks :: (Enum a, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++-- Tests whether the given bit mask is contained in the given bit pattern+-- (i.e., all bits set in the mask are also set in the pattern).+--+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm+ in+ bm' .&. bits == bm'++-- |Given a bit pattern, yield all bit masks that it contains.+--+-- * This does *not* attempt to compute a minimal set of bit masks that when+-- combined yield the bit pattern, instead all contained bit masks are+-- produced.+--+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]+extractBitMasks bits = + [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]+++-- Conversion routines+-- -------------------++-- |Integral conversion+--+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv = fromIntegral++-- |Floating conversion+--+cFloatConv :: (RealFloat a, RealFloat b) => a -> b+cFloatConv = realToFrac+-- As this conversion by default goes via `Rational', it can be very slow...+{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;+ "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x+ #-}++-- |Obtain C value from Haskell 'Bool'.+--+cFromBool :: Num a => Bool -> a+cFromBool = fromBool++-- |Obtain Haskell 'Bool' from C value.+--+cToBool :: Num a => a -> Bool+cToBool = toBool++-- |Convert a C enumeration to Haskell.+--+cToEnum :: (Integral i, Enum e) => i -> e+cToEnum = toEnum . cIntConv++-- |Convert a Haskell enumeration to C.+--+cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum = cIntConv . fromEnum
+ src/Text/Antlrc.hs view
@@ -0,0 +1,9 @@+-- Copyright (c)2010-2011, Mark Wright. All rights reserved.++-- | ANTLR C runtime library Haskell binding, for the ANTLR LL(*) parser generator.+module Text.Antlrc (+-- * Lexer token accessors.+ module Text.Antlrc.Lexer+ ) where++import Text.Antlrc.Lexer
+ src/Text/Antlrc/Lexer.chs view
@@ -0,0 +1,184 @@+-- Copyright (c)2010-2011, Mark Wright. All rights reserved.++{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Text.Antlrc.Lexer where++#include "antlr3lexer.h"++import C2HS+import Foreign.C.Types+import Foreign.Storable+import Ptr+import Foreign.Ptr+import System.IO.Unsafe+import Foreign.C+import Control.Monad+import Control.Applicative ((<$>))++{#context lib="antlr3c"#}++-- | Lexer token struct.+{#pointer *ANTLR3_COMMON_TOKEN as CommonToken newtype#}++-- | Lexer input stream struct.+{#pointer *ANTLR3_INPUT_STREAM as InputStream newtype#}++-- | Lexer struct.+{#pointer *ANTLR3_LEXER as Lexer newtype#}++-- | Cast from a pointer to an input stream to an input stream.+toInputStream :: Ptr InputStream -> InputStream+toInputStream = InputStream . castPtr++-- | Cast from a pointer to a token to a token.+toCommonToken :: Ptr CommonToken -> CommonToken+toCommonToken = CommonToken . castPtr++-- | Cast from a token to a pointer to a token.+fromCommonToken :: CommonToken -> Ptr b+fromCommonToken (CommonToken x) = castPtr x++-- The C function definitions are in lexerc.c+#c+ANTLR3_COMMON_TOKEN *LT(ANTLR3_INPUT_STREAM *input, int lti);+#endc++-- | Lookahead in the input stream at the token at the specified+-- positive offset, where:+--+-- > LT input 1 +--+-- is the current token. Or a negative offset may be specified, where: +--+-- > LT input (-1) +--+-- is the previous token.+--+-- > foreign export ccall isUnsignedInt :: Ptr InputStream -> IO Bool+-- > isUnsignedInt input =+-- > do token1 <- lT input 1 >>= tokenGetType+-- > if token1 /= UNSIGNED+-- > then return False+-- > else +-- > do +-- > token2 <- lT input 2 >>= tokenGetType+-- > return ((token2 /= CHAR) && (token2 /= SHORT) && (token2 /= LONG))+--+{#fun LT as lT+ { toInputStream `Ptr (InputStream)',+ `Int' } -> `Ptr (CommonToken)' fromCommonToken#}++-- | Pointer to an ANTLR string.+{#pointer *ANTLR3_STRING as AntlrString newtype#}++-- | Cast from an ANTLR string to a pointer to an ANTLR string.+fromAntlrString :: AntlrString -> Ptr b+fromAntlrString (AntlrString x) = castPtr x++#c+ANTLR3_STRING *tokenGetAntlrString(ANTLR3_COMMON_TOKEN *token);+#endc++-- | Obtain the token name ANTLR string for the specified token.+--+-- > tokenGetAntlrString token+--+-- For identifier tokens, the token string is interesting. For+-- other tokens such as operator tokens, the token string is+-- uninteresting, and may not be present, the token identifier enum +-- should be used instead.+{#fun tokenGetAntlrString+ { toCommonToken `Ptr (CommonToken)' } -> `Ptr (AntlrString)' fromAntlrString#}++-- | Convert an ANTLR string to a Maybe String. +fromAntlrStringToMaybeString :: AntlrString -> IO (Maybe String)+fromAntlrStringToMaybeString (AntlrString x) = + if x == Ptr.nullPtr+ then return Nothing+ else + {#get ANTLR3_STRING->chars#} x >>= \c ->+ {#get ANTLR3_STRING->len#} x >>= \l ->+ peekCStringLen ((castPtr c), (fromIntegral l)) >>= \s ->+ return (Just s)++-- | Obtain the token Maybe String for the specified token.+-- For identifier tokens, the token string is interesting. For+-- other tokens such as operator tokens, the token string is+-- uninteresting, and may not be present, the token identifier enum +-- should be used instead.+tokenGetTextMaybe :: Ptr (CommonToken) -> IO (Maybe String)+tokenGetTextMaybe c =+ tokenGetAntlrString c >>= \s ->+ fromAntlrStringToMaybeString (AntlrString s)++-- | Convert from an ANTLR string to a String.+-- Note: the peekCStringLen function does not say what will happen if the+-- C pointer is 0.+fromAntlrStringToString :: AntlrString -> IO String+fromAntlrStringToString (AntlrString x) = + {#get ANTLR3_STRING->chars#} x >>= \c ->+ {#get ANTLR3_STRING->len#} x >>= \l ->+ peekCStringLen ((castPtr c), (fromIntegral l)) >>= \s ->+ return s++-- | Obtain the token String for the specified token.+-- Note: the peekCStringLen function does not say what will happen if the+-- C pointer is 0.+--+-- > foreign export ccall saIntV :: Ptr CommonToken -> IO (StablePtr TermInfo)+-- > saIntV token =+-- > do+-- > -- read the IntV integer value from the token text into n+-- > t <- tokenGetText token+-- > n <- readIO t+-- > -- obtain the source code line and charPosition from the token+-- > l <- tokenGetLine token+-- > c <- tokenGetCharPositionInLine token+-- > -- return the term, which is TmZero, or TmSucc TmZero, or TmSucc (TmSucc (...TmSucc TmZero))+-- > newStablePtr (intV (Info l c) n)+--+tokenGetText :: Ptr (CommonToken) -> IO String+tokenGetText c =+ tokenGetAntlrString c >>= \s ->+ fromAntlrStringToString (AntlrString s)++-- | Obtain the token identifier for the specified token.+--+-- > foreign export ccall isInt :: Ptr InputStream -> IO Bool+-- > isInt input =+-- > do +-- > token1 <- lT input 1 >>= tokenGetType+-- > return (token1 == INT)+--+tokenGetType :: (Enum e) => Ptr (CommonToken) -> IO e+tokenGetType token = {#get ANTLR3_COMMON_TOKEN->type#} token >>= return . cToEnum++-- | Obtain the character position in the source code line of where the token+-- was read, for non-imaginary tokens.+--+-- > foreign export ccall saTrue :: Ptr CommonToken -> IO (StablePtr TermInfo)+-- > saTrue token =+-- > do+-- > -- obtain the source code line and charPosition from the token+-- > l <- tokenGetLine token+-- > c <- tokenGetCharPositionInLine token+-- > -- return the TmTrue term+-- > newStablePtr (TmTrue (Info l c))+--+tokenGetCharPositionInLine :: Ptr (CommonToken) -> IO Int+tokenGetCharPositionInLine token = {#get ANTLR3_COMMON_TOKEN->charPosition#} token >>= return . cIntConv++-- | Obtain the the source code line of where the token was read, for non-imaginary tokens.+--+-- > foreign export ccall saFalse :: Ptr CommonToken -> IO (StablePtr TermInfo)+-- > saFalse token =+-- > do+-- > -- obtain the source code line and charPosition from the token+-- > l <- tokenGetLine token+-- > c <- tokenGetCharPositionInLine token+-- > -- return the TmFalse term+-- > newStablePtr (TmFalse (Info l c))+--+tokenGetLine :: Ptr (CommonToken) -> IO Int+tokenGetLine token = {#get ANTLR3_COMMON_TOKEN->line#} token >>= return . cIntConv
+ utils/antlrcmkenums/Main.hs view
@@ -0,0 +1,128 @@+-- Copyright (c)2010, Mark Wright. All rights reserved.++module Main (main) where+import Data.Enumerator+import qualified Data.ByteString as B8+import Control.Exception as E+import qualified Data.List as L+import Control.Monad (liftM, unless)+import System.IO+import System.IO.Error (isEOFError)+import System.Environment+import Text.Regex.Posix+import Data.Char++tokenLineConsComma :: (Int, B8.ByteString) -> (Int, B8.ByteString)+tokenLineConsComma (n, b) =+ (n + 1, b')+ where+ b' = if n == 0+ then indent `B8.append` b+ else c `B8.cons` (nl `B8.cons` (indent `B8.append` b))+ c = toEnum (fromEnum ',')+ nl = toEnum (fromEnum '\n')+ indent = B8.replicate 2 (toEnum (fromEnum ' '))++tokenLine :: (Int, B8.ByteString) -> (Int, B8.ByteString)+tokenLine (n, b) =+ let tl = b =~ "[^\']*" :: B8.ByteString+ in+ if B8.null tl+ then (n, B8.empty)+ else tokenLineConsComma (n, tl)++tokenLines :: Handle -> Int -> [B8.ByteString] -> IO Int+tokenLines h acc bytes =+ let (n, tl) = foldl sumLines (acc, B8.empty) (zip [acc..] bytes)+ sumLines :: (Int, B8.ByteString) -> (Int, B8.ByteString) -> (Int, B8.ByteString)+ sumLines (m, s) (n, t) =+ (x, u)+ where+ (x, t') = tokenLine (n, t)+ u = s `B8.append` t'+ in do+ B8.hPutStr h tl+ return n++iterHandleLines :: Handle -> Iteratee B8.ByteString IO Int+iterHandleLines h = continue (step 0) where+ step acc EOF = yield acc EOF+ step acc (Chunks bytes) = Iteratee $ do+ eitherErr <- E.try $ tokenLines h acc bytes+ return $ case eitherErr of+ Left err -> Error err+ Right lines -> Continue (step lines)++enumHandleLines :: Handle -> Enumerator B8.ByteString IO a+enumHandleLines h = Iteratee . loop where+ loop (Continue k) = do+ eitherBytes <- E.try (B8.hGetLine h)+ case eitherBytes of+ Left err -> if isEOFError err+ then return (Continue k)+ else return $ Error $ E.toException err+ Right bytes | B8.null bytes -> return (Continue k)+ Right bytes -> runIteratee (k (Chunks [bytes])) >>= loop+ loop step = return step++enumFileLines :: FilePath -> Enumerator B8.ByteString IO b+enumFileLines path s = Iteratee $ do+ eitherH <- E.try $ openFile path ReadMode+ case eitherH of+ Left err -> return $ Error err+ Right h -> finally+ (runIteratee (enumHandleLines h s))+ (hClose h)++filePaths :: [String] -> (FilePath, FilePath)+filePaths args+ | argc == 1 = (inputFilePath, outFile inputFilePath)+ | otherwise = (inputFilePath, args !! 1)+ where+ argc = L.length args+ inputFilePath = L.head args+ outFile :: String -> FilePath+ outFile s = (s =~ "[^\\.]*") ++ "Tokens.h"++header :: Handle -> FilePath -> IO ()+header h s =+ let grammarName = s =~ "[^\\.]*" :: String+ headerGuardName = toUpper (L.head grammarName) : tail grammarName ++ "Tokens_H"+ tokensEnumName = toUpper (L.head grammarName) : tail grammarName ++ "Tokens"+ in+ do+ hPutStrLn h $ "#ifndef " ++ headerGuardName+ hPutStrLn h $ "#define " ++ headerGuardName ++ "\n"+ hPutStrLn h "#include <antlr3commontoken.h>\n"+ hPutStrLn h "#undef EOF\n"+ hPutStrLn h $ "enum " ++ tokensEnumName ++ "\n{"++trailer :: Handle -> IO ()+trailer h = do+ hPutStrLn h "\n};\n"+ hPutStrLn h "#endif\n"++main :: IO Int+main = do+ args <- getArgs+ let argc = L.length args+ if (argc >= 1) && (argc <= 2)+ then do+ let (inputFilePath, outputFilePath) = filePaths args+ enum = enumFileLines inputFilePath+ eitherH <- E.try $ openFile outputFilePath WriteMode+ case eitherH of+ Left err ->+ putStrLn "Failed to open output file " >> ioError err >> return 1+ Right h ->+ finally+ (header h inputFilePath >> run_ (enum $$ iterHandleLines h) >> trailer h >> return 0)+ (hClose h)+ else do+ putStrLn "Usage: antlrcmkenums grammar.tokens [grammarTokens.h]"+ putStrLn "antlrcmkenums reads the grammar.tokens file that is generated from grammar.g by"+ putStrLn "ANTLR. antlrcmkenums outputs a C/C++ header file grammarTokens.h containing the"+ putStrLn "C/C++ definition of an enum grammarToeksn, with an enum element for each token"+ putStrLn "that has been assigned a name string."+ return 1+