for the Debian
system (but may be used by others).
cpphs-1.16/docs/design 0000755 2056640 0024421 00000002112 12075315473 014633 0 ustar 1341796 Domain Users Design for hspp
First pass:
-----------
* traverse the file,
- processing #if's and #ifdef's
- reading #include's and recursively doing this pass on them
- leaving #line's behind
- whilst taking account of #define's and #undef's
* only needs to look at lines beginning with a #
* should discard C-style comments? (no)
* DO NOT gather the #define's for macros - their sequence matters!
pass1 :: SymTab -> String -> String
Second pass:
------------
* traverse the residual file,
- keeping track of #define'd macros
- expanding #define'd macros when an instance is encountered
* needs a whitespace-preserving tokeniser with odd rules to
cover e.g. token concatenation. Within Haskell, quotation marks start
strings, haskell comments are preserved. Within a cpp directive,
quotation marks do not start a string, and C-style comments are
converted to whitespace.
* Line continuation characters are tricky; probably should only
be recognised within a macro definition, not in ordinary code.
pass2 :: SymTab -> String -> String
cpphs-1.16/docs/index.html 0000755 2056640 0024421 00000060465 12077543766 015465 0 ustar 1341796 Domain Users
cpphs
cpphs
cpphs is a liberalised re-implementation of
cpp,
the C pre-processor, in Haskell.
Why re-implement cpp? Rightly or wrongly, the C pre-processor is
widely used in Haskell source code. It enables conditional compilation
for different compilers, different versions of the same compiler,
and different OS platforms. It is also occasionally used for its
macro language, which can enable certain forms of platform-specific
detail-filling, such as the tedious boilerplate generation of instance
definitions and FFI declarations. However, there are two problems with
cpp, aside from the obvious aesthetic ones:
- For some Haskell systems, notably Hugs on Windows, a true cpp
is not available by default.
- Even for the other Haskell systems, the common cpp provided by
the gcc 3.x and 4.x series has changed subtly in ways that are
incompatible with Haskell's syntax. There have always been
problems with, for instance, string gaps, and prime characters
in identifiers. These problems are only going to get worse.
So, it seemed right to provide an alternative to cpp, both more
compatible with Haskell, and itself written in Haskell so that it
can be distributed with compilers.
This version of the C pre-processor is pretty-much feature-complete,
and compatible with the -traditional style.
It has two main modes:
- conditional compilation only (--nomacro),
- and full macro-expansion (default).
In --nomacro mode, cpphs performs only conditional compilation
actions, namely #include's, #if's, and
#ifdef's are processed according to text-replacement
definitions and macro expansions (both command-line and internal).
In full compatibility mode (the default), textual replacements and macro
expansions are also processed in the remaining body of non-cpp text.
Source language features:
| #ifdef | simple conditional compilation |
| #if | the full boolean language of defined(),
&&, ||, ==, etc. |
| #elif | chained conditionals |
| #define | in-line definitions (text replacements and macros) |
| #undef | in-line revocation of definitions |
| #include | file inclusion |
| #line | line number directives |
| #pragma | cpp pragmas (ignored) |
| \\n | line continuations within all # directives |
| /**/ | token catenation within a macro definition |
| ## | ANSI-style token catenation |
| # | ANSI-style token stringisation |
| __FILE__ | special text replacement for DIY error messages |
| __LINE__ | special text replacement for DIY error messages |
| __DATE__ | special text replacement |
| __TIME__ | special text replacement |
Macro expansion is recursive. Redefinition of a macro name does not
generate a warning. Macros can be defined on the command-line with
-D just like textual replacements. Macro names are permitted to be
Haskell identifiers e.g. with the prime ' and backtick ` characters,
which is slightly looser than in C, but they still may not include
operator symbols.
Numbering of lines in the output is preserved so that any later
processor can give meaningful error messages. When a file is
#include'd, cpphs inserts #line directives for the
same reason. Numbering should be correct even in the presence of
line continuations. If you don't want #line directives in
the final output, use the --noline option, or if you would
prefer them in {-# LINE #-} Haskell pragma format, use the
--linepragma option.
Any syntax error in a cpp directive gives a warning message to stderr.
Failure to find a #include'd file also produces a warning to stderr. In
both cases, processing continues on the rest of the input.
Usage: cpphs [ filename | -Dsym | -Dsym=val | -Ipath ]+ [-Ofile]
[--include=file]*
[--nomacro] [--noline] [--linepragma] [--nowarn] [--pragma]
[--strip] [--strip-eol]
[--text] [--hashes] [--layout] [--unlit]
[ --cpp compatopts ]
cpphs --version
You can give any number of filenames on the command-line. The results
are catenated on standard output. (Macro definitions in one file do not
carry over into the next.) If no filename is given, cpphs reads from
standard input.
Note: if you wish to use cpphs as a replacement for gcc's
cpp in conjunction with the ghc compiler then the extra options you need
to give to ghc are these:
-cpp -pgmPcpphs -optP--cpp
Options:
| -Dsym |
define a textual replacement (default value is 1) |
| -Dsym=val |
define a textual replacement with a specific value |
| -Dsym(args)=val |
define a macro with arguments |
| -Ipath |
add a directory to the search path for #include's |
| -Ofile |
specify a file for output (default is stdout) |
| --include=file |
#include the given file at the start of the input |
| --nomacro |
only process #ifdef's and #include's, do not expand macros |
| --noline |
remove #line droppings from the output |
| --linepragma |
convert #line droppings into {-# LINE #-} format |
| --nowarn |
suppress messages from missing #include files, or #warning |
| --pragma |
retain #pragma in the output (normally removed) |
| --strip |
convert traditional C-style comments (not eol //) to whitespace,
even outside cpp directives |
| --strip-eol |
convert modern C-style comments (including /**/ and //) to whitespace,
even outside cpp directives |
| --hashes |
recognise the ANSI # stringise operator, and ## for
token catenation, within macros |
| --text |
treat input as plain text, not Haskell code |
| --layout |
preserve newlines within macro expansions |
| --unlit |
unlit literate source code |
| --cpp compatopts |
accept standard cpp options: -o, -x, -ansi, -traditional,
-P, -C, -A, etc |
| --version |
report version number of cpphs and stop |
There are NO textual replacements defined by default. (Normal cpp
usually has definitions for machine, OS, etc. You can easily create
a wrapper script if you need these.) The search path is searched in
order of the -I options, except that the directory of the calling file,
then the current directory, are always searched first. Again, there
is no default search path (unless you define one via a wrapper script).
Current stable version:
cpphs-1.16, release date 2013.01.22
By HTTP:
.tar.gz,
Hackage.
- Fix the interaction of runCpphsReturningSymTab with --nomacro.
Development:
The current darcs repository of
cpphs is available at
darcs get http://code.haskell.org/cpphs
(Users on Windows or MacOS filesystems may need to use the
--partial flag.)
What's new, over and above the latest stable release?
- Nothing since last release.
Older versions:
cpphs-1.15, release date 2012.11.30
By HTTP:
.tar.gz,
Hackage.
- Fix the interaction of --nomacro with --strip.
- Fix the error message received when # appears without a command.
cpphs-1.14, release date 2012.07.11
By HTTP:
.tar.gz,
Hackage.
- New API to return symbol table after processing.
cpphs-1.13, release date 2011.09.26
By HTTP:
.tar.gz,
Hackage.
- Accept the -U commandline option for compatibility with cpp.
cpphs-1.12, release date 2011.06.26
By HTTP:
.tar.gz,
Hackage.
- Compatibility fixes for ghc-7.2.
cpphs-1.11, release date 2010.01.31
By HTTP:
.tar.gz,
.zip,
Hackage.
- Major API change: runCpphs, cppIfdef and macroPass are now in the IO monad.
cpphs-1.10, release date 2010.01.30
By HTTP:
.tar.gz,
.zip,
- New command-line flag: --linepragma
cpphs-1.9, release date 2009.09.07
By HTTP:
.tar.gz,
.zip.
cpphs-1.8, release date 2009.08.06
By HTTP:
.tar.gz,
.zip.
- Bugfix for off-by-one error in line numbers with --include=file.
cpphs-1.7, release date 2009.06.22
By HTTP:
.tar.gz,
.zip.
- Bugfix for --unlit interaction with \end{code}.
cpphs-1.6, release date 2008.10.09
By HTTP:
.tar.gz,
.zip.
- New option --include=filename, compatible with cpp's
-include filename.
- New option --strip-eol now strips C eol // comments
in addition to /**/.
- Line pragmas can now have filenames containing spaces.
- Bugfix for cpp directives within {- -} Haskell comments.
cpphs-1.5, release date 2007.06.05
By HTTP:
.tar.gz,
.zip.
Windows binary,
- Fixed some more obscure corner cases, involving parameterised macro
expansion within conditionals e.g. #if FOO(BAR,QUUX)
- Internal refactoring, affecting parts of the library API.
cpphs-1.4, release date 2007.04.17
By HTTP:
.tar.gz,
.zip.
- Added a "--pragma" option to retain #pragma in the output.
- Fixed a number of obscure corner cases involving the interaction of
multiple features e.g. foo##__LINE__.
- Added the "--nowarn" option.
cpphs-1.3, release date 2006.10.09
By HTTP:
.tar.gz,
.zip,
Windows binary.
- Added a "--cpp" option for drop-in compatibility with standard cpp.
It causes cpphs to accept standard cpp flags and translate
them to cpphs equivalents. Compatibility options include: -o, -ansi,
-traditional, -stdc, -x, -include, -P, -C, -CC, -A. The file
behaviour is different too - if two filenames are given on the
commandline, then the second is treated as the output location.
- Fixed a corner-case bug in evaluating chained and overlapping #ifdefs.
cpphs-1.2, release date 2006.05.04
By HTTP:
.tar.gz,
.zip,
Windows binary.
- Re-arranged the source files into hierarchical libraries.
- Exposed the library interface as an installable Cabal package, with
Haddock documentation.
- Added the --unlit option, for removing literate-style comments.
cpphs-1.1, release date 2005.10.14
By HTTP:
.tar.gz,
.zip.
- Fixed the .cabal way of building cpphs.
- Update the --version reported (forgotten in 1.0, which still
mistakenly reports 0.9).
- No longer throws an error on an empty file.
cpphs-1.0, release date 2005.10.05
By HTTP:
.tar.gz,
.zip.
- Included the cpphs.compat script for argument
compatibility with the original cpp.
- Placed quotes around replacements for special macros __FILE__, __DATE__,
and __TIME__.
- If no files are specified, read from stdin.
- Ignore #! lines (e.g. in scripts)
- Parse -D commandline options consistently with cpp,
i.e. -Dfoo means foo=1
- Fix compatibility with preprocessors like hsc2hs, which use
non-cpp directives like #def. They are now passed through to the
output with a warning to stderr.
cpphs-0.9, release date 2005.03.17
By HTTP:
.tar.gz,
.zip.
- Bugfix for ghc-6.4 -O: flush output buffer.
cpphs-0.8, release date 2004.11.14
By HTTP:
.tar.gz,
.zip.
- Added the --text option, to signify the input should not
be lexed as Haskell. This causes macros to be defined or expanded
regardless of their location within comments, string delimiters, etc.
- Shuffled some source files around - there is now a runhugs script
to invoke cpphs nicely.
cpphs-0.7, release date 2004.09.01
By HTTP:
.tar.gz,
.zip.
- Enable the __FILE__, __LINE__, __DATE__,
and __TIME__ specials, which can be useful for creating
DIY error messages.
cpphs-0.6, release date 2004.07.30
By HTTP:
.tar.gz,
.zip.
cpphs-0.5, release date 2004.06.07
By HTTP:
.tar.gz,
.zip.
- Added a --version flag to report the version number.
- Renamed --stringise to --hashes, and use it to turn on ## catenation
as well.
- Bugfix for #if 1, previously interpreted as false.
- Bugfix for --nolines: it no longer adds extra spurious newlines.
- File inclusion now looks in the directory of the calling file.
- Failure to find an include file is now merely a warning to stderr
rather than an error.
- Added a --layout flag. Previously, line continuations in a macro
definition were always preserved in the output, permitting use
of the Haskell layout rule even inside a macro. The default is now
to remove line continuations for conformance with cpp, but the option
of using --layout is still possible.
cpphs-0.4, release date 2004.05.19
By HTTP:
.tar.gz,
.zip.
- New flag -Ofile to redirect output
- Bugfix for precedence of ! in #if !False && False
- Bugfix for whitespace permitted between # and if
- Bugfix for #define F "blah"; #include F
cpphs-0.3, release date 2004.05.18
By HTTP:
.tar.gz,
.zip.
Fix recursive macro expansion bug. Added option to strip C comments.
Added option to recognise the # stringise operator.
cpphs-0.2, release date 2004.05.15
By HTTP:
.tar.gz,
.zip.
Implements textual replacement and macro expansion.
cpphs-0.1, release date 2004.04.07
By HTTP:
.tar.gz,
.zip.
Initial release: implements conditional compilation and file inclusion only.
Building instructions
To build cpphs, use
hmake cpphs [-package base]
or
ghc --make cpphs [-o cpphs]
or
mv cpphs.hugs cpphs # a simple runhugs script
You will notice that the command-line arguments for cpphs
are not the same as for the original cpp. If you want
to use cpphs as a completely drop-in replacement for
the real cpp, that is, to accept the same arguments, and
have broadly the same behaviour in response to them, then use the
--cpp compatibility option as the first commandline flag.
In general, cpphs is based on the -traditional behaviour, not
ANSI C, and has the following main differences from the standard cpp.
General
- The # that introduces any cpp directive must be in the first
column of a line (whereas ANSI permits whitespace before the #).
- Generates the #line n "filename" syntax, not the # n
"filename" variant.
- C comments are only removed from within cpp directives. They are
not stripped from other text. Consider for instance that in
Haskell, all of the following are valid operator symbols: /*
*/ */* However, you can turn on C-comment removal with the
--strip option.
- Macros are never expanded within Haskell comments, strings,
or character constants, unless you give the --text option to
disable lexing the input as Haskell.
- Macros are always expanded recursively, unlike ANSI, which detects
and prevents self-recursion. For instance, #define foo x:foo
expands foo once only to x:foo in ANSI, but in cpphs
it becomes an infinite list x:x:x:x:..., i.e. cpphs does not
terminate.
Macro definition language
- Accepts /**/ for token-pasting in a macro definition.
However, /* */ (with any text between the open/close
comment) inserts whitespace.
- The ANSI ## token-pasting operator is available with
the --hashes flag. This is to avoid misinterpreting
any valid Haskell operator of the same name.
- Replaces a macro formal parameter with the actual, even inside a
string (double or single quoted). This is -traditional behaviour,
not supported in ANSI.
- Recognises the # stringisation operator in a macro
definition only if you use the --hashes option. (It is
an ANSI addition, only needed because quoted stringisation (above)
is prohibited by ANSI.)
- Preserves whitespace within a textual replacement definition
exactly (modulo newlines), but leading and trailing space is eliminated.
- Preserves whitespace within a macro definition (and trailing it)
exactly (modulo newlines), but leading space is eliminated.
- Preserves whitespace within macro call arguments exactly
(including newlines), but leading and trailing space is eliminated.
- With the --layout option, line continuations in a textual
replacement or macro definition are preserved as line-breaks in the
macro call. (Useful for layout-sensitive code in Haskell.)
You can use cpphs as a library from within a Haskell program. The main
interface is in Language.Preprocessor.Cpphs. Haddock
documentation is here. To make the library
available to your haskell compiler, you must install the cpphs package
using Cabal.
I am interested in hearing your feedback on cpphs. Bug reports
especially welcome. You can send feature requests too, but I won't
guarantee to implement them if they depart much from the ordinary
cpp's behaviour. Please mail
Copyright: © 2004-2012 Malcolm Wallace,
except for ParseLib (Copyright © 1995 Graham Hutton and Erik Meijer)
License: The library modules in cpphs are distributed under
the terms of the LGPL (see file LICENCE-LGPL
for more details). If that's a problem for you, contact me to make
other arrangements. The application module 'cpphs.hs' itself is GPL
(see file LICENCE-GPL). If you have a
commercial use for cpphs and find the terms of the (L)GPL too onerous,
you can instead choose to distribute unmodified binaries (not source),
under the terms of LICENCE-commercial
This software comes with no warranty. Use at your own risk.
cpphs-1.16/Language/ 0000755 2056640 0024421 00000000000 12077544327 014237 5 ustar 1341796 Domain Users cpphs-1.16/Language/Preprocessor/ 0000755 2056640 0024421 00000000000 12077544327 016725 5 ustar 1341796 Domain Users cpphs-1.16/Language/Preprocessor/Cpphs/ 0000755 2056640 0024421 00000000000 12077544327 020002 5 ustar 1341796 Domain Users cpphs-1.16/Language/Preprocessor/Cpphs/CppIfdef.hs 0000755 2056640 0024421 00000025236 12075315472 022024 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : CppIfdef
-- Copyright : 1999-2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
-- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.
-- and \#include's.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.CppIfdef
( cppIfdef -- :: FilePath -> [(String,String)] -> [String] -> Options
-- -> String -> IO [(Posn,String)]
) where
import Language.Preprocessor.Cpphs.SymTab
import Text.ParserCombinators.HuttonMeijer
import Language.Preprocessor.Cpphs.Position (Posn,newfile,newline,newlines
,cppline,cpp2hask,newpos)
import Language.Preprocessor.Cpphs.ReadFirst (readFirst)
import Language.Preprocessor.Cpphs.Tokenise (linesCpp,reslash)
import Language.Preprocessor.Cpphs.Options (BoolOptions(..))
import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine
,expandMacro)
import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)
import Data.Char (isDigit)
import Numeric (readHex,readOct,readDec)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.IO (hPutStrLn,stderr)
import Control.Monad (when)
-- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,
-- whilst taking account of \#define's and \#undef's as we encounter them.
cppIfdef :: FilePath -- ^ File for error reports
-> [(String,String)] -- ^ Pre-defined symbols and their values
-> [String] -- ^ Search path for \#includes
-> BoolOptions -- ^ Options controlling output style
-> String -- ^ The input file content
-> IO [(Posn,String)] -- ^ The file after processing (in lines)
cppIfdef fp syms search options =
cpp posn defs search options (Keep []) . (cppline posn:) . linesCpp
where
posn = newfile fp
defs = preDefine options syms
-- Previous versions had a very simple symbol table mapping strings
-- to strings. Now the #ifdef pass uses a more elaborate table, in
-- particular to deal with parameterised macros in conditionals.
-- | Internal state for whether lines are being kept or dropped.
-- In @Drop n b ps@, @n@ is the depth of nesting, @b@ is whether
-- we have already succeeded in keeping some lines in a chain of
-- @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,
-- used for error messages in case EOF is reached too soon.
data KeepState = Keep [Posn] | Drop Int Bool [Posn]
-- | Return just the list of lines that the real cpp would decide to keep.
cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState
-> [String] -> IO [(Posn,String)]
cpp _ _ _ _ (Keep ps) [] | not (null ps) = do
hPutStrLn stderr $ "Unmatched #if: positions of open context are:\n"++
unlines (map show ps)
return []
cpp _ _ _ _ _ [] = return []
cpp p syms path options (Keep ps) (l@('#':x):xs) =
let ws = words x
cmd = if null ws then "" else head ws
line = tail ws
sym = head (tail ws)
rest = tail (tail ws)
def = defineMacro options (sym++" "++ maybe "1" id (un rest))
un v = if null v then Nothing else Just (unwords v)
keepIf b = if b then Keep (p:ps) else Drop 1 False (p:ps)
skipn syms' retain ud xs' =
let n = 1 + length (filter (=='\n') l) in
(if macros options && retain then emitOne (p,reslash l)
else emitMany (replicate n (p,""))) $
cpp (newlines n p) syms' path options ud xs'
in case cmd of
"define" -> skipn (insertST def syms) True (Keep ps) xs
"undef" -> skipn (deleteST sym syms) True (Keep ps) xs
"ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs
"ifdef" -> skipn syms False (keepIf (definedST sym syms)) xs
"if" -> skipn syms False
(keepIf (gatherDefined p syms (unwords line))) xs
"else" -> skipn syms False (Drop 1 False ps) xs
"elif" -> skipn syms False (Drop 1 True ps) xs
"endif" | null ps ->
do hPutStrLn stderr $ "Unmatched #endif at "++show p
return []
"endif" -> skipn syms False (Keep (tail ps)) xs
"pragma" -> skipn syms True (Keep ps) xs
('!':_) -> skipn syms False (Keep ps) xs -- \#!runhs scripts
"include"-> do (inc,content) <- readFirst (file syms (unwords line))
p path
(warnings options)
cpp p syms path options (Keep ps)
(("#line 1 "++show inc): linesCpp content
++ cppline (newline p): xs)
"warning"-> if warnings options then
do hPutStrLn stderr (l++"\nin "++show p)
skipn syms False (Keep ps) xs
else skipn syms False (Keep ps) xs
"error" -> error (l++"\nin "++show p)
"line" | all isDigit sym
-> (if locations options && hashline options then emitOne (p,l)
else if locations options then emitOne (p,cpp2hask l)
else id) $
cpp (newpos (read sym) (un rest) p)
syms path options (Keep ps) xs
n | all isDigit n && not (null n)
-> (if locations options && hashline options then emitOne (p,l)
else if locations options then emitOne (p,cpp2hask l)
else id) $
cpp (newpos (read n) (un (tail ws)) p)
syms path options (Keep ps) xs
| otherwise
-> do when (warnings options) $
hPutStrLn stderr ("Warning: unknown directive #"++n
++"\nin "++show p)
emitOne (p,l) $
cpp (newline p) syms path options (Keep ps) xs
cpp p syms path options (Drop n b ps) (('#':x):xs) =
let ws = words x
cmd = if null ws then "" else head ws
delse | n==1 && b = Drop 1 b ps
| n==1 = Keep ps
| otherwise = Drop n b ps
dend | n==1 = Keep (tail ps)
| otherwise = Drop (n-1) b (tail ps)
delif s | n==1 && not b && gatherDefined p syms s
= Keep ps
| otherwise = Drop n b ps
skipn ud xs' =
let n' = 1 + length (filter (=='\n') x) in
emitMany (replicate n' (p,"")) $
cpp (newlines n' p) syms path options ud xs'
in
if cmd == "ifndef" ||
cmd == "if" ||
cmd == "ifdef" then skipn (Drop (n+1) b (p:ps)) xs
else if cmd == "elif" then skipn (delif (unwords (tail ws))) xs
else if cmd == "else" then skipn delse xs
else if cmd == "endif" then
if null ps then do hPutStrLn stderr $ "Unmatched #endif at "++show p
return []
else skipn dend xs
else skipn (Drop n b ps) xs
-- define, undef, include, error, warning, pragma, line
cpp p syms path options (Keep ps) (x:xs) =
let p' = newline p in seq p' $
emitOne (p,x) $ cpp p' syms path options (Keep ps) xs
cpp p syms path options d@(Drop _ _ _) (_:xs) =
let p' = newline p in seq p' $
emitOne (p,"") $ cpp p' syms path options d xs
-- | Auxiliary IO functions
emitOne :: a -> IO [a] -> IO [a]
emitMany :: [a] -> IO [a] -> IO [a]
emitOne x io = do ys <- unsafeInterleaveIO io
return (x:ys)
emitMany xs io = do ys <- unsafeInterleaveIO io
return (xs++ys)
----
gatherDefined :: Posn -> SymTab HashDefine -> String -> Bool
gatherDefined p st inp =
case papply (parseBoolExp st) inp of
[] -> error ("Cannot parse #if directive in file "++show p)
[(b,_)] -> b
_ -> error ("Ambiguous parse for #if directive in file "++show p)
parseBoolExp :: SymTab HashDefine -> Parser Bool
parseBoolExp st =
do a <- parseExp1 st
skip (string "||")
b <- first (skip (parseBoolExp st))
return (a || b)
+++
parseExp1 st
parseExp1 :: SymTab HashDefine -> Parser Bool
parseExp1 st =
do a <- parseExp0 st
skip (string "&&")
b <- first (skip (parseExp1 st))
return (a && b)
+++
parseExp0 st
parseExp0 :: SymTab HashDefine -> Parser Bool
parseExp0 st =
do skip (string "defined")
sym <- parens parseSym
return (definedST sym st)
+++
do parens (parseBoolExp st)
+++
do skip (char '!')
a <- parseExp0 st
return (not a)
+++
do sym1 <- parseSymOrCall st
op <- parseOp st
sym2 <- parseSymOrCall st
return (op (safeRead sym1) (safeRead sym2))
+++
do sym <- parseSymOrCall st
case safeRead sym of
0 -> return False
_ -> return True
where
safeRead s =
case s of
'0':'x':s' -> number readHex s'
'0':'o':s' -> number readOct s'
_ -> number readDec s
number rd s =
case rd s of
[] -> 0 :: Integer
((n,_):_) -> n :: Integer
parseOp :: SymTab HashDefine -> Parser (Integer -> Integer -> Bool)
parseOp _ =
do skip (string ">=")
return (>=)
+++
do skip (char '>')
return (>)
+++
do skip (string "<=")
return (<=)
+++
do skip (char '<')
return (<)
+++
do skip (string "==")
return (==)
+++
do skip (string "!=")
return (/=)
parseSymOrCall :: SymTab HashDefine -> Parser String
parseSymOrCall st =
do sym <- skip parseSym
args <- parens (parseSymOrCall st `sepby` skip (char ','))
return (convert sym args)
+++
do sym <- skip parseSym
return (convert sym [])
where
convert sym args =
case lookupST sym st of
Nothing -> sym
Just (a@SymbolReplacement{}) -> recursivelyExpand st (replacement a)
Just (a@MacroExpansion{}) -> expandMacro a args False
Just (a@AntiDefined{}) -> name a
recursivelyExpand :: SymTab HashDefine -> String -> String
recursivelyExpand st inp =
case papply (parseSymOrCall st) inp of
[(b,_)] -> b
_ -> inp
parseSym :: Parser String
parseSym = many1 (alphanum+++char '\''+++char '`')
parens p = bracket (skip (char '(')) (skip p) (skip (char ')'))
-- | Determine filename in \#include
file :: SymTab HashDefine -> String -> String
file st name =
case name of
('"':ns) -> init ns
('<':ns) -> init ns
_ -> let ex = recursivelyExpand st name in
if ex == name then name else file st ex
cpphs-1.16/Language/Preprocessor/Cpphs/HashDefine.hs 0000755 2056640 0024421 00000011501 12075315472 022330 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : HashDefine
-- Copyright : 2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- What structures are declared in a \#define.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.HashDefine
( HashDefine(..)
, ArgOrText(..)
, expandMacro
, parseHashDefine
, simplifyHashDefines
) where
import Data.Char (isSpace)
import Data.List (intercalate)
data HashDefine
= LineDrop
{ name :: String }
| Pragma
{ name :: String }
| AntiDefined
{ name :: String
, linebreaks :: Int
}
| SymbolReplacement
{ name :: String
, replacement :: String
, linebreaks :: Int
}
| MacroExpansion
{ name :: String
, arguments :: [String]
, expansion :: [(ArgOrText,String)]
, linebreaks :: Int
}
deriving (Eq,Show)
-- | 'smart' constructor to avoid warnings from ghc (undefined fields)
symbolReplacement :: HashDefine
symbolReplacement =
SymbolReplacement
{ name=undefined, replacement=undefined, linebreaks=undefined }
-- | Macro expansion text is divided into sections, each of which is classified
-- as one of three kinds: a formal argument (Arg), plain text (Text),
-- or a stringised formal argument (Str).
data ArgOrText = Arg | Text | Str deriving (Eq,Show)
-- | Expand an instance of a macro.
-- Precondition: got a match on the macro name.
expandMacro :: HashDefine -> [String] -> Bool -> String
expandMacro macro parameters layout =
let env = zip (arguments macro) parameters
replace (Arg,s) = maybe (error "formal param") id (lookup s env)
replace (Str,s) = maybe (error "formal param") str (lookup s env)
replace (Text,s) = if layout then s else filter (/='\n') s
str s = '"':s++"\""
in
concatMap replace (expansion macro)
-- | Parse a \#define, or \#undef, ignoring other \# directives
parseHashDefine :: Bool -> [String] -> Maybe HashDefine
parseHashDefine ansi def = (command . skip) def
where
skip xss@(x:xs) | all isSpace x = skip xs
| otherwise = xss
skip [] = []
command ("line":xs) = Just (LineDrop ("#line"++concat xs))
command ("pragma":xs) = Just (Pragma ("#pragma"++concat xs))
command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def })
command ("undef":xs) = Just (((undef . skip) xs))
command _ = Nothing
undef (sym:_) = AntiDefined { name=sym, linebreaks=0 }
define (sym:xs) = case {-skip-} xs of
("(":ys) -> (macroHead sym [] . skip) ys
ys -> symbolReplacement
{ name=sym
, replacement = concatMap snd
(classifyRhs [] (chop (skip ys))) }
macroHead sym args (",":xs) = (macroHead sym args . skip) xs
macroHead sym args (")":xs) = MacroExpansion
{ name =sym , arguments = reverse args
, expansion = classifyRhs args (skip xs)
, linebreaks = undefined }
macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs
macroHead sym args [] = error ("incomplete macro definition:\n"
++" #define "++sym++"("
++intercalate "," args)
classifyRhs args ("#":x:xs)
| ansi &&
x `elem` args = (Str,x): classifyRhs args xs
classifyRhs args ("##":xs)
| ansi = classifyRhs args xs
classifyRhs args (s:"##":s':xs)
| ansi && all isSpace s && all isSpace s'
= classifyRhs args xs
classifyRhs args (word:xs)
| word `elem` args = (Arg,word): classifyRhs args xs
| otherwise = (Text,word): classifyRhs args xs
classifyRhs _ [] = []
count = length . filter (=='\n') . concat
chop = reverse . dropWhile (all isSpace) . reverse
-- | Pretty-print hash defines to a simpler format, as key-value pairs.
simplifyHashDefines :: [HashDefine] -> [(String,String)]
simplifyHashDefines = concatMap simp
where
simp hd@LineDrop{} = []
simp hd@Pragma{} = []
simp hd@AntiDefined{} = []
simp hd@SymbolReplacement{} = [(name hd, replacement hd)]
simp hd@MacroExpansion{} = [(name hd++"("++intercalate "," (arguments hd)
++")"
,concatMap snd (expansion hd))]
cpphs-1.16/Language/Preprocessor/Cpphs/MacroPass.hs 0000755 2056640 0024421 00000021457 12075315472 022235 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : MacroPass
-- Copyright : 2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- Perform a cpp.second-pass, accumulating \#define's and \#undef's,
-- whilst doing symbol replacement and macro expansion.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.MacroPass
( macroPass
, preDefine
, defineMacro
, macroPassReturningSymTab
) where
import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro
, simplifyHashDefines)
import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..)
, parseMacroCall)
import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST
, emptyST, flattenST)
import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno)
import Language.Preprocessor.Cpphs.Options (BoolOptions(..))
import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Monad ((=<<))
import System.Time (getClockTime, toCalendarTime, formatCalendarTime)
import System.Locale (defaultTimeLocale)
noPos :: Posn
noPos = newfile "preDefined"
-- | Walk through the document, replacing calls of macros with the expanded RHS.
macroPass :: [(String,String)] -- ^ Pre-defined symbols and their values
-> BoolOptions -- ^ Options that alter processing style
-> [(Posn,String)] -- ^ The input file content
-> IO String -- ^ The file after processing
macroPass syms options =
fmap (safetail -- to remove extra "\n" inserted below
. concat
. onlyRights)
. macroProcess (pragma options) (layout options) (lang options)
(preDefine options syms)
. tokenise (stripEol options) (stripC89 options)
(ansi options) (lang options)
. ((noPos,""):) -- ensure recognition of "\n#" at start of file
where
safetail [] = []
safetail (_:xs) = xs
-- | auxiliary
onlyRights :: [Either a b] -> [b]
onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];)
-- | Walk through the document, replacing calls of macros with the expanded RHS.
-- Additionally returns the active symbol table after processing.
macroPassReturningSymTab
:: [(String,String)] -- ^ Pre-defined symbols and their values
-> BoolOptions -- ^ Options that alter processing style
-> [(Posn,String)] -- ^ The input file content
-> IO (String,[(String,String)])
-- ^ The file and symbol table after processing
macroPassReturningSymTab syms options =
fmap (mapFst (safetail -- to remove extra "\n" inserted below
. concat)
. walk)
. macroProcess (pragma options) (layout options) (lang options)
(preDefine options syms)
. tokenise (stripEol options) (stripC89 options)
(ansi options) (lang options)
. ((noPos,""):) -- ensure recognition of "\n#" at start of file
where
safetail [] = []
safetail (_:xs) = xs
walk (Right x: rest) = let (xs, foo) = walk rest
in (x:xs, foo)
walk (Left x: []) = ( [] , simplifyHashDefines (flattenST x) )
walk (Left x: rest) = walk rest
mapFst f (a,b) = (f a, b)
-- | Turn command-line definitions (from @-D@) into 'HashDefine's.
preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine
preDefine options defines =
foldr (insertST . defineMacro options . (\ (s,d)-> s++" "++d))
emptyST defines
-- | Turn a string representing a macro definition into a 'HashDefine'.
defineMacro :: BoolOptions -> String -> (String,HashDefine)
defineMacro opts s =
let (Cmd (Just hd):_) = tokenise True True (ansi opts) (lang opts)
[(noPos,"\n#define "++s++"\n")]
in (name hd, hd)
-- | Trundle through the document, one word at a time, using the WordStyle
-- classification introduced by 'tokenise' to decide whether to expand a
-- word or macro. Encountering a \#define or \#undef causes that symbol to
-- be overwritten in the symbol table. Any other remaining cpp directives
-- are discarded and replaced with blanks, except for \#line markers.
-- All valid identifiers are checked for the presence of a definition
-- of that name in the symbol table, and if so, expanded appropriately.
-- (Bool arguments are: keep pragmas? retain layout? haskell language?)
-- The result lazily intersperses output text with symbol tables. Lines
-- are emitted as they are encountered. A symbol table is emitted after
-- each change to the defined symbols, and always at the end of processing.
macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]
-> IO [Either (SymTab HashDefine) String]
macroProcess _ _ _ st [] = return [Left st]
macroProcess p y l st (Other x: ws) = emit x $ macroProcess p y l st ws
macroProcess p y l st (Cmd Nothing: ws) = emit "\n" $ macroProcess p y l st ws
macroProcess p y l st (Cmd (Just (LineDrop x)): ws)
= emit "\n" $
emit x $ macroProcess p y l st ws
macroProcess pragma y l st (Cmd (Just (Pragma x)): ws)
| pragma = emit "\n" $ emit x $ macroProcess pragma y l st ws
| otherwise = emit "\n" $ macroProcess pragma y l st ws
macroProcess p layout lang st (Cmd (Just hd): ws) =
let n = 1 + linebreaks hd
newST = insertST (name hd, hd) st
in
emit (replicate n '\n') $
emitSymTab newST $
macroProcess p layout lang newST ws
macroProcess pr layout lang st (Ident p x: ws) =
case x of
"__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws
"__LINE__" -> emit (show (lineno p)) $ macroProcess pr layout lang st ws
"__DATE__" -> do w <- return .
formatCalendarTime defaultTimeLocale "\"%d %b %Y\""
=<< toCalendarTime =<< getClockTime
emit w $ macroProcess pr layout lang st ws
"__TIME__" -> do w <- return .
formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""
=<< toCalendarTime =<< getClockTime
emit w $ macroProcess pr layout lang st ws
_ ->
case lookupST x st of
Nothing -> emit x $ macroProcess pr layout lang st ws
Just hd ->
case hd of
AntiDefined {name=n} -> emit n $
macroProcess pr layout lang st ws
SymbolReplacement {replacement=r} ->
let r' = if layout then r else filter (/='\n') r in
-- one-level expansion only:
-- emit r' $ macroProcess layout st ws
-- multi-level expansion:
macroProcess pr layout lang st
(tokenise True True False lang [(p,r')]
++ ws)
MacroExpansion {} ->
case parseMacroCall p ws of
Nothing -> emit x $
macroProcess pr layout lang st ws
Just (args,ws') ->
if length args /= length (arguments hd) then
emit x $ macroProcess pr layout lang st ws
else do args' <- mapM (fmap (concat.onlyRights)
. macroProcess pr layout
lang st)
args
-- one-level expansion only:
-- emit (expandMacro hd args' layout) $
-- macroProcess layout st ws'
-- multi-level expansion:
macroProcess pr layout lang st
(tokenise True True False lang
[(p,expandMacro hd args' layout)]
++ ws')
-- | Useful helper function.
emit :: a -> IO [Either b a] -> IO [Either b a]
emit x io = do xs <- unsafeInterleaveIO io
return (Right x:xs)
-- | Useful helper function.
emitSymTab :: b -> IO [Either b a] -> IO [Either b a]
emitSymTab x io = do xs <- unsafeInterleaveIO io
return (Left x:xs)
cpphs-1.16/Language/Preprocessor/Cpphs/Options.hs 0000755 2056640 0024421 00000013014 12075315472 021766 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : Options
-- Copyright : 2006 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- This module deals with Cpphs options and parsing them
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.Options
( CpphsOptions(..)
, BoolOptions(..)
, parseOptions
, defaultCpphsOptions
, defaultBoolOptions
) where
import Data.Maybe
import Data.List (isPrefixOf)
-- | Cpphs options structure.
data CpphsOptions = CpphsOptions
{ infiles :: [FilePath]
, outfiles :: [FilePath]
, defines :: [(String,String)]
, includes :: [String]
, preInclude:: [FilePath] -- ^ Files to #include before anything else
, boolopts :: BoolOptions
}
-- | Default options.
defaultCpphsOptions :: CpphsOptions
defaultCpphsOptions = CpphsOptions { infiles = [], outfiles = []
, defines = [], includes = []
, preInclude = []
, boolopts = defaultBoolOptions }
-- | Options representable as Booleans.
data BoolOptions = BoolOptions
{ macros :: Bool -- ^ Leave \#define and \#undef in output of ifdef?
, locations :: Bool -- ^ Place #line droppings in output?
, hashline :: Bool -- ^ Write #line or {-# LINE #-} ?
, pragma :: Bool -- ^ Keep #pragma in final output?
, stripEol :: Bool -- ^ Remove C eol (\/\/) comments everywhere?
, stripC89 :: Bool -- ^ Remove C inline (\/**\/) comments everywhere?
, lang :: Bool -- ^ Lex input as Haskell code?
, ansi :: Bool -- ^ Permit stringise \# and catenate \#\# operators?
, layout :: Bool -- ^ Retain newlines in macro expansions?
, literate :: Bool -- ^ Remove literate markup?
, warnings :: Bool -- ^ Issue warnings?
}
-- | Default settings of boolean options.
defaultBoolOptions :: BoolOptions
defaultBoolOptions = BoolOptions { macros = True, locations = True
, hashline = True, pragma = False
, stripEol = False, stripC89 = False
, lang = True, ansi = False
, layout = False, literate = False
, warnings = True }
-- | Raw command-line options. This is an internal intermediate data
-- structure, used during option parsing only.
data RawOption
= NoMacro
| NoLine
| LinePragma
| Pragma
| Text
| Strip
| StripEol
| Ansi
| Layout
| Unlit
| SuppressWarnings
| Macro (String,String)
| Path String
| PreInclude FilePath
| IgnoredForCompatibility
deriving (Eq, Show)
flags :: [(String, RawOption)]
flags = [ ("--nomacro", NoMacro)
, ("--noline", NoLine)
, ("--linepragma", LinePragma)
, ("--pragma", Pragma)
, ("--text", Text)
, ("--strip", Strip)
, ("--strip-eol", StripEol)
, ("--hashes", Ansi)
, ("--layout", Layout)
, ("--unlit", Unlit)
, ("--nowarn", SuppressWarnings)
]
-- | Parse a single raw command-line option. Parse failure is indicated by
-- result Nothing.
rawOption :: String -> Maybe RawOption
rawOption x | isJust a = a
where a = lookup x flags
rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d)
where (s,d) = break (=='=') xs
rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility
rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs
rawOption xs | "--include="`isPrefixOf`xs
= Just $ PreInclude (drop 10 xs)
rawOption _ = Nothing
trailing :: (Eq a) => [a] -> [a] -> [a]
trailing xs = reverse . dropWhile (`elem`xs) . reverse
-- | Convert a list of RawOption to a BoolOptions structure.
boolOpts :: [RawOption] -> BoolOptions
boolOpts opts =
BoolOptions
{ macros = not (NoMacro `elem` opts)
, locations = not (NoLine `elem` opts)
, hashline = not (LinePragma `elem` opts)
, pragma = Pragma `elem` opts
, stripEol = StripEol`elem` opts
, stripC89 = StripEol`elem` opts || Strip `elem` opts
, lang = not (Text `elem` opts)
, ansi = Ansi `elem` opts
, layout = Layout `elem` opts
, literate = Unlit `elem` opts
, warnings = not (SuppressWarnings `elem` opts)
}
-- | Parse all command-line options.
parseOptions :: [String] -> Either String CpphsOptions
parseOptions xs = f ([], [], []) xs
where
f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs
f (opts, ins, outs) (x@('-':_):xs) = case rawOption x of
Nothing -> Left x
Just a -> f (a:opts, ins, outs) xs
f (opts, ins, outs) (x:xs) = f (opts, normalise x:ins, outs) xs
f (opts, ins, outs) [] =
Right CpphsOptions { infiles = reverse ins
, outfiles = reverse outs
, defines = [ x | Macro x <- reverse opts ]
, includes = [ x | Path x <- reverse opts ]
, preInclude=[ x | PreInclude x <- reverse opts ]
, boolopts = boolOpts opts
}
normalise ('/':'/':filepath) = normalise ('/':filepath)
normalise (x:filepath) = x:normalise filepath
normalise [] = []
cpphs-1.16/Language/Preprocessor/Cpphs/Position.hs 0000755 2056640 0024421 00000006453 12075315472 022150 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : Position
-- Copyright : 2000-2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- Simple file position information, with recursive inclusion points.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.Position
( Posn(..)
, newfile
, addcol, newline, tab, newlines, newpos
, cppline, haskline, cpp2hask
, filename, lineno, directory
) where
import Data.List (isPrefixOf)
-- | Source positions contain a filename, line, column, and an
-- inclusion point, which is itself another source position,
-- recursively.
data Posn = Pn String !Int !Int (Maybe Posn)
deriving (Eq)
instance Show Posn where
showsPrec _ (Pn f l c i) = showString f .
showString " at line " . shows l .
showString " col " . shows c .
( case i of
Nothing -> id
Just p -> showString "\n used by " .
shows p )
-- | Constructor. Argument is filename.
newfile :: String -> Posn
newfile name = Pn name 1 1 Nothing
-- | Increment column number by given quantity.
addcol :: Int -> Posn -> Posn
addcol n (Pn f r c i) = Pn f r (c+n) i
-- | Increment row number, reset column to 1.
newline :: Posn -> Posn
--newline (Pn f r _ i) = Pn f (r+1) 1 i
newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i
-- | Increment column number, tab stops are every 8 chars.
tab :: Posn -> Posn
tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i
-- | Increment row number by given quantity.
newlines :: Int -> Posn -> Posn
newlines n (Pn f r _ i) = Pn f (r+n) 1 i
-- | Update position with a new row, and possible filename.
newpos :: Int -> Maybe String -> Posn -> Posn
newpos r Nothing (Pn f _ c i) = Pn f r c i
newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i
newpos r (Just f) (Pn _ _ c i) = Pn f r c i
-- | Project the line number.
lineno :: Posn -> Int
-- | Project the filename.
filename :: Posn -> String
-- | Project the directory of the filename.
directory :: Posn -> FilePath
lineno (Pn _ r _ _) = r
filename (Pn f _ _ _) = f
directory (Pn f _ _ _) = dirname f
-- | cpp-style printing of file position
cppline :: Posn -> String
cppline (Pn f r _ _) = "#line "++show r++" "++show f
-- | haskell-style printing of file position
haskline :: Posn -> String
haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}"
-- | Conversion from a cpp-style "#line" to haskell-style pragma.
cpp2hask :: String -> String
cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE "
++unwords (tail (words line))
++" #-}"
-- | Strip non-directory suffix from file name (analogous to the shell
-- command of the same name).
dirname :: String -> String
dirname = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse
where safetail [] = []
safetail (_:x) = x
cpphs-1.16/Language/Preprocessor/Cpphs/ReadFirst.hs 0000755 2056640 0024421 00000003606 12075315472 022224 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : ReadFirst
-- Copyright : 2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- Read the first file that matches in a list of search paths.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.ReadFirst
( readFirst
) where
import System.IO (hPutStrLn, stderr)
import System.Directory (doesFileExist)
import Data.List (intersperse)
import Control.Monad (when)
import Language.Preprocessor.Cpphs.Position (Posn,directory)
-- | Attempt to read the given file from any location within the search path.
-- The first location found is returned, together with the file content.
-- (The directory of the calling file is always searched first, then
-- the current directory, finally any specified search path.)
readFirst :: String -- ^ filename
-> Posn -- ^ inclusion point
-> [String] -- ^ search path
-> Bool -- ^ report warnings?
-> IO ( FilePath
, String
) -- ^ discovered filepath, and file contents
readFirst name demand path warn =
try (cons dd (".":path))
where
dd = directory demand
cons x xs = if null x then xs else x:xs
try [] = do
when warn $
hPutStrLn stderr ("Warning: Can't find file \""++name
++"\" in directories\n\t"
++concat (intersperse "\n\t" (cons dd (".":path)))
++"\n Asked for by: "++show demand)
return ("missing file: "++name,"")
try (p:ps) = do
let file = p++'/':name
ok <- doesFileExist file
if not ok then try ps
else do content <- readFile file
return (file,content)
cpphs-1.16/Language/Preprocessor/Cpphs/RunCpphs.hs 0000755 2056640 0024421 00000005754 12075316017 022105 0 ustar 1341796 Domain Users {-
-- The main program for cpphs, a simple C pre-processor written in Haskell.
-- Copyright (c) 2004 Malcolm Wallace
-- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011).
-}
module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs
, runCpphsReturningSymTab
) where
import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)
import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)
import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..))
import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)
import Language.Preprocessor.Unlit as Unlit (unlit)
runCpphs :: CpphsOptions -> FilePath -> String -> IO String
runCpphs options filename input = do
let bools = boolopts options
preInc = case preInclude options of
[] -> ""
is -> concatMap (\f->"#include \""++f++"\"\n") is
++ "#line 1 \""++filename++"\"\n"
pass1 <- cppIfdef filename (defines options) (includes options) bools
(preInc++input)
pass2 <- macroPass (defines options) bools pass1
let result= if not (macros bools)
then if stripC89 bools || stripEol bools
then concatMap deWordStyle $
tokenise (stripC89 bools) (stripEol bools)
(ansi bools) (lang bools) pass1
else unlines (map snd pass1)
else pass2
pass3 = if literate bools then Unlit.unlit filename else id
return (pass3 result)
runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String
-> IO (String,[(String,String)])
runCpphsReturningSymTab options filename input = do
let bools = boolopts options
preInc = case preInclude options of
[] -> ""
is -> concatMap (\f->"#include \""++f++"\"\n") is
++ "#line 1 \""++filename++"\"\n"
(pass2,syms) <-
if macros bools then do
pass1 <- cppIfdef filename (defines options) (includes options)
bools (preInc++input)
macroPassReturningSymTab (defines options) bools pass1
else do
pass1 <- cppIfdef filename (defines options) (includes options)
bools{macros=True} (preInc++input)
(_,syms) <- macroPassReturningSymTab (defines options) bools pass1
pass1 <- cppIfdef filename (defines options) (includes options)
bools (preInc++input)
let result = if stripC89 bools || stripEol bools
then concatMap deWordStyle $
tokenise (stripC89 bools) (stripEol bools)
(ansi bools) (lang bools) pass1
else init $ unlines (map snd pass1)
return (result,syms)
let pass3 = if literate bools then Unlit.unlit filename else id
return (pass3 pass2, syms)
cpphs-1.16/Language/Preprocessor/Cpphs/SymTab.hs 0000755 2056640 0024421 00000005157 12075315472 021543 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : SymTab
-- Copyright : 2000-2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : Stable
-- Portability : All
--
-- Symbol Table, based on index trees using a hash on the key.
-- Keys are always Strings. Stored values can be any type.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.SymTab
( SymTab
, emptyST
, insertST
, deleteST
, lookupST
, definedST
, flattenST
, IndTree
) where
-- | Symbol Table. Stored values are polymorphic, but the keys are
-- always strings.
type SymTab v = IndTree [(String,v)]
emptyST :: SymTab v
insertST :: (String,v) -> SymTab v -> SymTab v
deleteST :: String -> SymTab v -> SymTab v
lookupST :: String -> SymTab v -> Maybe v
definedST :: String -> SymTab v -> Bool
flattenST :: SymTab v -> [v]
emptyST = itgen maxHash []
insertST (s,v) ss = itiap (hash s) ((s,v):) ss id
deleteST s ss = itiap (hash s) (filter ((/=s).fst)) ss id
lookupST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
in if null vs then Nothing
else (Just . snd . head) vs
definedST s ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
in (not . null) vs
flattenST ss = itfold (map snd) (++) ss
----
-- | Index Trees (storing indexes at nodes).
data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
deriving Show
itgen :: Int -> a -> IndTree a
itgen 1 x = Leaf x
itgen n x =
let n' = n `div` 2
in Fork n' (itgen n' x) (itgen (n-n') x)
itiap :: --Eval a =>
Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
itiap _ f (Leaf x) k = let fx = f x in {-seq fx-} (k (Leaf fx))
itiap i f (Fork n lt rt) k =
if i k (Fork n lt' rt)
else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
itind :: Int -> IndTree a -> a
itind _ (Leaf x) = x
itind i (Fork n lt rt) = if ib) -> (b->b->b) -> IndTree a -> b
itfold leaf _fork (Leaf x) = leaf x
itfold leaf fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r)
----
-- Hash values
maxHash :: Int -- should be prime
maxHash = 101
class Hashable a where
hashWithMax :: Int -> a -> Int
hash :: a -> Int
hash = hashWithMax maxHash
instance Enum a => Hashable [a] where
hashWithMax m = h 0
where h a [] = a
h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
----
cpphs-1.16/Language/Preprocessor/Cpphs/Tokenise.hs 0000755 2056640 0024421 00000033750 12075315472 022125 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : Tokenise
-- Copyright : 2004 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- The purpose of this module is to lex a source file (language
-- unspecified) into tokens such that cpp can recognise a replaceable
-- symbol or macro-use, and do the right thing.
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs.Tokenise
( linesCpp
, reslash
, tokenise
, WordStyle(..)
, deWordStyle
, parseMacroCall
) where
import Data.Char
import Language.Preprocessor.Cpphs.HashDefine
import Language.Preprocessor.Cpphs.Position
-- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.
-- The main difference is that in Cpp mode we should recognise line
-- continuation characters.
data Mode = Haskell | Cpp
-- | linesCpp is, broadly speaking, Prelude.lines, except that
-- on a line beginning with a \#, line continuation characters are
-- recognised. In a line continuation, the newline character is
-- preserved, but the backslash is not.
linesCpp :: String -> [String]
linesCpp [] = []
linesCpp (x:xs) | x=='#' = tok Cpp ['#'] xs
| otherwise = tok Haskell [] (x:xs)
where
tok Cpp acc ('\\':'\n':ys) = tok Cpp ('\n':acc) ys
tok _ acc ('\n':'#':ys) = reverse acc: tok Cpp ['#'] ys
tok _ acc ('\n':ys) = reverse acc: tok Haskell [] ys
tok _ acc [] = reverse acc: []
tok mode acc (y:ys) = tok mode (y:acc) ys
-- | Put back the line-continuation characters.
reslash :: String -> String
reslash ('\n':xs) = '\\':'\n':reslash xs
reslash (x:xs) = x: reslash xs
reslash [] = []
----
-- | Submodes are required to deal correctly with nesting of lexical
-- structures.
data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)
| String Char | LineComment | NestComment Int
| CComment | CLineComment
-- | Each token is classified as one of Ident, Other, or Cmd:
-- * Ident is a word that could potentially match a macro name.
-- * Cmd is a complete cpp directive (\#define etc).
-- * Other is anything else.
data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)
deriving (Eq,Show)
other :: Posn -> String -> WordStyle
other _ s = Other s
deWordStyle :: WordStyle -> String
deWordStyle (Ident _ i) = i
deWordStyle (Other i) = i
deWordStyle (Cmd _) = "\n"
-- | tokenise is, broadly-speaking, Prelude.words, except that:
-- * the input is already divided into lines
-- * each word-like "token" is categorised as one of {Ident,Other,Cmd}
-- * \#define's are parsed and returned out-of-band using the Cmd variant
-- * All whitespace is preserved intact as tokens.
-- * C-comments are converted to white-space (depending on first param)
-- * Parens and commas are tokens in their own right.
-- * Any cpp line continuations are respected.
-- No errors can be raised.
-- The inverse of tokenise is (concatMap deWordStyle).
tokenise :: Bool -> Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]
tokenise _ _ _ _ [] = []
tokenise stripEol stripComments ansi lang ((pos,str):pos_strs) =
(if lang then haskell else plaintext) Any [] pos pos_strs str
where
-- rules to lex Haskell
haskell :: SubMode -> String -> Posn -> [(Posn,String)]
-> String -> [WordStyle]
haskell Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $
cpp Any haskell [] [] p ls xs
-- warning: non-maximal munch on comment
haskell Any acc p ls ('-':'-':xs) = emit acc $
haskell LineComment "--" p ls xs
haskell Any acc p ls ('{':'-':xs) = emit acc $
haskell (NestComment 0) "-{" p ls xs
haskell Any acc p ls ('/':'*':xs)
| stripComments = emit acc $
haskell CComment " " p ls xs
haskell Any acc p ls ('/':'/':xs)
| stripEol = emit acc $
haskell CLineComment " " p ls xs
haskell Any acc p ls ('"':xs) = emit acc $
haskell (String '"') ['"'] p ls xs
haskell Any acc p ls ('\'':xs) = emit acc $
haskell (String '\'') "'" p ls xs
haskell Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
haskell Any [] p ls xs
haskell Any acc p ls (x:xs) | space x = emit acc $
haskell (Pred space other) [x]
p ls xs
haskell Any acc p ls (x:xs) | symbol x = emit acc $
haskell (Pred symbol other) [x]
p ls xs
-- haskell Any [] p ls (x:xs) | ident0 x = id $
haskell Any acc p ls (x:xs) | ident0 x = emit acc $
haskell (Pred ident1 Ident) [x]
p ls xs
haskell Any acc p ls (x:xs) = haskell Any (x:acc) p ls xs
haskell pre@(Pred pred ws) acc p ls (x:xs)
| pred x = haskell pre (x:acc) p ls xs
haskell (Pred _ ws) acc p ls xs = ws p (reverse acc):
haskell Any [] p ls xs
haskell (String c) acc p ls ('\\':x:xs)
| x=='\\' = haskell (String c) ('\\':'\\':acc) p ls xs
| x==c = haskell (String c) (c:'\\':acc) p ls xs
haskell (String c) acc p ls (x:xs)
| x==c = emit (c:acc) $ haskell Any [] p ls xs
| otherwise = haskell (String c) (x:acc) p ls xs
haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs
haskell LineComment acc p ls (x:xs) = haskell LineComment (x:acc) p ls xs
haskell (NestComment n) acc p ls ('{':'-':xs)
= haskell (NestComment (n+1))
("-{"++acc) p ls xs
haskell (NestComment 0) acc p ls ('-':'}':xs)
= emit ("}-"++acc) $ haskell Any [] p ls xs
haskell (NestComment n) acc p ls ('-':'}':xs)
= haskell (NestComment (n-1))
("}-"++acc) p ls xs
haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)
p ls xs
haskell CComment acc p ls ('*':'/':xs) = emit (" "++acc) $
haskell Any [] p ls xs
haskell CComment acc p ls (x:xs) = haskell CComment (white x:acc) p ls xs
haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs
haskell CLineComment acc p ls (_:xs) = haskell CLineComment (' ':acc)
p ls xs
haskell mode acc _ ((p,l):ls) [] = haskell mode acc p ls ('\n':l)
haskell _ acc _ [] [] = emit acc $ []
-- rules to lex Cpp
cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]
-> String -> [WordStyle])
-> String -> [String] -> Posn -> [(Posn,String)]
-> String -> [WordStyle]
cpp mode next word line pos remaining input =
lexcpp mode word line remaining input
where
lexcpp Any w l ls ('/':'*':xs) = lexcpp (NestComment 0) "" (w*/*l) ls xs
lexcpp Any w l ls ('/':'/':xs) = lexcpp LineComment " " (w*/*l) ls xs
lexcpp Any w l ((p,l'):ls) ('\\':[]) = cpp Any next [] ("\n":w*/*l) p ls l'
lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs
lexcpp Any w l ls xs@('\n':_) = Cmd (parseHashDefine ansi
(reverse (w*/*l))):
next Any [] pos ls xs
-- lexcpp Any w l ls ('"':xs) = lexcpp (String '"') ['"'] (w*/*l) ls xs
-- lexcpp Any w l ls ('\'':xs) = lexcpp (String '\'') "'" (w*/*l) ls xs
lexcpp Any w l ls ('"':xs) = lexcpp Any [] ("\"":(w*/*l)) ls xs
lexcpp Any w l ls ('\'':xs) = lexcpp Any [] ("'": (w*/*l)) ls xs
lexcpp Any [] l ls (x:xs)
| ident0 x = lexcpp (Pred ident1 Ident) [x] l ls xs
-- lexcpp Any w l ls (x:xs) | ident0 x = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs
lexcpp Any w l ls (x:xs)
| single x = lexcpp Any [] ([x]:w*/*l) ls xs
| space x = lexcpp (Pred space other) [x] (w*/*l) ls xs
| symbol x = lexcpp (Pred symbol other) [x] (w*/*l) ls xs
| otherwise = lexcpp Any (x:w) l ls xs
lexcpp pre@(Pred pred _) w l ls (x:xs)
| pred x = lexcpp pre (x:w) l ls xs
lexcpp (Pred _ _) w l ls xs = lexcpp Any [] (w*/*l) ls xs
lexcpp (String c) w l ls ('\\':x:xs)
| x=='\\' = lexcpp (String c) ('\\':'\\':w) l ls xs
| x==c = lexcpp (String c) (c:'\\':w) l ls xs
lexcpp (String c) w l ls (x:xs)
| x==c = lexcpp Any [] ((c:w)*/*l) ls xs
| otherwise = lexcpp (String c) (x:w) l ls xs
lexcpp LineComment w l ((p,l'):ls) ('\\':[])
= cpp LineComment next [] (('\n':w)*/*l) pos ls l'
lexcpp LineComment w l ls ('\\':'\n':xs)
= lexcpp LineComment [] (('\n':w)*/*l) ls xs
lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs
lexcpp LineComment w l ls (_:xs) = lexcpp LineComment (' ':w) l ls xs
lexcpp (NestComment _) w l ls ('*':'/':xs)
= lexcpp Any [] (w*/*l) ls xs
lexcpp (NestComment n) w l ls (x:xs) = lexcpp (NestComment n) (white x:w) l
ls xs
lexcpp mode w l ((p,l'):ls) [] = cpp mode next w l p ls ('\n':l')
lexcpp _ _ _ [] [] = []
-- rules to lex non-Haskell, non-cpp text
plaintext :: SubMode -> String -> Posn -> [(Posn,String)]
-> String -> [WordStyle]
plaintext Any acc p ls ('\n':'#':xs) = emit acc $ -- emit "\n" $
cpp Any plaintext [] [] p ls xs
plaintext Any acc p ls ('/':'*':xs)
| stripComments = emit acc $
plaintext CComment " " p ls xs
plaintext Any acc p ls ('/':'/':xs)
| stripEol = emit acc $
plaintext CLineComment " " p ls xs
plaintext Any acc p ls (x:xs) | single x = emit acc $ emit [x] $
plaintext Any [] p ls xs
plaintext Any acc p ls (x:xs) | space x = emit acc $
plaintext (Pred space other) [x]
p ls xs
plaintext Any acc p ls (x:xs) | ident0 x = emit acc $
plaintext (Pred ident1 Ident) [x]
p ls xs
plaintext Any acc p ls (x:xs) = plaintext Any (x:acc) p ls xs
plaintext pre@(Pred pred ws) acc p ls (x:xs)
| pred x = plaintext pre (x:acc) p ls xs
plaintext (Pred _ ws) acc p ls xs = ws p (reverse acc):
plaintext Any [] p ls xs
plaintext CComment acc p ls ('*':'/':xs) = emit (" "++acc) $
plaintext Any [] p ls xs
plaintext CComment acc p ls (x:xs) = plaintext CComment (white x:acc) p ls xs
plaintext CLineComment acc p ls xs@('\n':_)
= emit acc $ plaintext Any [] p ls xs
plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)
p ls xs
plaintext mode acc _ ((p,l):ls) [] = plaintext mode acc p ls ('\n':l)
plaintext _ acc _ [] [] = emit acc $ []
-- predicates for lexing Haskell.
ident0 x = isAlpha x || x `elem` "_`"
ident1 x = isAlphaNum x || x `elem` "'_`"
symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"
single x = x `elem` "(),[];{}"
space x = x `elem` " \t"
-- conversion of comment text to whitespace
white '\n' = '\n'
white '\r' = '\r'
white _ = ' '
-- emit a token (if there is one) from the accumulator
emit "" = id
emit xs = (Other (reverse xs):)
-- add a reversed word to the accumulator
"" */* l = l
w */* l = reverse w : l
-- help out broken Haskell compilers which need balanced numbers of C
-- comments in order to do import chasing :-) -----> */*
-- | Parse a possible macro call, returning argument list and remaining input
parseMacroCall :: Posn -> [WordStyle] -> Maybe ([[WordStyle]],[WordStyle])
parseMacroCall p = call . skip
where
skip (Other x:xs) | all isSpace x = skip xs
skip xss = xss
call (Other "(":xs) = (args (0::Int) [] [] . skip) xs
call _ = Nothing
args 0 w acc ( Other ")" :xs) = Just (reverse (addone w acc), xs)
args 0 w acc ( Other "," :xs) = args 0 [] (addone w acc) (skip xs)
args n w acc (x@(Other "("):xs) = args (n+1) (x:w) acc xs
args n w acc (x@(Other ")"):xs) = args (n-1) (x:w) acc xs
args n w acc ( Ident _ v :xs) = args n (Ident p v:w) acc xs
args n w acc (x@(Other _) :xs) = args n (x:w) acc xs
args _ _ _ _ = Nothing
addone w acc = reverse (skip w): acc
cpphs-1.16/Language/Preprocessor/Cpphs.hs 0000755 2056640 0024421 00000002300 12075315472 020327 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : Language.Preprocessor.Cpphs
-- Copyright : 2000-2006 Malcolm Wallace
-- Licence : LGPL
--
-- Maintainer : Malcolm Wallace
-- Stability : experimental
-- Portability : All
--
-- Include the interface that is exported
-----------------------------------------------------------------------------
module Language.Preprocessor.Cpphs
( runCpphs, runCpphsReturningSymTab
, cppIfdef
, macroPass, macroPassReturningSymTab
, CpphsOptions(..), BoolOptions(..)
, parseOptions, defaultCpphsOptions, defaultBoolOptions
, module Language.Preprocessor.Cpphs.Position
) where
import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)
import Language.Preprocessor.Cpphs.MacroPass(macroPass
,macroPassReturningSymTab)
import Language.Preprocessor.Cpphs.RunCpphs(runCpphs
,runCpphsReturningSymTab)
import Language.Preprocessor.Cpphs.Options
(CpphsOptions(..), BoolOptions(..), parseOptions
,defaultCpphsOptions,defaultBoolOptions)
import Language.Preprocessor.Cpphs.Position
cpphs-1.16/Language/Preprocessor/Unlit.hs 0000755 2056640 0024421 00000006636 12075315472 020365 0 ustar 1341796 Domain Users -- | Part of this code is from "Report on the Programming Language Haskell",
-- version 1.2, appendix C.
module Language.Preprocessor.Unlit (unlit) where
import Data.Char
import Data.List (isPrefixOf)
data Classified = Program String | Blank | Comment
| Include Int String | Pre String
classify :: [String] -> [Classified]
classify [] = []
classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
where allProg [] = [] -- Should give an error message,
-- but I have no good position information.
allProg (('\\':x):xs) | "end{code}"`isPrefixOf`x = Blank : classify xs
allProg (x:xs) = Program x:allProg xs
classify (('>':x):xs) = Program (' ':x) : classify xs
classify (('#':x):xs) = (case words x of
(line:rest) | all isDigit line
-> Include (read line) (unwords rest)
_ -> Pre x
) : classify xs
classify (x:xs) | all isSpace x = Blank:classify xs
classify (x:xs) = Comment:classify xs
unclassify :: Classified -> String
unclassify (Program s) = s
unclassify (Pre s) = '#':s
unclassify (Include i f) = '#':' ':show i ++ ' ':f
unclassify Blank = ""
unclassify Comment = ""
-- | 'unlit' takes a filename (for error reports), and transforms the
-- given string, to eliminate the literate comments from the program text.
unlit :: FilePath -> String -> String
unlit file lhs = (unlines
. map unclassify
. adjacent file (0::Int) Blank
. classify) (inlines lhs)
adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number
adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment")
adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program")
adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs
adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs
adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs
adjacent file n _ [] = []
message :: String -> Int -> String -> String -> String
message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
-- Re-implementation of 'lines', for better efficiency (but decreased laziness).
-- Also, importantly, accepts non-standard DOS and Mac line ending characters.
inlines :: String -> [String]
inlines s = lines' s id
where
lines' [] acc = [acc []]
lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS
lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS
lines' ('\n':s) acc = acc [] : lines' s id -- Unix
lines' (c:s) acc = lines' s (acc . (c:))
cpphs-1.16/LICENCE-commercial 0000755 2056640 0024421 00000002503 12075315472 015610 0 ustar 1341796 Domain Users Commercial licence for cpphs.
Copyright 2004-2010, Malcolm Wallace (malcolm.wallace@me.com)
All rights reserved.
* This software, built from original unmodified sources, may be used for
any purpose whatsoever, without restriction.
* Redistribution in binary form, without modification, is permitted
provided that the above copyright notice, these conditions and the
following disclaimer are reproduced in the documentation and/or other
materials provided with the distribution.
* Redistribution in source form, with or without modification, is not
permitted under this license.
THIS SOFTWARE IS PROVIDED BY Malcolm Wallace
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
Malcolm Wallace 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.
cpphs-1.16/LICENCE-GPL 0000755 2056640 0024421 00000043111 12075315472 014117 0 ustar 1341796 Domain Users GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.
cpphs-1.16/LICENCE-LGPL 0000755 2056640 0024421 00000063633 12075315472 014246 0 ustar 1341796 Domain Users GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the Lesser GPL. It also counts
as the successor of the GNU Library Public License, version 2, hence
the version number 2.1.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Lesser General Public License, applies to some
specially designated software packages--typically libraries--of the
Free Software Foundation and other authors who decide to use it. You
can use it too, but we suggest you first think carefully about whether
this license or the ordinary General Public License is the better
strategy to use in any particular case, based on the explanations
below.
When we speak of free software, we are referring to freedom of use,
not price. Our General Public Licenses are designed to make sure that
you have the freedom to distribute copies of free software (and charge
for this service if you wish); that you receive source code or can get
it if you want it; that you can change the software and use pieces of
it in new free programs; and that you are informed that you can do
these things.
To protect your rights, we need to make restrictions that forbid
distributors to deny you these rights or to ask you to surrender these
rights. These restrictions translate to certain responsibilities for
you if you distribute copies of the library or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link other code with the library, you must provide
complete object files to the recipients, so that they can relink them
with the library after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
We protect your rights with a two-step method: (1) we copyright the
library, and (2) we offer you this license, which gives you legal
permission to copy, distribute and/or modify the library.
To protect each distributor, we want to make it very clear that
there is no warranty for the free library. Also, if the library is
modified by someone else and passed on, the recipients should know
that what they have is not the original version, so that the original
author's reputation will not be affected by problems that might be
introduced by others.
Finally, software patents pose a constant threat to the existence of
any free program. We wish to make sure that a company cannot
effectively restrict the users of a free program by obtaining a
restrictive license from a patent holder. Therefore, we insist that
any patent license obtained for a version of the library must be
consistent with the full freedom of use specified in this license.
Most GNU software, including some libraries, is covered by the
ordinary GNU General Public License. This license, the GNU Lesser
General Public License, applies to certain designated libraries, and
is quite different from the ordinary General Public License. We use
this license for certain libraries in order to permit linking those
libraries into non-free programs.
When a program is linked with a library, whether statically or using
a shared library, the combination of the two is legally speaking a
combined work, a derivative of the original library. The ordinary
General Public License therefore permits such linking only if the
entire combination fits its criteria of freedom. The Lesser General
Public License permits more lax criteria for linking other code with
the library.
We call this license the "Lesser" General Public License because it
does Less to protect the user's freedom than the ordinary General
Public License. It also provides other free software developers Less
of an advantage over competing non-free programs. These disadvantages
are the reason we use the ordinary General Public License for many
libraries. However, the Lesser license provides advantages in certain
special circumstances.
For example, on rare occasions, there may be a special need to
encourage the widest possible use of a certain library, so that it
becomes a de-facto standard. To achieve this, non-free programs must
be allowed to use the library. A more frequent case is that a free
library does the same job as widely used non-free libraries. In this
case, there is little to gain by limiting the free library to free
software only, so we use the Lesser General Public License.
In other cases, permission to use a particular library in non-free
programs enables a greater number of people to use a large body of
free software. For example, permission to use the GNU C Library in
non-free programs enables many more people to use the whole GNU
operating system, as well as its variant, the GNU/Linux operating
system.
Although the Lesser General Public License is Less protective of the
users' freedom, it does ensure that the user of a program that is
linked with the Library has the freedom and the wherewithal to run
that program using a modified version of the Library.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, whereas the latter must
be combined with the library in order to run.
GNU LESSER GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library or other
program which contains a notice placed by the copyright holder or
other authorized party saying it may be distributed under the terms of
this Lesser General Public License (also called "this License").
Each licensee is addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control
compilation and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (1) uses at run time a
copy of the library already present on the user's computer system,
rather than copying library functions into the executable, and (2)
will operate properly with a modified version of the library, if
the user installs one, as long as the modified version is
interface-compatible with the version that the work was made with.
c) Accompany the work with a written offer, valid for at least
three years, to give the same user the materials specified in
Subsection 6a, above, for a charge no more than the cost of
performing this distribution.
d) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
e) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the materials to be distributed need not include anything that is
normally distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties with
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply, and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License
may add an explicit geographical distribution limitation excluding those
countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Lesser General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!
cpphs-1.16/Makefile 0000755 2056640 0024421 00000003276 12077543530 014162 0 ustar 1341796 Domain Users LIBRARY = cpphs
VERSION = 1.16
DIRS = Language/Preprocessor/Cpphs \
Text/ParserCombinators
SRCS = Language/Preprocessor/Cpphs.hs \
Language/Preprocessor/Cpphs/CppIfdef.hs \
Language/Preprocessor/Cpphs/HashDefine.hs \
Language/Preprocessor/Cpphs/MacroPass.hs \
Language/Preprocessor/Cpphs/Options.hs \
Language/Preprocessor/Cpphs/Position.hs \
Language/Preprocessor/Cpphs/ReadFirst.hs \
Language/Preprocessor/Cpphs/RunCpphs.hs \
Language/Preprocessor/Cpphs/SymTab.hs \
Language/Preprocessor/Cpphs/Tokenise.hs \
Language/Preprocessor/Unlit.hs \
Text/ParserCombinators/HuttonMeijer.hs \
cpphs.hs
AUX = README LICENCE* CHANGELOG $(LIBRARY).cabal Setup.hs Makefile \
cpphs.hugs cpphs.compat \
tests/[A-BD-Z]* tests/[a-np-z]* \
docs/[a-z]*
HC = ghc
HFLAGS =
HEAP =
HOSTSTRIP = strip
all: $(LIBRARY)
package:
tar cf tmp.tar $(SRCS) $(AUX)
mkdir $(LIBRARY)-$(VERSION)
cd $(LIBRARY)-$(VERSION); tar xf ../tmp.tar
tar zcf $(LIBRARY)-$(VERSION).tar.gz $(LIBRARY)-$(VERSION)
zip -r $(LIBRARY)-$(VERSION).zip $(LIBRARY)-$(VERSION)
rm -r tmp.tar $(LIBRARY)-$(VERSION)
haddock: $(SRCS)
mkdir -p docs/$(LIBRARY)
for dir in $(DIRS); do mkdir -p docs/$(LIBRARY)/$$dir; done
for file in $(SRCS); \
do HsColour -anchor -html $$file \
>docs/$(LIBRARY)/`dirname $$file`/`basename $$file .hs`.html;\
done
haddock --html --title=$(LIBRARY) \
--odir=docs/$(LIBRARY) --package=$(LIBRARY) \
--source-module="%{MODULE/.//}.html" \
--source-entity="%{MODULE/.//}.html#%{NAME}" \
$(SRCS)
$(LIBRARY): $(SRCS)
$(HC) $(HFLAGS) $(HEAP) -o $@ $(SRCS)
$(HOSTSTRIP) $@
cpphs-1.16/README 0000755 2056640 0024421 00000003063 12077543631 013376 0 ustar 1341796 Domain Users This directory contains 'cpphs', a simplified but robust
re-implementation of cpp, the C pre-processor, in Haskell.
TO BUILD
--------
Just use
hmake cpphs [-package base]
or
ghc --make cpphs [-o cpphs] # -o needed for ghc <= 6.4.1 ]
or
runhugs cpphs # or rename the script cpphs.hugs to cpphs
USAGE
-----
cpphs [filename | -Dsym | -Dsym=val | -Ipath]+ [-Ofile]
[ --include=file ]*
[ --nomacro | --noline | --nowarn | --strip | --strip-eol |
--pragma | --text | --hashes | --layout | --unlit |
--linepragma ]*
[ --cpp compatopts ]
For fuller details, see docs/index.html
If you want to use cpphs as a completely drop-in replacement for the
real cpp, that is, to accept the same arguments, and have broadly
the same behaviour in response to them, then use the --cpp compatibility
option.
COPYRIGHT
---------
Copyright (c) 2004-2013 Malcolm Wallace (Malcolm.Wallace@me.com)
except for Text.ParserCombinators.HuttonMeijer (Copyright (c) 1995
Graham Hutton and Erik Meijer).
LICENCE
-------
These library modules are distributed under the terms of the LGPL.
The application module 'cpphs.hs' is GPL.
This software comes with no warranty. Use at your own risk.
If you have a commercial use for cpphs, and feel the terms of the (L)GPL
are too onerous, you have the option of distributing unmodified binaries
(only, not sources) under the terms of a different licence (see
LICENCE-commercial).
WEBSITE
-------
http://haskell.org/cpphs/
darcs get http://code.haskell.org/~malcolm/cpphs
cpphs-1.16/Setup.hs 0000755 2056640 0024421 00000000056 12075315473 014150 0 ustar 1341796 Domain Users import Distribution.Simple
main = defaultMain
cpphs-1.16/tests/ 0000755 2056640 0024421 00000000000 12077544330 013650 5 ustar 1341796 Domain Users cpphs-1.16/tests/Arr.lhs 0000755 2056640 0024421 00000060073 12075315473 015117 0 ustar 1341796 Domain Users \begin{code}
{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Arr
-- Copyright : (c) The University of Glasgow, 1994-2000
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC extensions)
--
-- GHC\'s array implementation.
--
-----------------------------------------------------------------------------
-- #hide
module GHC.Arr where
import {-# SOURCE #-} GHC.Err ( error )
import GHC.Enum
import GHC.Num
import GHC.ST
import GHC.Base
import GHC.List
import GHC.Show
infixl 9 !, //
default ()
\end{code}
%*********************************************************
%* *
\subsection{The @Ix@ class}
%* *
%*********************************************************
\begin{code}
-- | The 'Ix' class is used to map a contiguous subrange of values in
-- a type onto integers. It is used primarily for array indexing
-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").
--
-- The first argument @(l,u)@ of each of these operations is a pair
-- specifying the lower and upper bounds of a contiguous subrange of values.
--
-- An implementation is entitled to assume the following laws about these
-- operations:
--
-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@
--
-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
--
-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@
--
-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@
--
-- Minimal complete instance: 'range', 'index' and 'inRange'.
--
class (Ord a) => Ix a where
-- | The list of values in the subrange defined by a bounding pair.
range :: (a,a) -> [a]
-- | The position of a subscript in the subrange.
index :: (a,a) -> a -> Int
-- | Like 'index', but without checking that the value is in range.
unsafeIndex :: (a,a) -> a -> Int
-- | Returns 'True' the given subscript lies in the range defined
-- the bounding pair.
inRange :: (a,a) -> a -> Bool
-- | The size of the subrange defined by a bounding pair.
rangeSize :: (a,a) -> Int
-- | like 'rangeSize', but without checking that the upper bound is
-- in range.
unsafeRangeSize :: (a,a) -> Int
-- Must specify one of index, unsafeIndex
index b i | inRange b i = unsafeIndex b i
| otherwise = error "Error in array index"
unsafeIndex b i = index b i
rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
| otherwise = 0 -- This case is only here to
-- check for an empty range
-- NB: replacing (inRange b h) by (l <= h) fails for
-- tuples. E.g. (1,2) <= (2,1) but the range is empty
unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
\end{code}
Note that the following is NOT right
rangeSize (l,h) | l <= h = index b h + 1
| otherwise = 0
Because it might be the case that l (a,a) -> a -> String -> b
indexError rng i tp
= error (showString "Ix{" . showString tp . showString "}.index: Index " .
showParen True (showsPrec 0 i) .
showString " out of range " $
showParen True (showsPrec 0 rng) "")
----------------------------------------------------------------------
instance Ix Char where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = fromEnum i - fromEnum m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Char"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Int where
{-# INLINE range #-}
-- The INLINE stops the build in the RHS from getting inlined,
-- so that callers can fuse with the result of range
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = i - m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
{-# INLINE inRange #-}
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
----------------------------------------------------------------------
instance Ix Integer where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = fromInteger (i - m)
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Integer"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Bool where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Bool"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix Ordering where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Ordering"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix () where
{-# INLINE range #-}
range ((), ()) = [()]
{-# INLINE unsafeIndex #-}
unsafeIndex ((), ()) () = 0
{-# INLINE inRange #-}
inRange ((), ()) () = True
{-# INLINE index #-}
index b i = unsafeIndex b i
----------------------------------------------------------------------
instance (Ix a, Ix b) => Ix (a, b) where -- as derived
{-# SPECIALISE instance Ix (Int,Int) #-}
{- INLINE range #-}
range ((l1,l2),(u1,u2)) =
[ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
{- INLINE unsafeIndex #-}
unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
{- INLINE inRange #-}
inRange ((l1,l2),(u1,u2)) (i1,i2) =
inRange (l1,u1) i1 && inRange (l2,u2) i2
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
{-# SPECIALISE instance Ix (Int,Int,Int) #-}
range ((l1,l2,l3),(u1,u2,u3)) =
[(i1,i2,i3) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3)]
unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))
inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
[(i1,i2,i3,i4) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4)]
unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1)))
inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4
-- Default method for index
instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
[(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4),
i5 <- range (l5,u5)]
unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))))
inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
inRange (l5,u5) i5
-- Default method for index
\end{code}
%*********************************************************
%* *
\subsection{The @Array@ types}
%* *
%*********************************************************
\begin{code}
type IPr = (Int, Int)
-- | The type of immutable non-strict (boxed) arrays
-- with indices in @i@ and elements in @e@.
data Ix i => Array i e = Array !i !i (Array# e)
-- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type
-- arguments are as follows:
--
-- * @s@: the state variable argument for the 'ST' type
--
-- * @i@: the index type of the array (should be an instance of 'Ix')
--
-- * @e@: the element type of the array.
--
data STArray s i e = STArray !i !i (MutableArray# s e)
-- No Ix context for STArray. They are stupid,
-- and force an Ix context on the equality instance.
-- Just pointer equality on mutable arrays:
instance Eq (STArray s i e) where
STArray _ _ arr1# == STArray _ _ arr2# =
sameMutableArray# arr1# arr2#
\end{code}
%*********************************************************
%* *
\subsection{Operations on immutable arrays}
%* *
%*********************************************************
\begin{code}
{-# NOINLINE arrEleBottom #-}
arrEleBottom :: a
arrEleBottom = error "(Array.!): undefined array element"
-- | Construct an array with the specified bounds and containing values
-- for given indices within these bounds.
--
-- The array is undefined (i.e. bottom) if any index in the list is
-- out of bounds. The Haskell 98 Report further specifies that if any
-- two associations in the list have the same index, the value at that
-- index is undefined (i.e. bottom). However in GHC's implementation,
-- the value at such an index is the value part of the last association
-- with that index in the list.
--
-- Because the indices must be checked for these errors, 'array' is
-- strict in the bounds argument and in the indices of the association
-- list, but nonstrict in the values. Thus, recurrences such as the
-- following are possible:
--
-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
--
-- Not every index within the bounds of the array need appear in the
-- association list, but the values associated with indices that do not
-- appear will be undefined (i.e. bottom).
--
-- If, in any dimension, the lower bound is greater than the upper bound,
-- then the array is legal, but empty. Indexing an empty array always
-- gives an array-bounds error, but 'bounds' still yields the bounds
-- with which the array was constructed.
{-# INLINE array #-}
array :: Ix i
=> (i,i) -- ^ a pair of /bounds/, each of the index type
-- of the array. These bounds are the lowest and
-- highest indices in the array, in that order.
-- For example, a one-origin vector of length
-- '10' has bounds '(1,10)', and a one-origin '10'
-- by '10' matrix has bounds '((1,1),(10,10))'.
-> [(i, e)] -- ^ a list of /associations/ of the form
-- (/index/, /value/). Typically, this list will
-- be expressed as a comprehension. An
-- association '(i, x)' defines the value of
-- the array at index 'i' to be 'x'.
-> Array i e
array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeArray #-}
unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
unsafeArray (l,u) ies = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
foldr (fill marr#) (done l u marr#) ies s2# }})
{-# INLINE fill #-}
fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
fill marr# (I# i#, e) next s1# =
case writeArray# marr# i# e s1# of { s2# ->
next s2# }
{-# INLINE done #-}
done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)
done l u marr# s1# =
case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, Array l u arr# #) }
-- This is inefficient and I'm not sure why:
-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
-- The code below is better. It still doesn't enable foldr/build
-- transformation on the list of elements; I guess it's impossible
-- using mechanisms currently available.
-- | Construct an array from a pair of bounds and a list of values in
-- index order.
{-# INLINE listArray #-}
listArray :: Ix i => (i,i) -> [e] -> Array i e
listArray (l,u) es = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let fillFromList i# xs s3# | i# ==# n# = s3#
| otherwise = case xs of
[] -> s3#
y:ys -> case writeArray# marr# i# y s3# of { s4# ->
fillFromList (i# +# 1#) ys s4# } in
case fillFromList 0# es s2# of { s3# ->
done l u marr# s3# }}})
-- | The value at the given index in an array.
{-# INLINE (!) #-}
(!) :: Ix i => Array i e -> i -> e
arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)
{-# INLINE unsafeAt #-}
unsafeAt :: Ix i => Array i e -> Int -> e
unsafeAt (Array _ _ arr#) (I# i#) =
case indexArray# arr# i# of (# e #) -> e
-- | The bounds with which an array was constructed.
{-# INLINE bounds #-}
bounds :: Ix i => Array i e -> (i,i)
bounds (Array l u _) = (l,u)
-- | The list of indices of an array in ascending order.
{-# INLINE indices #-}
indices :: Ix i => Array i e -> [i]
indices (Array l u _) = range (l,u)
-- | The list of elements of an array in index order.
{-# INLINE elems #-}
elems :: Ix i => Array i e -> [e]
elems arr@(Array l u _) =
[unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
-- | The list of associations of an array in index order.
{-# INLINE assocs #-}
assocs :: Ix i => Array i e -> [(i, e)]
assocs arr@(Array l u _) =
[(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
-- | The 'accumArray' deals with repeated indices in the association
-- list using an /accumulating function/ which combines the values of
-- associations with the same index.
-- For example, given a list of values of some index type, @hist@
-- produces a histogram of the number of occurrences of each index within
-- a specified range:
--
-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]
--
-- If the accumulating function is strict, then 'accumArray' is strict in
-- the values, as well as the indices, in the association list. Thus,
-- unlike ordinary arrays built with 'array', accumulated arrays should
-- not in general be recursive.
{-# INLINE accumArray #-}
accumArray :: Ix i
=> (e -> a -> e) -- ^ accumulating function
-> e -- ^ initial value
-> (i,i) -- ^ bounds of the array
-> [(i, a)] -- ^ association list
-> Array i e
accumArray f init (l,u) ies =
unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# init s1# of { (# s2#, marr# #) ->
foldr (adjust f marr#) (done l u marr#) ies s2# }})
{-# INLINE adjust #-}
adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
adjust f marr# (I# i#, new) next s1# =
case readArray# marr# i# s1# of { (# s2#, old #) ->
case writeArray# marr# i# (f old new) s2# of { s3# ->
next s3# }}
-- | Constructs an array identical to the first argument except that it has
-- been updated by the associations in the right argument.
-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
--
-- > m//[((i,i), 0) | i <- [1..n]]
--
-- is the same matrix, except with the diagonal zeroed.
--
-- Repeated indices in the association list are handled as for 'array':
-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),
-- but GHC's implementation uses the last association for each index.
{-# INLINE (//) #-}
(//) :: Ix i => Array i e -> [(i, e)] -> Array i e
arr@(Array l u _) // ies =
unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeReplace #-}
unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
unsafeReplace arr@(Array l u _) ies = runST (do
STArray _ _ marr# <- thawSTArray arr
ST (foldr (fill marr#) (done l u marr#) ies))
-- | @'accum' f@ takes an array and an association list and accumulates
-- pairs from the list into the array with the accumulating function @f@.
-- Thus 'accumArray' can be defined using 'accum':
--
-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])
--
{-# INLINE accum #-}
accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
accum f arr@(Array l u _) ies =
unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeAccum #-}
unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
unsafeAccum f arr@(Array l u _) ies = runST (do
STArray _ _ marr# <- thawSTArray arr
ST (foldr (adjust f marr#) (done l u marr#) ies))
{-# INLINE amap #-}
amap :: Ix i => (a -> b) -> Array i a -> Array i b
amap f arr@(Array l u _) =
unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
-- | 'ixmap' allows for transformations on array indices.
-- It may be thought of as providing function composition on the right
-- with the mapping that the original array embodies.
--
-- A similar transformation of array values may be achieved using 'fmap'
-- from the 'Array' instance of the 'Functor' class.
{-# INLINE ixmap #-}
ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
ixmap (l,u) f arr =
unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
{-# INLINE eqArray #-}
eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
l1 == l2 && u1 == u2 &&
and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
{-# INLINE cmpArray #-}
cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
{-# INLINE cmpIntArray #-}
cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
if rangeSize (l2,u2) == 0 then GT else
case compare l1 l2 of
EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
other -> other
where
cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
EQ -> rest
other -> other
{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
\end{code}
%*********************************************************
%* *
\subsection{Array instances}
%* *
%*********************************************************
\begin{code}
instance Ix i => Functor (Array i) where
fmap = amap
instance (Ix i, Eq e) => Eq (Array i e) where
(==) = eqArray
instance (Ix i, Ord e) => Ord (Array i e) where
compare = cmpArray
instance (Ix a, Show a, Show b) => Show (Array a b) where
showsPrec p a =
showParen (p > appPrec) $
showString "array " .
showsPrec appPrec1 (bounds a) .
showChar ' ' .
showsPrec appPrec1 (assocs a)
-- Precedence of 'array' is the precedence of application
-- The Read instance is in GHC.Read
\end{code}
%*********************************************************
%* *
\subsection{Operations on mutable arrays}
%* *
%*********************************************************
Idle ADR question: What's the tradeoff here between flattening these
datatypes into @STArray ix ix (MutableArray# s elt)@ and using
it as is? As I see it, the former uses slightly less heap and
provides faster access to the individual parts of the bounds while the
code used has the benefit of providing a ready-made @(lo, hi)@ pair as
required by many array-related functions. Which wins? Is the
difference significant (probably not).
Idle AJG answer: When I looked at the outputted code (though it was 2
years ago) it seems like you often needed the tuple, and we build
it frequently. Now we've got the overloading specialiser things
might be different, though.
\begin{code}
{-# INLINE newSTArray #-}
newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
newSTArray (l,u) init = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# init s1# of { (# s2#, marr# #) ->
(# s2#, STArray l u marr# #) }}
{-# INLINE boundsSTArray #-}
boundsSTArray :: STArray s i e -> (i,i)
boundsSTArray (STArray l u _) = (l,u)
{-# INLINE readSTArray #-}
readSTArray :: Ix i => STArray s i e -> i -> ST s e
readSTArray marr@(STArray l u _) i =
unsafeReadSTArray marr (index (l,u) i)
{-# INLINE unsafeReadSTArray #-}
unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->
readArray# marr# i# s1#
{-# INLINE writeSTArray #-}
writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
writeSTArray marr@(STArray l u _) i e =
unsafeWriteSTArray marr (index (l,u) i) e
{-# INLINE unsafeWriteSTArray #-}
unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->
case writeArray# marr# i# e s1# of { s2# ->
(# s2#, () #) }
\end{code}
%*********************************************************
%* *
\subsection{Moving between mutable and immutable}
%* *
%*********************************************************
\begin{code}
freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
freezeSTArray (STArray l u marr#) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
let copy i# s3# | i# ==# n# = s3#
| otherwise =
case readArray# marr# i# s3# of { (# s4#, e #) ->
case writeArray# marr'# i# e s4# of { s5# ->
copy (i# +# 1#) s5# }} in
case copy 0# s2# of { s3# ->
case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
(# s4#, Array l u arr# #) }}}}
{-# INLINE unsafeFreezeSTArray #-}
unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->
case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, Array l u arr# #) }
thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
thawSTArray (Array l u arr#) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let copy i# s3# | i# ==# n# = s3#
| otherwise =
case indexArray# arr# i# of { (# e #) ->
case writeArray# marr# i# e s3# of { s4# ->
copy (i# +# 1#) s4# }} in
case copy 0# s2# of { s3# ->
(# s3#, STArray l u marr# #) }}}
{-# INLINE unsafeThawSTArray #-}
unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->
case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
(# s2#, STArray l u marr# #) }
\end{code}
cpphs-1.16/tests/chains 0000755 2056640 0024421 00000000754 12075315473 015053 0 ustar 1341796 Domain Users For this test, assume that all of e,f,g,h are defined.
Also that c,d are defined, a,b are not.
If cpphs does operator precedence wrongly in infix chains, the final
conditional will be interpreted wrongly.
#if defined(a) || defined(b) || defined(c) || defined(d)
chained || OK
#endif
#if defined(e) && defined(f) && defined(g) && defined(h)
chained && OK
#endif
#if defined(a) && defined(b) || defined(c) && defined(d)
mixed chain of || and && OK
#else
mixed chain of || and && BROKEN
#endif
cpphs-1.16/tests/comments 0000755 2056640 0024421 00000000213 12075315473 015421 0 ustar 1341796 Domain Users here is an ordinary C comment: /* comment here */
and here is a C++-style end-of-line comment: // comment here
this line has no comments
cpphs-1.16/tests/config.h 0000755 2056640 0024421 00000000000 12075315473 015261 0 ustar 1341796 Domain Users cpphs-1.16/tests/cpp 0000755 2056640 0024421 00000000357 12075315473 014367 0 ustar 1341796 Domain Users #define /**/ ++ `mplus` // not expected to work
#define 0 mzero // not expected to work
#define x0 X' // should work
#define x' Xprime // should work
#define `foo` .(foo)/**/, // bizarreness
x ++ y = x0 * 0 * y `foo` x'
// /*
cpphs-1.16/tests/elif 0000755 2056640 0024421 00000000541 12075315473 014517 0 ustar 1341796 Domain Users #if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \
( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)
import System.IO.Unsafe (unsafePerformIO)
#elif defined(__GLASGOW_HASKELL__)
import IOExts (unsafePerformIO)
#elif defined(__NHC__)
import IOExtras (unsafePerformIO)
#elif defined(__HBC__)
import UnsafePerformIO
#endif
cpphs-1.16/tests/endcode-a 0000755 2056640 0024421 00000000042 12075315473 015413 0 ustar 1341796 Domain Users \hidden{
\begin{code}
\end{code}}
cpphs-1.16/tests/endcode-b 0000755 2056640 0024421 00000000043 12075315473 015415 0 ustar 1341796 Domain Users \hidden{
\begin{code}
\end{code}
}
cpphs-1.16/tests/expect1 0000755 2056640 0024421 00000000251 12075315473 015147 0 ustar 1341796 Domain Users #line 1 "testfile"
1 top of file
3
5 X is defined
7
11
15
19
23 no inclusion, this is an else clause
25
31 third branch of elif
33
34 end of file
cpphs-1.16/tests/expect10 0000755 2056640 0024421 00000000274 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "multiline"
5 back to ordinary text.
#line 1 "./inclusion"
hello world, this is an inclusion
#line 7 "multiline"
7 hello again
8 some more
9 aLongMacroDefinition(a,b)
10 end
cpphs-1.16/tests/expect11 0000755 2056640 0024421 00000000063 12075315473 015231 0 ustar 1341796 Domain Users #line 1 "stringise"
This is "abcd ef" foo abcd ef
cpphs-1.16/tests/expect12 0000755 2056640 0024421 00000000047 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "recursive"
D D D D D D D D
cpphs-1.16/tests/expect13 0000755 2056640 0024421 00000000405 12075315473 015233 0 ustar 1341796 Domain Users #line 1 "ross"
f = 4
g = do { putStr "Hello "; putStrLn "World" }
h = 4
cpphs-1.16/tests/expect14 0000755 2056640 0024421 00000000030 12075315473 015226 0 ustar 1341796 Domain Users #line 1 "precedence"
cpphs-1.16/tests/expect15 0000755 2056640 0024421 00000000140 12075315473 015231 0 ustar 1341796 Domain Users #line 1 "indirect"
#line 1 "./inclusion"
hello world, this is an inclusion
#line 3 "indirect"
cpphs-1.16/tests/expect15a 0000755 2056640 0024421 00000000144 12075315473 015376 0 ustar 1341796 Domain Users #line 1 "indirect-a"
#line 1 "./inclusion"
hello world, this is an inclusion
#line 3 "indirect-a"
cpphs-1.16/tests/expect16 0000755 2056640 0024421 00000000240 12075315473 015233 0 ustar 1341796 Domain Users #line 1 "numbers"
number (1) in if
number (0) in if
rejected false hex number in if
real hex number (0x1) in if
hex number (0x00) in if
cpphs-1.16/tests/expect17 0000755 2056640 0024421 00000000022 12075315473 015232 0 ustar 1341796 Domain Users #line 1 "pragma"
cpphs-1.16/tests/expect18 0000755 2056640 0024421 00000000001 12075315473 015230 0 ustar 1341796 Domain Users
cpphs-1.16/tests/expect19 0000755 2056640 0024421 00000000031 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "parens"
yes
cpphs-1.16/tests/expect2 0000755 2056640 0024421 00000000234 12075315473 015151 0 ustar 1341796 Domain Users #line 1 "testfile"
1 top of file
3
5 X is defined
7
11
15
19
23 no inclusion, this is an else clause
25
27 no elif
33
34 end of file
cpphs-1.16/tests/expect20 0000755 2056640 0024421 00000000437 12075315473 015236 0 ustar 1341796 Domain Users #line 1 "chains"
For this test, assume that all of 1,1,1,1 are defined.
Also that 1,1 are defined, a,b are not.
If cpphs does operator precedence wrongly in infix chains, the final
conditional will be interpreted wrongly.
chained || OK
chained && OK
mixed chain of || and && OK
cpphs-1.16/tests/expect21 0000755 2056640 0024421 00000000137 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "specials"
line 2
line 3
line 4 Error "horrible" at line 4 of file "specials"
line 5
cpphs-1.16/tests/expect22 0000755 2056640 0024421 00000000236 12075315473 015235 0 ustar 1341796 Domain Users #line 1 "specialinclude"
1
2
#line 1 "./specials"
line 2
line 3
line 4 Error "horrible" at line 4 of file "./specials"
line 5
#line 4 "specialinclude"
4
5
cpphs-1.16/tests/expect23 0000755 2056640 0024421 00000000037 12075315473 015235 0 ustar 1341796 Domain Users #line 1 "incomplete"
incomplete cpphs-1.16/tests/expect24 0000755 2056640 0024421 00000001131 12075315473 015232 0 ustar 1341796 Domain Users #line 1 "text"
Here is some ordinary text with embedded Haskell-ish constructs,
that should however /not/ be interpreted as Haskell if the --text
option is given to cpphs. For instance, here is a Haskell comment
including a cpp definition: {-
# define FOO bar
and now we end the comment: -} and try out the definition: FOO
Likewise, double and single quotes no longer delimit strings or chars: "
# define BAZ FOO
and what do we have here?: " ' BAZ '
Also, in text-mode, macros should be expanded inside Haskell comments:
-- expand(this,other,that)
and strings "expand(this,other,that)".
cpphs-1.16/tests/expect25 0000755 2056640 0024421 00000001145 12075315473 015240 0 ustar 1341796 Domain Users #line 1 "text"
Here is some ordinary text with embedded Haskell-ish constructs,
that should however /not/ be interpreted as Haskell if the --text
option is given to cpphs. For instance, here is a Haskell comment
including a cpp definition: {-
and now we end the comment: -} and try out the definition: bar
Likewise, double and single quotes no longer delimit strings or chars: "
and what do we have here?: " ' bar '
Also, in text-mode, macros should be expanded inside Haskell comments:
-- Some text including this, the other, and that.
and strings "Some text including this, the other, and that.".
cpphs-1.16/tests/expect26 0000755 2056640 0024421 00000000321 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "nastyhack"
-- hackery to convice cpp to splice 6.2.2 into a string
version :: String
version = tail "\
\ 6.2.2"
version2 = "6.2.2"
version3 = "6.2.2"
version4 = #6.2.2
version5 = "6.2.2"
cpphs-1.16/tests/expect27 0000755 2056640 0024421 00000000371 12075315473 015242 0 ustar 1341796 Domain Users #line 1 "nastyhack"
-- hackery to convice cpp to splice GHC_PKG_VERSION into a string
version :: String
version = tail "\
\ GHC_PKG_VERSION"
version2 = "GHC_PKG_VERSION"
version3 = "GHC_PKG_VERSION"
version4 = #6.2.2
version5 = "6.2.2"
cpphs-1.16/tests/expect28 0000755 2056640 0024421 00000000063 12075315473 015241 0 ustar 1341796 Domain Users #line 1 "symbolvalue"
the symbol is defined as 1
cpphs-1.16/tests/expect29 0000755 2056640 0024421 00000000255 12075315473 015245 0 ustar 1341796 Domain Users #line 1 "Test.hsc"
module Test where
main :: IO ()
main = putStrLn "shows a cpphs+hsc2hs bug with comments"
{-
#def inline int cpphs_will_stumble(void) {return 42;}
-}
cpphs-1.16/tests/expect3 0000755 2056640 0024421 00000000244 12075315473 015153 0 ustar 1341796 Domain Users #line 1 "testfile"
1 top of file
3
5 X is defined
7
11
15
19
23 no inclusion, this is an else clause
25
29 this is an elif
33
34 end of file
cpphs-1.16/tests/expect30 0000755 2056640 0024421 00000053532 12075315473 015243 0 ustar 1341796 Domain Users #line 1 "Arr.lhs"
{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Arr
-- Copyright : (c) The University of Glasgow, 1994-2000
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC extensions)
--
-- GHC\'s array implementation.
--
-----------------------------------------------------------------------------
-- #hide
module GHC.Arr where
import {-# SOURCE #-} GHC.Err ( error )
import GHC.Enum
import GHC.Num
import GHC.ST
import GHC.Base
import GHC.List
import GHC.Show
infixl 9 !, //
default ()
-- | The 'Ix' class is used to map a contiguous subrange of values in
-- a type onto integers. It is used primarily for array indexing
-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").
--
-- The first argument @(l,u)@ of each of these operations is a pair
-- specifying the lower and upper bounds of a contiguous subrange of values.
--
-- An implementation is entitled to assume the following laws about these
-- operations:
--
-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@
--
-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
--
-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@
--
-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@
--
-- Minimal complete instance: 'range', 'index' and 'inRange'.
--
class (Ord a) => Ix a where
-- | The list of values in the subrange defined by a bounding pair.
range :: (a,a) -> [a]
-- | The position of a subscript in the subrange.
index :: (a,a) -> a -> Int
-- | Like 'index', but without checking that the value is in range.
unsafeIndex :: (a,a) -> a -> Int
-- | Returns 'True' the given subscript lies in the range defined
-- the bounding pair.
inRange :: (a,a) -> a -> Bool
-- | The size of the subrange defined by a bounding pair.
rangeSize :: (a,a) -> Int
-- | like 'rangeSize', but without checking that the upper bound is
-- in range.
unsafeRangeSize :: (a,a) -> Int
-- Must specify one of index, unsafeIndex
index b i | inRange b i = unsafeIndex b i
| otherwise = error "Error in array index"
unsafeIndex b i = index b i
rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
| otherwise = 0 -- This case is only here to
-- check for an empty range
-- NB: replacing (inRange b h) by (l <= h) fails for
-- tuples. E.g. (1,2) <= (2,1) but the range is empty
unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
-- abstract these errors from the relevant index functions so that
-- the guts of the function will be small enough to inline.
{-# NOINLINE indexError #-}
indexError :: Show a => (a,a) -> a -> String -> b
indexError rng i tp
= error (showString "Ix{" . showString tp . showString "}.index: Index " .
showParen True (showsPrec 0 i) .
showString " out of range " $
showParen True (showsPrec 0 rng) "")
----------------------------------------------------------------------
instance Ix Char where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = fromEnum i - fromEnum m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Char"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Int where
{-# INLINE range #-}
-- The INLINE stops the build in the RHS from getting inlined,
-- so that callers can fuse with the result of range
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = i - m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
{-# INLINE inRange #-}
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
----------------------------------------------------------------------
instance Ix Integer where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = fromInteger (i - m)
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Integer"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Bool where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Bool"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix Ordering where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Ordering"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix () where
{-# INLINE range #-}
range ((), ()) = [()]
{-# INLINE unsafeIndex #-}
unsafeIndex ((), ()) () = 0
{-# INLINE inRange #-}
inRange ((), ()) () = True
{-# INLINE index #-}
index b i = unsafeIndex b i
----------------------------------------------------------------------
instance (Ix a, Ix b) => Ix (a, b) where -- as derived
{-# SPECIALISE instance Ix (Int,Int) #-}
{- INLINE range #-}
range ((l1,l2),(u1,u2)) =
[ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
{- INLINE unsafeIndex #-}
unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
{- INLINE inRange #-}
inRange ((l1,l2),(u1,u2)) (i1,i2) =
inRange (l1,u1) i1 && inRange (l2,u2) i2
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
{-# SPECIALISE instance Ix (Int,Int,Int) #-}
range ((l1,l2,l3),(u1,u2,u3)) =
[(i1,i2,i3) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3)]
unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))
inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
[(i1,i2,i3,i4) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4)]
unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1)))
inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4
-- Default method for index
instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
[(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4),
i5 <- range (l5,u5)]
unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))))
inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
inRange (l5,u5) i5
-- Default method for index
type IPr = (Int, Int)
-- | The type of immutable non-strict (boxed) arrays
-- with indices in @i@ and elements in @e@.
data Ix i => Array i e = Array !i !i (Array# e)
-- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type
-- arguments are as follows:
--
-- * @s@: the state variable argument for the 'ST' type
--
-- * @i@: the index type of the array (should be an instance of 'Ix')
--
-- * @e@: the element type of the array.
--
data STArray s i e = STArray !i !i (MutableArray# s e)
-- No Ix context for STArray. They are stupid,
-- and force an Ix context on the equality instance.
-- Just pointer equality on mutable arrays:
instance Eq (STArray s i e) where
STArray _ _ arr1# == STArray _ _ arr2# =
sameMutableArray# arr1# arr2#
{-# NOINLINE arrEleBottom #-}
arrEleBottom :: a
arrEleBottom = error "(Array.!): undefined array element"
-- | Construct an array with the specified bounds and containing values
-- for given indices within these bounds.
--
-- The array is undefined (i.e. bottom) if any index in the list is
-- out of bounds. The Haskell 98 Report further specifies that if any
-- two associations in the list have the same index, the value at that
-- index is undefined (i.e. bottom). However in GHC's implementation,
-- the value at such an index is the value part of the last association
-- with that index in the list.
--
-- Because the indices must be checked for these errors, 'array' is
-- strict in the bounds argument and in the indices of the association
-- list, but nonstrict in the values. Thus, recurrences such as the
-- following are possible:
--
-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
--
-- Not every index within the bounds of the array need appear in the
-- association list, but the values associated with indices that do not
-- appear will be undefined (i.e. bottom).
--
-- If, in any dimension, the lower bound is greater than the upper bound,
-- then the array is legal, but empty. Indexing an empty array always
-- gives an array-bounds error, but 'bounds' still yields the bounds
-- with which the array was constructed.
{-# INLINE array #-}
array :: Ix i
=> (i,i) -- ^ a pair of /bounds/, each of the index type
-- of the array. These bounds are the lowest and
-- highest indices in the array, in that order.
-- For example, a one-origin vector of length
-- '10' has bounds '(1,10)', and a one-origin '10'
-- by '10' matrix has bounds '((1,1),(10,10))'.
-> [(i, e)] -- ^ a list of /associations/ of the form
-- (/index/, /value/). Typically, this list will
-- be expressed as a comprehension. An
-- association '(i, x)' defines the value of
-- the array at index 'i' to be 'x'.
-> Array i e
array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeArray #-}
unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
unsafeArray (l,u) ies = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
foldr (fill marr#) (done l u marr#) ies s2# }})
{-# INLINE fill #-}
fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
fill marr# (I# i#, e) next s1# =
case writeArray# marr# i# e s1# of { s2# ->
next s2# }
{-# INLINE done #-}
done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)
done l u marr# s1# =
case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, Array l u arr# #) }
-- This is inefficient and I'm not sure why:
-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
-- The code below is better. It still doesn't enable foldr/build
-- transformation on the list of elements; I guess it's impossible
-- using mechanisms currently available.
-- | Construct an array from a pair of bounds and a list of values in
-- index order.
{-# INLINE listArray #-}
listArray :: Ix i => (i,i) -> [e] -> Array i e
listArray (l,u) es = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let fillFromList i# xs s3# | i# ==# n# = s3#
| otherwise = case xs of
[] -> s3#
y:ys -> case writeArray# marr# i# y s3# of { s4# ->
fillFromList (i# +# 1#) ys s4# } in
case fillFromList 0# es s2# of { s3# ->
done l u marr# s3# }}})
-- | The value at the given index in an array.
{-# INLINE (!) #-}
(!) :: Ix i => Array i e -> i -> e
arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)
{-# INLINE unsafeAt #-}
unsafeAt :: Ix i => Array i e -> Int -> e
unsafeAt (Array _ _ arr#) (I# i#) =
case indexArray# arr# i# of (# e #) -> e
-- | The bounds with which an array was constructed.
{-# INLINE bounds #-}
bounds :: Ix i => Array i e -> (i,i)
bounds (Array l u _) = (l,u)
-- | The list of indices of an array in ascending order.
{-# INLINE indices #-}
indices :: Ix i => Array i e -> [i]
indices (Array l u _) = range (l,u)
-- | The list of elements of an array in index order.
{-# INLINE elems #-}
elems :: Ix i => Array i e -> [e]
elems arr@(Array l u _) =
[unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
-- | The list of associations of an array in index order.
{-# INLINE assocs #-}
assocs :: Ix i => Array i e -> [(i, e)]
assocs arr@(Array l u _) =
[(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
-- | The 'accumArray' deals with repeated indices in the association
-- list using an /accumulating function/ which combines the values of
-- associations with the same index.
-- For example, given a list of values of some index type, @hist@
-- produces a histogram of the number of occurrences of each index within
-- a specified range:
--
-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]
--
-- If the accumulating function is strict, then 'accumArray' is strict in
-- the values, as well as the indices, in the association list. Thus,
-- unlike ordinary arrays built with 'array', accumulated arrays should
-- not in general be recursive.
{-# INLINE accumArray #-}
accumArray :: Ix i
=> (e -> a -> e) -- ^ accumulating function
-> e -- ^ initial value
-> (i,i) -- ^ bounds of the array
-> [(i, a)] -- ^ association list
-> Array i e
accumArray f init (l,u) ies =
unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeAccumArray #-}
unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# init s1# of { (# s2#, marr# #) ->
foldr (adjust f marr#) (done l u marr#) ies s2# }})
{-# INLINE adjust #-}
adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
adjust f marr# (I# i#, new) next s1# =
case readArray# marr# i# s1# of { (# s2#, old #) ->
case writeArray# marr# i# (f old new) s2# of { s3# ->
next s3# }}
-- | Constructs an array identical to the first argument except that it has
-- been updated by the associations in the right argument.
-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
--
-- > m//[((i,i), 0) | i <- [1..n]]
--
-- is the same matrix, except with the diagonal zeroed.
--
-- Repeated indices in the association list are handled as for 'array':
-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),
-- but GHC's implementation uses the last association for each index.
{-# INLINE (//) #-}
(//) :: Ix i => Array i e -> [(i, e)] -> Array i e
arr@(Array l u _) // ies =
unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeReplace #-}
unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
unsafeReplace arr@(Array l u _) ies = runST (do
STArray _ _ marr# <- thawSTArray arr
ST (foldr (fill marr#) (done l u marr#) ies))
-- | @'accum' f@ takes an array and an association list and accumulates
-- pairs from the list into the array with the accumulating function @f@.
-- Thus 'accumArray' can be defined using 'accum':
--
-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])
--
{-# INLINE accum #-}
accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
accum f arr@(Array l u _) ies =
unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
{-# INLINE unsafeAccum #-}
unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
unsafeAccum f arr@(Array l u _) ies = runST (do
STArray _ _ marr# <- thawSTArray arr
ST (foldr (adjust f marr#) (done l u marr#) ies))
{-# INLINE amap #-}
amap :: Ix i => (a -> b) -> Array i a -> Array i b
amap f arr@(Array l u _) =
unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
-- | 'ixmap' allows for transformations on array indices.
-- It may be thought of as providing function composition on the right
-- with the mapping that the original array embodies.
--
-- A similar transformation of array values may be achieved using 'fmap'
-- from the 'Array' instance of the 'Functor' class.
{-# INLINE ixmap #-}
ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
ixmap (l,u) f arr =
unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
{-# INLINE eqArray #-}
eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
l1 == l2 && u1 == u2 &&
and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
{-# INLINE cmpArray #-}
cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
{-# INLINE cmpIntArray #-}
cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
if rangeSize (l2,u2) == 0 then GT else
case compare l1 l2 of
EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
other -> other
where
cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
EQ -> rest
other -> other
{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
instance Ix i => Functor (Array i) where
fmap = amap
instance (Ix i, Eq e) => Eq (Array i e) where
(==) = eqArray
instance (Ix i, Ord e) => Ord (Array i e) where
compare = cmpArray
instance (Ix a, Show a, Show b) => Show (Array a b) where
showsPrec p a =
showParen (p > appPrec) $
showString "array " .
showsPrec appPrec1 (bounds a) .
showChar ' ' .
showsPrec appPrec1 (assocs a)
-- Precedence of 'array' is the precedence of application
-- The Read instance is in GHC.Read
{-# INLINE newSTArray #-}
newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
newSTArray (l,u) init = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# init s1# of { (# s2#, marr# #) ->
(# s2#, STArray l u marr# #) }}
{-# INLINE boundsSTArray #-}
boundsSTArray :: STArray s i e -> (i,i)
boundsSTArray (STArray l u _) = (l,u)
{-# INLINE readSTArray #-}
readSTArray :: Ix i => STArray s i e -> i -> ST s e
readSTArray marr@(STArray l u _) i =
unsafeReadSTArray marr (index (l,u) i)
{-# INLINE unsafeReadSTArray #-}
unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->
readArray# marr# i# s1#
{-# INLINE writeSTArray #-}
writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
writeSTArray marr@(STArray l u _) i e =
unsafeWriteSTArray marr (index (l,u) i) e
{-# INLINE unsafeWriteSTArray #-}
unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->
case writeArray# marr# i# e s1# of { s2# ->
(# s2#, () #) }
freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
freezeSTArray (STArray l u marr#) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
let copy i# s3# | i# ==# n# = s3#
| otherwise =
case readArray# marr# i# s3# of { (# s4#, e #) ->
case writeArray# marr'# i# e s4# of { s5# ->
copy (i# +# 1#) s5# }} in
case copy 0# s2# of { s3# ->
case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
(# s4#, Array l u arr# #) }}}}
{-# INLINE unsafeFreezeSTArray #-}
unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->
case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
(# s2#, Array l u arr# #) }
thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
thawSTArray (Array l u arr#) = ST $ \s1# ->
case rangeSize (l,u) of { I# n# ->
case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
let copy i# s3# | i# ==# n# = s3#
| otherwise =
case indexArray# arr# i# of { (# e #) ->
case writeArray# marr# i# e s3# of { s4# ->
copy (i# +# 1#) s4# }} in
case copy 0# s2# of { s3# ->
(# s3#, STArray l u marr# #) }}}
{-# INLINE unsafeThawSTArray #-}
unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->
case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
(# s2#, STArray l u marr# #) }
cpphs-1.16/tests/expect31 0000755 2056640 0024421 00000000102 12075315473 015225 0 ustar 1341796 Domain Users #line 1 "elif"
import System.IO.Unsafe (unsafePerformIO)
cpphs-1.16/tests/expect32 0000755 2056640 0024421 00000000130 12075315473 015227 0 ustar 1341796 Domain Users #line 1 "pragma"
#pragma ident "@(#)time.h 1.39 99/08/10 SMI"
cpphs-1.16/tests/expect33 0000755 2056640 0024421 00000000107 12075315473 015234 0 ustar 1341796 Domain Users #pragma ident "@(#)time.h 1.39 99/08/10 SMI"
cpphs-1.16/tests/expect34 0000755 2056640 0024421 00000000036 12075315473 015236 0 ustar 1341796 Domain Users #line 1 "igloo"
1
foo
cpphs-1.16/tests/expect35 0000755 2056640 0024421 00000000043 12075315473 015235 0 ustar 1341796 Domain Users #line 1 "igloo2"
baz
1
foo
cpphs-1.16/tests/expect36 0000755 2056640 0024421 00000000051 12075315473 015235 0 ustar 1341796 Domain Users #line 1 "igloo3"
quux
FOOFOO
bar
cpphs-1.16/tests/expect36a 0000755 2056640 0024421 00000000052 12075315473 015377 0 ustar 1341796 Domain Users #line 1 "igloo3a"
quux
FOOFOO
bar
cpphs-1.16/tests/expect36b 0000755 2056640 0024421 00000000047 12075315473 015404 0 ustar 1341796 Domain Users #line 1 "igloo3b"
quux
11
foo
cpphs-1.16/tests/expect37 0000755 2056640 0024421 00000000046 12075315473 015242 0 ustar 1341796 Domain Users #line 1 "igloo4"
wibble
11
foo
cpphs-1.16/tests/expect37a 0000755 2056640 0024421 00000000047 12075315473 015404 0 ustar 1341796 Domain Users #line 1 "igloo4a"
wibble
11
foo
cpphs-1.16/tests/expect38 0000755 2056640 0024421 00000000067 12075315473 015246 0 ustar 1341796 Domain Users #line 1 "mauke"
main = print 7 -- should print 7
cpphs-1.16/tests/expect39 0000755 2056640 0024421 00000000026 12075315473 015242 0 ustar 1341796 Domain Users #line 1 "mauke2"
4
cpphs-1.16/tests/expect4 0000755 2056640 0024421 00000000316 12075315473 015154 0 ustar 1341796 Domain Users #line 1 "testfile"
1 top of file
3
5 X is defined
7
11
15
19
#line 1 "./inclusion"
hello world, this is an inclusion
#line 22 "testfile"
25
31 third branch of elif
33
34 end of file
cpphs-1.16/tests/expect40 0000755 2056640 0024421 00000000060 12075315473 015230 0 ustar 1341796 Domain Users #line 1 "fasta"
b7 = unsafeVisualize(foo)
cpphs-1.16/tests/expect40a 0000755 2056640 0024421 00000000060 12075315473 015371 0 ustar 1341796 Domain Users #line 1 "fasta2"
b6 = unsafeVisualize(foo)
cpphs-1.16/tests/expect41 0000755 2056640 0024421 00000000031 12075315473 015227 0 ustar 1341796 Domain Users #line 1 "hashjoin"
2
cpphs-1.16/tests/expect42 0000755 2056640 0024421 00000000051 12075315473 015232 0 ustar 1341796 Domain Users #line 1 "wrongline"
2
#line 20 "foo"
20
cpphs-1.16/tests/expect43 0000755 2056640 0024421 00000000073 12075315473 015237 0 ustar 1341796 Domain Users #line 1 "param"
11 -- gcc gives BARBAR, cpphs gives 11
cpphs-1.16/tests/expect44 0000755 2056640 0024421 00000000236 12075315473 015241 0 ustar 1341796 Domain Users #line 1 "comments"
here is an ordinary C comment:
and here is a C++-style end-of-line comment: // comment here
this line has no comments
cpphs-1.16/tests/expect44a 0000755 2056640 0024421 00000000236 12075315473 015402 0 ustar 1341796 Domain Users #line 1 "comments"
here is an ordinary C comment:
and here is a C++-style end-of-line comment:
this line has no comments
cpphs-1.16/tests/expect45 0000755 2056640 0024421 00000000044 12075315473 015237 0 ustar 1341796 Domain Users #line 1 "nestcomment"
{-
foo
-}
cpphs-1.16/tests/expect46 0000755 2056640 0024421 00000000214 12075315473 015237 0 ustar 1341796 Domain Users #line 1 "preinclude"
#line 1 "./inclusion"
hello world, this is an inclusion
#line 2 "preinclude"
#line 1 "preinclude"
something arbitrary
cpphs-1.16/tests/expect47 0000755 2056640 0024421 00000000030 12075315473 015234 0 ustar 1341796 Domain Users #line 1 "endcode-a"
cpphs-1.16/tests/expect48 0000755 2056640 0024421 00000000031 12075315473 015236 0 ustar 1341796 Domain Users #line 1 "endcode-b"
cpphs-1.16/tests/expect49 0000755 2056640 0024421 00000000052 12075315473 015242 0 ustar 1341796 Domain Users #line 1 "undef.hs"
wibble 3
this is FOO
cpphs-1.16/tests/expect5 0000755 2056640 0024421 00000000220 12075315473 015147 0 ustar 1341796 Domain Users 1 top of file
3
5 0 is defined
7
11
15
19
hello world, this is an inclusion
25
31 third branch of elif
33
34 end of file
cpphs-1.16/tests/expect50 0000755 2056640 0024421 00000000262 12075315473 015235 0 ustar 1341796 Domain Users {-# LINE 1 "linepragma" #-}
{-# LINE 1 "./inclusion" #-}
hello world, this is an inclusion
{-# LINE 2 "linepragma" #-}
{-# LINE 2 "linepragma" #-}
{-# LINE 3 "linepragma" #-}
cpphs-1.16/tests/expect51 0000755 2056640 0024421 00000000501 12075315473 015232 0 ustar 1341796 Domain Users #line 1 "nomacro"
This file is intended to show the interaction of --nomacro with --strip
which was broken up until cpphs-1.14.
Here is a line with some comment // to eol
Here is a line with some C89 comment /* inlined */ with more text after it.
Here is a line that uses 1 but it should look like uppercase foo, not 1.
cpphs-1.16/tests/expect52 0000755 2056640 0024421 00000000504 12075315473 015236 0 ustar 1341796 Domain Users #line 1 "nomacro"
This file is intended to show the interaction of --nomacro with --strip
which was broken up until cpphs-1.14.
Here is a line with some comment // to eol
Here is a line with some C89 comment /* inlined */ with more text after it.
Here is a line that uses FOO but it should look like uppercase foo, not 1.
cpphs-1.16/tests/expect53 0000755 2056640 0024421 00000000503 12075315473 015236 0 ustar 1341796 Domain Users #line 1 "nomacro"
This file is intended to show the interaction of --nomacro with --strip
which was broken up until cpphs-1.14.
Here is a line with some comment
Here is a line with some C89 comment with more text after it.
Here is a line that uses FOO but it should look like uppercase foo, not 1.
cpphs-1.16/tests/expect54 0000755 2056640 0024421 00000000501 12075315473 015235 0 ustar 1341796 Domain Users #line 1 "nomacro"
This file is intended to show the interaction of --nomacro with --strip
which was broken up until cpphs-1.14.
Here is a line with some comment
Here is a line with some C89 comment with more text after it.
Here is a line that uses 1 but it should look like uppercase foo, not 1.
cpphs-1.16/tests/expect6 0000755 2056640 0024421 00000000100 12075315473 015145 0 ustar 1341796 Domain Users #line 1 "cpp"
x ++ y = X' * 0 * y .(foo), Xprime
// /*
cpphs-1.16/tests/expect7 0000755 2056640 0024421 00000022127 12075315473 015163 0 ustar 1341796 Domain Users #line 1 "Storable.hs"
{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.Storable
-- Copyright : (c) The FFI task force 2001
-- License : see libraries/base/LICENSE
--
-- Maintainer : ffi@haskell.org
-- Stability : provisional
-- Portability : portable
--
-- The module "Foreign.Storable" provides most elementary support for
-- marshalling and is part of the language-independent portion of the
-- Foreign Function Interface (FFI), and will normally be imported via
-- the "Foreign" module.
--
-----------------------------------------------------------------------------
module Foreign.Storable
( Storable(
sizeOf, -- :: a -> Int
alignment, -- :: a -> Int
peekElemOff, -- :: Ptr a -> Int -> IO a
pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
peekByteOff, -- :: Ptr b -> Int -> IO a
pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
peek, -- :: Ptr a -> IO a
poke) -- :: Ptr a -> a -> IO ()
) where
import Control.Monad ( liftM )
#line 1 "./MachDeps.h"
#line 40 "Storable.hs"
#line 1 "./config.h"
#line 41 "Storable.hs"
import GHC.Storable
import GHC.Stable ( StablePtr )
import GHC.Num
import GHC.Int
import GHC.Word
import GHC.Stable
import GHC.Ptr
import GHC.Float
import GHC.Err
import GHC.IOBase
import GHC.Base
{- |
The member functions of this class facilitate writing values of
primitive types to raw memory (which may have been allocated with the
above mentioned routines) and reading values from blocks of raw
memory. The class, furthermore, includes support for computing the
storage requirements and alignment restrictions of storable types.
Memory addresses are represented as values of type @'Ptr' a@, for some
@a@ which is an instance of class 'Storable'. The type argument to
'Ptr' helps provide some valuable type safety in FFI code (you can\'t
mix pointers of different types without an explicit cast), while
helping the Haskell type system figure out which marshalling method is
needed for a given pointer.
All marshalling between Haskell and a foreign language ultimately
boils down to translating Haskell data structures into the binary
representation of a corresponding data structure of the foreign
language and vice versa. To code this marshalling in Haskell, it is
necessary to manipulate primtive data types stored in unstructured
memory blocks. The class 'Storable' facilitates this manipulation on
all types for which it is instantiated, which are the standard basic
types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
as well as 'Ptr'.
Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
'pokeByteOff'.
-}
class Storable a where
sizeOf :: a -> Int
-- ^ Computes the storage requirements (in bytes) of the argument.
-- The value of the argument is not used.
alignment :: a -> Int
-- ^ Computes the alignment constraint of the argument. An
-- alignment constraint @x@ is fulfilled by any address divisible
-- by @x@. The value of the argument is not used.
peekElemOff :: Ptr a -> Int -> IO a
-- ^ Read a value from a memory area regarded as an array
-- of values of the same kind. The first argument specifies
-- the start address of the array and the second the index into
-- the array (the first element of the array has index
-- @0@). The following equality holds,
--
-- > peekElemOff addr idx = IOExts.fixIO $ \result ->
-- > peek (addr `plusPtr` (idx * sizeOf result))
--
-- Note that this is only a specification, not
-- necessarily the concrete implementation of the
-- function.
pokeElemOff :: Ptr a -> Int -> a -> IO ()
-- ^ Write a value to a memory area regarded as an array of
-- values of the same kind. The following equality holds:
--
-- > pokeElemOff addr idx x =
-- > poke (addr `plusPtr` (idx * sizeOf x)) x
peekByteOff :: Ptr b -> Int -> IO a
-- ^ Read a value from a memory location given by a base
-- address and offset. The following equality holds:
--
-- > peekByteOff addr off = peek (addr `plusPtr` off)
pokeByteOff :: Ptr b -> Int -> a -> IO ()
-- ^ Write a value to a memory location given by a base
-- address and offset. The following equality holds:
--
-- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
peek :: Ptr a -> IO a
-- ^ Read a value from the given memory location.
--
-- Note that the peek and poke functions might require properly
-- aligned addresses to function correctly. This is architecture
-- dependent; thus, portable code should ensure that when peeking or
-- poking values of some type @a@, the alignment
-- constraint for @a@, as given by the function
-- 'alignment' is fulfilled.
poke :: Ptr a -> a -> IO ()
-- ^ Write the given value to the given memory location. Alignment
-- restrictions might apply; see 'peek'.
-- circular default instances
peekElemOff = peekElemOff_ undefined
where peekElemOff_ :: a -> Ptr a -> Int -> IO a
peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
peekByteOff ptr off = peek (ptr `plusPtr` off)
pokeByteOff ptr off = poke (ptr `plusPtr` off)
peek ptr = peekElemOff ptr 0
poke ptr = pokeElemOff ptr 0
-- System-dependent, but rather obvious instances
instance Storable Bool where
sizeOf _ = sizeOf (undefined::HTYPE_INT)
alignment _ = alignment (undefined::HTYPE_INT)
peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
instance Storable (Char) where {
sizeOf _ = SIZEOF_INT32;
alignment _ = ALIGNMENT_INT32;
peekElemOff = readWideCharOffPtr;
pokeElemOff = writeWideCharOffPtr }
instance Storable (Int) where {
sizeOf _ = SIZEOF_HSINT;
alignment _ = ALIGNMENT_HSINT;
peekElemOff = readIntOffPtr;
pokeElemOff = writeIntOffPtr }
instance Storable (Word) where {
sizeOf _ = SIZEOF_HSWORD;
alignment _ = ALIGNMENT_HSWORD;
peekElemOff = readWordOffPtr;
pokeElemOff = writeWordOffPtr }
instance Storable ((Ptr a)) where {
sizeOf _ = SIZEOF_HSPTR;
alignment _ = ALIGNMENT_HSPTR;
peekElemOff = readPtrOffPtr;
pokeElemOff = writePtrOffPtr }
instance Storable ((FunPtr a)) where {
sizeOf _ = SIZEOF_HSFUNPTR;
alignment _ = ALIGNMENT_HSFUNPTR;
peekElemOff = readFunPtrOffPtr;
pokeElemOff = writeFunPtrOffPtr }
instance Storable ((StablePtr a)) where {
sizeOf _ = SIZEOF_HSSTABLEPTR;
alignment _ = ALIGNMENT_HSSTABLEPTR;
peekElemOff = readStablePtrOffPtr;
pokeElemOff = writeStablePtrOffPtr }
instance Storable (Float) where {
sizeOf _ = SIZEOF_HSFLOAT;
alignment _ = ALIGNMENT_HSFLOAT;
peekElemOff = readFloatOffPtr;
pokeElemOff = writeFloatOffPtr }
instance Storable (Double) where {
sizeOf _ = SIZEOF_HSDOUBLE;
alignment _ = ALIGNMENT_HSDOUBLE;
peekElemOff = readDoubleOffPtr;
pokeElemOff = writeDoubleOffPtr }
instance Storable (Word8) where {
sizeOf _ = SIZEOF_WORD8;
alignment _ = ALIGNMENT_WORD8;
peekElemOff = readWord8OffPtr;
pokeElemOff = writeWord8OffPtr }
instance Storable (Word16) where {
sizeOf _ = SIZEOF_WORD16;
alignment _ = ALIGNMENT_WORD16;
peekElemOff = readWord16OffPtr;
pokeElemOff = writeWord16OffPtr }
instance Storable (Word32) where {
sizeOf _ = SIZEOF_WORD32;
alignment _ = ALIGNMENT_WORD32;
peekElemOff = readWord32OffPtr;
pokeElemOff = writeWord32OffPtr }
instance Storable (Word64) where {
sizeOf _ = SIZEOF_WORD64;
alignment _ = ALIGNMENT_WORD64;
peekElemOff = readWord64OffPtr;
pokeElemOff = writeWord64OffPtr }
instance Storable (Int8) where {
sizeOf _ = SIZEOF_INT8;
alignment _ = ALIGNMENT_INT8;
peekElemOff = readInt8OffPtr;
pokeElemOff = writeInt8OffPtr }
instance Storable (Int16) where {
sizeOf _ = SIZEOF_INT16;
alignment _ = ALIGNMENT_INT16;
peekElemOff = readInt16OffPtr;
pokeElemOff = writeInt16OffPtr }
instance Storable (Int32) where {
sizeOf _ = SIZEOF_INT32;
alignment _ = ALIGNMENT_INT32;
peekElemOff = readInt32OffPtr;
pokeElemOff = writeInt32OffPtr }
instance Storable (Int64) where {
sizeOf _ = SIZEOF_INT64;
alignment _ = ALIGNMENT_INT64;
peekElemOff = readInt64OffPtr;
pokeElemOff = writeInt64OffPtr }
cpphs-1.16/tests/expect8 0000755 2056640 0024421 00000002216 12075315473 015161 0 ustar 1341796 Domain Users #line 1 "HsOpenGLExt.h"
/* -----------------------------------------------------------------------------
*
* Module : GL extension support for Graphics.Rendering.OpenGL
* Copyright : (c) Sven Panne 2002-2004
* License : BSD-style (see the file libraries/OpenGL/LICENSE)
*
* Maintainer : sven.panne@aedion.de
* Stability : provisional
* Portability : portable
*
* This header should only define preprocessor macros!
*
* -------------------------------------------------------------------------- */
/* NOTE: The macro must immediately start with the foreign declaration,
otherwise the magic mangler (hack_foreign) in the Hugs build system
doesn't recognize it. */
foreign import ccall unsafe "dynamic" dyn_glFogCoorddEXT :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (GLdouble -> IO ()) ;
glFogCoorddEXT :: (GLdouble -> IO ()) ;
glFogCoorddEXT = dyn_glFogCoorddEXT ptr_glFogCoorddEXT ;
ptr_glFogCoorddEXT :: FunPtr a ;
ptr_glFogCoorddEXT = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress ("GL_EXT_fog_coord or OpenGL 1.4") ("glFogCoorddEXT")) ;
{-# NOINLINE ptr_glFogCoorddEXT #-}
cpphs-1.16/tests/expect9 0000755 2056640 0024421 00000000317 12075315473 015162 0 ustar 1341796 Domain Users #line 1 "multiline"
5 back to ordinary text.
#line 1 "./inclusion"
hello world, this is an inclusion
#line 7 "multiline"
7 hello again
8 some more
9 some line here;
and some more;
finish now
10 end
cpphs-1.16/tests/fasta 0000755 2056640 0024421 00000000402 12075315473 014672 0 ustar 1341796 Domain Users #define XCONCAT(a, b) a##b
#define CONCAT(a, b) XCONCAT(a, b)
#define PS(val) () <- trace (val) (return ())
#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
V(foo)
cpphs-1.16/tests/fasta2 0000755 2056640 0024421 00000000401 12075315473 014753 0 ustar 1341796 Domain Users #define XCONCAT(a, b) a##b
#define CONCAT(a, b) XCONCAT(a, b)
#define PS(val) () <- trace (val) (return ())
#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
V(foo)
cpphs-1.16/tests/hashjoin 0000755 2056640 0024421 00000000071 12075315473 015401 0 ustar 1341796 Domain Users #define FOO 1
#define BAR FOO##FOO
#define FOOFOO 2
BAR
cpphs-1.16/tests/HsOpenGLExt.h 0000755 2056640 0024421 00000002271 12075315473 016130 0 ustar 1341796 Domain Users /* -----------------------------------------------------------------------------
*
* Module : GL extension support for Graphics.Rendering.OpenGL
* Copyright : (c) Sven Panne 2002-2004
* License : BSD-style (see the file libraries/OpenGL/LICENSE)
*
* Maintainer : sven.panne@aedion.de
* Stability : provisional
* Portability : portable
*
* This header should only define preprocessor macros!
*
* -------------------------------------------------------------------------- */
#ifndef HSOPENGLEXT_H
#define HSOPENGLEXT_H
/* NOTE: The macro must immediately start with the foreign declaration,
otherwise the magic mangler (hack_foreign) in the Hugs build system
doesn't recognize it. */
#define EXTENSION_ENTRY(_msg,_entry,_ty) \
foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \
_entry :: (_ty) ; \
_entry = dyn_##_entry ptr_##_entry ; \
ptr_/**/_entry :: FunPtr a ; \
ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \
{-# NOINLINE ptr_/**/_entry #-}
#endif
EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ())
cpphs-1.16/tests/igloo 0000755 2056640 0024421 00000000106 12075315473 014706 0 ustar 1341796 Domain Users #define FOO 1
#define BAR FOO
BAR
#if BAR == 1
foo
#else
bar
#endif
cpphs-1.16/tests/igloo2 0000755 2056640 0024421 00000000121 12075315473 014765 0 ustar 1341796 Domain Users #define FOO 1
#define BAZ(x) x
baz
BAZ(1)
#if BAZ(1) == 1
foo
#else
bar
#endif
cpphs-1.16/tests/igloo3 0000755 2056640 0024421 00000000126 12075315473 014773 0 ustar 1341796 Domain Users #define FOO 1
#define QUUX FOO ## FOO
quux
QUUX
#if QUUX == 11
foo
#else
bar
#endif
cpphs-1.16/tests/igloo3a 0000755 2056640 0024421 00000000124 12075315473 015132 0 ustar 1341796 Domain Users #define FOO 1
#define QUUX FOO##FOO
quux
QUUX
#if QUUX == 11
foo
#else
bar
#endif
cpphs-1.16/tests/igloo3b 0000755 2056640 0024421 00000000162 12075315473 015135 0 ustar 1341796 Domain Users #define FOO 1
#define QUUX(a) a ## a
#define WIBBLE QUUX(FOO)
quux
WIBBLE
#if WIBBLE == 11
foo
#else
bar
#endif
cpphs-1.16/tests/igloo4 0000755 2056640 0024421 00000000114 12075315473 014771 0 ustar 1341796 Domain Users #define WIBBLE 1 ## 1
wibble
WIBBLE
#if WIBBLE == 11
foo
#else
bar
#endif
cpphs-1.16/tests/igloo4a 0000755 2056640 0024421 00000000112 12075315473 015130 0 ustar 1341796 Domain Users #define WIBBLE 1##1
wibble
WIBBLE
#if WIBBLE == 11
foo
#else
bar
#endif
cpphs-1.16/tests/inclusion 0000755 2056640 0024421 00000000042 12075315473 015577 0 ustar 1341796 Domain Users hello world, this is an inclusion
cpphs-1.16/tests/incomplete 0000755 2056640 0024421 00000000012 12075315473 015730 0 ustar 1341796 Domain Users incomplete cpphs-1.16/tests/indirect 0000755 2056640 0024421 00000000041 12075315473 015374 0 ustar 1341796 Domain Users #define F "inclusion"
#include F
cpphs-1.16/tests/indirect-a 0000755 2056640 0024421 00000000047 12075315473 015620 0 ustar 1341796 Domain Users #define F(f) in##f
#include F(clusion)
cpphs-1.16/tests/linepragma 0000755 2056640 0024421 00000000101 12075315473 015707 0 ustar 1341796 Domain Users #include "inclusion"
#line 2 "linepragma"
#line 3 "linepragma"
cpphs-1.16/tests/MachDeps.h 0000755 2056640 0024421 00000000000 12075315473 015500 0 ustar 1341796 Domain Users cpphs-1.16/tests/mauke 0000755 2056640 0024421 00000000124 12075315473 014677 0 ustar 1341796 Domain Users #define X /\
* comment */ main
#define Y _\
_LINE__
X = print Y -- should print 7
cpphs-1.16/tests/mauke2 0000755 2056640 0024421 00000000034 12075315473 014761 0 ustar 1341796 Domain Users #define foo _\
_LINE__
foo
cpphs-1.16/tests/multiline 0000755 2056640 0024421 00000000300 12075315473 015573 0 ustar 1341796 Domain Users #define aLongMacroDefinition(x,y) \
some line here; \
and some more; \
finish now
5 back to ordinary text.
#include "inclusion"
7 hello again
8 some more
9 aLongMacroDefinition(a,b)
10 end
cpphs-1.16/tests/nastyhack 0000755 2056640 0024421 00000000547 12075315473 015573 0 ustar 1341796 Domain Users #define GHC_PKG_VERSION 6.2.2
-- hackery to convice cpp to splice GHC_PKG_VERSION into a string
version :: String
version = tail "\
\ GHC_PKG_VERSION"
version2 = "GHC_PKG_VERSION"
#define v3 "GHC_PKG_VERSION"
version3 = v3
#define stringify(s) #s
version4 = stringify(GHC_PKG_VERSION)
#define stringify2(s) "s"
version5 = stringify2(GHC_PKG_VERSION)
cpphs-1.16/tests/nestcomment 0000755 2056640 0024421 00000000041 12075315473 016127 0 ustar 1341796 Domain Users {-
#if 1
foo
#else
bar
#endif
-}
cpphs-1.16/tests/nomacro 0000755 2056640 0024421 00000000476 12075315473 015245 0 ustar 1341796 Domain Users This file is intended to show the interaction of --nomacro with --strip
which was broken up until cpphs-1.14.
#define FOO 1
Here is a line with some comment // to eol
Here is a line with some C89 comment /* inlined */ with more text after it.
Here is a line that uses FOO but it should look like uppercase foo, not 1.
cpphs-1.16/tests/numbers 0000755 2056640 0024421 00000000606 12075315473 015255 0 ustar 1341796 Domain Users #if 1
number (1) in if
#else
rejected number (1) in if
#endif
#if 0
wrongly accepted number (0) in if
#else
number (0) in if
#endif
#if eaf
false hex number in if
#else
rejected false hex number in if
#endif
#if 0x1
real hex number (0x1) in if
#else
rejected real hex number (0x1) in if
#endif
#if 0x00
wrongly accepted real hex number (0x00) in if
#else
hex number (0x00) in if
#endif
cpphs-1.16/tests/param 0000755 2056640 0024421 00000000143 12075315473 014676 0 ustar 1341796 Domain Users #define FOO 1
#define BAR FOO
#define JOIN(f) f##f
JOIN(BAR) -- gcc gives BARBAR, cpphs gives 11
cpphs-1.16/tests/parens 0000755 2056640 0024421 00000000240 12075315473 015064 0 ustar 1341796 Domain Users #if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \
|| ( defined(__NHC__) && __NHC__ >= 117 )
#define FINALIZERPTR yes
#endif
FINALIZERPTR
cpphs-1.16/tests/pragma 0000755 2056640 0024421 00000000113 12075315473 015042 0 ustar 1341796 Domain Users #pragma ident "@(#)time.h 1.39 99/08/10 SMI" /* SVr4.0 1.18 */
cpphs-1.16/tests/precedence 0000755 2056640 0024421 00000000070 12075315473 015672 0 ustar 1341796 Domain Users #if !0 && 0
boolean operator precedence is wrong
#endif
cpphs-1.16/tests/preinclude 0000755 2056640 0024421 00000000024 12075315473 015726 0 ustar 1341796 Domain Users something arbitrary
cpphs-1.16/tests/recursive 0000755 2056640 0024421 00000000054 12075315473 015606 0 ustar 1341796 Domain Users #define C D D
#define B C C
#define A B B
A
cpphs-1.16/tests/ross 0000755 2056640 0024421 00000000516 12075315473 014570 0 ustar 1341796 Domain Users /* 1. C comments should be deleted by the preprocessor */
/* 2. repeated expansion */
#define FOO 4
#define BAR FOO
f = BAR
/* 3. continuation lines in macros shouldn't give newlines */
#define LONG_MACRO \
{ putStr "Hello "; \
putStrLn "World" }
g = do LONG_MACRO
/* 4. projection macros */
#define MACRO(x) x
h = MACRO(FOO)
cpphs-1.16/tests/runtests 0000755 2056640 0024421 00000005564 12075315473 015501 0 ustar 1341796 Domain Users #!/bin/sh
CPPHS=${1:-"../cpphs"}
FAIL=0
runtest() {
if $1 >out 2>/dev/null && diff $2 out >/dev/null
then echo "passed: " $1
else FAIL=$?
echo "FAILED: ($2) " $1
fi
}
if $CPPHS Int
alignment, -- :: a -> Int
peekElemOff, -- :: Ptr a -> Int -> IO a
pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
peekByteOff, -- :: Ptr b -> Int -> IO a
pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
peek, -- :: Ptr a -> IO a
poke) -- :: Ptr a -> a -> IO ()
) where
#ifdef __NHC__
import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr
,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)
#else
import Control.Monad ( liftM )
#include "MachDeps.h"
#include "config.h"
#ifdef __GLASGOW_HASKELL__
import GHC.Storable
import GHC.Stable ( StablePtr )
import GHC.Num
import GHC.Int
import GHC.Word
import GHC.Stable
import GHC.Ptr
import GHC.Float
import GHC.Err
import GHC.IOBase
import GHC.Base
#else
import Data.Int
import Data.Word
import Foreign.Ptr
import Foreign.StablePtr
#endif
#ifdef __HUGS__
import Hugs.Prelude
import Hugs.Storable
#endif
{- |
The member functions of this class facilitate writing values of
primitive types to raw memory (which may have been allocated with the
above mentioned routines) and reading values from blocks of raw
memory. The class, furthermore, includes support for computing the
storage requirements and alignment restrictions of storable types.
Memory addresses are represented as values of type @'Ptr' a@, for some
@a@ which is an instance of class 'Storable'. The type argument to
'Ptr' helps provide some valuable type safety in FFI code (you can\'t
mix pointers of different types without an explicit cast), while
helping the Haskell type system figure out which marshalling method is
needed for a given pointer.
All marshalling between Haskell and a foreign language ultimately
boils down to translating Haskell data structures into the binary
representation of a corresponding data structure of the foreign
language and vice versa. To code this marshalling in Haskell, it is
necessary to manipulate primtive data types stored in unstructured
memory blocks. The class 'Storable' facilitates this manipulation on
all types for which it is instantiated, which are the standard basic
types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
as well as 'Ptr'.
Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
'pokeByteOff'.
-}
class Storable a where
sizeOf :: a -> Int
-- ^ Computes the storage requirements (in bytes) of the argument.
-- The value of the argument is not used.
alignment :: a -> Int
-- ^ Computes the alignment constraint of the argument. An
-- alignment constraint @x@ is fulfilled by any address divisible
-- by @x@. The value of the argument is not used.
peekElemOff :: Ptr a -> Int -> IO a
-- ^ Read a value from a memory area regarded as an array
-- of values of the same kind. The first argument specifies
-- the start address of the array and the second the index into
-- the array (the first element of the array has index
-- @0@). The following equality holds,
--
-- > peekElemOff addr idx = IOExts.fixIO $ \result ->
-- > peek (addr `plusPtr` (idx * sizeOf result))
--
-- Note that this is only a specification, not
-- necessarily the concrete implementation of the
-- function.
pokeElemOff :: Ptr a -> Int -> a -> IO ()
-- ^ Write a value to a memory area regarded as an array of
-- values of the same kind. The following equality holds:
--
-- > pokeElemOff addr idx x =
-- > poke (addr `plusPtr` (idx * sizeOf x)) x
peekByteOff :: Ptr b -> Int -> IO a
-- ^ Read a value from a memory location given by a base
-- address and offset. The following equality holds:
--
-- > peekByteOff addr off = peek (addr `plusPtr` off)
pokeByteOff :: Ptr b -> Int -> a -> IO ()
-- ^ Write a value to a memory location given by a base
-- address and offset. The following equality holds:
--
-- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
peek :: Ptr a -> IO a
-- ^ Read a value from the given memory location.
--
-- Note that the peek and poke functions might require properly
-- aligned addresses to function correctly. This is architecture
-- dependent; thus, portable code should ensure that when peeking or
-- poking values of some type @a@, the alignment
-- constraint for @a@, as given by the function
-- 'alignment' is fulfilled.
poke :: Ptr a -> a -> IO ()
-- ^ Write the given value to the given memory location. Alignment
-- restrictions might apply; see 'peek'.
-- circular default instances
#ifdef __GLASGOW_HASKELL__
peekElemOff = peekElemOff_ undefined
where peekElemOff_ :: a -> Ptr a -> Int -> IO a
peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
#else
peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)
#endif
pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
peekByteOff ptr off = peek (ptr `plusPtr` off)
pokeByteOff ptr off = poke (ptr `plusPtr` off)
peek ptr = peekElemOff ptr 0
poke ptr = pokeElemOff ptr 0
#ifndef __GLASGOW_HASKELL__
sizeOfPtr :: Storable a => Ptr a -> a -> Int
sizeOfPtr px x = sizeOf x
#endif
-- System-dependent, but rather obvious instances
instance Storable Bool where
sizeOf _ = sizeOf (undefined::HTYPE_INT)
alignment _ = alignment (undefined::HTYPE_INT)
peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
#define STORABLE(T,size,align,read,write) \
instance Storable (T) where { \
sizeOf _ = size; \
alignment _ = align; \
peekElemOff = read; \
pokeElemOff = write }
#ifdef __GLASGOW_HASKELL__
STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
readWideCharOffPtr,writeWideCharOffPtr)
#elif defined(__HUGS__)
STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
readCharOffPtr,writeCharOffPtr)
#endif
STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
readIntOffPtr,writeIntOffPtr)
#ifdef __GLASGOW_HASKELL__
STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
readWordOffPtr,writeWordOffPtr)
#endif
STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
readPtrOffPtr,writePtrOffPtr)
STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
readFunPtrOffPtr,writeFunPtrOffPtr)
STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
readStablePtrOffPtr,writeStablePtrOffPtr)
STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
readFloatOffPtr,writeFloatOffPtr)
STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
readDoubleOffPtr,writeDoubleOffPtr)
STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
readWord8OffPtr,writeWord8OffPtr)
STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
readWord16OffPtr,writeWord16OffPtr)
STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
readWord32OffPtr,writeWord32OffPtr)
STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
readWord64OffPtr,writeWord64OffPtr)
STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
readInt8OffPtr,writeInt8OffPtr)
STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
readInt16OffPtr,writeInt16OffPtr)
STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
readInt32OffPtr,writeInt32OffPtr)
STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
readInt64OffPtr,writeInt64OffPtr)
#endif
cpphs-1.16/tests/stringise 0000755 2056640 0024421 00000000055 12075315473 015607 0 ustar 1341796 Domain Users #define foo(x) This is #x foo x
foo(abcd ef)
cpphs-1.16/tests/symbolvalue 0000755 2056640 0024421 00000000054 12075315473 016141 0 ustar 1341796 Domain Users #if XXX
the symbol is defined as XXX
#endif
cpphs-1.16/tests/Test.hsc 0000755 2056640 0024421 00000000317 12075315473 015274 0 ustar 1341796 Domain Users module Test where
main :: IO ()
main = putStrLn "shows a cpphs+hsc2hs bug with comments"
#def inline int that_one_will_work(void) {return 42;}
{-
#def inline int cpphs_will_stumble(void) {return 42;}
-}
cpphs-1.16/tests/testfile 0000755 2056640 0024421 00000000621 12075315473 015416 0 ustar 1341796 Domain Users 1 top of file
#define X 0
3
#ifdef X
5 X is defined
#endif
7
#if X
9 X is non-zero
#endif
11
#if error
#error "error message goes here"
#endif
15
#if warning
#warning "warning message goes here"
#endif
19
#if include
#include "inclusion"
#else
23 no inclusion, this is an else clause
#endif
25
#if noelif
27 no elif
#elif elif
29 this is an elif
#else
31 third branch of elif
#endif
33
34 end of file
cpphs-1.16/tests/text 0000755 2056640 0024421 00000001210 12075315473 014556 0 ustar 1341796 Domain Users Here is some ordinary text with embedded Haskell-ish constructs,
that should however /not/ be interpreted as Haskell if the --text
option is given to cpphs. For instance, here is a Haskell comment
including a cpp definition: {-
# define FOO bar
and now we end the comment: -} and try out the definition: FOO
Likewise, double and single quotes no longer delimit strings or chars: "
# define BAZ FOO
and what do we have here?: " ' BAZ '
# define expand(a,b,c) Some text including a, the b, and c.
Also, in text-mode, macros should be expanded inside Haskell comments:
-- expand(this,other,that)
and strings "expand(this,other,that)".
cpphs-1.16/tests/undef.hs 0000755 2056640 0024421 00000000060 12075315473 015306 0 ustar 1341796 Domain Users #define FOO 3
wibble FOO
#undef FOO
this is FOO
cpphs-1.16/tests/wrongline 0000755 2056640 0024421 00000000073 12075315473 015604 0 ustar 1341796 Domain Users #define whereami __LINE__
whereami
#line 20 "foo"
__LINE__
cpphs-1.16/Text/ 0000755 2056640 0024421 00000000000 12077544327 013440 5 ustar 1341796 Domain Users cpphs-1.16/Text/ParserCombinators/ 0000755 2056640 0024421 00000000000 12077544327 017075 5 ustar 1341796 Domain Users cpphs-1.16/Text/ParserCombinators/HuttonMeijer.hs 0000755 2056640 0024421 00000016731 12075315473 022055 0 ustar 1341796 Domain Users -----------------------------------------------------------------------------
-- |
-- Module : ParseLib
-- Copyright : ...
-- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
--
-- Maintainer : Malcolm Wallace
-- Stability : Stable
-- Portability : All
--
-- A LIBRARY OF MONADIC PARSER COMBINATORS
--
-- 29th July 1996
--
-- Graham Hutton Erik Meijer
-- University of Nottingham University of Utrecht
--
-- This Haskell script defines a library of parser combinators, and is
-- taken from sections 1-6 of our article "Monadic Parser Combinators".
-- Some changes to the library have been made in the move from Gofer
-- to Haskell:
--
-- * Do notation is used in place of monad comprehension notation;
--
-- * The parser datatype is defined using "newtype", to avoid the overhead
-- of tagging and untagging parsers with the P constructor.
-----------------------------------------------------------------------------
module Text.ParserCombinators.HuttonMeijer
(Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
sepby, sepby1, chainl,
chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
letter, alphanum, string, ident, nat, int, spaces, comment, junk,
skip, token, natural, integer, symbol, identifier) where
import Data.Char
import Control.Monad
infixr 5 +++
type Token = Char
---------------------------------------------------------
-- | The parser monad
newtype Parser a = P ([Token] -> [(a,[Token])])
instance Functor Parser where
-- map :: (a -> b) -> (Parser a -> Parser b)
fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
instance Monad Parser where
-- return :: a -> Parser a
return v = P (\inp -> [(v,inp)])
-- >>= :: Parser a -> (a -> Parser b) -> Parser b
(P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
-- fail :: String -> Parser a
fail _ = P (\_ -> [])
instance MonadPlus Parser where
-- mzero :: Parser a
mzero = P (\_ -> [])
-- mplus :: Parser a -> Parser a -> Parser a
(P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
-- ------------------------------------------------------------
-- * Other primitive parser combinators
-- ------------------------------------------------------------
item :: Parser Token
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
first :: Parser a -> Parser a
first (P p) = P (\inp -> case p inp of
[] -> []
(x:_) -> [x])
papply :: Parser a -> [Token] -> [(a,[Token])]
papply (P p) inp = p inp
-- ------------------------------------------------------------
-- * Derived combinators
-- ------------------------------------------------------------
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = first (p `mplus` q)
sat :: (Token -> Bool) -> Parser Token
sat p = do {x <- item; if p x then return x else mzero}
--tok :: Token -> Parser Token
--tok t = do {x <- item; if t==snd x then return t else mzero}
many :: Parser a -> Parser [a]
many p = many1 p +++ return []
--many p = force (many1 p +++ return [])
many1 :: Parser a -> Parser [a]
many1 p = do {x <- p; xs <- many p; return (x:xs)}
sepby :: Parser a -> Parser b -> Parser [a]
p `sepby` sep = (p `sepby1` sep) +++ return []
sepby1 :: Parser a -> Parser b -> Parser [a]
p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op v = (p `chainl1` op) +++ return v
chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainl1` op = do {x <- p; rest x}
where
rest x = do {f <- op; y <- p; rest (f x y)}
+++ return x
chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainr p op v = (p `chainr1` op) +++ return v
chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainr1` op = do {x <- p; rest x}
where
rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
+++ return x
ops :: [(Parser a, b)] -> Parser b
ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
bracket :: Parser a -> Parser b -> Parser c -> Parser b
bracket open p close = do {open; x <- p; close; return x}
-- ------------------------------------------------------------
-- * Useful parsers
-- ------------------------------------------------------------
char :: Char -> Parser Char
char x = sat (\y -> x == y)
digit :: Parser Char
digit = sat isDigit
lower :: Parser Char
lower = sat isLower
upper :: Parser Char
upper = sat isUpper
letter :: Parser Char
letter = sat isAlpha
alphanum :: Parser Char
alphanum = sat isAlphaNum +++ char '_'
string :: String -> Parser String
string "" = return ""
string (x:xs) = do {char x; string xs; return (x:xs)}
ident :: Parser String
ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
nat :: Parser Int
nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
where
m `op` n = 10*m + n
int :: Parser Int
int = do {char '-'; n <- nat; return (-n)} +++ nat
-- ------------------------------------------------------------
-- * Lexical combinators
-- ------------------------------------------------------------
spaces :: Parser ()
spaces = do {many1 (sat isSpace); return ()}
comment :: Parser ()
--comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
--comment = do
-- _ <- string "--"
-- _ <- many (sat (\x -> x /= '\n'))
-- return ()
comment = do
bracket (string "/*") (many item) (string "*/")
return ()
junk :: Parser ()
junk = do {many (spaces +++ comment); return ()}
skip :: Parser a -> Parser a
skip p = do {junk; p}
token :: Parser a -> Parser a
token p = do {v <- p; junk; return v}
-- ------------------------------------------------------------
-- * Token parsers
-- ------------------------------------------------------------
natural :: Parser Int
natural = token nat
integer :: Parser Int
integer = token int
symbol :: String -> Parser String
symbol xs = token (string xs)
identifier :: [String] -> Parser String
identifier ks = token (do {x <- ident;
if not (elem x ks) then return x
else return mzero})
------------------------------------------------------------------------------