language-c-comments (empty) → 0.1
raw patch · 9 files changed
+544/−0 lines, 9 filesdep +arraydep +basedep +language-csetup-changed
Dependencies added: array, base, language-c
Files
- LICENSE +23/−0
- README +11/−0
- Setup.hs +4/−0
- dist/build/Language/C/Comments/Lexer.hs +343/−0
- examples/Main.hs +24/−0
- language-c-comments.cabal +27/−0
- src/Language/C/Comments.hs +52/−0
- src/Language/C/Comments/Lexer.x +22/−0
- src/Language/C/Comments/LineParser.hs +38/−0
+ LICENSE view
@@ -0,0 +1,23 @@+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. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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,11 @@+= Language.C.Comments =++Language C Comments is a Haskell library for extracting comments from C code.+It will parse both single- and multi-line comments, and correctly handles+split lines.++See http://github.com/ghulette/language-c-comments++== Build and Install ==++cabal install
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain
+ dist/build/Language/C/Comments/Lexer.hs view
@@ -0,0 +1,343 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LINE 1 "src/Language/C/Comments/Lexer.x" #-}++module Language.C.Comments.Lexer where+++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++{-# LINE 18 "templates/wrappers.hs" #-}++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ String) -- current input string++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,s) = c++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p,c,[]) = Nothing+alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq`+ Just (c, (p', c, s))+++{-# LINE 51 "templates/wrappers.hs" #-}++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text. It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+ deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad++{-# LINE 162 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++{-# LINE 251 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper++{-# LINE 273 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version++{-# LINE 297 "templates/wrappers.hs" #-}++{-# LINE 322 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.+++--alexScanTokens :: String -> [token]+alexScanTokens str = go (alexStartPos,'\n',str)+ where go inp@(pos,_,str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : go inp'++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version++{-# LINE 354 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++alex_base :: AlexAddr+alex_base = AlexA# "\xdf\xff\xff\xff\x00\x00\x00\x00\xf8\xff\xff\xff\xf9\xff\xff\xff\xfa\xff\xff\xff\x02\x00\x00\x00\xfe\xff\xff\xff\x30\x00\x00\x00\x48\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x03\x00\x00\x00\xe6\xff\xff\xff\xe0\xff\xff\xff\xe7\xff\xff\xff\xe8\xff\xff\xff\x00\x00\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\x0d\x00\x0d\x00\x0e\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x01\x00\x01\x00\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x05\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\x06\x00\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x03\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x00\x00\x00\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x03\x00\x00\x00\x03\x00\x00\x00\x09\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_check :: AlexAddr+alex_check = AlexA# "\xff\xff\x22\x00\x0a\x00\x0a\x00\x0a\x00\x0d\x00\x0d\x00\x0d\x00\x0a\x00\x0a\x00\x2a\x00\x0d\x00\x0a\x00\x0a\x00\x2f\x00\x0d\x00\x2a\x00\x2a\x00\x2a\x00\xff\xff\xff\xff\x2f\x00\xff\xff\x2f\x00\xff\xff\xff\xff\x22\x00\x22\x00\x22\x00\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\x5c\x00\x5c\x00\x5c\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x45\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_deflt :: AlexAddr+alex_deflt = AlexA# "\x11\x00\xff\xff\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\xff\xff\xff\xff\xff\xff\x0c\x00\x0c\x00\x0f\x00\x0f\x00\x0f\x00\xff\xff\xff\xff"#++alex_accept = listArray (0::Int,17) [[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_2))],[],[],[],[],[],[],[],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_1))],[],[],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))]]+alex_action_0 = \pos s -> (s , Nothing) +alex_action_1 = \pos s -> (" ", Just (pos,s)) +alex_action_2 = \pos s -> (s , Nothing) +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 37 "templates/GenericTemplate.hs" #-}++{-# LINE 47 "templates/GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#++#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+ narrow16Int# i+ where+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#+#else+ indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN+ narrow32Int# i+ where+ i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+ (b2 `uncheckedShiftL#` 16#) `or#`+ (b1 `uncheckedShiftL#` 8#) `or#` b0)+ b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+ b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+ b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ b0 = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 4#+#else+ indexInt32OffAddr# arr off+#endif++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+ = AlexEOF+ | AlexError !AlexInput+ | AlexSkip !AlexInput !Int+ | AlexToken !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (I# (sc))+ = alexScanUser undefined input (I# (sc))++alexScanUser user input (I# (sc))+ = case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, input') ->+ case alexGetChar input of+ Nothing -> ++++ AlexEOF+ Just _ ->++++ AlexError input'++ (AlexLastSkip input'' len, _) ->++++ AlexSkip input'' len++ (AlexLastAcc k input''' len, _) ->++++ AlexToken input''' len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+ input `seq` -- strict in the input+ let + new_acc = check_accs (alex_accept `quickIndex` (I# (s)))+ in+ new_acc `seq`+ case alexGetChar input of+ Nothing -> (new_acc, input)+ Just (c, new_input) -> ++++ let+ !(base) = alexIndexInt32OffAddr alex_base s+ !((I# (ord_c))) = ord c+ !(offset) = (base +# ord_c)+ !(check) = alexIndexInt16OffAddr alex_check offset+ + !(new_s) = if (offset >=# 0#) && (check ==# ord_c)+ then alexIndexInt16OffAddr alex_table offset+ else alexIndexInt16OffAddr alex_deflt s+ in+ case new_s of + -1# -> (new_acc, input)+ -- on an error, we want to keep the input *before* the+ -- character that failed, not after.+ _ -> alex_scan_tkn user orig_input (len +# 1#) + new_input new_s new_acc++ where+ check_accs [] = last_acc+ check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))+ check_accs (AlexAccPred a predx : rest)+ | predx user orig_input (I# (len)) input+ = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkipPred predx : rest)+ | predx user orig_input (I# (len)) input+ = AlexLastSkip input (I# (len))+ check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+ = AlexNone+ | AlexLastAcc a !AlexInput !Int+ | AlexLastSkip !AlexInput !Int++data AlexAcc a user+ = AlexAcc a+ | AlexAccSkip+ | AlexAccPred a (AlexAccPred user)+ | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+ = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, _) -> False+ _ -> True+ -- TODO: there's no need to find the longest+ -- match when checking the right context, just+ -- the first match will do.++-- used by wrappers+iUnbox (I# (i)) = i
+ examples/Main.hs view
@@ -0,0 +1,24 @@+-- Simple example reads a C file, extracts comments, and prints them.+-- Build with something like:+-- ghc -package-conf ../dist/package.conf.inplace --make Main.hs++import Language.C+import Language.C.Comments+import System (getArgs)+import Text.Printf++printComment :: Comment -> IO ()+printComment c = do+ let posn = commentPosition c+ file = posFile posn+ row = posRow posn+ col = posColumn posn+ printf "(%d:%d) %s\n" row col file+ putStrLn $ commentText c+ putStrLn "---"++main :: IO ()+main = do+ [file] <- getArgs+ cmnts <- comments file+ mapM_ printComment cmnts
+ language-c-comments.cabal view
@@ -0,0 +1,27 @@+Name: language-c-comments+Version: 0.1+Cabal-Version: >= 1.2.3+Build-Type: Simple+License: BSD3+License-File: LICENSE+Author: Geoff Hulette+Maintainer: ghulette@gmail.com+Stability: experimental+Homepage: http://github.com/ghulette/language-c-comments+Bug-reports: http://github.com/ghulette/language-c-comments/issues+Synopsis: Extracting comments from C code+Description: Language C Comments is a Haskell library for extracting + comments from C code. It will parse both single- and + multi-line comments, and correctly handles split lines.+Category: Language++Extra-Source-Files: examples/Main.hs+Data-Files: LICENSE, README++Library+ Build-Depends: base >= 4 && < 5,array,language-c >= 0.3.2+ Build-Tools: alex+ Hs-Source-Dirs: src+ Exposed-Modules: Language.C.Comments+ Other-Modules: Language.C.Comments.Lexer+ Language.C.Comments.LineParser
+ src/Language/C/Comments.hs view
@@ -0,0 +1,52 @@+module Language.C.Comments+ ( Comment+ , commentPosition+ , commentText+ , comments+ , commentsFromString+ ) where+ +import Control.Arrow+import Data.Maybe (maybeToList)+import Language.C.Comments.Lexer+import Language.C.Comments.LineParser (parseLines)+import Language.C.Data.Position++convertPosn :: FilePath -> AlexPosn -> Position+convertPosn file (AlexPn offset line col) = Position file line col++parseComments :: String -> (String,[(AlexPosn,String)])+parseComments = + alexScanTokens >>> unzip >>> (concat *** concatMap maybeToList)++-- | Comment positions use Language.C.Data.Position for compatibility with+-- Language.C.+data Comment = Comment + { commentPosition :: Position+ , commentText :: String+ } deriving (Eq,Show)++-- | Comments are ordered by position within files.+instance Ord Comment where+ compare x y = compare (commentPosition x) (commentPosition y)++commentsInFile :: FilePath -> String -> [Comment]+commentsInFile file code = + let + convertPosnsIn = map (first (convertPosn file))+ makeComment = \(p,t) -> Comment p t+ joinBrokenLines = unlines . parseLines+ (_,cmnts) = parseComments (joinBrokenLines code)+ in+ map makeComment (convertPosnsIn cmnts)++-- | Extract comments from a C file+comments :: FilePath -> IO [Comment]+comments file = do+ code <- readFile file+ return $ commentsInFile file code++-- | Extract comments from a string. A comment's position contains a+-- filename; this method uses the empty string in its place.+commentsFromString :: String -> [Comment]+commentsFromString = commentsInFile ""
+ src/Language/C/Comments/Lexer.x view
@@ -0,0 +1,22 @@+{+module Language.C.Comments.Lexer where++}++%wrapper "posn"++-- We have to recognize strings, so we don't grab pseudo-comments inside them.+-- Just copypasted from src/Language/C/Parser/Lexer.x+$octdigit = 0-7+$hexdigit = [0-9a-fA-F]+@charesc = \\([ntvbrfaeE\\\?\'\"]|$octdigit{1,3}|x$hexdigit+)+$instr = \0-\255 # [ \\ \" \n \r ] -- valid character in a string literal+@string = \"($instr|@charesc)*\"++-- Regexp for C comments, credit to http://ostermiller.org/findcomment.html+@comment = \/\*([^\*]|[\r\n]|(\*+([^\*\/]|[\r\n])))*\*+\/|(\/\/.*)++tokens :-+ @string { \pos s -> (s , Nothing) }+ @comment { \pos s -> (" ", Just (pos,s)) }+ .|\n { \pos s -> (s , Nothing) }
+ src/Language/C/Comments/LineParser.hs view
@@ -0,0 +1,38 @@+-- Turns a raw C string into lines, taking into account lines that are +-- explicitly broken with a trailing slash (\).++module Language.C.Comments.LineParser (parseLines) where++isWhitespace :: Char -> Bool+isWhitespace ' ' = True+isWhitespace '\t' = True+isWhitespace _ = False++stripTrailingWhitespace :: String -> String+stripTrailingWhitespace = reverse . (dropWhile isWhitespace) . reverse++stripBreak :: String -> String+stripBreak s | isBrokenLine s = dropLast (stripTrailingWhitespace s)+ | otherwise = s+ where + dropLast = reverse . tail . reverse+ +isBrokenLine :: String -> Bool+isBrokenLine = (endsWith '\\') . stripTrailingWhitespace+ where + startsWith _ [] = False+ startsWith x (y:_) = x == y+ endsWith = \c -> (startsWith c) . reverse++joinBrokenLines :: [String] -> [String]+joinBrokenLines [] = []+joinBrokenLines [line] = [stripBreak line] -- if the last line is broken+joinBrokenLines (line1:line2:rest) =+ if isBrokenLine line1 then + let joinedLine = (stripBreak line1) ++ line2 in+ joinBrokenLines (joinedLine:rest)+ else + line1:(joinBrokenLines (line2:rest))++parseLines :: String -> [String]+parseLines = joinBrokenLines . lines