diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -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 diff --git a/antlrc.cabal b/antlrc.cabal new file mode 100644 --- /dev/null +++ b/antlrc.cabal @@ -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: + . + + . + Documentation for the ANTLR C runtime library is at: + . + + . + Documentation for the ANTLR parser generator is at: + . + + . +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 diff --git a/cbits/lexerc.c b/cbits/lexerc.c new file mode 100644 --- /dev/null +++ b/cbits/lexerc.c @@ -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); +} diff --git a/src/C2HS.hs b/src/C2HS.hs new file mode 100644 --- /dev/null +++ b/src/C2HS.hs @@ -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 diff --git a/src/Text/Antlrc.hs b/src/Text/Antlrc.hs new file mode 100644 --- /dev/null +++ b/src/Text/Antlrc.hs @@ -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 diff --git a/src/Text/Antlrc/Lexer.chs b/src/Text/Antlrc/Lexer.chs new file mode 100644 --- /dev/null +++ b/src/Text/Antlrc/Lexer.chs @@ -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 diff --git a/utils/antlrcmkenums/Main.hs b/utils/antlrcmkenums/Main.hs new file mode 100644 --- /dev/null +++ b/utils/antlrcmkenums/Main.hs @@ -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 \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 +