alex (empty) → 2.1.0
raw patch · 55 files changed
+7404/−0 lines, 55 filesdep +basedep +haskell98build-type:Customsetup-changed
Dependencies added: base, haskell98
Files
- ANNOUNCE +21/−0
- LICENSE +30/−0
- README +31/−0
- Setup.lhs +117/−0
- TODO +31/−0
- alex.cabal +71/−0
- alex.spec +49/−0
- doc/Makefile +6/−0
- doc/aclocal.m4 +174/−0
- doc/alex.1.in +111/−0
- doc/alex.xml +1394/−0
- doc/config.mk.in +15/−0
- doc/configure.ac +12/−0
- doc/docbook-xml.mk +130/−0
- doc/fptools.css +36/−0
- examples/Makefile +31/−0
- examples/Tokens.x +34/−0
- examples/Tokens_gscan.x +40/−0
- examples/Tokens_posn.x +40/−0
- examples/examples.x +19/−0
- examples/haskell.x +172/−0
- examples/lit.x +47/−0
- examples/pp.x +38/−0
- examples/state.x +32/−0
- examples/tiny.y +69/−0
- examples/tkns.hs +5/−0
- examples/words.x +17/−0
- examples/words_monad.x +28/−0
- examples/words_posn.x +17/−0
- src/AbsSyn.hs +263/−0
- src/CharSet.hs +56/−0
- src/DFA.hs +245/−0
- src/DFS.hs +136/−0
- src/Info.hs +64/−0
- src/Main.hs +318/−0
- src/Map.hs +67/−0
- src/NFA.hs +223/−0
- src/Output.hs +336/−0
- src/ParseMonad.hs +127/−0
- src/Parser.hs +1130/−0
- src/Parser.y +218/−0
- src/Scan.hs +354/−0
- src/Scan.x +216/−0
- src/Set.hs +14/−0
- src/Sort.hs +69/−0
- src/Util.hs +38/−0
- src/ghc_hooks.c +5/−0
- templates/GenericTemplate.hs +221/−0
- templates/Makefile +67/−0
- templates/wrappers.hs +180/−0
- tests/Makefile +39/−0
- tests/simple.x +73/−0
- tests/tokens.x +40/−0
- tests/tokens_gscan.x +44/−0
- tests/tokens_posn.x +44/−0
+ ANNOUNCE view
@@ -0,0 +1,21 @@+I am pleased to announce version 2.1.0 of Alex, the lexical analyser+generator for Haskell.++Changes in Alex 2.1.0 vs. 2.0.1:++ * Switch to a Cabal build system: you need a recent version of Cabal+ (1.1.6 or later). If you have GHC 6.4.2, then you need to upgrade+ Cabal before building Alex. GHC 6.6 is fine.++ * Slight change in the error semantics: the input returned on error+ is before the erroneous character was read, not after. This helps+ to give better error messages.++Distributions can be obtained from Alex's home page:++ http://www.haskell.org/alex/++Alex is distributed under a BSD-style license.++Cheers,+ Simon
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 1995-2003, Chris Dornan and Simon Marlow+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders, nor the names of the+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,31 @@+ Alex: A Lexical Analyser Generator++ Version 2.0++ 8 August 2003+++Alex is a Lex-like tool for generating Haskell scanners. For complete+documentation, see the doc directory.++Alex version 2.0 has changed fairly considerably since version 1.x,+and the syntax is almost completely different. For a detailed list of+changes, see the CHANGES file.++Alex is now covered by a BSD-Style licence; see the licence file in+the `doc' directory for details.++The sources are in the the `src' directory and the documentation in the `doc'+directory; various examples are in the 'examples' subdirectory.++The source code in the 'src' and 'examples' directories is intended+for a Haskell 98 compiler with hierarchical modules. It should work+with an version of GHC >= 5.04.++Please report any bugs or comments to the email addresses given below.++Share and enjoy,++Chris Dornan: cdornan@arm.com+Isaac Jones: ijones@syntaxpolice.org+Simon Marlow: simonmar@microsoft.com
+ Setup.lhs view
@@ -0,0 +1,117 @@+#!/usr/bin/runhaskell++\begin{code}+module Main where++import Control.Exception ( finally )+import Distribution.PackageDescription ( PackageDescription )+import Distribution.Setup ( BuildFlags, CleanFlags, CopyDest(..), CopyFlags(..), InstallFlags )+import Distribution.Simple ( defaultMainWithHooks, defaultUserHooks, UserHooks(..), Args, compilerPath )+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), mkDataDir )+import System.Directory+import System.Exit ( ExitCode(..) )+import System.IO+import System.IO.Error+import System.Process+import System.Cmd+import Text.Printf ( printf )++main :: IO ()+main = defaultMainWithHooks defaultUserHooks{ postBuild = myPostBuild,+ postClean = myPostClean,+ postCopy = myPostCopy,+ postInst = myPostInstall }++myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode+myPostBuild _ _ _ lbi =+ excursion "templates" $ do+ let cpp_template src dst opts = do+ let dst_pp = dst ++ ".hspp"+ ghc = compilerPath (compiler lbi)+ ghc_args = ["-o", dst_pp, "-E", "-cpp", src] ++ opts+ -- hack to turn cpp-style '# 27 "GenericTemplate.hs"' into + -- '{-# LINE 27 "GenericTemplate.hs" #-}'.+ perl_args = ["-pe", "s/^#\\s+(\\d+)\\s+(\"[^\"]*\")/{-# LINE \\1 \\2 #-}/g;s/\\$(Id:.*)\\$/\\1/g", dst_pp]+ mb_perl <- findExecutable "perl"+ perl <- case mb_perl of+ Nothing -> ioError (userError "You need \"perl\" installed and on your PATH to complete the build")+ Just path -> return path+ do_cmd ghc ghc_args `cmd_seq` do_cmd_out perl perl_args dst++ cmd_seqs ([ cpp_template "GenericTemplate.hs" dst opts | (dst,opts) <- templates ] +++ [ cpp_template "wrappers.hs" dst opts | (dst,opts) <- wrappers ])++myPostClean :: Args -> CleanFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ExitCode+myPostClean _ _ _ _ =+ excursion "templates" $ do+ sequence [ try (removeFile f) >> try (removeFile (f ++ ".hspp"))+ | (f,_) <- all_templates]+ return ExitSuccess++myPostInstall :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode+myPostInstall _ _ pkg_descr lbi =+ install pkg_descr lbi NoCopyDest++myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode+myPostCopy _ copy_flags pkg_descr lbi = + install pkg_descr lbi (copyDest copy_flags)++install :: PackageDescription -> LocalBuildInfo -> CopyDest -> IO ExitCode+install pkg_descr lbi copy_dest =+ excursion "templates" $ do+ let dataDir = mkDataDir pkg_descr lbi copy_dest+ createDirectoryIfMissing True dataDir+ sequence [ copyFile f (dataDir ++ '/':f) | (f,_) <- all_templates ] + -- XXX: joinFileName+ return ExitSuccess++all_templates :: [(FilePath,[String])]+all_templates = templates ++ wrappers++templates :: [(FilePath,[String])]+templates = [+ ("AlexTemplate", []),+ ("AlexTemplate-ghc", ["-DALEX_GHC"]),+ ("AlexTemplate-ghc-debug", ["-DALEX_GHC","-DALEX_DEBUG"]),+ ("AlexTemplate-debug", ["-DALEX_DEBUG"])+ ]++wrappers :: [(FilePath,[String])]+wrappers = [+ ("AlexWrapper-basic", ["-DALEX_BASIC"]),+ ("AlexWrapper-posn", ["-DALEX_POSN"]),+ ("AlexWrapper-monad", ["-DALEX_MONAD"]),+ ("AlexWrapper-gscan", ["-DALEX_GSCAN"])+ ]++-- -----------------------------------------------------------------------------+-- Utils++do_cmd :: FilePath -> [String] -> IO ExitCode+do_cmd cmd args = do+ putStrLn (unwords (cmd:args))+ ph <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing+ waitForProcess ph++do_cmd_out :: FilePath -> [String] -> FilePath -> IO ExitCode+do_cmd_out cmd args outfile = do+ putStrLn (unwords (cmd:args))+ outh <- openFile outfile WriteMode+ ph <- runProcess cmd args Nothing Nothing Nothing (Just outh) Nothing+ waitForProcess ph++cmd_seq :: IO ExitCode -> IO ExitCode -> IO ExitCode+cmd_seq c1 c2 = do+ e <- c1+ case e of+ ExitSuccess -> c2+ _ -> return e++cmd_seqs :: [IO ExitCode] -> IO ExitCode+cmd_seqs = foldr cmd_seq (return ExitSuccess)++excursion :: FilePath -> IO a -> IO a+excursion d io = do+ cwd <- getCurrentDirectory+ (do setCurrentDirectory d; io) `finally` setCurrentDirectory cwd+\end{code}
+ TODO view
@@ -0,0 +1,31 @@+- Option for pure Haskell 98 output?++- Extend to Unicode (32-bit Char)++- Put in {-# LINE #-} pragmas for token actions++- bug: we throw away the first character of code++- Prune states that aren't reachable?++- Issues a warning for tokens that can't be generated?++- Info file?+ - start codes+ - accepting states++- More compact lexer table encoding:+ - equivalence classes?++- Improve performance of Alex itself++- AlexEOF doesn't provide a way to get at the text position of the EOF.++- AlexState should include some user state - would make this monad+ more useful in general.++- Allow user-defined wrappers? Wrappers in files relative to the+ current directory, for example?++- case-insensitivity option (like flex's -i).+
+ alex.cabal view
@@ -0,0 +1,71 @@+name: alex+version: 2.1.0+license: BSD3+license-file: LICENSE+copyright: (c) Chis Dornan, Simon Marlow+author: Chris Dornan and Simon Marlow+maintainer: Simon Marlow <simonmar@microsoft.com>+stability: stable+homepage: http://www.haskell.org/alex/+synopsis: Alex is a tool for generating lexical analysers in Haskell+build-depends: base>=1.0, haskell98>=1.0+extra-source-files:+ ANNOUNCE+ README+ TODO+ alex.spec+ doc/Makefile+ doc/aclocal.m4+ doc/alex.1.in+ doc/alex.xml+ doc/config.mk.in+ doc/configure.ac+ doc/docbook-xml.mk+ doc/fptools.css+ examples/Makefile+ examples/Tokens.x+ examples/Tokens_gscan.x+ examples/Tokens_posn.x+ examples/examples.x+ examples/haskell.x+ examples/lit.x+ examples/pp.x+ examples/state.x+ examples/tiny.y+ examples/tkns.hs+ examples/words.x+ examples/words_monad.x+ examples/words_posn.x+ src/Parser.y+ src/Scan.hs+ src/ghc_hooks.c+ templates/GenericTemplate.hs+ templates/Makefile+ templates/wrappers.hs+ tests/Makefile+ tests/simple.x+ tests/tokens.x+ tests/tokens_gscan.x+ tests/tokens_posn.x++executable: alex+hs-source-dirs: src+main-is: Main.hs+extensions: CPP+other-modules:+ AbsSyn+ CharSet+ DFA+ DFS+ Info+ Main+ Map+ NFA+ Output+ Parser+ ParseMonad+ Scan+ Set+ Sort+ Util+ghc-options: -O
+ alex.spec view
@@ -0,0 +1,49 @@+%define name alex+%define version 2.1.0+%define release 1++Name: %{name}+Version: %{version}+Release: %{release}+License: BSD-like+Group: Development/Languages/Haskell+URL: http://haskell.org/alex/+Source: http://haskell.org/alex/dist/%{version}/alex-%{version}.tar.gz+Packager: Sven Panne <sven.panne@aedion.de>+BuildRoot: %{_tmppath}/%{name}-%{version}-build+Prefix: %{_prefix}+BuildRequires: happy, ghc, docbook-dtd, docbook-xsl-stylesheets, libxslt, libxml2, fop, xmltex, dvips+Summary: The lexer generator for Haskell++%description+Alex is a tool for generating lexical analysers in Haskell, given a+description of the tokens to be recognised in the form of regular+expressions. It is similar to the tool lex or flex for C/C++.++%prep+%setup -n alex-%{version}++%build+runhaskell Setup.lhs configure --prefix=%{prefix}+runhaskell Setup.lhs build+cd doc+test -f configure || autoreconf+./configure+make html++%install+runhaskell Setup.lhs copy --destdir=${RPM_BUILD_ROOT}++%clean+rm -rf ${RPM_BUILD_ROOT}++%files+%defattr(-,root,root)+%doc ANNOUNCE+%doc LICENSE+%doc README+%doc TODO+%doc doc/alex+%doc examples+%{prefix}/bin/alex+%{prefix}/share/alex-%{version}
+ doc/Makefile view
@@ -0,0 +1,6 @@+include config.mk++XML_DOC = alex+INSTALL_XML_DOC = alex++include docbook-xml.mk
+ doc/aclocal.m4 view
@@ -0,0 +1,174 @@+# FP_GEN_DOCBOOK_XML+# ------------------+# Generates a DocBook XML V4.2 document in conftest.xml.+AC_DEFUN([FP_GEN_DOCBOOK_XML],+[rm -f conftest.xml+cat > conftest.xml << EOF+<?xml version="1.0" encoding="iso-8859-1"?>+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">+<book id="test">+ <title>A DocBook Test Document</title>+ <chapter id="id-one">+ <title>A Chapter Title</title>+ <para>This is a paragraph, referencing <xref linkend="id-two"/>.</para>+ </chapter>+ <chapter id="id-two">+ <title>Another Chapter Title</title>+ <para>This is another paragraph, referencing <xref linkend="id-one"/>.</para>+ </chapter>+</book>+EOF+]) # FP_GEN_DOCBOOK_XML+++# FP_PROG_XSLTPROC+# ----------------+# Sets the output variable XsltprocCmd to the full path of the XSLT processor+# xsltproc. XsltprocCmd is empty if xsltproc could not be found.+AC_DEFUN([FP_PROG_XSLTPROC],+[AC_PATH_PROG([XsltprocCmd], [xsltproc])+if test -z "$XsltprocCmd"; then+ AC_MSG_WARN([cannot find xsltproc in your PATH, you will not be able to build the documentation])+fi+])# FP_PROG_XSLTPROC+++# FP_DIR_DOCBOOK_XSL(XSL-DIRS)+# ----------------------------+# Check which of the directories XSL-DIRS contains DocBook XSL stylesheets. The+# output variable DIR_DOCBOOK_XSL will contain the first usable directory or+# will be empty if none could be found.+AC_DEFUN([FP_DIR_DOCBOOK_XSL],+[AC_REQUIRE([FP_PROG_XSLTPROC])dnl+if test -n "$XsltprocCmd"; then+ AC_CACHE_CHECK([for DocBook XSL stylesheet directory], fp_cv_dir_docbook_xsl,+ [FP_GEN_DOCBOOK_XML+ fp_cv_dir_docbook_xsl=no+ for fp_var in $1; do+ if $XsltprocCmd ${fp_var}/html/docbook.xsl conftest.xml > /dev/null 2>&1; then+ fp_cv_dir_docbook_xsl=$fp_var+ break+ fi+ done+ rm -rf conftest*])+fi+if test x"$fp_cv_dir_docbook_xsl" = xno; then+ AC_MSG_WARN([cannot find DocBook XSL stylesheets, you will not be able to build the documentation])+ DIR_DOCBOOK_XSL=+else+ DIR_DOCBOOK_XSL=$fp_cv_dir_docbook_xsl+fi+AC_SUBST([DIR_DOCBOOK_XSL])+])# FP_DIR_DOCBOOK_XSL+++# FP_PROG_XMLLINT+# ----------------+# Sets the output variable XmllintCmd to the full path of the XSLT processor+# xmllint. XmllintCmd is empty if xmllint could not be found.+AC_DEFUN([FP_PROG_XMLLINT],+[AC_PATH_PROG([XmllintCmd], [xmllint])+if test -z "$XmllintCmd"; then+ AC_MSG_WARN([cannot find xmllint in your PATH, you will not be able to validate your documentation])+fi+])# FP_PROG_XMLLINT+++# FP_CHECK_DOCBOOK_DTD+# --------------------+AC_DEFUN([FP_CHECK_DOCBOOK_DTD],+[AC_REQUIRE([FP_PROG_XMLLINT])dnl+if test -n "$XmllintCmd"; then+ AC_MSG_CHECKING([for DocBook DTD])+ FP_GEN_DOCBOOK_XML+ if $XmllintCmd --valid --noout conftest.xml > /dev/null 2>&1; then+ AC_MSG_RESULT([ok])+ else+ AC_MSG_RESULT([failed])+ AC_MSG_WARN([cannot find a DTD for DocBook XML V4.2, you will not be able to validate your documentation])+ AC_MSG_WARN([check your XML_CATALOG_FILES environment variable and/or /etc/xml/catalog])+ fi+ rm -rf conftest*+fi+])# FP_CHECK_DOCBOOK_DTD+++# FP_GEN_FO+# ------------------+# Generates a formatting objects document in conftest.fo.+AC_DEFUN([FP_GEN_FO],+[rm -f conftest.fo+cat > conftest.fo << EOF+<?xml version="1.0"?>+<fo:root xmlns:fo="http://www.w3.org/1999/XSL/Format">+ <fo:layout-master-set>+ <fo:simple-page-master master-name="blank">+ <fo:region-body/>+ </fo:simple-page-master>+ </fo:layout-master-set>+ <fo:page-sequence master-reference="blank">+ <fo:flow flow-name="xsl-region-body">+ <fo:block>+ Test!+ </fo:block>+ </fo:flow>+ </fo:page-sequence>+</fo:root>+EOF+]) # FP_GEN_FO+++# FP_PROG_FOP+# -----------+# Set the output variable 'FopCmd' to the first working 'fop' in the current+# 'PATH'. Note that /usr/bin/fop is broken in SuSE 9.1 (unpatched), so try+# /usr/share/fop/fop.sh in that case (or no 'fop'), too.+AC_DEFUN([FP_PROG_FOP],+[AC_PATH_PROGS([FopCmd1], [fop])+if test -n "$FopCmd1"; then+ AC_CACHE_CHECK([for $FopCmd1 usability], [fp_cv_fop_usability],+ [FP_GEN_FO+ if "$FopCmd1" -fo conftest.fo -ps conftest.ps > /dev/null 2>&1; then+ fp_cv_fop_usability=yes+ else+ fp_cv_fop_usability=no+ fi+ rm -rf conftest*])+ if test x"$fp_cv_fop_usability" = xyes; then+ FopCmd=$FopCmd1+ fi+fi+if test -z "$FopCmd"; then+ AC_PATH_PROGS([FopCmd2], [fop.sh], , [/usr/share/fop])+ FopCmd=$FopCmd2+fi+AC_SUBST([FopCmd])+])# FP_PROG_FOP+++# FP_PROG_FO_PROCESSOR+# --------------------+# Try to find an FO processor. PassiveTeX output is sometimes a bit strange, so+# try FOP first. Sets the output variables FopCmd, XmltexCmd, DvipsCmd, and+# PdfxmltexCmd.+AC_DEFUN([FP_PROG_FO_PROCESSOR],+[AC_REQUIRE([FP_PROG_FOP])+AC_PATH_PROG([XmltexCmd], [xmltex])+AC_PATH_PROG([DvipsCmd], [dvips])+if test -z "$FopCmd"; then+ if test -z "$XmltexCmd"; then+ AC_MSG_WARN([cannot find an FO => DVI converter, you will not be able to build DVI or PostScript documentation])+ else+ if test -z "$DvipsCmd"; then+ AC_MSG_WARN([cannot find a DVI => PS converter, you will not be able to build PostScript documentation])+ fi+ fi+ AC_PATH_PROG([PdfxmltexCmd], [pdfxmltex])+ if test -z "$PdfxmltexCmd"; then+ AC_MSG_WARN([cannot find an FO => PDF converter, you will not be able to build PDF documentation])+ fi+elif test -z "$XmltexCmd"; then+ AC_MSG_WARN([cannot find an FO => DVI converter, you will not be able to build DVI documentation])+fi+])# FP_PROG_FO_PROCESSOR
+ doc/alex.1.in view
@@ -0,0 +1,111 @@+.TH ALEX 1 "2003-09-09" "Glasgow FP Suite" "Alex Lexical Analyser Generator" +.SH NAME +alex \- the lexical analyser generator for Haskell + +.SH SYNOPSIS +.B alex +[\fIOPTION\fR]... \fIfile\fR [\fIOPTION\fR]... + +.SH DESCRIPTION +This manual page documents briefly the +.BR alex +command. + +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. Instead, it +has documentation in various other formats, including DVI, Info and +HTML; see below. + +.PP +.B Alex +is a lexical analyser generator system for Haskell. It is similar to the +tool lex or flex for C/C++. + +.PP +Input files are expected to be of the form +.I file.x +and +.B alex +will produce output in +.I file.y + +.PP +Caveat: When using +.I hbc +(Chalmers Haskell) the command argument structure is slightly +different. This is because the hbc run time system takes some flags +as its own (for setting things like the heap size, etc). This problem +can be circumvented by adding a single dash (`-') to your command +line. So when using a hbc generated version of Alex, the argument +structure is: + +.B alex \- +[\fIOPTION\fR]... \fIfile\fR [\fIOPTION\fR]... + +.SH OPTIONS +The programs follow the usual GNU command line syntax, with long +options starting with two dashes (`--'). A summary of options is +included below. For a complete description, see the other +documentation. + +.TP +.BR \-d ", " \-\-debug +Instructs Alex to generate a lexer which will output debugging messsages +as it runs. + +.TP +.BR \-g ", " \-\-ghc +Instructs Alex to generate a lexer which is optimised for compiling with +GHC. The lexer will be significantly more efficient, both in terms of +the size of the compiled lexer and its runtime. + +.TP +\fB\-o\fR \fIFILE\fR, \fB\-\-outfile=\fIFILE +Specifies the filename in which the output is to be placed. By default, +this is the name of the input file with the +.I .x +suffix replaced by +.I .hs + +.TP +\fB\-i\fR [\fIFILE\fR], \fB\-\-info\fR[=\fIFILE\fR] +Produces a human-readable rendition of the state machine (DFA) that +Alex derives from the lexer, in +.I FILE +(default: +.I file.info +where the input file is +.I file.x +). + +The format of the info file is currently a bit basic, and not +particularly informative. + +.TP +.BR \-v ", " \-\-version +Print version information on standard output then exit successfully. + +.SH FILES +.I @LIBDIR@ + +.SH "SEE ALSO" +.BR @DOCDIR@ , +the Alex homepage +.UR http://haskell.org/alex/ +(http://haskell.org/alex/) +.UE + +.SH COPYRIGHT +Alex Version @VERSION@ + +Copyright (c) 1995-2003, Chris Dornan and Simon Marlow + +.SH AUTHOR +This manual page was written by Ian Lynagh +<igloo@debian.org>, based on the happy manpage, for the Debian GNU/Linux +system (but may be used by others). + +.\" Local variables: +.\" mode: nroff +.\" End:
+ doc/alex.xml view
@@ -0,0 +1,1394 @@+<?xml version="1.0" encoding="iso-8859-1"?>+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">++<book id="alex">++ <bookinfo>+ <date>2003-8-11</date>+ <title>Alex User Guide</title>+ <author>+ <firstname>Chris</firstname>+ <surname>Dornan</surname>+ </author>+ <author>+ <firstname>Isaac</firstname>+ <surname>Jones</surname>+ </author>+ <author>+ <firstname>Simon</firstname>+ <surname>Marlow</surname>+ </author>+ <address><email>ijones@syntaxpolice.org</email></address>+ <!-- <copyright> -->+ <!-- <year>1997-2001</year> -->+ <!-- <holder>Simon Marlow</holder> -->+ <!-- </copyright> -->++ <abstract>+ <para>Alex is a tool for generating lexical analysers in+ Haskell, given a description of the tokens to be recognised in+ the form of regular expressions. It is similar to the tool+ <quote>lex</quote> or <quote>flex</quote> for C/C++.</para>+ </abstract>+ </bookinfo>++ <!-- Table of contents -->+ <toc></toc>++ <chapter id="about">+ <title>About Alex</title>++ <para>Alex can always be obtained from its <ulink+ url="http://www.haskell.org/alex">home page</ulink>. The latest+ source code lives in the <literal>fptools</literal> CVS+ repository; instructions on accessing that repository are <ulink+ url="http://www.haskell.org/ghc/docs/latest/html/building/sec-cvs.html">here</ulink>.</para>++ <section id="relnotes-210">+ <title>Release Notes for version 2.1.0</title>++ <itemizedlist>+ <listitem>+ <para>Switch to a Cabal build system: you need a recent+ version of Cabal (1.1.6 or later). If you have GHC 6.4.2,+ then you need to upgrade Cabal before building Alex. GHC+ 6.6 is fine.</para>+ </listitem>++ <listitem>+ <para>Slight change in the error semantics: the input+ returned on error is before the erroneous character was+ read, not after. This helps to give better error+ messages.</para>+ </listitem>+ </itemizedlist>+ </section>++ <section id="relnotes-20">+ <title>Release Notes for version 2.0</title>+ + <para>Alex has changed a <emphasis>lot</emphasis> between+ versions 1.x and 2.0. The following is supposed to be an+ exhaustive list of the changes:</para>++ <section id="changes-syntax">+ <title>Syntax changes</title>++ <itemizedlist>+ <listitem>+ <para>Code blocks are now surrounded by+ <literal>{...}</literal> rather than+ <literal>%{...%}</literal>.</para>+ </listitem>++ <listitem>+ <para>Character-set macros now begin with+ ‘<literal>$</literal>’ instead of+ ‘<literal>^</literal>’ and have+ multi-character names.</para>+ </listitem>++ <listitem>+ <para>Regular expression macros now begin with+ ‘<literal>@</literal>’ instead of+ ‘<literal>%</literal>’ and have+ multi-character names.</para>+ </listitem>++ <listitem>+ <para>Macro definitions are no longer surrounded by+ <literal>{ ... }</literal>.</para>+ </listitem>++ <listitem>+ <para>Rules are now of the form+<programlisting><c1,c2,...> regex { code }</programlisting>+ where <literal>c1</literal>, <literal>c2</literal> are+ startcodes, and <literal>code</literal> is an arbitrary+ Haskell expression.</para>+ </listitem>++ <listitem>+ <para>Regular expression syntax changes:</para>++ <itemizedlist>+ <listitem>+ <para><literal>()</literal> is the empty regular+ expression (used to be+ ‘<literal>$</literal>’)</para>+ </listitem>++ <listitem>+ <para>set complement can now be expressed as+ <literal>[^sets]</literal> (for similarity with lex+ regular expressions).</para>+ </listitem>++ <listitem>+ <para>The <literal>'abc'</literal> form is no longer+ available, use <literal>[abc]</literal>+ instead.</para>+ </listitem>++ <listitem>+ <para>‘<literal>^</literal>’ and+ ‘<literal>$</literal>’ have the usual+ meanings: ‘<literal>^</literal>’ matches+ just after a ‘<literal>\n</literal>’, and+ ‘<literal>$</literal>’ matches just before+ a ‘<literal>\n</literal>’.</para>+ </listitem>++ <listitem>+ <para>‘<literal>\n</literal>’ is now the+ escape character, not+ ‘<literal>^</literal>’.</para>+ </listitem>++ <listitem>+ <para>The form <literal>"..."</literal> means the same+ as the sequence of characters inside the quotes, the+ difference being that special characters do not need+ to be escaped inside <literal>"..."</literal>.</para>+ </listitem>+ </itemizedlist>+ </listitem>++ <listitem>+ <para>Rules can have arbitrary predicates attached to+ them. This subsumes the previous left-context and+ right-context facilities (although these are still allowed+ as syntactic sugar).</para>+ </listitem>+ </itemizedlist>+ </section>++ <section id="changes-files">+ <title>Changes in the form of an Alex file</title>++ <itemizedlist>+ <listitem>+ <para>Each file can now only define a single grammar.+ This change was made to simplify code generation.+ Multiple grammars can be simulated using startcodes, or+ split into separate modules.</para>+ </listitem>++ <listitem>+ <para>The programmer experience has been simplified, and+ at the same time made more flexible. See the <xref+ linkend="api"/> for details.</para>+ </listitem>++ <listitem>+ <para>You no longer need to import the+ <literal>Alex</literal> module.</para>+ </listitem>+ </itemizedlist>+ </section>++ <section id="changes-usage">+ <title>Usage changes</title>+ + <para>The command-line syntax is quite different. See <xref+ linkend="invoking"/>.</para>+ </section>++ <section id="changes-implementation">+ <title>Implementation changes</title>+ + <itemizedlist>+ <listitem>+ <para>A more efficient table representation, coupled with+ standard table-compression techniques, are used to keep+ the size of the generated code down.</para>+ </listitem>++ <listitem>+ <para>When compiling a grammar with GHC, the -g switch+ causes an even faster and smaller grammar to be+ generated.</para>+ </listitem>++ <listitem>+ <para>Startcodes are implemented in a different way: each+ state corresponds to a different initial state in the DFA,+ so the scanner doesn't have to check the startcode when it+ gets to an accept state. This results in a larger, but+ quicker, scanner.</para>+ </listitem>+ </itemizedlist>+ </section>+ </section>++ <section id="bug-reports">+ <title>Reporting bugs in Alex</title>++ <para>Please report bugs in Alex to+ <email>simonmar@microsoft.com</email>. There are no specific+ mailing lists for the discussion of Alex-related matters, but+ such topics should be fine on the <ulink+ url="http://www.haskell.org/mailman/listinfo/haskell">Haskell</ulink>+ and <ulink+ url="http://www.haskell.org/mailman/listinfo/haskell-cafe">Haskell+ Cafe</ulink> mailing lists.</para>+ </section>++ <section id="license">+ <title>License</title>++ <para>Copyright (c) 1995-2003, Chris Dornan and Simon Marlow.+ All rights reserved.</para>++ <para>Redistribution and use in source and binary forms, with or+ without modification, are permitted provided that the following+ conditions are met:</para>++ <itemizedlist>+ <listitem>+ <para>Redistributions of source code must retain the above+ copyright notice, this list of conditions and the following+ disclaimer.</para>+ </listitem>++ <listitem>+ <para>Redistributions in binary form must reproduce the+ above copyright notice, this list of conditions and the+ following disclaimer in the documentation and/or other+ materials provided with the distribution.</para>+ </listitem>++ <listitem>+ <para>Neither the name of the copyright holders, nor the+ names of the contributors may be used to endorse or promote+ products derived from this software without specific prior+ written permission.</para>+ </listitem>+ </itemizedlist>++ <para>THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+ DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF+ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED+ AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF+ THE POSSIBILITY OF SUCH DAMAGE.</para>+ </section>+ </chapter>++ <chapter id="introduction">+ <title>Introduction</title>++ <para>Alex is a tool for generating lexical analysers in Haskell,+ given a description of the tokens to be recognised in the form of+ regular expressions. It is similar to the tools+ lex and flex for C/C++.</para>++ <para>Alex takes a description of tokens based on regular+ expressions and generates a Haskell module containing code for+ scanning text efficiently. Alex is designed to be familiar to+ exisiting lex users, although it does depart from lex in a number+ of ways.</para>++ <figure id="fig-tokens" float="1"><title>A simple Alex specification.</title>+<programlisting>{+module Main (main) where+}++%wrapper "basic"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { \s -> Let }+ in { \s -> In }+ $digit+ { \s -> Int (read s) }+ [\=\+\-\*\/\(\)] { \s -> Sym (head s) }+ $alpha [$alpha $digit \_ \']* { \s -> Var s }++{+-- Each action has type :: String -> Token++-- The token type:+data Token =+ Let |+ In |+ Sym Char |+ Var String |+ Int Int+ deriving (Eq,Show)++main = do+ s <- getContents+ print (alexScanTokens s)+}</programlisting></figure>++ <para>A sample specification is given in <xref+ linkend="fig-tokens"/>. The first few lines between the+ <literal>{</literal> and <literal>}</literal> provide a code scrap+ (some inlined Haskell code) to be placed directly in the output,+ the scrap at the top of the module is normally used to declare the+ module name for the generated Haskell module, in this case+ <literal>Main</literal>.</para>++ <para>The next line, <literal>%wrapper "basic"</literal> controls+ what kind of support code Alex should produce along with the basic+ scanner. The <literal>basic</literal> wrapper selects a scanner+ that tokenises a <literal>String</literal> and returns a list of+ tokens. Wrappers are described fully in <xref+ linkend="api"/>.</para>++ <para>The next two lines define the <literal>$digit</literal> and+ <literal>$alpha</literal> macros for use in the token+ definitions.</para>++ <para>The ‘<literal>tokens :-</literal>’ line ends the+ macro definitions and starts the definition of the scanner.</para>++ <para>The scanner is specified as a series of token definitions+ where each token specification takes the form of</para>++<programlisting><replaceable>regexp</replaceable> { <replaceable>code</replaceable> }</programlisting>++ <para>The meaming of a this rule is "if the input matches+ <replaceable>regexp</replaceable>, then return+ <replaceable>code</replaceable>". The code part along with the+ braces can be replaced by simply+ ‘<literal>;</literal>’, meaning that this token should+ be ignored in the input stream. As you can see, we've used this+ to ignore whitespace in our example.</para>++ <para>Our scanner is set up so that the actions are all functions+ with type <literal>String->Token</literal>. When the token is+ matched, the portion of the input stream that it matched is passed+ to the appropriate action function as a+ <literal>String</literal>.</para>++ <para>At the bottom of the file we have another code fragment,+ surrounded by braces <literal>{ ... }</literal>. In this+ fragment, we declare the type of the tokens, and give a+ <literal>main</literal> function that we can use for testing it;+ the <literal>main</literal> function just tokenises the input and+ prints the results to standard output.</para>++ <para>Alex has kindly provided the following function which we can+ use to invoke the scanner:</para>++<programlisting>alexScanTokens :: String -> [Token]</programlisting>++ <para>Alex arranges for the input stream to be tokenised, each of+ the action functions to be passed the appriate+ <literal>String</literal>, and a list of <literal>Token</literal>s+ returned as the result. If the input stream is lazy, the output+ stream will also be produced lazily<footnote><para>that is, unless you+ have any patterns that require a long lookahead.</para>+ </footnote>.</para>++ <para>We have demonstrated the simplest form of scanner here,+ which was selected by the <literal>%wrapper "basic"</literal> line+ near the top of the file. In general, actions do not have to have+ type <literal>String->Token</literal>, and there's no requirement+ for the scanner to return a list of tokens.</para>++ <para>With this specification in the file+ <literal>Tokens.x</literal>, Alex can be used to generate+ <literal>Tokens.hs</literal>:</para>++<screen>$ alex Tokens.x</screen>++ <para>If the module needed to be placed in different file,+ <literal>Main.hs</literal> for example, then the output filename+ can be specified using the <option>-o</option> option:</para>++<screen>$ alex Tokens.x -o Main.hs</screen>++ <para>The resulting module is Haskell 98 compatible. It can also+ be readily used with a <ulink+ url="http://www.haskell.org/happy/">Happy</ulink> parser.</para>+ </chapter>++ <chapter id="syntax">+ <title>Alex Files</title>++ <para>In this section we describe the layout of an Alex lexical+ specification. We begin with the lexical syntax; elements of the+ lexical syntax are referred to throughout the rest of this+ documentation, so you may need to refer back to the following+ section several times.</para>++ <section id="lexical">+ <title>Lexical syntax</title>+ + <para>Alex's lexical syntax is given below. It is written as a+ set of macro definitions using Alex's own syntax. These macros+ are used in the BNF specification of the syntax later on.</para>++<programlisting>$digit = [0-9]+$octdig = [0-7]+$hexdig = [0-9A-Fa-f]+$special = [\.\;\,\$\|\*\+\?\#\~\-\{\}\(\)\[\]\^\/]+$graphic = $printable # $white++@string = \" ($graphic # \")* \"+@id = [A-Za-z][A-Za-z'_]*+@smac = '$' id+@rmac = '@' id+@char = ($graphic # $special) | @escape+@escape = '\\' ($printable | 'x' $hexdig+ | 'o' $octdig+ | $digit+)+@code = -- curly braces surrounding a Haskell code fragment</programlisting>+ </section>++ <section id="alex-files">+ <title>Syntax of Alex files</title>++ <para>In the following description of the Alex syntax, we use an+ extended form of BNF, where optional phrases are enclosed in+ square brackets (<literal>[ ... ]</literal>), and phrases which+ may be repeated zero or more times are enclosed in braces+ (<literal>{ ... }</literal>). Literal text is enclosed in+ single quotes.</para>++ <para>An Alex lexical specification is normally placed in a file+ with a <literal>.x</literal> extension. The overall layout of+ an Alex file is:</para>++<programlisting>alex := [ @code ] [ wrapper ] { macrodef } @id ':-' { rule } [ @code ]</programlisting>++ <para>The file begins and ends with optional code fragments.+ These code fragments are copied verbatim into the generated+ source file.</para>++ <para>At the top of the file, the code fragment is normally used+ to declare the module name and some imports, and that is all it+ should do: don't declare any functions or types in the top code+ fragment, because Alex may need to inject some imports of its+ own into the generated lexer code, and it does this by adding+ them directly after this code fragment in the output+ file.</para>++ <para>Next comes an optional wrapper specification:</para>++<programlisting>wrapper := '%wrapper' @string</programlisting>++ <para>wrappers are described in <xref+ linkend="wrappers"/>.</para>++ <section id="macrodefs">+ <title>Macro definitions</title>++ <para>Next, the lexer specification can contain a series of+ macro definitions. There are two kinds of macros,+ <firstterm>character set macros</firstterm>, which begin with+ a <literal>$</literal>, and <firstterm>regular expression+ macros</firstterm>, which begin with a <literal>@</literal>.+ A character set macro can be used wherever a character set is+ valid (see <xref linkend="charsets"/>), and a regular+ expression macro can be used wherever a regular expression is+ valid (see <xref linkend="regexps"/>).</para>++<programlisting>macrodef := @smac '=' set+ | @rmac '=' regexp</programlisting>+ </section>++ <section id="rules">+ <title>Rules</title>++ <para>The rules are heralded by the sequence+ ‘<literal><replaceable>id</replaceable> :-</literal>’+ in the file. It doesn't matter what you use for the+ identifer, it is just there for documentation purposes. In+ fact, it can be omitted, but the <literal>:-</literal> must be+ left in.</para>++ <para>The syntax of rules is as follows:</para>++<programlisting>rule := [ startcodes ] token+ | startcodes '{' { token } '}'++token := [ left_ctx ] regexp [ right_ctx ] rhs++rhs := @code | ';'</programlisting>++ <para>Each rule defines one token in the lexical+ specification. When the input stream matches the regular+ expression in a rule, the Alex lexer will return the value of+ the expression on the right hand side, which we call the+ <firstterm>action</firstterm>. The action can be any Haskell+ expression. Alex only places one restriction on actions: all+ the actions must have the same type. They can be values in a+ token type, for example, or possibly operations in a monad.+ More about how this all works is in <xref+ linkend="api"/>.</para>++ <para>The action may be missing, indicated by replacing it+ with ‘<literal>;</literal>’, in which case the+ token will be skipped in the input stream.</para>++ <para>Alex will always find the longest match. For example,+ if we have a rule that matches whitespace:</para>++<programlisting>$white+ ;</programlisting>++ <para>Then this rule will match as much whitespace at the+ beginning of the input stream as it can. Be careful: if we+ had instead written this rule as</para>++<programlisting>$white* ;</programlisting>++ <para>then it would also match the empty string, which would+ mean that Alex could never fail to match a rule!</para>++ <para>When the input stream matches more than one rule, the+ rule which matches the longest prefix of the input stream+ wins. If there are still several rules which match an equal+ number of characters, then the rule which appears earliest in+ the file wins.</para>++ <section id="contexts">+ <title>Contexts</title>+ + <para>Alex allows a left and right context to be placed on+ any rule:</para>+ +<programlisting>+left_ctx := '^'+ | set '^'++right_ctx := '$'+ | '/' regexp+ | '/' @code+</programlisting>++ <para>The left context matches the character which+ immediately precedes the token in the input stream. The+ character immediately preceding the beginning of the stream+ is assumed to be ‘<literal>\n</literal>’. The+ special left-context ‘<literal>^</literal>’ is+ shorthand for ‘<literal>\n^</literal>’.</para>++ <para>Right context is rather more general. There are three+ forms:</para>++ <variablelist>+ <varlistentry>+ <term>+ <literal>/ <replaceable>regexp</replaceable></literal>+ </term>+ <listitem>+ <para>This right-context causes the rule to match if+ and only if it is followed in the input stream by text+ which matches+ <replaceable>regexp</replaceable>.</para>++ <para>NOTE: this should be used sparingly, because it+ can have a serious impact on performance. Any time+ this rule <emphasis>could</emphasis> match, its+ right-context will be checked against the current+ input stream.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>$</literal></term>+ <listitem>+ <para>Equivalent to+ ‘<literal>/\n</literal>’.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>/ { ... }</literal></term>+ <listitem>+ <para>This form is called a+ <emphasis>predicate</emphasis> on the rule. The+ Haskell expression inside the curly braces should have+ type:+<programlisting>{ ... } :: user -- predicate state+ -> AlexInput -- input stream before the token+ -> Int -- length of the token+ -> AlexInput -- input stream after the token+ -> Bool -- True <=> accept the token</programlisting>+ Alex will only accept the token as matching if+ the predicate returns <literal>True</literal>.</para>++ <para>See <xref linkend="api"/> for the meaning of the+ <literal>AlexInput</literal> type. The+ <literal>user</literal> argument is available for+ passing into the lexer a special state which is used+ by predicates; to give this argument a value, the+ <literal>alexScanUser</literal> entry point to the+ lexer must be used (see <xref+ linkend="basic-api"/>).</para>+ </listitem>+ </varlistentry>+ </variablelist>+ </section>++ <section id="startcodes">+ <title>Start codes</title>+ + <para>Start codes are a way of adding state to a lexical+ specification, such that only certain rules will match for a+ given state.</para>++ <para>A startcode is simply an identifer, or the special+ start code ‘<literal>0</literal>’. Each rule+ may be given a list of startcodes under which it+ applies:</para>++<programlisting>startcode := @id | '0'+startcodes := '<' startcode { ',' startcode } '>'</programlisting>+ + <para>When the lexer is invoked to scan the next token from+ the input stream, the start code to use is also specified+ (see <xref linkend="api"/>). Only rules that mention this+ start code are then enabled. Rules which do not have a list+ of startcodes are available all the time.</para>++ <para>Each distinct start code mentioned in the lexical+ specification causes a definition of the same name to be+ inserted in the generated source file, whose value is of+ type <literal>Int</literal>. For example, if we mentioned+ startcodes <literal>foo</literal> and <literal>bar</literal>+ in the lexical spec, then Alex will create definitions such+ as:+<programlisting>foo = 1+bar = 2</programlisting>+ in the output file.</para>++ <para>Another way to think of start codes is as a way to+ define several different (but possibly overlapping) lexical+ specifications in a single file, since each start code+ corresponds to a different set of rules. In concrete terms,+ each start code corresponds to a distinct initial state in+ the state machine that Alex derives from the lexical+ specification.</para>++ <para>Here is an example of using startcodes as states, for+ collecting the characters inside a string:</para>++<programlisting><0> ([^\"] | \n)* ;+<0> \" { begin string }+<string> [^\"] { stringchar }+<string> \" { begin 0 }</programlisting>++ <para>When it sees a quotation mark, the lexer switches into+ the <literal>string</literal> state and each character+ thereafter causes a <literal>stringchar</literal> action,+ until the next quotation mark is found, when we switch back+ into the <literal>0</literal> state again.</para>+ + <para>From the lexer's point of view, the startcode is just+ an integer passed in, which tells it which state to start+ in. In order to actually use it as a state, you must have+ some way for the token actions to specify new start codes -+ <xref linkend="api"/> describes some ways this can be done.+ In some applications, it might be necessary to keep a+ <emphasis>stack</emphasis> of start codes, where at the end+ of a state we pop the stack and resume parsing in the+ previous state. If you want this functionality, you have to+ program it yourself.</para>+ </section>++ </section> <!-- rules -->+ </section> <!-- syntax of alex files -->+ </chapter> <!-- alex files -->++ <chapter id="regexps">+ <title>Regular Expression</title>++ <para>Regular expressions are the patterns that Alex uses to match+ tokens in the input stream.</para>++ <section id="regexp-syntax">+ <title>Syntax of regular expressions</title>++<programlisting>regexp := rexp2 { '|' rexp2 }++rexp2 := rexp1 { rexp1 }++rexp1 := rexp0 [ '*' | '+' | '?' | repeat ]++rexp0 := set+ | @rmac+ | @string+ | '(' [ regexp ] ')'++repeat := '{' $digit '}'+ | '{' $digit ',' '}'+ | '{' $digit ',' $digit '}'</programlisting>++ <para>The syntax of regular expressions is fairly standard, the+ only difference from normal lex-style regular expressions being+ that we allow the sequence <literal>()</literal> to denote the+ regular expression that matches the empty string.</para>++ <para>Spaces are ignored in a regular expression, so feel free+ to space out your regular expression as much as you like, even+ split it over multiple lines and include comments. Literal+ whitespace can be included by surrounding it with quotes+ <literal>" "</literal>, or by escaping each whitespace character+ with <literal>\</literal>.</para>++ <variablelist>+ <varlistentry>+ <term><literal><replaceable>set</replaceable></literal></term>+ <listitem>+ <para>Matches any of the characters in+ <replaceable>set</replaceable>. See <xref+ linkend="charsets"/> for the syntax of sets.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>@foo</literal></term>+ <listitem>+ <para>Expands to the definition of the appropriate+ regular expression macro.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>"..."</literal></term>+ <listitem>+ <para>Matches the sequence of characters in the string, in+ that order.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>*</literal></term>+ <listitem>+ <para>Matches zero or more occurences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>+</literal></term>+ <listitem>+ <para>Matches one or more occurences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>?</literal></term>+ <listitem>+ <para>Matches zero or one occurences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>{<replaceable>n</replaceable>}</literal></term>+ <listitem>+ <para>Matches <replaceable>n</replaceable> occurrences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>{<replaceable>n</replaceable>,}</literal></term>+ <listitem>+ <para>Matches <replaceable>n</replaceable> or more occurrences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>r</replaceable>{<replaceable>n</replaceable>,<replaceable>m</replaceable>}</literal></term>+ <listitem>+ <para>Matches between <replaceable>n</replaceable> and+ <replaceable>m</replaceable> (inclusive) occurrences of+ <replaceable>r</replaceable>.</para>+ </listitem>+ </varlistentry>+ </variablelist>+ </section>++ <section id="charsets">+ <title>Syntax of character sets</title>++ <para>Character sets are the fundamental elements in a regular+ expression. A character set is a pattern that matches a single+ character. The syntax of character sets is as follows:</para>++<programlisting>set := set ['#' set0]++set0 := @char [ '-' @char ]+ | '.'+ | @smac+ | '[' [^] { set } ']'+ | '~' set0</programlisting>++ <para>The various character set constructions are:</para>+ + <variablelist>+ <varlistentry>+ <term><literal><replaceable>char</replaceable></literal></term>+ <listitem>+ <para>The simplest character set is a single character.+ Note that special characters such as <literal>[</literal>+ and <literal>.</literal> must be escaped by prefixing them+ with <literal>\</literal> (see the lexical syntax, <xref+ linkend="lexical"/>, for the list of special+ characters).</para>++ <para>Certain non-printable characters have special escape+ sequences. These are: <literal>\a</literal>,+ <literal>\b</literal>, <literal>\f</literal>,+ <literal>\n</literal>, <literal>\r</literal>,+ <literal>\t</literal>, and <literal>\v</literal>. Other+ characters can be represented by using their numerical+ character values (although this may be non-portable):+ <literal>\x0A</literal> is equivalent to+ <literal>\n</literal>, for example.</para>++ <para>Whitespace characters are ignored; to represent a+ literal space, escape it with <literal>\</literal>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>char</replaceable>-<replaceable>char</replaceable></literal></term>+ <listitem>+ <para>A range of characters can be expressed by separating+ the characters with a ‘<literal>-</literal>’,+ all the characters with codes in the given range are+ included in the set. Character ranges can also be+ non-portable.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>.</literal></term>+ <listitem>+ <para>The built-in set ‘<literal>.</literal>’+ matches all characters except newline+ (<literal>\n</literal>).</para>++ <para>Equivalent to the set+ <literal>[\x00-\xff] # \n</literal>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal><replaceable>set0</replaceable> # <replaceable>set1</replaceable></literal></term>+ <listitem>+ <para>Matches all the characters in+ <replaceable>set0</replaceable> that are not in+ <replaceable>set1</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>[<replaceable>sets</replaceable>]</literal></term>+ <listitem>+ <para>The union of <replaceable>sets</replaceable>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>[^<replaceable>sets</replaceable>]</literal></term>+ <listitem>+ <para>The complement of the union of the+ <replaceable>sets</replaceable>. Equivalent to+ ‘<literal>. # [<replaceable>sets</replaceable>]</literal>’.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>~<replaceable>set</replaceable></literal></term>+ <listitem>+ <para>The complement of <replaceable>set</replaceable>.+ Equivalent to ‘<literal>. # <replaceable>set</replaceable></literal>’</para>+ </listitem>+ </varlistentry>+ </variablelist>++ <para>A set macro is written as <literal>$</literal> followed by+ an identifier. There are some builtin character set+ macros:</para>++ <variablelist>+ <varlistentry>+ <term><literal>$white</literal></term>+ <listitem>+ <para>Matches all whitespace characters, including+ newline.</para>++ <para>Equivalent to the set+ <literal>[\t\n\f\v\r]</literal>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>$printable</literal></term>+ <listitem>+ <para>Matches all printable characters (characters 32 to+ 126 in ASCII). Equivalent to the set+ <literal>[\32-\126]</literal>.</para>+ </listitem>+ </varlistentry>+ </variablelist>+ + <para>Character set macros can be defined at the top of the file+ at the same time as regular expression macros (see <xref+ linkend="regexps"/>). Here are some example character set+ macros:</para>++<programlisting>$lls = a-z -- little letters+$not_lls = ~a-z -- anything but little letters+$ls_ds = [a-zA-Z0-9] -- letters and digits+$sym = [ \! \@ \# \$ ] -- the symbols !, @, #, and $+$sym_q_nl = [ \' \! \@ \# \$ \n ] -- the above symbols with ' and newline+$quotable = $printable # \' -- any graphic character except '+$del = \127 -- ASCII DEL</programlisting>+ </section>++ </chapter>++ <chapter id="api">+ <title>The Interface to an Alex-generated lexer</title>++ <para>This section answers the question: "How do I include an+ Alex lexer in my program?</para>++ <para>Alex provides for a great deal of flexibility in how the+ lexer is exposed to the rest of the program. For instance,+ there's no need to parse a <literal>String</literal> directly if+ you have some special character-buffer operations that avoid the+ overheads of ordinary Haskell <literal>String</literal>s. You+ might want Alex to keep track of the line and column number in the+ input text, or you might wish to do it yourself (perhaps you use a+ different tab width from the standard 8-columns, for+ example).</para>++ <para>The general story is this: Alex provides a basic interface+ to the generated lexer (described in the next section), which you+ can use to parse tokens given an abstract input type with+ operations over it. You also have the option of including a+ <firstterm>wrapper</firstterm>, which provides a higher-level+ abstraction over the basic interface; Alex comes with several+ wrappers.</para>++ <section id="basic-api">+ <title>Basic interface</title>++ <para>If you compile your Alex file without a+ <literal>%wrapper</literal> declaration, then you get access to+ the lowest-level API to the lexer. You must provide definitions+ for the following, either in the same module or imported from+ another module:</para>++<programlisting>type AlexInput+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexInputPrevChar :: AlexInput -> Char</programlisting>++ <para>The generated lexer is independent of the input type,+ which is why you have to provide a definition for the input type+ yourself. Note that the input type needs to keep track of the+ <emphasis>previous</emphasis> character in the input stream;+ this is used for implementing patterns with a left-context+ (those that begin with <literal>^</literal> or+ <literal><replaceable>set</replaceable>^</literal>). If you+ don't ever use patterns with a left-context in your lexical+ specification, then you can safely forget about the previous+ character in the input stream, and have+ <literal>alexInputPrevChar</literal> return+ <literal>undefined</literal>.</para>++ <para>Alex will provide the following function:</para>++<programlisting>alexScan :: AlexInput -- The current input+ -> Int -- The "start code"+ -> AlexReturn action -- The return value++data AlexReturn action+ = AlexEOF++ | AlexError+ !AlexInput -- Remaining input++ | AlexSkip+ !AlexInput -- Remaining input+ !Int -- Token length++ | AlexToken + !AlexInput -- Remaining input+ !Int -- Token length+ action -- action value</programlisting>++ <para>Calling <literal>alexScan</literal> will scan a single+ token from the input stream, and return a value of type+ <literal>AlexReturn</literal>. The value returned is either:</para>++ <variablelist>+ <varlistentry>+ <term><literal>AlexEOF</literal></term>+ <listitem>+ <para>The end-of-file was reached.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>AlexError</literal></term>+ <listitem>+ <para>A valid token could not be recognised.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>AlexSkip</literal></term>+ <listitem>+ <para>The matched token did not have an action associated+ with it.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><literal>AlexToken</literal></term>+ <listitem>+ <para>A token was matched, and the action associated with+ it is returned.</para>+ </listitem>+ </varlistentry>+ </variablelist>++ <para>The <literal>action</literal> is simply the value of the+ expression inside <literal>{...}</literal> on the+ right-hand-side of the appropriate rule in the Alex file.+ Alex doesn't specify what type these expressions should have, it+ simply requires that they all have the same type, or else you'll+ get a type error when you try to compile the generated+ lexer.</para>++ <para>Once you have the <literal>action</literal>, it is up to+ you what to do with it. The type of <literal>action</literal>+ could be a function which takes the <literal>String</literal>+ representation of the token and returns a value in some token+ type, or it could be a continuation that takes the new input and+ calls <literal>alexScan</literal> again, building a list of+ tokens as it goes.</para>++ <para>This is pretty low-level stuff; you have complete+ flexibility about how you use the lexer, but there might be a+ fair amount of support code to write before you can actually use+ it. For this reason, we also provide a selection of wrappers+ that add some common functionality to this basic scheme.+ Wrappers are described in the next section.</para>++ <para>There is another entry point, which is useful if your+ grammar contains any predicates (see <xref+ linkend="contexts"/>):</para>++<programlisting>alexScanUser+ :: user -- predicate state+ -> AlexInput -- The current input+ -> Int -- The "start code"+ -> Maybe ( -- Nothing on error or EOF+ AlexInput, -- The remaining input+ Int, -- Length of this token+ action -- The action (an unknown type)+ )</programlisting>++ <para>The extra argument, of some type <literal>user</literal>,+ is passed to each predicate.</para>+ </section>++ <section id="wrappers">+ <title>Wrappers</title>++ <para>To use one of the provided wrappers, include the following+ declaration in your file:</para>++<programlisting>%wrapper "<replaceable>name</replaceable>"</programlisting>++ <para>where <replaceable>name</replaceable> is the name of the+ wrapper, eg. <literal>basic</literal>. The following sections+ describe each of the wrappers that come with Alex.</para>++ <section>+ <title>The "basic" wrapper</title>++ <para>The basic wrapper is a good way to obtain a function of+ type <literal>String -> [token]</literal> from a lexer+ specification, with little fuss.</para>++ <para>It provides definitions for+ <literal>AlexInput</literal>, <literal>alexGetChar</literal>+ and <literal>alexInputPrevChar</literal> that are suitable for+ lexing a <literal>String</literal> input. It also provides a+ function <literal>alexScanTokens</literal> which takes a+ <literal>String</literal> input and returns a list of the+ tokens it contains.</para>++ <para>The <literal>basic</literal> wrapper provides no support+ for using startcodes; the initial startcode is always set to+ zero.</para>++ <para>Here is the actual code included in the lexer when the+ basic wrapper is selected:</para>++<programlisting>type AlexInput = (Char, -- previous char+ String) -- current input string++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (_, []) = Nothing+alexGetChar (_, c:cs) = Just (c, (c,cs))++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (c,_) = c++-- alexScanTokens :: String -> [token]+alexScanTokens str = go ('\n',str)+ where go inp@(_,str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act (take len str) : go inp'</programlisting>++ <para>The type signature for <literal>alexScanTokens</literal>+ is commented out, because the <literal>token</literal> type is+ unkonwn. All of the actions in your lexical specification+ should have type:</para>++<programlisting>{ ... } :: String -> token</programlisting>++ <para>for some type <literal>token</literal>.</para>++ <para>For an example of the use of the basic wrapper, see the+ file <literal>examples/Tokens_basic.x</literal> in the Alex+ distribution.</para>+ </section>++ <section>+ <title>The "posn" wrapper</title>++ <para>The posn wrapper provides slightly more functionality+ than the basic wrapper: it keeps track of line and column+ numbers of tokens in the input text.</para>++ <para>The posn wrapper provides the following, in addition to+ the straightforward definitions of+ <literal>alexGetChar</literal> and+ <literal>alexInputPrevChar</literal>:</para>++<programlisting>data AlexPosn = AlexPn !Int -- absolute character offset+ !Int -- line number+ !Int -- column number++type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ String) -- current input string++--alexScanTokens :: String -> [token]+alexScanTokens str = go (alexStartPos,'\n',str)+ where go inp@(pos,_,str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : go inp'</programlisting>++ <para>The types of the token actions should be:</para>++<programlisting>{ ... } :: AlexPosn -> String -> token</programlisting>++ <para>For an example using the <literal>posn</literal>+ wrapper, see the file+ <literal>examples/Tokens_posn.x</literal> in the Alex+ distribution.</para>+ </section>++ <section>+ <title>The "monad" wrapper</title>++ <para>The <literal>monad</literal> wrapper is the most+ flexible of the wrappers provided with Alex. It includes a+ state monad which keeps track of the current input and text+ position, and the startcode. It is intended to be a template+ for building your own monads - feel free to copy the code and+ modify it to build a monad with the facilities you+ need.</para>++<programlisting>data AlexState = AlexState {+ alex_pos :: !AlexPosn, -- position at current input location+ alex_inp :: String, -- the current input+ alex_chr :: !Char, -- the character before the input+ alex_scd :: !Int -- the current startcode+ }++newtype Alex a = Alex { unAlex :: AlexState+ -> Either String (AlexState, a) }++runAlex :: String -> Alex a -> Either String a++alexGetInput :: Alex AlexInput+alexSetInput :: AlexInput -> Alex ()++alexError :: String -> Alex a++alexGetStartCode :: Alex Int+alexSetStartCode :: Int -> Alex ()</programlisting>++ <para>To invoke a scanner under the <literal>monad</literal>+ wrapper, use <literal>alexMonadScan</literal>:</para>++<programlisting>alexMonadScan :: Alex result</programlisting>++ <para>The token actions should have the following type:</para>++<programlisting>type AlexAction result = AlexInput -> Int -> Alex result+{ ... } :: AlexAction result</programlisting>++ <para>The <literal>monad</literal> wrapper also provides some+ useful combinators for constructing token actions:</para>++<programlisting>-- skip :: AlexAction result+skip input len = alexMonadScan++-- andBegin :: AlexAction result -> Int -> AlexAction result+(act `andBegin` code) input len = do alexSetStartCode code; act input len++-- begin :: Int -> AlexAction result+begin code = skip `andBegin` code++-- token :: (String -> Int -> token) -> AlexAction token+token t input len = return (t input len)</programlisting>+ </section>++ <section>+ <title>The "gscan" wrapper</title>++ <para>The <literal>gscan</literal> wrapper is provided mainly+ for historical reasons: it exposes an interface which is very+ similar to that provided by Alex version 1.x. The interface+ is intended to be very general, allowing actions to modify the+ startcode, and pass around an arbitrary state value.</para>++<programlisting>alexGScan :: StopAction state result -> state -> String -> result++type StopAction state result + = AlexPosn -> Char -> String -> (Int,state) -> result</programlisting> ++ <para>The token actions should all have this type:</para>++<programlisting>{ ... } :: AlexPosn -- token position+ -> Char -- previous character+ -> String -- input string at token+ -> Int -- length of token+ -> ((Int,state) -> result) -- continuation+ -> (Int,state) -- current (startcode,state)+ -> result</programlisting> + </section>+ </section>+ </chapter>++ <chapter id="invoking">+ <title>Invoking Alex</title>++ <para>The command line syntax for Alex is entirely+ standard:</para>++<screen>$ alex { <replaceable>option</replaceable> } <replaceable>file</replaceable>.x { <replaceable>option</replaceable> }</screen>++ <para>Alex expects a single+ <literal><replaceable>file</replaceable>.x</literal> to be named+ on the command line. By default, Alex will create+ <literal><replaceable>file</replaceable>.hs</literal> containing+ the Haskell source for the lexer.</para>++ <para>The options that Alex accepts are listed below:</para>++ <variablelist>+ <varlistentry>+ <term><option>-o</option> <replaceable>file</replaceable></term>+ <term><option>--outfile</option>=<replaceable>file</replaceable></term>+ <listitem>+ <para>Specifies the filename in which the output is to be+ placed. By default, this is the name of the input file with+ the <literal>.x</literal> suffix replaced by+ <literal>.hs</literal>.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-i</option> <optional><replaceable>file</replaceable></optional></term>+ <term><option>--info</option> <optional><replaceable>=file</replaceable></optional></term>+ <listitem>+ <para>Produces a human-readable rendition of the state+ machine (DFA) that Alex derives from the lexer, in+ <replaceable>file</replaceable> (default:+ <literal><replaceable>file</replaceable>.info</literal>+ where the input file is+ <literal><replaceable>file</replaceable>.x</literal>).</para>++ <para>The format of the info file is currently a bit basic,+ and not particularly informative.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-t</option> <optional><replaceable>dir</replaceable></optional></term>+ <term><option>--template</option>=<replaceable>dir</replaceable></term>+ <listitem>+ <para>Look in <replaceable>dir</replaceable> for template files.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-g</option></term>+ <term><option>--ghc</option></term>+ <listitem>+ <para>Causes Alex to produce a lexer which is optimised for+ compiling with GHC. The lexer will be significantly more+ efficient, both in terms of the size of the compiled+ lexer and its runtime.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-d</option></term>+ <term><option>--debug</option></term>+ <listitem>+ <para>Causes Alex to produce a lexer which will output+ debugging messsages as it runs.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-?</option></term>+ <term><option>--help</option></term>+ <listitem>+ <para>Display help and exit.</para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term><option>-V</option></term>+ <term><option>--version</option></term>+ <listitem>+ <para>Output version information and exit. Note that for legacy+ reasons <option>-v</option> is supported, too, but the use of it+ is deprecated. <option>-v</option> will be used for verbose mode+ when it is actually implemented.</para>+ </listitem>+ </varlistentry>+ </variablelist>+ </chapter>++</book>
+ doc/config.mk.in view
@@ -0,0 +1,15 @@+#-----------------------------------------------------------------------------+# DocBook XML stuff++XSLTPROC = @XsltprocCmd@+XMLLINT = @XmllintCmd@+FOP = @FopCmd@+XMLTEX = @XmltexCmd@+PDFXMLTEX = @PdfxmltexCmd@+DVIPS = @DvipsCmd@++DIR_DOCBOOK_XSL = @DIR_DOCBOOK_XSL@++XSLTPROC_LABEL_OPTS = --stringparam toc.section.depth 3 \+ --stringparam section.autolabel 1 \+ --stringparam section.label.includes.component.label 1
+ doc/configure.ac view
@@ -0,0 +1,12 @@++AC_INIT([Haddock docs], [1.0], [simonmar@microsoft.com], [])++AC_CONFIG_SRCDIR([Makefile])++dnl ** check for DocBook toolchain+FP_CHECK_DOCBOOK_DTD+FP_DIR_DOCBOOK_XSL([/usr/share/xml/docbook/stylesheet/nwalsh/current /usr/share/xml/docbook/stylesheet/nwalsh /usr/share/sgml/docbook/docbook-xsl-stylesheets* /usr/share/sgml/docbook/xsl-stylesheets* /opt/kde?/share/apps/ksgmltools2/docbook/xsl /usr/share/docbook-xsl /usr/share/sgml/docbkxsl /usr/local/share/xsl/docbook /sw/share/xml/xsl/docbook-xsl])+FP_PROG_FO_PROCESSOR++AC_CONFIG_FILES([config.mk])+AC_OUTPUT
+ doc/docbook-xml.mk view
@@ -0,0 +1,130 @@+#-----------------------------------------------------------------------------+# DocBook XML++.PHONY: html html-no-chunks chm HxS fo dvi ps pdf++ifneq "$(XML_DOC)" ""++all :: html++# multi-file XML document: main document name is specified in $(XML_DOC),+# sub-documents (.xml files) listed in $(XML_SRCS).++ifeq "$(XML_SRCS)" ""+XML_SRCS = $(wildcard *.xml)+endif++XML_HTML = $(addsuffix /index.html,$(basename $(XML_DOC)))+XML_HTML_NO_CHUNKS = $(addsuffix .html,$(XML_DOC))+XML_CHM = $(addsuffix .chm,$(XML_DOC))+XML_HxS = $(addsuffix .HxS,$(XML_DOC))+XML_FO = $(addsuffix .fo,$(XML_DOC))+XML_DVI = $(addsuffix .dvi,$(XML_DOC))+XML_PS = $(addsuffix .ps,$(XML_DOC))+XML_PDF = $(addsuffix .pdf,$(XML_DOC))++$(XML_HTML) $(XML_NO_CHUNKS_HTML) $(XML_FO) $(XML_DVI) $(XML_PS) $(XML_PDF) :: $(XML_SRCS)++html :: $(XML_HTML)+html-no-chunks :: $(XML_HTML_NO_CHUNKS)+chm :: $(XML_CHM)+HxS :: $(XML_HxS)+fo :: $(XML_FO)+dvi :: $(XML_DVI)+ps :: $(XML_PS)+pdf :: $(XML_PDF)++CLEAN_FILES += $(XML_HTML_NO_CHUNKS) $(XML_FO) $(XML_DVI) $(XML_PS) $(XML_PDF)++FPTOOLS_CSS = fptools.css++clean ::+ $(RM) -rf $(XML_DOC).out $(basename $(XML_DOC)) $(basename $(XML_DOC))-htmlhelp++validate ::+ $(XMLLINT) --valid --noout $(XMLLINT_OPTS) $(XML_DOC).xml+endif++#-----------------------------------------------------------------------------+# DocBook XML suffix rules+#++%.html : %.xml+ $(XSLTPROC) --output $@ \+ --stringparam html.stylesheet $(FPTOOLS_CSS) \+ $(XSLTPROC_LABEL_OPTS) $(XSLTPROC_OPTS) \+ $(DIR_DOCBOOK_XSL)/html/docbook.xsl $<++%/index.html : %.xml+ $(RM) -rf $(dir $@)+ $(XSLTPROC) --stringparam base.dir $(dir $@) \+ --stringparam use.id.as.filename 1 \+ --stringparam html.stylesheet $(FPTOOLS_CSS) \+ $(XSLTPROC_LABEL_OPTS) $(XSLTPROC_OPTS) \+ $(DIR_DOCBOOK_XSL)/html/chunk.xsl $<+ cp $(FPTOOLS_CSS) $(dir $@)++# Note: Numeric labeling seems to be uncommon for HTML Help+%-htmlhelp/index.html : %.xml+ $(RM) -rf $(dir $@)+ $(XSLTPROC) --stringparam base.dir $(dir $@) \+ --stringparam manifest.in.base.dir 1 \+ --stringparam htmlhelp.chm "..\\"$(basename $<).chm \+ $(XSLTPROC_OPTS) \+ $(DIR_DOCBOOK_XSL)/htmlhelp/htmlhelp.xsl $<++%-htmlhelp2/collection.HxC : %.xml+ $(RM) -rf $(dir $@)+ $(XSLTPROC) --stringparam base.dir $(dir $@) \+ --stringparam use.id.as.filename 1 \+ --stringparam manifest.in.base.dir 1 \+ $(XSLTPROC_OPTS) \+ $(DIR_DOCBOOK_XSL)/htmlhelp2/htmlhelp2.xsl $<++# TODO: Detect hhc & Hxcomp via autoconf+#+# Two obstacles here:+#+# * The reason for the strange "if" below is that hhc returns 0 on error and 1+# on success, the opposite of what shells and make expect.+#+# * There seems to be some trouble with DocBook indices, but the *.chm looks OK,+# anyway, therefore we pacify make by "|| true". Ugly...+#+%.chm : %-htmlhelp/index.html+ ( cd $(dir $<) && if hhc htmlhelp.hhp ; then false ; else true ; fi ) || true++%.HxS : %-htmlhelp2/collection.HxC+ ( cd $(dir $<) && if Hxcomp -p collection.HxC -o ../$@ ; then false ; else true ; fi )++%.fo : %.xml+ $(XSLTPROC) --output $@ \+ --stringparam draft.mode no \+ $(XSLTPROC_LABEL_OPTS) $(XSLTPROC_OPTS) \+ $(DIR_DOCBOOK_XSL)/fo/docbook.xsl $<++ifeq "$(FOP)" ""+ifneq "$(PDFXMLTEX)" ""+%.pdf : %.fo+ $(PDFXMLTEX) $<+ if grep "LaTeX Warning: Label(s) may have changed.Rerun to get cross-references right." $(basename $@).log > /dev/null ; then \+ $(PDFXMLTEX) $< ; \+ $(PDFXMLTEX) $< ; \+ fi+endif+else+%.ps : %.fo+ $(FOP) $(FOP_OPTS) -fo $< -ps $@++%.pdf : %.fo+ $(FOP) $(FOP_OPTS) -fo $< -pdf $@+endif++ifneq "$(XMLTEX)" ""+%.dvi : %.fo+ $(XMLTEX) $<+ if grep "LaTeX Warning: Label(s) may have changed.Rerun to get cross-references right." $(basename $@).log > /dev/null ; then \+ $(XMLTEX) $< ; \+ $(XMLTEX) $< ; \+ fi+endif
+ doc/fptools.css view
@@ -0,0 +1,36 @@+div {+ font-family: sans-serif;+ color: black;+ background: white+}++h1, h2, h3, h4, h5, h6, p.title { color: #005A9C }++h1 { font: 170% sans-serif }+h2 { font: 140% sans-serif }+h3 { font: 120% sans-serif }+h4 { font: bold 100% sans-serif }+h5 { font: italic 100% sans-serif }+h6 { font: small-caps 100% sans-serif }++pre {+ font-family: monospace;+ border-width: 1px;+ border-style: solid;+ padding: 0.3em+}++pre.screen { color: #006400 }+pre.programlisting { color: maroon }++div.example {+ background-color: #fffcf5;+ margin: 1ex 0em;+ border: solid #412e25 1px;+ padding: 0ex 0.4em+}++a:link { color: #0000C8 }+a:hover { background: #FFFFA8 }+a:active { color: #D00000 }+a:visited { color: #680098 }
+ examples/Makefile view
@@ -0,0 +1,31 @@+TOP = ..+include $(TOP)/mk/boilerplate.mk++PROGS = lit Tokens Tokens_posn Tokens_gscan words words_posn words_monad \+ tiny haskell++lit : lit.hs+ $(HC) $(HC_OPTS) -o $@ $<++tiny : Tokens_posn.o tiny.o+ $(HC) $(HC_OPTS) -o $@ Tokens_posn.o tiny.o++Tokens_posn : Tokens_posn.hs+ $(HC) $(HC_OPTS) -o $@ $<++Tokens_gscan : Tokens_gscan.hs+ $(HC) $(HC_OPTS) -o $@ $<++words : words.hs+ $(HC) $(HC_OPTS) -o $@ $<++words_posn : words_posn.hs+ $(HC) $(HC_OPTS) -o $@ $<++words_monad : words_monad.hs+ $(HC) $(HC_OPTS) -o $@ $<++haskell : haskell.hs+ $(HC) $(HC_OPTS) -o $@ $<++include $(TOP)/mk/target.mk
+ examples/Tokens.x view
@@ -0,0 +1,34 @@+{+module Tokens (Token(..), alexScanTokens) where+}++%wrapper "basic"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ { \s -> White }+ "--".* { \s -> Comment }+ let { \s -> Let }+ in { \s -> In }+ $digit+ { \s -> Int (read s) }+ [\=\+\-\*\/\(\)] { \s -> Sym (head s) }+ $alpha [$alpha $digit \_ \']* { \s -> Var s }++{+-- Each right-hand side has type :: String -> Token++-- The token type:+data Token =+ White |+ Comment |+ Let |+ In |+ Sym Char |+ Var String |+ Int Int |+ Err + deriving (Eq,Show)+}
+ examples/Tokens_gscan.x view
@@ -0,0 +1,40 @@+{+module Main (main) where+}++%wrapper "gscan"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { tok (\p s -> Let p) }+ in { tok (\p s -> In p) }+ $digit+ { tok (\p s -> Int p (read s)) }+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head s)) }+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p s) }++{+-- Some action helpers:+tok f p c str len cont (sc,state) = f p (take len str) : cont (sc,state)++-- The token type:+data Token =+ Let AlexPosn |+ In AlexPosn |+ Sym AlexPosn Char |+ Var AlexPosn String |+ Int AlexPosn Int |+ Err AlexPosn+ deriving (Eq,Show)++main = do+ s <- getContents+ print (alexGScan stop undefined s)+ where+ stop p c "" (sc,s) = []+ stop p c _ (sc,s) = error "lexical error"+}
+ examples/Tokens_posn.x view
@@ -0,0 +1,40 @@+{+module Tokens_posn (Token(..), AlexPosn(..), alexScanTokens, token_posn) where+}++%wrapper "posn"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { tok (\p s -> Let p) }+ in { tok (\p s -> In p) }+ $digit+ { tok (\p s -> Int p (read s)) }+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head s)) }+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p s) }++{+-- Each right-hand side has type :: AlexPosn -> String -> Token++-- Some action helpers:+tok f p s = f p s++-- The token type:+data Token =+ Let AlexPosn |+ In AlexPosn |+ Sym AlexPosn Char |+ Var AlexPosn String |+ Int AlexPosn Int+ deriving (Eq,Show)++token_posn (Let p) = p+token_posn (In p) = p+token_posn (Sym p _) = p+token_posn (Var p _) = p+token_posn (Int p _) = p+}
+ examples/examples.x view
@@ -0,0 +1,19 @@+"example_rexps":-++ <a_star> ::= $ | a+ -- = a*, zero or more as+ <a_plus> ::= aa* -- = a+, one or more as+ <a_quest> ::= $ | a -- = a?, zero or one as+ <a_3> ::= a{3} -- = aaa, three as+ <a_3_5> ::= a{3,5} -- = a{3}a?a?+ <a_3_> ::= a{3,} -- = a{3}a*+++"example_sets":-++ <lls> ::= a-z -- little letters+ <not_lls> ::= ~a-z -- anything but little letters+ <ls_ds> ::= [a-zA-Z0-9] -- letters and digits+ <sym> ::= `!@@#$' -- the symbols !, @@, # and $+ <sym_q_nl> ::= [`!#@@$'^'^n] -- the above symbols with ' and newline+ <quotable> ::= ^p#^' -- any graphic character except '+ <del> ::= ^127 -- ASCII DEL
+ examples/haskell.x view
@@ -0,0 +1,172 @@+--+-- Lexical syntax for Haskell 98.+--+-- (c) Simon Marlow 2003, with the caveat that much of this is+-- translated directly from the syntax in the Haskell 98 report.+--+-- This isn't a complete Haskell 98 lexer - it doesn't handle layout+-- for one thing. However, it could be adapted with a small+-- amount of effort.+--++{+module Main (main) where+}++%wrapper "monad"++$whitechar = [ \t\n\r\f\v]+$special = [\(\)\,\;\[\]\`\{\}]++$ascdigit = 0-9+$unidigit = [] -- TODO+$digit = [$ascdigit $unidigit]++$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]+$unisymbol = [] -- TODO+$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\']++$large = [A-Z \xc0-\xd6 \xd8-\xde]+$small = [a-z \xdf-\xf6 \xf8-\xff \_]+$alpha = [$small $large]++$graphic = [$small $large $symbol $digit $special \:\"\']++$octit = 0-7+$hexit = [0-9 A-F a-f]+$idchar = [$alpha $digit \']+$symchar = [$symbol \:]+$nl = [\n\r]++@reservedid = + as|case|class|data|default|deriving|do|else|hiding|if|+ import|in|infix|infixl|infixr|instance|let|module|newtype|+ of|qualified|then|type|where++@reservedop =+ ".." | ":" | "::" | "=" | \\ | "|" | "<-" | "->" | "@" | "~" | "=>"++@varid = $small $idchar*+@conid = $large $idchar*+@varsym = $symbol $symchar*+@consym = \: $symchar*++@decimal = $digit++@octal = $octit++@hexadecimal = $hexit++@exponent = [eE] [\-\+] @decimal++$cntrl = [$large \@\[\\\]\^\_]+@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK+ | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE+ | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM+ | SUB | ESC | FS | GS | RS | US | SP | DEL+$charesc = [abfnrtv\\\"\'\&]+@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal)+@gap = \\ $whitechar+ \\+@string = $graphic # [\"\\] | " " | @escape | @gap++haskell :-++<0> $white+ { skip }+<0> "--"\-*[^$symbol].* { skip }++"{-" { nested_comment }++<0> $special { mkL LSpecial }++<0> @reservedid { mkL LReservedId }+<0> @conid \. @varid { mkL LQVarId }+<0> @conid \. @conid { mkL LQConId }+<0> @varid { mkL LVarId }+<0> @conid { mkL LConId }++<0> @reservedop { mkL LReservedOp }+<0> @conid \. @varsym { mkL LVarSym }+<0> @conid \. @consym { mkL LConSym }+<0> @varsym { mkL LVarSym }+<0> @consym { mkL LConSym }++<0> @decimal + | 0[oO] @octal+ | 0[xX] @hexadecimal { mkL LInteger }++<0> @decimal \. @decimal @exponent?+ | @decimal @exponent { mkL LFloat }++<0> \' ($graphic # [\'\\] | " " | @escape) \'+ { mkL LChar }++<0> \" @string* \" { mkL LString }++{+data Lexeme = L AlexPosn LexemeClass String++data LexemeClass+ = LInteger+ | LFloat+ | LChar+ | LString+ | LSpecial+ | LReservedId+ | LReservedOp+ | LVarId+ | LQVarId+ | LConId+ | LQConId+ | LVarSym+ | LQVarSym+ | LConSym+ | LQConSym+ | LEOF+ deriving Eq+ +mkL :: LexemeClass -> AlexInput -> Int -> Alex Lexeme+mkL c (p,_,str) len = return (L p c (take len str))++nested_comment :: AlexInput -> Int -> Alex Lexeme+nested_comment _ _ = do+ input <- alexGetInput+ go 1 input+ where go 0 input = do alexSetInput input; alexMonadScan+ go n input = do+ case alexGetChar input of+ Nothing -> err input+ Just (c,input) -> do+ case c of+ '-' -> do+ case alexGetChar input of+ Nothing -> err input+ Just ('\125',input) -> go (n-1) input+ Just (c,input) -> go n input+ '\123' -> do+ case alexGetChar input of+ Nothing -> err input+ Just ('-',input) -> go (n+1) input+ Just (c,input) -> go n input+ c -> go n input++ err input = do alexSetInput input; lexError "error in nested comment" ++lexError s = do+ (p,c,input) <- alexGetInput+ alexError (showPosn p ++ ": " ++ s ++ + (if (not (null input))+ then " before " ++ show (head input)+ else " at end of file"))++scanner str = runAlex str $ do+ let loop i = do tok@(L _ cl _) <- alexMonadScan; + if cl == LEOF+ then return i+ else do loop $! (i+1)+ loop 0++alexEOF = return (L undefined LEOF "")++showPosn (AlexPn _ line col) = show line ++ ':': show col++main = do+ s <- getContents+ print (scanner s)+}
+ examples/lit.x view
@@ -0,0 +1,47 @@+{+module Main (main) where+}++%wrapper "gscan"++$space = $white # \n+@blank = \n $space*+@scrap = \n \> .*+@comment = \n ( [^ \> $white] | $space+ ~$white ) .*++lit :-+ + @blank @scrap+ { scrap }+ @blank @comment* { comment }+ +{+scrap _ _ inp len cont st = strip len inp+ where+ strip 0 _ = cont st+ strip (n+1) (c:rst) =+ if c=='\n'+ then '\n':strip_nl n rst+ else c:strip n rst++ strip_nl (n+1) ('>':rst) = ' ':strip n rst+ strip_nl n rst = strip n rst++comment _ _ inp len cont st = strip len inp+ where+ strip 0 _ = cont st+ strip (n+1) (c:rst) = if c=='\n' then c:strip n rst else strip n rst+++main:: IO ()+main = interact literate++literate:: String -> String+literate inp = drop 2 (alexGScan stop_act () ('\n':'\n':inp))++stop_act p _ "" st = []+stop_act p _ _ _ = error (msg ++ loc p ++ "\n")++msg = "literate preprocessing error at "++loc (AlexPn _ l c) = "line " ++ show(l-2) ++ ", column " ++ show c+}
+ examples/pp.x view
@@ -0,0 +1,38 @@+%{+import System+import Char+import Alex+%}+++"pp_lx"/"pp_acts":-++{ ^s = ^w#^n } -- spaces and tabs, etc.+{ ^f = [A-Za-z0-9`~%-_.,/'] } -- file name character++ <inc> ::= ^#include^s+^"^f+^"^s*^n+ <txt> ::= .*^n+++%{+inc p c inp len cont st = pp fn >> cont st+ where+ fn = (takeWhile ('"'/=) . tail . dropWhile isSpace . drop 8) inp++txt p c inp len cont st = putStr (take len inp) >> cont st+++main:: IO ()+main = getArgs >>= \args ->+ case args of+ [fn] -> pp fn+ _ -> error "usage: pp file\n"+ +pp:: String -> IO ()+pp fn = readFile fn >>= \cts -> gscan pp_scan () cts++pp_scan:: GScan () (IO ())+pp_scan = load_gscan (pp_acts,stop_act) pp_lx+ where+ stop_act _ _ _ _ = return ()+%}
+ examples/state.x view
@@ -0,0 +1,32 @@+{+module Main (main) where+}++%wrapper "gscan"++state :-++ $white+ { skip }+ \{ [^\}]* \} { code }+ [A-Za-z]+ { ide }++{+code _ _ inp len cont (sc,frags) = cont (sc,frag:frags)+ where+ frag = take (len-4) (drop 2 inp)++ide _ _ inp len cont st = Ide (take len inp):cont st++skip _ _ inp len cont st = cont st++data Token = Ide String | Eof String | Err deriving Show++stop_act _ _ "" (_,frags) = [Eof (unlines(reverse frags))]+stop_act _ _ _ _ = [Err]++tokens:: String -> [Token]+tokens inp = alexGScan stop_act [] inp++main:: IO ()+main = interact (show.tokens)+}
+ examples/tiny.y view
@@ -0,0 +1,69 @@+-- An example demonstrating how to connect a Happy parser to an Alex lexer.+{+import Tokens_posn+}++%name calc+%tokentype { Token }++%token let { Let _ }+ in { In _ }+ int { Int _ $$ }+ var { Var _ $$ }+ '=' { Sym _ '=' }+ '+' { Sym _ '+' }+ '-' { Sym _ '-' }+ '*' { Sym _ '*' }+ '/' { Sym _ '/' }+ '(' { Sym _ '(' }+ ')' { Sym _ ')' }++%%++Exp :: { Exp }+Exp : let var '=' Exp in Exp { LetE $2 $4 $6 }+ | Exp1 { $1 }++Exp1 : Exp1 '+' Term { PlusE $1 $3 }+ | Exp1 '-' Term { MinusE $1 $3 }+ | Term { $1 }++Term : Term '*' Factor { TimesE $1 $3 }+ | Term '/' Factor { DivE $1 $3 }+ | Factor { $1 }++Factor : '-' Atom { NegE $2 }+ | Atom { $1 }++Atom : int { IntE $1 }+ | var { VarE $1 }+ | '(' Exp ')' { $2 }++{+data Exp =+ LetE String Exp Exp |+ PlusE Exp Exp |+ MinusE Exp Exp |+ TimesE Exp Exp |+ DivE Exp Exp |+ NegE Exp |+ IntE Int |+ VarE String+ deriving Show+++main:: IO ()+main = interact (show.runCalc)++runCalc :: String -> Exp+runCalc = calc . alexScanTokens++happyError :: [Token] -> a+happyError tks = error ("Parse error at " ++ lcn ++ "\n")+ where+ lcn = case tks of+ [] -> "end of file"+ tk:_ -> "line " ++ show l ++ ", column " ++ show c+ where+ AlexPn _ l c = token_posn tk+}
+ examples/tkns.hs view
@@ -0,0 +1,5 @@+import Alex+import Tokens++main:: IO ()+main = interact (show.tokens)
+ examples/words.x view
@@ -0,0 +1,17 @@+-- Performance test; run with input /usr/dict/words, for example+{+module Main (main) where+}++%wrapper "basic"++words :-++$white+ ;+[A-Za-z0-9\'\-]+ { \s -> () }++{+main = do+ s <- getContents+ print (length (alexScanTokens s))+}
+ examples/words_monad.x view
@@ -0,0 +1,28 @@+-- Performance test; run with input /usr/dict/words, for example+{+module Main (main) where+}++%wrapper "monad"++words :-++$white+ { skip }+[A-Za-z0-9\'\-]+ { word }++{+word (_,_,input) len = return (take len input)++scanner str = runAlex str $ do+ let loop i = do tok <- alexMonadScan; + if tok == "stopped." || tok == "error." + then return i+ else do let i' = i+1 in i' `seq` loop i'+ loop 0++alexEOF = return "stopped."++main = do+ s <- getContents+ print (scanner s)+}
+ examples/words_posn.x view
@@ -0,0 +1,17 @@+-- Performance test; run with input /usr/dict/words, for example+{+module Main (main) where+}++%wrapper "posn"++words :-++$white+ ;+[A-Za-z0-9\'\-]+ { \p s -> () }++{+main = do+ s <- getContents+ print (length (alexScanTokens s))+}
+ src/AbsSyn.hs view
@@ -0,0 +1,263 @@+-- -----------------------------------------------------------------------------+-- +-- AbsSyn.hs, part of Alex+--+-- (c) Chris Dornan 1995-2000, Simon Marlow 2003+--+-- This module provides a concrete representation for regular expressions and+-- scanners. Scanners are used for tokenising files in preparation for parsing.+--+-- ----------------------------------------------------------------------------}++module AbsSyn (+ Code, Directive(..),+ Scanner(..),+ RECtx(..),+ RExp(..),+ DFA(..), State(..), SNum, StartCode, Accept(..),+ RightContext(..),+ encodeStartCodes, extractActions,+ Target(..)+ ) where++import CharSet ( CharSet )+import Map ( Map )+import qualified Map hiding ( Map )+import Sort ( nub' )+import Util ( str, nl )++import Data.Maybe ( fromJust )++infixl 4 :|+infixl 5 :%%++-- -----------------------------------------------------------------------------+-- Abstract Syntax for Alex scripts++type Code = String++data Directive+ = WrapperDirective String -- use this wrapper++-- TODO: update this comment+--+-- A `Scanner' consists of an association list associating token names with+-- regular expressions with context. The context may include a list of start+-- codes, some leading context to test the character immediately preceding the+-- token and trailing context to test the residual input after the token.+-- +-- The start codes consist of the names and numbers of the start codes;+-- initially the names only will be generated by the parser, the numbers being+-- allocated at a later stage. Start codes become meaningful when scanners are+-- converted to DFAs; see the DFA section of the Scan module for details.++data Scanner = Scanner { scannerName :: String,+ scannerTokens :: [RECtx] }+ deriving Show++data RECtx = RECtx { reCtxStartCodes :: [(String,StartCode)],+ reCtxPreCtx :: Maybe CharSet,+ reCtxRE :: RExp,+ reCtxPostCtx :: RightContext RExp,+ reCtxCode :: Maybe Code+ }++data RightContext r+ = NoRightContext + | RightContextRExp r+ | RightContextCode Code++instance Show RECtx where+ showsPrec _ (RECtx scs _ r rctx code) = + showStarts scs . shows r . showRCtx rctx . showMaybeCode code++showMaybeCode Nothing = id+showMaybeCode (Just code) = showCode code++showCode code = showString " { " . showString code . showString " }"++showStarts [] = id+showStarts scs = shows scs++showRCtx NoRightContext = id+showRCtx (RightContextRExp r) = ('\\':) . shows r+showRCtx (RightContextCode code) = showString "\\ " . showCode code++-- -----------------------------------------------------------------------------+-- DFAs++data DFA s a = DFA+ { dfa_start_states :: [s],+ dfa_states :: Map s (State s a)+ }++data State s a = State [Accept a] (Map Char s)++type SNum = Int++data Accept a+ = Acc { accPrio :: Int,+ accAction :: Maybe a,+ accLeftCtx :: Maybe CharSet,+ accRightCtx :: RightContext SNum+ }++type StartCode = Int++-- -----------------------------------------------------------------------------+-- Regular expressions++-- `RExp' provides an abstract syntax for regular expressions. `Eps' will+-- match empty strings; `Ch p' matches strings containinng a single character+-- `c' if `p c' is true; `re1 :%% re2' matches a string if `re1' matches one of+-- its prefixes and `re2' matches the rest; `re1 :| re2' matches a string if+-- `re1' or `re2' matches it; `Star re', `Plus re' and `Ques re' can be+-- expressed in terms of the other operators. See the definitions of `ARexp'+-- for a formal definition of the semantics of these operators.++data RExp + = Eps+ | Ch CharSet+ | RExp :%% RExp+ | RExp :| RExp+ | Star RExp+ | Plus RExp+ | Ques RExp ++instance Show RExp where+ showsPrec _ Eps = showString "()"+ showsPrec _ (Ch set) = showString "[..]"+ showsPrec _ (l :%% r) = shows l . shows r+ showsPrec _ (l :| r) = shows l . ('|':) . shows r+ showsPrec _ (Star r) = shows r . ('*':)+ showsPrec _ (Plus r) = shows r . ('+':)+ showsPrec _ (Ques r) = shows r . ('?':)++{------------------------------------------------------------------------------+ Abstract Regular Expression+------------------------------------------------------------------------------}+++-- This section contains demonstrations; it is not part of Alex.++{-+-- This function illustrates `ARexp'. It returns true if the string in its+-- argument is matched by the regular expression.++recognise:: RExp -> String -> Bool+recognise re inp = any (==len) (ap_ar (arexp re) inp)+ where+ len = length inp+++-- `ARexp' provides an regular expressions in abstract format. Here regular+-- expressions are represented by a function that takes the string to be+-- matched and returns the sizes of all the prefixes matched by the regular+-- expression (the list may contain duplicates). Each of the `RExp' operators+-- are represented by similarly named functions over ARexp. The `ap' function+-- takes an `ARExp', a string and returns the sizes of all the prefixes+-- matching that regular expression. `arexp' converts an `RExp' to an `ARexp'.+++arexp:: RExp -> ARexp+arexp Eps = eps_ar+arexp (Ch p) = ch_ar p+arexp (re :%% re') = arexp re `seq_ar` arexp re'+arexp (re :| re') = arexp re `bar_ar` arexp re'+arexp (Star re) = star_ar (arexp re)+arexp (Plus re) = plus_ar (arexp re)+arexp (Ques re) = ques_ar (arexp re)+++star_ar:: ARexp -> ARexp+star_ar sc = eps_ar `bar_ar` plus_ar sc++plus_ar:: ARexp -> ARexp+plus_ar sc = sc `seq_ar` star_ar sc++ques_ar:: ARexp -> ARexp+ques_ar sc = eps_ar `bar_ar` sc+++-- Hugs abstract type definition -- not for GHC.++type ARexp = String -> [Int]+-- in ap_ar, eps_ar, ch_ar, seq_ar, bar_ar++ap_ar:: ARexp -> String -> [Int]+ap_ar sc = sc++eps_ar:: ARexp+eps_ar inp = [0]++ch_ar:: (Char->Bool) -> ARexp+ch_ar p "" = []+ch_ar p (c:rst) = if p c then [1] else []++seq_ar:: ARexp -> ARexp -> ARexp+seq_ar sc sc' inp = [n+m| n<-sc inp, m<-sc' (drop n inp)]++bar_ar:: ARexp -> ARexp -> ARexp +bar_ar sc sc' inp = sc inp ++ sc' inp+-}++-- -----------------------------------------------------------------------------+-- Utils++-- Map the available start codes onto [1..]++encodeStartCodes:: Scanner -> (Scanner,[StartCode],ShowS)+encodeStartCodes scan = (scan', 0 : map snd name_code_pairs, sc_hdr)+ where+ scan' = scan{ scannerTokens = map mk_re_ctx (scannerTokens scan) }++ mk_re_ctx (RECtx scs lc re rc code)+ = RECtx (map mk_sc scs) lc re rc code++ mk_sc (nm,_) = (nm, if nm=="0" then 0 + else fromJust (Map.lookup nm code_map))++ sc_hdr tl =+ case name_code_pairs of+ [] -> tl+ (nm,_):rst -> "\n" ++ nm ++ foldr f t rst+ where+ f (nm, _) t = "," ++ nm ++ t+ t = " :: Int\n" ++ foldr fmt_sc tl name_code_pairs+ where+ fmt_sc (nm,sc) t = nm ++ " = " ++ show sc ++ "\n" ++ t++ code_map = Map.fromList name_code_pairs++ name_code_pairs = zip (nub' (<=) nms) [1..]++ nms = [nm | RECtx{reCtxStartCodes = scs} <- scannerTokens scan,+ (nm,_) <- scs, nm /= "0"]+++-- Grab the code fragments for the token actions, and replace them+-- with function names of the form alex_action_$n$. We do this+-- because the actual action fragments might be duplicated in the+-- generated file.++extractActions :: Scanner -> (Scanner,ShowS)+extractActions scanner = (scanner{scannerTokens = new_tokens}, decl_str)+ where+ (new_tokens, decls) = unzip (zipWith f (scannerTokens scanner) act_names)++ f r@RECtx{ reCtxCode = Just code } name+ = (r{reCtxCode = Just name}, Just (mkDecl name code))+ f r@RECtx{ reCtxCode = Nothing } name+ = (r{reCtxCode = Nothing}, Nothing)++ mkDecl fun code = str fun . str " = " . str code . nl++ act_names = map (\n -> "alex_action_" ++ show n) [0..]++ decl_str = foldr (.) id [ decl | Just decl <- decls ]++-- -----------------------------------------------------------------------------+-- Code generation targets++data Target = GhcTarget | HaskellTarget+
+ src/CharSet.hs view
@@ -0,0 +1,56 @@+-- -----------------------------------------------------------------------------+-- +-- CharSet.hs, part of Alex+--+-- (c) Chris Dornan 1995-2000, Simon Marlow 2003+--+-- An abstract CharSet type for Alex. To begin with we'll use Alex's+-- original definition of sets as functions, then later will+-- transition to something that will work better with Unicode.+--+-- ----------------------------------------------------------------------------}++module CharSet (+ CharSet, -- abstract+ emptyCharSet,+ charSetSingleton,+ charSet,+ charSetMinus,+ charSetComplement,+ charSetRange,+ charSetUnion,+ charSetToArray,+ charSetElems+ ) where++import Data.Array ( Array, array )++-- Implementation as functions+type CharSet = Char -> Bool++emptyCharSet = const False++charSetSingleton :: Char -> CharSet+charSetSingleton c = \x -> x == c++charSet :: [Char] -> CharSet+charSet s x = x `elem` s++charSetMinus :: CharSet -> CharSet -> CharSet+charSetMinus s1 s2 x = s1 x && not (s2 x)++charSetUnion :: CharSet -> CharSet -> CharSet+charSetUnion s1 s2 x = s1 x || s2 x++charSetComplement :: CharSet -> CharSet+charSetComplement s1 = not . s1++charSetRange :: Char -> Char -> CharSet+charSetRange c1 c2 x = x >= c1 && x <= c2++charSetToArray :: CharSet -> Array Char Bool+charSetToArray set = array (fst (head ass), fst (last ass)) ass+ where ass = [(c,set c) | c <- ['\0'..'\xff']]++charSetElems :: CharSet -> [Char]+charSetElems set = [c | c <- ['\0'..'\xff'], set c]
+ src/DFA.hs view
@@ -0,0 +1,245 @@+-- -----------------------------------------------------------------------------+-- +-- DFA.hs, part of Alex+--+-- (c) Chris Dornan 1995-2000, Simon Marlow 2003+--+-- This module generates a DFA from a scanner by first converting it+-- to an NFA and then converting the NFA with the subset construction.+-- +-- See the chapter on `Finite Automata and Lexical Analysis' in the+-- dragon book for an excellent overview of the algorithms in this+-- module.+--+-- ----------------------------------------------------------------------------}++module DFA(scanner2dfa) where++import AbsSyn+import qualified Map+import NFA+import Sort ( msort, nub' )++import Data.Array ( (!) )+import Data.Maybe ( fromJust )++{- Defined in the Scan Module++-- (This section should logically belong to the DFA module but it has been+-- placed here to make this module self-contained.)+-- +-- `DFA' provides an alternative to `Scanner' (described in the RExp module);+-- it can be used directly to scan text efficiently. Additionally it has an+-- extra place holder for holding action functions for generating+-- application-specific tokens. When this place holder is not being used, the+-- unit type will be used.+-- +-- Each state in the automaton consist of a list of `Accept' values, descending+-- in priority, and an array mapping characters to new states. As the array+-- may only cover a sub-range of the characters, a default state number is+-- given in the third field. By convention, all transitions to the -1 state+-- represent invalid transitions.+-- +-- A list of accept states is provided for as the original specification may+-- have been ambiguous, in which case the highest priority token should be+-- taken (the one appearing earliest in the specification); this can not be+-- calculated when the DFA is generated in all cases as some of the tokens may+-- be associated with leading or trailing context or start codes.+-- +-- `scan_token' (see above) can deal with unconditional accept states more+-- efficiently than those associated with context; to save it testing each time+-- whether the list of accept states contains an unconditional state, the flag+-- in the first field of `St' is set to true whenever the list contains an+-- unconditional state.+-- +-- The `Accept' structure contains the priority of the token being accepted+-- (lower numbers => higher priorities), the name of the token, a place holder+-- that can be used for storing the `action' function for constructing the+-- token from the input text and thge scanner's state, a list of start codes+-- (listing the start codes that the scanner must be in for the token to be+-- accepted; empty => no restriction), the leading and trailing context (both+-- `Nothing' if there is none).+-- +-- The leading context consists simply of a character predicate that will+-- return true if the last character read is acceptable. The trailing context+-- consists of an alternative starting state within the DFA; if this `sub-dfa'+-- turns up any accepting state when applied to the residual input then the+-- trailing context is acceptable (see `scan_token' above).++type DFA a = Array SNum (State a)++type SNum = Int++data State a = St Bool [Accept a] SNum (Array Char SNum)++data Accept a = Acc Int String a [StartCode] (MB(Char->Bool)) (MB SNum)++type StartCode = Int+-}+++-- Scanners are converted to DFAs by converting them to NFAs first. Converting+-- an NFA to a DFA works by identifying the states of the DFA with subsets of+-- the NFA. The PartDFA is used to construct the DFA; it is essentially a DFA+-- in which the states are represented directly by state sets of the NFA.+-- `nfa2pdfa' constructs the partial DFA from the NFA by searching for all the+-- transitions from a given list of state sets, initially containing the start+-- state of the partial DFA, until all possible state sets have been considered+-- The final DFA is then constructed with a `mk_dfa'.++scanner2dfa:: Scanner -> [StartCode] -> DFA SNum Code+scanner2dfa scanner scs = nfa2dfa scs (scanner2nfa scanner scs)++nfa2dfa:: [StartCode] -> NFA -> DFA SNum Code+nfa2dfa scs nfa = mk_int_dfa nfa (nfa2pdfa nfa pdfa (dfa_start_states pdfa))+ where+ pdfa = new_pdfa n_starts nfa+ n_starts = length scs -- number of start states++-- `nfa2pdfa' works by taking the next outstanding state set to be considered+-- and and ignoring it if the state is already in the partial DFA, otherwise+-- generating all possible transitions from it, adding the new state to the+-- partial DFA and continuing the closure with the extra states. Note the way+-- it incorporates the trailing context references into the search (by+-- including `rctx_ss' in the search).++nfa2pdfa:: NFA -> DFA StateSet Code -> [StateSet] -> DFA StateSet Code+nfa2pdfa nfa pdfa [] = pdfa+nfa2pdfa nfa pdfa (ss:umkd)+ | ss `in_pdfa` pdfa = nfa2pdfa nfa pdfa umkd+ | otherwise = nfa2pdfa nfa pdfa' umkd'+ where+ pdfa' = add_pdfa ss (State accs (Map.fromList ss_outs)) pdfa++ umkd' = rctx_sss ++ map snd ss_outs ++ umkd++ ss_outs = [ (ch, mk_ss nfa ss')+ | ch <- dfa_alphabet,+ let ss' = [ s' | (p,s') <- outs, p ch ],+ not (null ss')+ ]++ rctx_sss = [ mk_ss nfa [s]+ | s <- ss,+ Acc _ _ _ (RightContextRExp s) <- accs ]++ outs = [ out | s <- ss, out <- nst_outs (nfa!s) ]+ accs = sort_accs [acc| s<-ss, acc<-nst_accs (nfa!s)]++dfa_alphabet:: [Char]+dfa_alphabet = ['\0'..'\255']++-- `sort_accs' sorts a list of accept values into decending order of priority,+-- eliminating any elements that follow an unconditional accept value.++sort_accs:: [Accept a] -> [Accept a]+sort_accs accs = foldr chk [] (msort le accs)+ where+ chk acc@(Acc _ _ Nothing NoRightContext) rst = [acc]+ chk acc rst = acc:rst++ le (Acc{accPrio = n}) (Acc{accPrio=n'}) = n<=n'++++{------------------------------------------------------------------------------+ State Sets and Partial DFAs+------------------------------------------------------------------------------}++++-- A `PartDFA' is a partially constructed DFA in which the states are+-- represented by sets of states of the original NFA. It is represented by a+-- triple consisting of the start state of the partial DFA, the NFA from which+-- it is derived and a map from state sets to states of the partial DFA. The+-- state set for a given list of NFA states is calculated by taking the epsilon+-- closure of all the states, sorting the result with duplicates eliminated.++type StateSet = [SNum]++new_pdfa:: Int -> NFA -> DFA StateSet a+new_pdfa starts nfa+ = DFA { dfa_start_states = start_ss,+ dfa_states = Map.empty+ }+ where+ start_ss = [ msort (<=) (nst_cl(nfa!n)) | n <- [0..starts]]++ -- starts is the number of start states++-- constructs the epsilon-closure of a set of NFA states+mk_ss:: NFA -> [SNum] -> StateSet+mk_ss nfa l = nub' (<=) [s'| s<-l, s'<-nst_cl(nfa!s)]++add_pdfa:: StateSet -> State StateSet a -> DFA StateSet a -> DFA StateSet a+add_pdfa ss pst (DFA st mp) = DFA st (Map.insert ss pst mp)++in_pdfa:: StateSet -> DFA StateSet a -> Bool+in_pdfa ss (DFA _ mp) = ss `Map.member` mp++-- Construct a DFA with numbered states, from a DFA whose states are+-- sets of states from the original NFA.++mk_int_dfa:: NFA -> DFA StateSet a -> DFA SNum a+mk_int_dfa nfa pdfa@(DFA start_states mp)+ = DFA [0 .. length start_states-1] + (Map.fromList [ (lookup st, cnv pds) | (st, pds) <- Map.toAscList mp ])+ where+ mp' = Map.fromList (zip (start_states ++ + (map fst . Map.toAscList) (foldr Map.delete mp start_states)) [0..])++ lookup = fromJust . flip Map.lookup mp'++ cnv :: State StateSet a -> State SNum a+ cnv (State accs as) = State accs' as'+ where+ as' = Map.mapWithKey (\ch s -> lookup s) as++ accs' = map cnv_acc accs+ cnv_acc (Acc p a lctx rctx) = Acc p a lctx rctx'+ where rctx' = + case rctx of+ RightContextRExp s -> + RightContextRExp (lookup (mk_ss nfa [s]))+ other -> other++{-++-- `mk_st' constructs a state node from the list of accept values and a list of+-- transitions. The transitions list all the valid transitions out of the+-- node; all invalid transitions should be represented in the array by state+-- -1. `mk_st' has to work out whether the accept states contain an+-- unconditional entry, in which case the first field of `St' should be true,+-- and which default state to use in constructing the array (the array may span+-- a sub-range of the character set, the state number given the third argument+-- of `St' being taken as the default if an input character lies outside the+-- range). The default values is chosen to minimise the bounds of the array+-- and so there are two candidates: the value that 0 maps to (in which case+-- some initial segment of the array may be omitted) or the value that 255 maps+-- to (in which case a final segment of the array may be omitted), hence the+-- calculation of `(df,bds)'.+-- +-- Note that empty arrays are avoided as they can cause severe problems for+-- some popular Haskell compilers.++mk_st:: [Accept Code] -> [(Char,Int)] -> State Code+mk_st accs as =+ if null as+ then St accs (-1) (listArray ('0','0') [-1])+ else St accs df (listArray bds [arr!c| c<-range bds])+ where+ bds = if sz==0 then ('0','0') else bds0++ (sz,df,bds0) | sz1 < sz2 = (sz1,df1,bds1)+ | otherwise = (sz2,df2,bds2)++ (sz1,df1,bds1) = mk_bds(arr!chr 0)+ (sz2,df2,bds2) = mk_bds(arr!chr 255)++ mk_bds df = (t-b, df, (chr b, chr (255-t)))+ where+ b = length (takeWhile id [arr!c==df| c<-['\0'..'\xff']])+ t = length (takeWhile id [arr!c==df| c<-['\xff','\xfe'..'\0']])++ arr = listArray ('\0','\xff') (take 256 (repeat (-1))) // as+-}
+ src/DFS.hs view
@@ -0,0 +1,136 @@+{------------------------------------------------------------------------------+ DFS++This module is a portable version of the ghc-specific `DFS.g.hs', which is+itself a straightforward encoding of the Launchbury/King paper on linear graph+algorithms. This module uses balanced binary trees instead of mutable arrays+to implement the depth-first search so the complexity of the algorithms is+n.log(n) instead of linear.++The vertices of the graphs manipulated by these modules are labelled with the+integers from 0 to n-1 where n is the number of vertices in the graph.++The module's principle products are `mk_graph' for constructing a graph from an+edge list, `t_close' for taking the transitive closure of a graph and `scc'+for generating a list of strongly connected components; the components are+listed in dependency order and each component takes the form of a `dfs tree'+(see Launchberry and King). Thus if each edge (fid,fid') encodes the fact that+function `fid' references function `fid'' in a program then `scc' performs a+dependency analysis.++Chris Dornan, 23-Jun-94, 2-Jul-96, 29-Aug-96, 29-Sep-97+------------------------------------------------------------------------------}++module DFS where++import Set ( Set )+import qualified Set hiding ( Set )++import Data.Array ( (!), accumArray, listArray )++-- The result of a depth-first search of a graph is a list of trees,+-- `GForrest'. `post_order' provides a post-order traversal of a forrest.++type GForrest = [GTree]+data GTree = GNode Int GForrest++postorder:: GForrest -> [Int]+postorder ts = po ts []+ where+ po ts l = foldr po_tree l ts++ po_tree (GNode a ts) l = po ts (a:l)++list_tree:: GTree -> [Int]+list_tree t = l_t t []+ where+ l_t (GNode x ts) l = foldr l_t (x:l) ts+++-- Graphs are represented by a pair of an integer, giving the number of nodes+-- in the graph, and function mapping each vertex (0..n-1, n=size of graph) to+-- its neighbouring nodes. `mk_graph' takes a size and an edge list and+-- constructs a graph.++type Graph = (Int,Int->[Int])+type Edge = (Int,Int)++mk_graph:: Int -> [Edge] -> Graph+mk_graph sz es = (sz,\v->ar!v)+ where+ ar = accumArray (flip (:)) [] (0,sz-1) [(v,v')| (v,v')<-es]++vertices:: Graph -> [Int]+vertices (sz,_) = [0..sz-1]++out:: Graph -> Int -> [Int]+out (_,f) = f++edges:: Graph -> [Edge]+edges g = [(v,v')| v<-vertices g, v'<-out g v]++rev_edges:: Graph -> [Edge]+rev_edges g = [(v',v)| v<-vertices g, v'<-out g v]++reverse_graph:: Graph -> Graph+reverse_graph g@(sz,_) = mk_graph sz (rev_edges g)+++-- `t_close' takes the transitive closure of a graph; `scc' returns the stronly+-- connected components of the graph and `top_sort' topologically sorts the+-- graph. Note that the array is given one more element in order to avoid+-- problems with empty arrays.++t_close:: Graph -> Graph+t_close g@(sz,_) = (sz,\v->ar!v)+ where+ ar = listArray (0,sz) ([postorder(dff' [v] g)| v<-vertices g]++[und])+ und = error "t_close"++scc:: Graph -> GForrest+scc g = dff' (reverse (top_sort (reverse_graph g))) g++top_sort:: Graph -> [Int]+top_sort = postorder . dff +++-- `dff' computes the depth-first forrest. It works by unrolling the+-- potentially infinite tree from each of the vertices with `generate_g' and+-- then pruning out the duplicates.++dff:: Graph -> GForrest+dff g = dff' (vertices g) g++dff':: [Int] -> Graph -> GForrest+dff' vs (bs,f) = prune (map (generate_g f) vs)++generate_g:: (Int->[Int]) -> Int -> GTree+generate_g f v = GNode v (map (generate_g f) (f v))++prune:: GForrest -> GForrest+prune ts = snd(chop(empty_int,ts))+ where+ empty_int:: Set Int+ empty_int = Set.empty++chop:: (Set Int,GForrest) -> (Set Int,GForrest)+chop p@(vstd,[]) = p+chop (vstd,GNode v ts:us) =+ if v `Set.member` vstd+ then chop (vstd,us)+ else let vstd1 = Set.insert v vstd+ (vstd2,ts') = chop (vstd1,ts)+ (vstd3,us') = chop (vstd2,us)+ in+ (vstd3,GNode v ts' : us')+++{-- Some simple test functions++test:: Graph Char+test = mk_graph (char_bds ('a','h')) (mk_pairs "eefggfgegdhfhged")+ where+ mk_pairs [] = []+ mk_pairs (a:b:l) = (a,b):mk_pairs l++-}
+ src/Info.hs view
@@ -0,0 +1,64 @@+-- -----------------------------------------------------------------------------+-- +-- Info.hs, part of Alex+--+-- (c) Simon Marlow 2003+--+-- Generate a human-readable rendition of the state machine.+--+-- ----------------------------------------------------------------------------}++module Info (infoDFA) where++import AbsSyn+import qualified Map+import Util ( str, nl, interleave_shows, char, ljustify )++-- -----------------------------------------------------------------------------+-- Generate a human readable dump of the state machine++infoDFA :: Int -> String -> DFA SNum Code -> ShowS+infoDFA n func_nm dfa+ = str "Scanner : " . str func_nm . nl+ . str "States : " . shows (length dfa_list) . nl+ . nl . infoDFA dfa+ where + dfa_list = Map.toAscList (dfa_states dfa)++ infoDFA dfa = interleave_shows nl (map infoStateN dfa_list)++ infoStateN (i,s) = str "State " . shows i . nl . infoState s . nl++ infoState :: State SNum Code -> ShowS+ infoState (State accs out)+ = infoArr out . nl+ -- . str ("\tDefault -> ") . shows df++ infoArr out+ = char '\t' . interleave_shows (str "\n\t")+ (map infoTransition (Map.toAscList out))++ infoTransition (char,state)+ = str (ljustify 8 (show char))+ . str " -> "+ . shows state++-- outputAccs :: [Accept Code] -> ShowS+-- outputAccs accs+-- = brack (interleave_shows (char ',') (map (paren.outputAcc) accs))+-- +-- outputAcc (Acc prio act scs lctx rctx)+-- = str "Acc " . shows prio . space+-- . paren (str act) . space+-- . shows scs . space+-- . outputLCtx lctx . space+-- . shows rctx+--+-- outputLCtx Nothing+-- = str "Nothing"+-- outputLCtx (Just set)+-- = str "Just " . paren (outputArr (charSetToArray set))+--+-- outputArr arr+-- = str "Array.array " . shows (bounds arr) . space+-- . shows (assocs arr)
+ src/Main.hs view
@@ -0,0 +1,318 @@+-- -----------------------------------------------------------------------------+-- +-- Main.hs, part of Alex+--+-- (c) Chris Dornan 1995-2000, Simon Marlow 2003+--+-- ----------------------------------------------------------------------------}++module Main (main) where++import AbsSyn+import CharSet+import DFA+import Info+import Map ( Map )+import qualified Map hiding ( Map )+import Output+import ParseMonad ( runP )+import Parser+import Scan+import Util ( hline )+import Paths_alex ( version, getDataDir )++import Control.Exception as Exception ( block, unblock, catch, throw )+import Control.Monad ( when, liftM )+import Data.Char ( chr )+import Data.List ( isSuffixOf )+import Data.Maybe ( isJust, fromJust )+import Data.Version ( showVersion )+import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) )+import System.Directory ( removeFile )+import System.Environment ( getProgName, getArgs )+import System.Exit ( ExitCode(..), exitWith )+import System.IO ( stderr, Handle, IOMode(..), openFile, hClose, hPutStr, hPutStrLn )++-- `main' decodes the command line arguments and calls `alex'. ++main:: IO ()+main = do+ args <- getArgs+ case getOpt Permute argInfo args of+ (cli,_,[]) | DumpHelp `elem` cli -> do+ prog <- getProgramName+ bye (usageInfo (usageHeader prog) argInfo)+ (cli,_,[]) | DumpVersion `elem` cli ->+ bye copyright+ (cli,[file],[]) -> + runAlex cli file+ (_,_,errors) -> do+ prog <- getProgramName+ die (concat errors ++ usageInfo (usageHeader prog) argInfo)++projectVersion :: String+projectVersion = showVersion version++copyright :: String+copyright = "Alex version " ++ projectVersion ++ ", (c) 2003 Chris Dornan and Simon Marlow\n"++usageHeader :: String -> String+usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file\n"++runAlex :: [CLIFlags] -> FilePath -> IO ()+runAlex cli file = do+ basename <- case (reverse file) of+ 'x':'.':r -> return (reverse r)+ _ -> die (file ++ ": filename must end in \'.x\'\n")+ + prg <- readFile file+ script <- parseScript file prg+ alex cli file basename script++parseScript :: FilePath -> String+ -> IO (Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code))+parseScript file prg =+ case runP prg initialParserEnv parse of+ Left (Just (AlexPn _ line col),err) -> + die (file ++ ":" ++ show line ++ ":" ++ show col+ ++ ": " ++ err ++ "\n")+ Left (Nothing, err) ->+ die (file ++ ": " ++ err ++ "\n")++ Right script -> return script++alex :: [CLIFlags] -> FilePath -> FilePath+ -> (Maybe (AlexPosn, Code), [Directive], Scanner, Maybe (AlexPosn, Code))+ -> IO ()+alex cli file basename script = do+ (put_info, finish_info) <- + case [ f | OptInfoFile f <- cli ] of+ [] -> return (\_ -> return (), return ())+ [Nothing] -> infoStart file (basename ++ ".info")+ [Just f] -> infoStart file f+ _ -> dieAlex "multiple -i/--info options"+ + o_file <- case [ f | OptOutputFile f <- cli ] of+ [] -> return (basename ++ ".hs")+ [f] -> return f+ _ -> dieAlex "multiple -o/--outfile options"+ + let target + | OptGhcTarget `elem` cli = GhcTarget+ | otherwise = HaskellTarget++ template_dir <- templateDir getDataDir cli+ let template_name = templateFile template_dir target cli+ + -- open the output file; remove it if we encounter an error+ bracketOnError + (openFile o_file WriteMode)+ (\h -> do hClose h; removeFile o_file)+ $ \out_h -> do++ let+ (maybe_header, directives, scanner1, maybe_footer) = script+ (scanner2, scs, sc_hdr) = encodeStartCodes scanner1+ (scanner_final, actions) = extractActions scanner2+ + wrapper_name <- wrapperFile template_dir directives++ hPutStr out_h (optsToInject target cli)+ injectCode maybe_header file out_h++ hPutStr out_h (importsToInject target cli)++ let dfa = scanner2dfa scanner_final scs+ nm = scannerName scanner_final++ put_info (infoDFA 1 nm dfa "")+ hPutStr out_h (outputDFA target 1 nm dfa "")++ injectCode maybe_footer file out_h++ hPutStr out_h (sc_hdr "")+ hPutStr out_h (actions "")++ -- add the template+ tmplt <- readFile template_name+ hPutStr out_h tmplt++ -- add the wrapper, if necessary+ when (isJust wrapper_name) $+ do str <- readFile (fromJust wrapper_name)+ hPutStr out_h str++ hClose out_h+ finish_info++-- inject some code, and add a {-# LINE #-} pragma at the top+injectCode :: Maybe (AlexPosn,Code) -> FilePath -> Handle -> IO ()+injectCode Nothing _ _ = return ()+injectCode (Just (AlexPn _ ln _,code)) filename hdl = do+ hPutStrLn hdl ("{-# LINE " ++ show ln ++ " \"" ++ filename ++ "\" #-}")+ hPutStrLn hdl code++optsToInject :: Target -> [CLIFlags] -> String+optsToInject GhcTarget _ = "{-# OPTIONS -fglasgow-exts -cpp #-}\n"+optsToInject _ _ = "{-# OPTIONS -cpp #-}\n"++importsToInject :: Target -> [CLIFlags] -> String+importsToInject _ cli = always_imports ++ debug_imports ++ glaexts_import+ where+ glaexts_import | OptGhcTarget `elem` cli = import_glaexts+ | otherwise = ""++ debug_imports | OptDebugParser `elem` cli = import_debug+ | otherwise = ""++-- CPP is turned on for -fglasogw-exts, so we can use conditional+-- compilation. We need to #include "config.h" to get hold of+-- WORDS_BIGENDIAN (see GenericTemplate.hs).++always_imports :: String+always_imports = "#if __GLASGOW_HASKELL__ >= 603\n" +++ "#include \"ghcconfig.h\"\n" +++ "#else\n" +++ "#include \"config.h\"\n" +++ "#endif\n" +++ "#if __GLASGOW_HASKELL__ >= 503\n" +++ "import Data.Array\n" +++ "import Data.Char (ord)\n" +++ "import Data.Array.Base (unsafeAt)\n" +++ "#else\n" +++ "import Array\n" +++ "import Char (ord)\n" +++ "#endif\n"++import_glaexts :: String+import_glaexts = "#if __GLASGOW_HASKELL__ >= 503\n" +++ "import GHC.Exts\n" +++ "#else\n" +++ "import GlaExts\n" +++ "#endif\n"++import_debug :: String+import_debug = "#if __GLASGOW_HASKELL__ >= 503\n" +++ "import System.IO\n" +++ "import System.IO.Unsafe\n" +++ "import Debug.Trace\n" +++ "#else\n" +++ "import IO\n" +++ "import IOExts\n" +++ "#endif\n"++templateDir :: IO FilePath -> [CLIFlags] -> IO FilePath+templateDir def cli+ = case [ d | OptTemplateDir d <- cli ] of+ [] -> def+ ds -> return (last ds)++templateFile :: FilePath -> Target -> [CLIFlags] -> FilePath+templateFile dir target cli+ = dir ++ "/AlexTemplate" ++ maybe_ghc ++ maybe_debug+ where + maybe_ghc = case target of+ GhcTarget -> "-ghc"+ _ -> ""++ maybe_debug+ | OptDebugParser `elem` cli = "-debug"+ | otherwise = ""++wrapperFile :: FilePath -> [Directive] -> IO (Maybe FilePath)+wrapperFile dir directives =+ case [ f | WrapperDirective f <- directives ] of+ [] -> return Nothing+ [f] -> return (Just (dir ++ "/AlexWrapper-" ++ f))+ _many -> dieAlex "multiple %wrapper directives"++infoStart :: FilePath -> FilePath -> IO (String -> IO (), IO ())+infoStart x_file info_file = do+ bracketOnError+ (openFile info_file WriteMode)+ (\h -> do hClose h; removeFile info_file)+ (\h -> do infoHeader h x_file+ return (hPutStr h, hClose h)+ )++infoHeader :: Handle -> FilePath -> IO ()+infoHeader h file = do+ hPutStrLn h ("Info file produced by Alex version " ++ projectVersion ++ + ", from " ++ file)+ hPutStrLn h hline+ hPutStr h "\n"++initialParserEnv :: (Map String CharSet, Map String RExp)+initialParserEnv = (initSetEnv, initREEnv)++initSetEnv :: Map String CharSet+initSetEnv = Map.fromList [("white", charSet " \t\n\v\f\r"),+ ("printable", charSet [chr 32 .. chr 126]),+ (".", charSetComplement emptyCharSet + `charSetMinus` charSetSingleton '\n')]++initREEnv :: Map String RExp+initREEnv = Map.empty++-- -----------------------------------------------------------------------------+-- Command-line flags++data CLIFlags + = OptDebugParser+ | OptGhcTarget+ | OptOutputFile FilePath+ | OptInfoFile (Maybe FilePath)+ | OptTemplateDir FilePath+ | DumpHelp+ | DumpVersion+ deriving Eq++argInfo :: [OptDescr CLIFlags]+argInfo = [+ Option ['o'] ["outfile"] (ReqArg OptOutputFile "FILE")+ "write the output to FILE (default: file.hs)",+ Option ['i'] ["info"] (OptArg OptInfoFile "FILE")+ "put detailed state-machine info in FILE (or file.info)",+ Option ['t'] ["template"] (ReqArg OptTemplateDir "DIR")+ "look in DIR for template files",+ Option ['g'] ["ghc"] (NoArg OptGhcTarget)+ "use GHC extensions",+ Option ['d'] ["debug"] (NoArg OptDebugParser)+ "produce a debugging scanner",+ Option ['?'] ["help"] (NoArg DumpHelp)+ "display this help and exit",+ Option ['V','v'] ["version"] (NoArg DumpVersion) -- ToDo: -v is deprecated!+ "output version information and exit"+ ]++-- -----------------------------------------------------------------------------+-- Utils++getProgramName :: IO String+getProgramName = liftM (`withoutSuffix` ".bin") getProgName+ where str `withoutSuffix` suff+ | suff `isSuffixOf` str = take (length str - length suff) str+ | otherwise = str++bye :: String -> IO a+bye s = putStr s >> exitWith ExitSuccess++die :: String -> IO a+die s = hPutStr stderr s >> exitWith (ExitFailure 1)++dieAlex :: String -> IO a+dieAlex s = getProgramName >>= \prog -> die (prog ++ ": " ++ s)++bracketOnError+ :: IO a -- ^ computation to run first (\"acquire resource\")+ -> (a -> IO b) -- ^ computation to run last (\"release resource\")+ -> (a -> IO c) -- ^ computation to run in-between+ -> IO c -- returns the value from the in-between computation+bracketOnError before after thing =+ block (do+ a <- before + r <- Exception.catch + (unblock (thing a))+ (\e -> do { after a; throw e })+ return r+ )
+ src/Map.hs view
@@ -0,0 +1,67 @@+module Map (+ Map,+ member, lookup, findWithDefault,+ empty,+ insert, insertWith,+ delete,+ union, unionWith, unions,+ mapWithKey,+ elems,+ fromList, fromListWith,+ toAscList+) where++import Prelude hiding ( lookup )++#if __GLASGOW_HASKELL__ >= 603+import Data.Map+#else+import Data.FiniteMap++type Map k a = FiniteMap k a++member :: Ord k => k -> Map k a -> Bool+member = elemFM++lookup :: Ord k => k -> Map k a -> Maybe a+lookup = flip lookupFM++findWithDefault :: Ord k => a -> k -> Map k a -> a+findWithDefault a k m = lookupWithDefaultFM m a k++empty :: Map k a+empty = emptyFM++insert :: Ord k => k -> a -> Map k a -> Map k a+insert k a m = addToFM m k a++insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a+insertWith c k a m = addToFM_C c m k a++delete :: Ord k => k -> Map k a -> Map k a+delete = flip delFromFM++union :: Ord k => Map k a -> Map k a -> Map k a+union = flip plusFM++unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a+unionWith c l r = plusFM_C c r l++unions :: Ord k => [Map k a] -> Map k a+unions = foldl (flip plusFM) emptyFM++mapWithKey :: (k -> a -> b) -> Map k a -> Map k b+mapWithKey = mapFM++elems :: Map k a -> [a]+elems = eltsFM++fromList :: Ord k => [(k,a)] -> Map k a+fromList = listToFM++fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a +fromListWith c = addListToFM_C (flip c) emptyFM++toAscList :: Map k a -> [(k,a)]+toAscList = fmToList+#endif
+ src/NFA.hs view
@@ -0,0 +1,223 @@+-- -----------------------------------------------------------------------------+-- +-- NFA.hs, part of Alex+--+-- (c) Chris Dornan 1995-2000, Simon Marlow 2003+--+-- The `scanner2nfa' takes a `Scanner' (see the `RExp' module) and+-- generates its equivelent nondeterministic finite automaton. NFAs+-- are turned into DFAs in the DFA module.+-- +-- See the chapter on `Finite Automata and Lexical Analysis' in the+-- dragon book for an excellent overview of the algorithms in this+-- module.+--+-- ----------------------------------------------------------------------------}++module NFA where++import AbsSyn+import CharSet ( CharSet, charSetToArray )+import DFS ( t_close, out )+import Map ( Map )+import qualified Map hiding ( Map )+import Util ( str, space )++import Control.Monad ( zipWithM, zipWithM_ )+import Data.Array ( Array, (!), array, listArray, assocs, bounds )+--import Debug.Trace++-- Each state of a nondeterministic automaton contains a list of `Accept'+-- values, a list of epsilon transitions (an epsilon transition represents a+-- transition to another state that can be made without reading a character)+-- and a list of transitions qualified with a character predicate (the+-- transition can only be made to the given state on input of a character+-- permitted by the predicate). Although a list of `Accept' values is provided+-- for, in actual fact each state will have zero or one of them (the `Maybe'+-- type is not used because the flexibility offered by the list representation+-- is useful).++type NFA = Array SNum NState++data NState = NSt {+ nst_accs :: [Accept Code],+ nst_cl :: [SNum],+ nst_outs :: [(CharSet,SNum)]+ }++-- Debug stuff+instance Show (Accept a) where+ showsPrec _ (Acc p act lctx rctx) = shows p --TODO++instance Show NState where+ showsPrec _ (NSt accs cl outs) =+ str "NSt " . shows accs . space . shows cl . space .+ shows [ (charSetToArray c, s) | (c,s) <- outs ]++{- From the Scan Module++-- The `Accept' structure contains the priority of the token being accepted+-- (lower numbers => higher priorities), the name of the token, a place holder+-- that can be used for storing the `action' function, a list of start codes+-- (listing the start codes that the scanner must be in for the token to be+-- accepted; empty => no restriction), the leading and trailing context (both+-- `Nothing' if there is none).+-- +-- The leading context consists simply of a character predicate that will+-- return true if the last character read is acceptable. The trailing context+-- consists of an alternative starting state within the DFA; if this `sub-dfa'+-- turns up any accepting state when applied to the residual input then the+-- trailing context is acceptable.+-}+++-- `scanner2nfa' takes a scanner (see the AbsSyn module) and converts it to an+-- NFA, using the NFA creation monad (see below).+--+-- We generate a start state for each startcode, with the same number+-- as that startcode, and epsilon transitions from this state to each+-- of the sub-NFAs for each of the tokens acceptable in that startcode.++scanner2nfa:: Scanner -> [StartCode] -> NFA+scanner2nfa Scanner{scannerTokens = toks} startcodes+ = runNFA $+ do+ -- make a start state for each start code (these will be+ -- numbered from zero).+ start_states <- sequence (replicate (length startcodes) newState)+ + -- construct the NFA for each token+ tok_states <- zipWithM do_token toks [0..]++ -- make an epsilon edge from each state state to each+ -- token that is acceptable in that state+ zipWithM_ (tok_transitions (zip toks tok_states)) + startcodes start_states++ where+ do_token (RECtx scs lctx re rctx code) prio = do+ b <- newState+ e <- newState+ rexp2nfa b e re++ rctx_e <- case rctx of+ NoRightContext ->+ return NoRightContext+ RightContextCode code ->+ return (RightContextCode code)+ RightContextRExp re -> do + r_b <- newState+ r_e <- newState+ rexp2nfa r_b r_e re+ accept r_e rctxt_accept+ return (RightContextRExp r_b)+++ let lctx' = case lctx of+ Nothing -> Nothing+ Just st -> Just st++ accept e (Acc prio code lctx' rctx_e)+ return b++ tok_transitions toks_with_states start_code start_state = do+ let states = [ s | (RECtx scs _ _ _ _, s) <- toks_with_states,+ null scs || start_code `elem` map snd scs ]+ mapM_ (epsilonEdge start_state) states++-- -----------------------------------------------------------------------------+-- NFA creation from a regular expression++-- rexp2nfa B E R generates an NFA that begins in state B, recognises+-- R, and ends in state E only if R has been recognised. ++rexp2nfa :: SNum -> SNum -> RExp -> NFAM ()+rexp2nfa b e Eps = epsilonEdge b e+rexp2nfa b e (Ch p) = charEdge b p e+rexp2nfa b e (re1 :%% re2) = do+ s <- newState+ rexp2nfa b s re1+ rexp2nfa s e re2+rexp2nfa b e (re1 :| re2) = do+ rexp2nfa b e re1+ rexp2nfa b e re2+rexp2nfa b e (Star re) = do+ s <- newState+ epsilonEdge b s+ rexp2nfa s s re+ epsilonEdge s e+rexp2nfa b e (Plus re) = do+ s1 <- newState+ s2 <- newState+ rexp2nfa s1 s2 re+ epsilonEdge b s1+ epsilonEdge s2 s1+ epsilonEdge s2 e+rexp2nfa b e (Ques re) = do+ rexp2nfa b e re+ epsilonEdge b e++-- -----------------------------------------------------------------------------+-- NFA creation monad.++-- Partial credit to Thomas Hallgren for this code, as I adapted it from+-- his "Lexing Haskell in Haskell" lexer generator.++type MapNFA = Map SNum NState++newtype NFAM a = N {unN :: SNum -> MapNFA -> (SNum, MapNFA, a)}++instance Monad NFAM where+ return a = N $ \s n -> (s,n,a)++ m >>= k = N $ \s n -> case unN m s n of+ (s,n,a) -> unN (k a) s n++runNFA :: NFAM () -> NFA+runNFA m = case unN m 0 Map.empty of+ (s, nfa_map, ()) -> -- trace (show (Map.toAscList nfa_map)) $ + e_close (array (0,s-1) (Map.toAscList nfa_map))++e_close:: Array Int NState -> NFA+e_close ar = listArray bds+ [NSt accs (out gr v) outs|(v,NSt accs _ outs)<-assocs ar]+ where+ gr = t_close (hi+1,\v->nst_cl (ar!v))+ bds@(_,hi) = bounds ar++newState :: NFAM SNum+newState = N $ \s n -> (s+1,n,s)++charEdge :: SNum -> CharSet -> SNum -> NFAM ()+charEdge from charset to = N $ \s n -> (s, addEdge n from charset to, ())+ where+ addEdge n from charset to = + case Map.lookup from n of+ Nothing -> + Map.insert from (NSt [] [] [(charset,to)]) n+ Just (NSt acc eps trans) ->+ Map.insert from (NSt acc eps ((charset,to):trans)) n++epsilonEdge :: SNum -> SNum -> NFAM ()+epsilonEdge from to + | from == to = return ()+ | otherwise = N $ \s n -> (s, addEdge n from to, ())+ where+ addEdge n from to = + case Map.lookup from n of+ Nothing -> Map.insert from (NSt [] [to] []) n+ Just (NSt acc eps trans) -> Map.insert from (NSt acc (to:eps) trans) n++accept :: SNum -> Accept Code -> NFAM ()+accept state new_acc = N $ \s n -> (s, addAccept n state, ())+ where+ addAccept n state = + case Map.lookup state n of+ Nothing ->+ Map.insert state (NSt [new_acc] [] []) n+ Just (NSt acc eps trans) ->+ Map.insert state (NSt (new_acc:acc) eps trans) n+++rctxt_accept :: Accept Code+rctxt_accept = Acc 0 Nothing Nothing NoRightContext
+ src/Output.hs view
@@ -0,0 +1,336 @@+-- -----------------------------------------------------------------------------+-- +-- Output.hs, part of Alex+--+-- (c) Simon Marlow 2003+--+-- Code-outputing and table-generation routines+--+-- ----------------------------------------------------------------------------}++module Output (outputDFA) where++import AbsSyn+import CharSet+import Util+import qualified Map++import Control.Monad.ST ( ST, runST )+import Data.Array ( Array )+import Data.Array.Base ( unsafeRead )+import Data.Array.ST ( STUArray, newArray, readArray, writeArray, freeze )+import Data.Array.Unboxed ( UArray, bounds, assocs, elems, (!), array, listArray )+import Data.Bits+import Data.Char ( ord, chr )+-- import Debug.Trace+import Data.List ( maximumBy, sortBy, groupBy )++-- -----------------------------------------------------------------------------+-- Printing the output++outputDFA :: Target -> Int -> String -> DFA SNum Code -> ShowS+outputDFA target n func_nm dfa+ = interleave_shows nl + [outputBase, outputTable, outputCheck, outputDefault, outputAccept]+ where + (base, table, check, deflt, accept) = mkTables dfa++ table_size = length table - 1+ n_states = length base - 1++ base_nm = "alex_base"+ table_nm = "alex_table"+ check_nm = "alex_check"+ deflt_nm = "alex_deflt"+ accept_nm = "alex_accept"++ outputBase = do_array hexChars32 base_nm n_states base+ outputTable = do_array hexChars16 table_nm table_size table+ outputCheck = do_array hexChars16 check_nm table_size check+ outputDefault = do_array hexChars16 deflt_nm n_states deflt++ do_array hex_chars nm upper_bound ints = case target of+ GhcTarget ->+ str nm . str " :: AlexAddr\n"+ . str nm . str " = AlexA# \""+ . str (hex_chars ints)+ . str "\"#\n"++ _ ->+ str nm . str " :: Array Int Int\n"+ . str nm . str " = listArray (0," . shows upper_bound+ . str ") [" . interleave_shows (char ',') (map shows ints)+ . str "]\n"++ outputAccept+ = -- No type signature: we don't know what the type of the actions is.+ -- str accept_nm . str " :: Array Int (Accept Code)\n"+ str accept_nm . str " = listArray (0::Int," . shows n_states+ . str ") [" . interleave_shows (char ',') (map outputAccs accept)+ . str "]\n"++ outputAccs :: [Accept Code] -> ShowS+ outputAccs accs+ = brack (interleave_shows (char ',') (map (paren.outputAcc) accs))++ outputAcc (Acc prio Nothing Nothing NoRightContext)+ = str "AlexAccSkip"+ outputAcc (Acc prio (Just act) Nothing NoRightContext)+ = str "AlexAcc " . paren (str act)+ outputAcc (Acc prio Nothing lctx rctx)+ = str "AlexAccSkipPred " . space+ . paren (outputPred lctx rctx)+ outputAcc (Acc prio (Just act) lctx rctx)+ = str "AlexAccPred " . space+ . paren (str act) . space+ . paren (outputPred lctx rctx)++ outputPred (Just set) NoRightContext+ = outputLCtx set+ outputPred Nothing rctx+ = outputRCtx rctx+ outputPred (Just set) rctx+ = outputLCtx set+ . str " `alexAndPred` "+ . outputRCtx rctx++ outputLCtx set + = case charSetElems set of+ [] -> error "outputLCtx"+ [c] -> str "alexPrevCharIs " . shows c+ _other -> str "alexPrevCharIsOneOf " + . paren (outputArr (charSetToArray set))++ outputRCtx NoRightContext = id+ outputRCtx (RightContextRExp sn)+ = str "alexRightContext " . shows sn+ outputRCtx (RightContextCode code)+ = str code++ outputArr arr+ = str "array " . shows (bounds arr) . space+ . shows (assocs arr)++-- -----------------------------------------------------------------------------+-- Generating arrays.++-- Here we use the table-compression algorithm described in section+-- 3.9 of the dragon book, which is a common technique used by lexical+-- analyser generators.++-- We want to generate:+--+-- base :: Array SNum Int+-- maps the current state to an offset in the main table+--+-- table :: Array Int SNum+-- maps (base!state + char) to the next state+--+-- check :: Array Int SNum+-- maps (base!state + char) to state if table entry is valid,+-- otherwise we use the default for this state+--+-- default :: Array SNum SNum+-- default production for this state+--+-- accept :: Array SNum [Accept Code]+-- maps state to list of accept codes for this state+--+-- For each state, we decide what will be the default symbol (pick the+-- most common). We now have a mapping Char -> SNum, with one special+-- state reserved as the default.+++mkTables :: DFA SNum Code+ -> ( + [Int], -- base+ [Int], -- table+ [Int], -- check+ [Int], -- default+ [[Accept Code]] -- accept+ )+mkTables dfa+ = ( elems base_offs, + take max_off (elems table),+ take max_off (elems check),+ elems defaults,+ accept+ )+ where + accept = [ as | State as _ <- elems dfa_arr ]++ state_assocs = Map.toAscList (dfa_states dfa)+ n_states = length state_assocs+ top_state = n_states - 1++ dfa_arr :: Array SNum (State SNum Code)+ dfa_arr = array (0,top_state) state_assocs++ -- fill in all the error productions+ expand_states =+ [ expand (dfa_arr!state) | state <- [0..top_state] ]+ + expand (State _ out) = + [(i, lookup out i) | i <- ['\0'..'\255']]+ where lookup out i = case Map.lookup i out of+ Nothing -> -1+ Just s -> s++ defaults :: UArray SNum SNum+ defaults = listArray (0,top_state) (map best_default expand_states)++ -- find the most common destination state in a given state, and+ -- make it the default.+ best_default :: [(Char,SNum)] -> SNum+ best_default prod_list+ | null sorted = -1+ | otherwise = snd (head (maximumBy lengths eq))+ where sorted = sortBy compareSnds prod_list+ compareSnds (_,a) (_,b) = compare a b+ eq = groupBy (\(_,a) (_,b) -> a == b) sorted+ lengths a b = length a `compare` length b++ -- remove all the default productions from the DFA+ dfa_no_defaults =+ [ (s, prods_without_defaults s out)+ | (s, out) <- zip [0..] expand_states+ ]++ prods_without_defaults s out + = [ (ord c, dest) | (c,dest) <- out, dest /= defaults!s ]++ (base_offs, table, check, max_off)+ = runST (genTables n_states 255 dfa_no_defaults)+ ++genTables+ :: Int -- number of states+ -> Int -- maximum token no.+ -> [(SNum,[(Int,SNum)])] -- entries for the table+ -> ST s (UArray Int Int, -- base+ UArray Int Int, -- table+ UArray Int Int, -- check+ Int -- highest offset in table+ )++genTables n_states max_token entries = do++ base <- newArray (0, n_states-1) 0+ table <- newArray (0, mAX_TABLE_SIZE) 0+ check <- newArray (0, mAX_TABLE_SIZE) (-1)+ off_arr <- newArray (-max_token, mAX_TABLE_SIZE) 0++ max_off <- genTables' base table check off_arr entries max_token++ base' <- freeze base+ table' <- freeze table+ check' <- freeze check+ return (base', table',check',max_off+1)++ where mAX_TABLE_SIZE = n_states * (max_token + 1)+++genTables'+ :: STUArray s Int Int -- base+ -> STUArray s Int Int -- table+ -> STUArray s Int Int -- check+ -> STUArray s Int Int -- offset array+ -> [(SNum,[(Int,SNum)])] -- entries for the table+ -> Int -- maximum token no.+ -> ST s Int -- highest offset in table++genTables' base table check off_arr entries max_token+ = fit_all entries 0 1+ where++ fit_all [] max_off fst_zero = return max_off+ fit_all (s:ss) max_off fst_zero = do+ (off, new_max_off, new_fst_zero) <- fit s max_off fst_zero+ writeArray off_arr off 1+ fit_all ss new_max_off new_fst_zero++ -- fit a vector into the table. Return the offset of the vector,+ -- the maximum offset used in the table, and the offset of the first+ -- entry in the table (used to speed up the lookups a bit).+ fit (_,[]) max_off fst_zero = return (0,max_off,fst_zero)++ fit (state_no, state@((t,_):_)) max_off fst_zero = do+ -- start at offset 1 in the table: all the empty states+ -- (states with just a default reduction) are mapped to+ -- offset zero.+ off <- findFreeOffset (-t + fst_zero) check off_arr state+ let new_max_off | furthest_right > max_off = furthest_right+ | otherwise = max_off+ furthest_right = off + max_token++ --trace ("fit: state " ++ show state_no ++ ", off " ++ show off ++ ", elems " ++ show state) $ do++ writeArray base state_no off+ addState off table check state+ new_fst_zero <- findFstFreeSlot check fst_zero+ return (off, new_max_off, new_fst_zero)+++-- Find a valid offset in the table for this state.+findFreeOffset off check off_arr state = do+ -- offset 0 isn't allowed+ if off == 0 then try_next else do++ -- don't use an offset we've used before+ b <- readArray off_arr off+ if b /= 0 then try_next else do++ -- check whether the actions for this state fit in the table+ ok <- fits off state check+ if ok then return off else try_next + where+ try_next = findFreeOffset (off+1) check off_arr state++-- This is an inner loop, so we use some strictness hacks, and avoid+-- array bounds checks (unsafeRead instead of readArray) to speed+-- things up a bit.+fits :: Int -> [(Int,Int)] -> STUArray s Int Int -> ST s Bool+fits off [] check = off `seq` check `seq` return True -- strictness hacks+fits off ((t,_):rest) check = do+ i <- unsafeRead check (off+t)+ if i /= -1 then return False+ else fits off rest check++addState off table check [] = return ()+addState off table check ((t,val):state) = do+ writeArray table (off+t) val+ writeArray check (off+t) t+ addState off table check state++findFstFreeSlot :: STUArray s Int Int -> Int -> ST s Int+findFstFreeSlot table n = do+ i <- readArray table n+ if i == -1 then return n+ else findFstFreeSlot table (n+1)++-----------------------------------------------------------------------------+-- Convert an integer to a 16-bit number encoded in \xNN\xNN format suitable+-- for placing in a string (copied from Happy's ProduceCode.lhs)++hexChars16 :: [Int] -> String+hexChars16 acts = concat (map conv16 acts)+ where+ conv16 i | i > 0x7fff || i < -0x8000+ = error ("Internal error: hexChars16: out of range: " ++ show i)+ | otherwise+ = hexChar16 i++hexChars32 :: [Int] -> String+hexChars32 acts = concat (map conv32 acts)+ where+ conv32 i = hexChar16 (i .&. 0xffff) ++ + hexChar16 ((i `shiftR` 16) .&. 0xffff)++hexChar16 :: Int -> String+hexChar16 i = toHex (i .&. 0xff)+ ++ toHex ((i `shiftR` 8) .&. 0xff) -- force little-endian++toHex i = ['\\','x', hexDig (i `div` 16), hexDig (i `mod` 16)]++hexDig i | i <= 9 = chr (i + ord '0')+ | otherwise = chr (i - 10 + ord 'a')
+ src/ParseMonad.hs view
@@ -0,0 +1,127 @@+-- -----------------------------------------------------------------------------+-- +-- ParseMonad.hs, part of Alex+--+-- (c) Simon Marlow 2003+--+-- ----------------------------------------------------------------------------}++module ParseMonad (+ AlexInput, alexInputPrevChar, alexGetChar,+ AlexPosn(..), alexStartPos,+ + P, runP, StartCode, failP, lookupSMac, lookupRMac, newSMac, newRMac,+ setStartCode, getStartCode, getInput, setInput,+ ) where++import AbsSyn hiding ( StartCode )+import CharSet ( CharSet )+import Map ( Map )+import qualified Map hiding ( Map )++-- -----------------------------------------------------------------------------+-- The input type++type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ String) -- current input string++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,s) = c++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p,c,[]) = Nothing+alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq`+ Just (c, (p', c, s))++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text. It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.++data AlexPosn = AlexPn !Int !Int !Int+ deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)++-- -----------------------------------------------------------------------------+-- Alex lexing/parsing monad++type ParseError = (Maybe AlexPosn, String)+type StartCode = Int++data PState = PState {+ smac_env :: Map String CharSet,+ rmac_env :: Map String RExp,+ startcode :: Int,+ input :: AlexInput+ }++newtype P a = P { unP :: PState -> Either ParseError (PState,a) }++instance Monad P where+ (P m) >>= k = P $ \env -> case m env of+ Left err -> Left err+ Right (env',ok) -> unP (k ok) env'+ return a = P $ \env -> Right (env,a)++runP :: String -> (Map String CharSet, Map String RExp) + -> P a -> Either ParseError a+runP str (senv,renv) (P p) + = case p initial_state of+ Left err -> Left err+ Right (_,a) -> Right a+ where initial_state = + PState{ smac_env=senv, rmac_env=renv,+ startcode = 0, input=(alexStartPos,'\n',str) }++failP str = P $ \PState{ input = (p,_,_) } -> Left (Just p,str)++-- Macros are expanded during parsing, to simplify the abstract+-- syntax. The parsing monad passes around two environments mapping+-- macro names to sets and regexps respectively.++lookupSMac :: (AlexPosn,String) -> P CharSet+lookupSMac (posn,smac)+ = P $ \s@PState{ smac_env = senv } -> + case Map.lookup smac senv of+ Just ok -> Right (s,ok)+ Nothing -> Left (Just posn, "unknown set macro: $" ++ smac)++lookupRMac :: String -> P RExp+lookupRMac rmac + = P $ \s@PState{ rmac_env = renv } -> + case Map.lookup rmac renv of+ Just ok -> Right (s,ok)+ Nothing -> Left (Nothing, "unknown regex macro: %" ++ rmac)++newSMac :: String -> CharSet -> P ()+newSMac smac set + = P $ \s -> Right (s{smac_env = Map.insert smac set (smac_env s)}, ())++newRMac :: String -> RExp -> P ()+newRMac rmac rexp + = P $ \s -> Right (s{rmac_env = Map.insert rmac rexp (rmac_env s)}, ())++setStartCode :: StartCode -> P ()+setStartCode sc = P $ \s -> Right (s{ startcode = sc }, ())++getStartCode :: P StartCode+getStartCode = P $ \s -> Right (s, startcode s)++getInput :: P AlexInput+getInput = P $ \s -> Right (s, input s)++setInput :: AlexInput -> P ()+setInput inp = P $ \s -> Right (s{ input = inp }, ())
+ src/Parser.hs view
@@ -0,0 +1,1130 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+-- -----------------------------------------------------------------------------+-- +-- Parser.y, part of Alex+--+-- (c) Simon Marlow 2003+--+-- -----------------------------------------------------------------------------++module Parser ( parse, P ) where+import AbsSyn+import Scan+import CharSet+import ParseMonad hiding ( StartCode )++import Data.Char+--import Debug.Trace+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+#else+import Array+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif++-- parser produced by Happy Version 1.16++newtype HappyAbsSyn = HappyAbsSyn (() -> ())+happyIn4 :: ((Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code))) -> (HappyAbsSyn )+happyIn4 x = unsafeCoerce# x+{-# INLINE happyIn4 #-}+happyOut4 :: (HappyAbsSyn ) -> ((Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code)))+happyOut4 x = unsafeCoerce# x+{-# INLINE happyOut4 #-}+happyIn5 :: (Maybe (AlexPosn,Code)) -> (HappyAbsSyn )+happyIn5 x = unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> (Maybe (AlexPosn,Code))+happyOut5 x = unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: ([Directive]) -> (HappyAbsSyn )+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> ([Directive])+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (Directive) -> (HappyAbsSyn )+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (Directive)+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (()) -> (HappyAbsSyn )+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (())+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (()) -> (HappyAbsSyn )+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (())+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (Scanner) -> (HappyAbsSyn )+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (Scanner)+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: ([RECtx]) -> (HappyAbsSyn )+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> ([RECtx])+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: ([RECtx]) -> (HappyAbsSyn )+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> ([RECtx])+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: (RECtx) -> (HappyAbsSyn )+happyIn13 x = unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> (RECtx)+happyOut13 x = unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: ([RECtx]) -> (HappyAbsSyn )+happyIn14 x = unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> ([RECtx])+happyOut14 x = unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: ([(String,StartCode)]) -> (HappyAbsSyn )+happyIn15 x = unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> ([(String,StartCode)])+happyOut15 x = unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: ([(String,StartCode)]) -> (HappyAbsSyn )+happyIn16 x = unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> ([(String,StartCode)])+happyOut16 x = unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: (String) -> (HappyAbsSyn )+happyIn17 x = unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> (String)+happyOut17 x = unsafeCoerce# x+{-# INLINE happyOut17 #-}+happyIn18 :: (Maybe Code) -> (HappyAbsSyn )+happyIn18 x = unsafeCoerce# x+{-# INLINE happyIn18 #-}+happyOut18 :: (HappyAbsSyn ) -> (Maybe Code)+happyOut18 x = unsafeCoerce# x+{-# INLINE happyOut18 #-}+happyIn19 :: (Maybe CharSet, RExp, RightContext RExp) -> (HappyAbsSyn )+happyIn19 x = unsafeCoerce# x+{-# INLINE happyIn19 #-}+happyOut19 :: (HappyAbsSyn ) -> (Maybe CharSet, RExp, RightContext RExp)+happyOut19 x = unsafeCoerce# x+{-# INLINE happyOut19 #-}+happyIn20 :: (CharSet) -> (HappyAbsSyn )+happyIn20 x = unsafeCoerce# x+{-# INLINE happyIn20 #-}+happyOut20 :: (HappyAbsSyn ) -> (CharSet)+happyOut20 x = unsafeCoerce# x+{-# INLINE happyOut20 #-}+happyIn21 :: (RightContext RExp) -> (HappyAbsSyn )+happyIn21 x = unsafeCoerce# x+{-# INLINE happyIn21 #-}+happyOut21 :: (HappyAbsSyn ) -> (RightContext RExp)+happyOut21 x = unsafeCoerce# x+{-# INLINE happyOut21 #-}+happyIn22 :: (RExp) -> (HappyAbsSyn )+happyIn22 x = unsafeCoerce# x+{-# INLINE happyIn22 #-}+happyOut22 :: (HappyAbsSyn ) -> (RExp)+happyOut22 x = unsafeCoerce# x+{-# INLINE happyOut22 #-}+happyIn23 :: (RExp) -> (HappyAbsSyn )+happyIn23 x = unsafeCoerce# x+{-# INLINE happyIn23 #-}+happyOut23 :: (HappyAbsSyn ) -> (RExp)+happyOut23 x = unsafeCoerce# x+{-# INLINE happyOut23 #-}+happyIn24 :: (RExp) -> (HappyAbsSyn )+happyIn24 x = unsafeCoerce# x+{-# INLINE happyIn24 #-}+happyOut24 :: (HappyAbsSyn ) -> (RExp)+happyOut24 x = unsafeCoerce# x+{-# INLINE happyOut24 #-}+happyIn25 :: (RExp -> RExp) -> (HappyAbsSyn )+happyIn25 x = unsafeCoerce# x+{-# INLINE happyIn25 #-}+happyOut25 :: (HappyAbsSyn ) -> (RExp -> RExp)+happyOut25 x = unsafeCoerce# x+{-# INLINE happyOut25 #-}+happyIn26 :: (RExp) -> (HappyAbsSyn )+happyIn26 x = unsafeCoerce# x+{-# INLINE happyIn26 #-}+happyOut26 :: (HappyAbsSyn ) -> (RExp)+happyOut26 x = unsafeCoerce# x+{-# INLINE happyOut26 #-}+happyIn27 :: (CharSet) -> (HappyAbsSyn )+happyIn27 x = unsafeCoerce# x+{-# INLINE happyIn27 #-}+happyOut27 :: (HappyAbsSyn ) -> (CharSet)+happyOut27 x = unsafeCoerce# x+{-# INLINE happyOut27 #-}+happyIn28 :: (CharSet) -> (HappyAbsSyn )+happyIn28 x = unsafeCoerce# x+{-# INLINE happyIn28 #-}+happyOut28 :: (HappyAbsSyn ) -> (CharSet)+happyOut28 x = unsafeCoerce# x+{-# INLINE happyOut28 #-}+happyIn29 :: ([CharSet]) -> (HappyAbsSyn )+happyIn29 x = unsafeCoerce# x+{-# INLINE happyIn29 #-}+happyOut29 :: (HappyAbsSyn ) -> ([CharSet])+happyOut29 x = unsafeCoerce# x+{-# INLINE happyOut29 #-}+happyIn30 :: ((AlexPosn,String)) -> (HappyAbsSyn )+happyIn30 x = unsafeCoerce# x+{-# INLINE happyIn30 #-}+happyOut30 :: (HappyAbsSyn ) -> ((AlexPosn,String))+happyOut30 x = unsafeCoerce# x+{-# INLINE happyOut30 #-}+happyInTok :: Token -> (HappyAbsSyn )+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x72\x00\x72\x00\x66\x00\x00\x00\x52\x00\x51\x00\x60\x00\x67\x00\x00\x00\x00\x00\x63\x00\x51\x00\x7b\x00\x6d\x00\x00\x00\x5b\x00\x00\x00\x1a\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x49\x00\x7b\x00\x80\x00\x00\x00\x64\x00\x00\x00\x00\x00\x62\x00\x00\x00\x4d\x00\x13\x00\x00\x00\x13\x00\x00\x00\x01\x00\xff\xff\x6d\x00\x02\x00\x10\x00\x1b\x00\x00\x00\x00\x00\x7b\x00\x48\x00\x73\x00\x59\x00\x7b\x00\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x6d\x00\x00\x00\x15\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x25\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x69\x00\x39\x00\x5c\x00\x00\x00\x00\x00\x4b\x00\x4a\x00\x00\x00\x00\x00\x00\x00\x30\x00\x3a\x00\x11\x00\xfe\x00\x00\x00\x03\x01\x00\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x00\x2b\x00\x07\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\xaa\x00\x00\x00\x96\x00\x00\x00\xda\x00\xf6\xff\xec\x00\x22\x00\x00\x00\x20\x00\x00\x00\x00\x00\x23\x00\x00\x00\xc2\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\xff\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x00\x00\x00\xbc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\xfc\xff\x00\x00\xfa\xff\xfd\xff\x00\x00\xf7\xff\xfa\xff\x00\x00\xf9\xff\xfb\xff\x00\x00\xf7\xff\x00\x00\x00\x00\xf5\xff\xdb\xff\xd9\xff\xd7\xff\xcd\xff\xca\xff\xc7\xff\xc1\xff\x00\x00\x00\x00\xc2\xff\xcf\xff\xc9\xff\xc0\xff\xce\xff\xf6\xff\xf8\xff\xfc\xff\xf2\xff\xf4\xff\xf2\xff\xef\xff\x00\x00\x00\x00\x00\x00\xdd\xff\xcd\xff\x00\x00\xe2\xff\xfe\xff\x00\x00\x00\x00\xc2\xff\x00\x00\xc2\xff\xc4\xff\x00\x00\xd0\xff\xd8\xff\xd6\xff\xd5\xff\xd4\xff\x00\x00\xda\xff\x00\x00\xdc\xff\x00\x00\xcc\xff\x00\x00\xc6\xff\xc3\xff\xc8\xff\xcb\xff\x00\x00\xe9\xff\xe8\xff\xe7\xff\xe1\xff\xe3\xff\xe0\xff\x00\x00\xdd\xff\xee\xff\xe5\xff\xe6\xff\xf1\xff\xec\xff\xf3\xff\xec\xff\x00\x00\xe4\xff\xdf\xff\xde\xff\x00\x00\xeb\xff\xc5\xff\x00\x00\xd3\xff\xd2\xff\x00\x00\xea\xff\xf0\xff\xed\xff\xd1\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x02\x00\x01\x00\x0c\x00\x0e\x00\x12\x00\x13\x00\x14\x00\x06\x00\x16\x00\x17\x00\x18\x00\x0b\x00\x1a\x00\x0d\x00\x0c\x00\x0d\x00\x10\x00\x1b\x00\x12\x00\x01\x00\x14\x00\x03\x00\x15\x00\x17\x00\x1a\x00\x05\x00\x11\x00\x1b\x00\x1c\x00\x1d\x00\x0f\x00\x0d\x00\x0c\x00\x01\x00\x10\x00\x14\x00\x12\x00\x01\x00\x14\x00\x17\x00\x18\x00\x17\x00\x1a\x00\x0c\x00\x0d\x00\x1b\x00\x1c\x00\x1d\x00\x16\x00\x0d\x00\x11\x00\x19\x00\x10\x00\x06\x00\x12\x00\x01\x00\x14\x00\x01\x00\x18\x00\x17\x00\x1a\x00\x04\x00\x05\x00\x1b\x00\x1c\x00\x1d\x00\x18\x00\x0d\x00\x1a\x00\x15\x00\x10\x00\x0c\x00\x12\x00\x01\x00\x0c\x00\x02\x00\x03\x00\x17\x00\x04\x00\x05\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x05\x00\x0d\x00\x0e\x00\x04\x00\x10\x00\x13\x00\x12\x00\x01\x00\x1b\x00\x02\x00\x03\x00\x17\x00\x0e\x00\x07\x00\x1b\x00\x1b\x00\x1c\x00\x1d\x00\x1a\x00\x0d\x00\x00\x00\x01\x00\x10\x00\x13\x00\x12\x00\x01\x00\x1e\x00\x1f\x00\x0f\x00\x17\x00\x21\x00\x01\x00\x11\x00\x1b\x00\x1c\x00\x1d\x00\x0f\x00\x0d\x00\x18\x00\x01\x00\x10\x00\x17\x00\x12\x00\x20\x00\x01\x00\x0f\x00\x10\x00\x17\x00\x12\x00\x20\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x10\x00\x1a\x00\x12\x00\x1b\x00\x1c\x00\x10\x00\xff\xff\x12\x00\xff\xff\x14\x00\xff\xff\x1b\x00\x1c\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x07\x00\x08\x00\x09\x00\xff\xff\x0b\x00\xff\xff\xff\xff\xff\xff\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x09\x00\x0a\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x09\x00\x0a\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\x14\x00\x09\x00\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x0f\x00\x10\x00\xff\xff\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x12\x00\x13\x00\x14\x00\xff\xff\x16\x00\x17\x00\x18\x00\x14\x00\x1a\x00\x16\x00\x17\x00\x18\x00\xff\xff\x1a\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x4e\x00\x16\x00\x5d\x00\x4c\x00\x55\x00\x0f\x00\x10\x00\x4a\x00\x11\x00\x12\x00\x13\x00\x51\x00\x14\x00\x17\x00\x5e\x00\x44\x00\x18\x00\x5e\x00\x19\x00\x16\x00\x2b\x00\x2a\x00\x4b\x00\x1a\x00\x4f\x00\x5b\x00\x54\x00\x1b\x00\x1c\x00\x1d\x00\x2d\x00\x17\x00\x5c\x00\x2b\x00\x18\x00\x48\x00\x19\x00\x16\x00\x2b\x00\x1d\x00\x13\x00\x1a\x00\x14\x00\x43\x00\x44\x00\x1b\x00\x1c\x00\x1d\x00\x46\x00\x17\x00\x48\x00\x47\x00\x18\x00\x1f\x00\x19\x00\x16\x00\x2b\x00\x02\x00\x42\x00\x1a\x00\x14\x00\x1e\x00\x0b\x00\x1b\x00\x1c\x00\x1d\x00\x31\x00\x17\x00\x14\x00\x34\x00\x18\x00\x62\x00\x19\x00\x16\x00\x60\x00\x09\x00\x06\x00\x1a\x00\x0a\x00\x0b\x00\x57\x00\x1b\x00\x1c\x00\x1d\x00\x58\x00\x17\x00\x34\x00\x59\x00\x18\x00\x5a\x00\x19\x00\x16\x00\x3d\x00\x05\x00\x06\x00\x1a\x00\x3e\x00\x3b\x00\x42\x00\x1b\x00\x1c\x00\x1d\x00\x04\x00\x17\x00\x04\x00\x02\x00\x18\x00\x40\x00\x19\x00\x16\x00\x0d\x00\x0e\x00\x2d\x00\x1a\x00\xff\xff\x16\x00\x2e\x00\x1b\x00\x1c\x00\x1d\x00\x2d\x00\x17\x00\x21\x00\x16\x00\x18\x00\x09\x00\x19\x00\x08\x00\x16\x00\x2d\x00\x18\x00\x1a\x00\x19\x00\x08\x00\x00\x00\x1b\x00\x1c\x00\x1d\x00\x18\x00\x04\x00\x19\x00\x1b\x00\x1c\x00\x18\x00\x00\x00\x19\x00\x00\x00\x31\x00\x00\x00\x1b\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x1c\x00\x51\x00\x22\x00\x23\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x00\x00\x27\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x28\x00\x13\x00\x00\x00\x14\x00\x21\x00\x22\x00\x23\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x00\x00\x27\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x28\x00\x13\x00\x00\x00\x14\x00\x52\x00\x60\x00\x2e\x00\x13\x00\x3e\x00\x14\x00\x25\x00\x26\x00\x00\x00\x27\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x28\x00\x13\x00\x00\x00\x14\x00\x52\x00\x53\x00\x2e\x00\x13\x00\x40\x00\x14\x00\x25\x00\x26\x00\x00\x00\x27\x00\x0f\x00\x10\x00\x4f\x00\x11\x00\x28\x00\x13\x00\x00\x00\x14\x00\x25\x00\x26\x00\x00\x00\x27\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x28\x00\x13\x00\x00\x00\x14\x00\x3b\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x12\x00\x13\x00\x00\x00\x14\x00\x4b\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x12\x00\x13\x00\x00\x00\x14\x00\x32\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x12\x00\x13\x00\x00\x00\x14\x00\x0e\x00\x0f\x00\x10\x00\x00\x00\x11\x00\x12\x00\x13\x00\x39\x00\x14\x00\x11\x00\x12\x00\x13\x00\x00\x00\x14\x00\x2e\x00\x13\x00\x2f\x00\x14\x00\x36\x00\x37\x00\x38\x00\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = array (1, 63) [+ (1 , happyReduce_1),+ (2 , happyReduce_2),+ (3 , happyReduce_3),+ (4 , happyReduce_4),+ (5 , happyReduce_5),+ (6 , happyReduce_6),+ (7 , happyReduce_7),+ (8 , happyReduce_8),+ (9 , happyReduce_9),+ (10 , happyReduce_10),+ (11 , happyReduce_11),+ (12 , happyReduce_12),+ (13 , happyReduce_13),+ (14 , happyReduce_14),+ (15 , happyReduce_15),+ (16 , happyReduce_16),+ (17 , happyReduce_17),+ (18 , happyReduce_18),+ (19 , happyReduce_19),+ (20 , happyReduce_20),+ (21 , happyReduce_21),+ (22 , happyReduce_22),+ (23 , happyReduce_23),+ (24 , happyReduce_24),+ (25 , happyReduce_25),+ (26 , happyReduce_26),+ (27 , happyReduce_27),+ (28 , happyReduce_28),+ (29 , happyReduce_29),+ (30 , happyReduce_30),+ (31 , happyReduce_31),+ (32 , happyReduce_32),+ (33 , happyReduce_33),+ (34 , happyReduce_34),+ (35 , happyReduce_35),+ (36 , happyReduce_36),+ (37 , happyReduce_37),+ (38 , happyReduce_38),+ (39 , happyReduce_39),+ (40 , happyReduce_40),+ (41 , happyReduce_41),+ (42 , happyReduce_42),+ (43 , happyReduce_43),+ (44 , happyReduce_44),+ (45 , happyReduce_45),+ (46 , happyReduce_46),+ (47 , happyReduce_47),+ (48 , happyReduce_48),+ (49 , happyReduce_49),+ (50 , happyReduce_50),+ (51 , happyReduce_51),+ (52 , happyReduce_52),+ (53 , happyReduce_53),+ (54 , happyReduce_54),+ (55 , happyReduce_55),+ (56 , happyReduce_56),+ (57 , happyReduce_57),+ (58 , happyReduce_58),+ (59 , happyReduce_59),+ (60 , happyReduce_60),+ (61 , happyReduce_61),+ (62 , happyReduce_62),+ (63 , happyReduce_63)+ ]++happy_n_terms = 34 :: Int+happy_n_nonterms = 27 :: Int++happyReduce_1 = happyReduce 5# 0# happyReduction_1+happyReduction_1 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut5 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + case happyOut10 happy_x_4 of { happy_var_4 -> + case happyOut5 happy_x_5 of { happy_var_5 -> + happyIn4+ ((happy_var_1,happy_var_2,happy_var_4,happy_var_5)+ ) `HappyStk` happyRest}}}}++happyReduce_2 = happySpecReduce_1 1# happyReduction_2+happyReduction_2 happy_x_1+ = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn5+ (case happy_var_1 of T pos (CodeT code) -> + Just (pos,code)+ )}++happyReduce_3 = happySpecReduce_0 1# happyReduction_3+happyReduction_3 = happyIn5+ (Nothing+ )++happyReduce_4 = happySpecReduce_2 2# happyReduction_4+happyReduction_4 happy_x_2+ happy_x_1+ = case happyOut7 happy_x_1 of { happy_var_1 -> + case happyOut6 happy_x_2 of { happy_var_2 -> + happyIn6+ (happy_var_1 : happy_var_2+ )}}++happyReduce_5 = happySpecReduce_0 2# happyReduction_5+happyReduction_5 = happyIn6+ ([]+ )++happyReduce_6 = happySpecReduce_2 3# happyReduction_6+happyReduction_6 happy_x_2+ happy_x_1+ = case happyOutTok happy_x_2 of { (T _ (StringT happy_var_2)) -> + happyIn7+ (WrapperDirective happy_var_2+ )}++happyReduce_7 = happySpecReduce_2 4# happyReduction_7+happyReduction_7 happy_x_2+ happy_x_1+ = happyIn8+ (()+ )++happyReduce_8 = happySpecReduce_0 4# happyReduction_8+happyReduction_8 = happyIn8+ (()+ )++happyReduce_9 = happyMonadReduce 2# 5# happyReduction_9+happyReduction_9 (happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOutTok happy_x_1 of { (T _ (SMacDefT happy_var_1)) -> + case happyOut27 happy_x_2 of { happy_var_2 -> + ( newSMac happy_var_1 happy_var_2)}}+ ) (\r -> happyReturn (happyIn9 r))++happyReduce_10 = happyMonadReduce 2# 5# happyReduction_10+happyReduction_10 (happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOutTok happy_x_1 of { (T _ (RMacDefT happy_var_1)) -> + case happyOut22 happy_x_2 of { happy_var_2 -> + ( newRMac happy_var_1 happy_var_2)}}+ ) (\r -> happyReturn (happyIn9 r))++happyReduce_11 = happySpecReduce_2 6# happyReduction_11+happyReduction_11 happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (T _ (BindT happy_var_1)) -> + case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn10+ (Scanner happy_var_1 happy_var_2+ )}}++happyReduce_12 = happySpecReduce_2 7# happyReduction_12+happyReduction_12 happy_x_2+ happy_x_1+ = case happyOut12 happy_x_1 of { happy_var_1 -> + case happyOut11 happy_x_2 of { happy_var_2 -> + happyIn11+ (happy_var_1 ++ happy_var_2+ )}}++happyReduce_13 = happySpecReduce_0 7# happyReduction_13+happyReduction_13 = happyIn11+ ([]+ )++happyReduce_14 = happySpecReduce_2 8# happyReduction_14+happyReduction_14 happy_x_2+ happy_x_1+ = case happyOut15 happy_x_1 of { happy_var_1 -> + case happyOut13 happy_x_2 of { happy_var_2 -> + happyIn12+ ([ replaceCodes happy_var_1 happy_var_2 ]+ )}}++happyReduce_15 = happyReduce 4# 8# happyReduction_15+happyReduction_15 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOut15 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_3 of { happy_var_3 -> + happyIn12+ (map (replaceCodes happy_var_1) happy_var_3+ ) `HappyStk` happyRest}}++happyReduce_16 = happySpecReduce_1 8# happyReduction_16+happyReduction_16 happy_x_1+ = case happyOut13 happy_x_1 of { happy_var_1 -> + happyIn12+ ([ happy_var_1 ]+ )}++happyReduce_17 = happySpecReduce_2 9# happyReduction_17+happyReduction_17 happy_x_2+ happy_x_1+ = case happyOut19 happy_x_1 of { happy_var_1 -> + case happyOut18 happy_x_2 of { happy_var_2 -> + happyIn13+ (let (l,e,r) = happy_var_1 in + RECtx [] l e r happy_var_2+ )}}++happyReduce_18 = happySpecReduce_2 10# happyReduction_18+happyReduction_18 happy_x_2+ happy_x_1+ = case happyOut13 happy_x_1 of { happy_var_1 -> + case happyOut14 happy_x_2 of { happy_var_2 -> + happyIn14+ (happy_var_1 : happy_var_2+ )}}++happyReduce_19 = happySpecReduce_0 10# happyReduction_19+happyReduction_19 = happyIn14+ ([]+ )++happyReduce_20 = happySpecReduce_3 11# happyReduction_20+happyReduction_20 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut16 happy_x_2 of { happy_var_2 -> + happyIn15+ (happy_var_2+ )}++happyReduce_21 = happySpecReduce_3 12# happyReduction_21+happyReduction_21 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut17 happy_x_1 of { happy_var_1 -> + case happyOut16 happy_x_3 of { happy_var_3 -> + happyIn16+ ((happy_var_1,0) : happy_var_3+ )}}++happyReduce_22 = happySpecReduce_1 12# happyReduction_22+happyReduction_22 happy_x_1+ = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn16+ ([(happy_var_1,0)]+ )}++happyReduce_23 = happySpecReduce_1 13# happyReduction_23+happyReduction_23 happy_x_1+ = happyIn17+ ("0"+ )++happyReduce_24 = happySpecReduce_1 13# happyReduction_24+happyReduction_24 happy_x_1+ = case happyOutTok happy_x_1 of { (T _ (IdT happy_var_1)) -> + happyIn17+ (happy_var_1+ )}++happyReduce_25 = happySpecReduce_1 14# happyReduction_25+happyReduction_25 happy_x_1+ = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn18+ (case happy_var_1 of T _ (CodeT code) -> Just code+ )}++happyReduce_26 = happySpecReduce_1 14# happyReduction_26+happyReduction_26 happy_x_1+ = happyIn18+ (Nothing+ )++happyReduce_27 = happySpecReduce_3 15# happyReduction_27+happyReduction_27 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut20 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_2 of { happy_var_2 -> + case happyOut21 happy_x_3 of { happy_var_3 -> + happyIn19+ ((Just happy_var_1,happy_var_2,happy_var_3)+ )}}}++happyReduce_28 = happySpecReduce_2 15# happyReduction_28+happyReduction_28 happy_x_2+ happy_x_1+ = case happyOut22 happy_x_1 of { happy_var_1 -> + case happyOut21 happy_x_2 of { happy_var_2 -> + happyIn19+ ((Nothing,happy_var_1,happy_var_2)+ )}}++happyReduce_29 = happySpecReduce_1 16# happyReduction_29+happyReduction_29 happy_x_1+ = happyIn20+ (charSetSingleton '\n'+ )++happyReduce_30 = happySpecReduce_2 16# happyReduction_30+happyReduction_30 happy_x_2+ happy_x_1+ = case happyOut27 happy_x_1 of { happy_var_1 -> + happyIn20+ (happy_var_1+ )}++happyReduce_31 = happySpecReduce_1 17# happyReduction_31+happyReduction_31 happy_x_1+ = happyIn21+ (RightContextRExp (Ch (charSetSingleton '\n'))+ )++happyReduce_32 = happySpecReduce_2 17# happyReduction_32+happyReduction_32 happy_x_2+ happy_x_1+ = case happyOut22 happy_x_2 of { happy_var_2 -> + happyIn21+ (RightContextRExp happy_var_2+ )}++happyReduce_33 = happySpecReduce_2 17# happyReduction_33+happyReduction_33 happy_x_2+ happy_x_1+ = case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn21+ (RightContextCode (case happy_var_2 of + T _ (CodeT code) -> code)+ )}++happyReduce_34 = happySpecReduce_0 17# happyReduction_34+happyReduction_34 = happyIn21+ (NoRightContext+ )++happyReduce_35 = happySpecReduce_3 18# happyReduction_35+happyReduction_35 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOut22 happy_x_3 of { happy_var_3 -> + happyIn22+ (happy_var_1 :| happy_var_3+ )}}++happyReduce_36 = happySpecReduce_1 18# happyReduction_36+happyReduction_36 happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn22+ (happy_var_1+ )}++happyReduce_37 = happySpecReduce_2 19# happyReduction_37+happyReduction_37 happy_x_2+ happy_x_1+ = case happyOut23 happy_x_1 of { happy_var_1 -> + case happyOut24 happy_x_2 of { happy_var_2 -> + happyIn23+ (happy_var_1 :%% happy_var_2+ )}}++happyReduce_38 = happySpecReduce_1 19# happyReduction_38+happyReduction_38 happy_x_1+ = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn23+ (happy_var_1+ )}++happyReduce_39 = happySpecReduce_2 20# happyReduction_39+happyReduction_39 happy_x_2+ happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + case happyOut25 happy_x_2 of { happy_var_2 -> + happyIn24+ (happy_var_2 happy_var_1+ )}}++happyReduce_40 = happySpecReduce_1 20# happyReduction_40+happyReduction_40 happy_x_1+ = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn24+ (happy_var_1+ )}++happyReduce_41 = happySpecReduce_1 21# happyReduction_41+happyReduction_41 happy_x_1+ = happyIn25+ (Star+ )++happyReduce_42 = happySpecReduce_1 21# happyReduction_42+happyReduction_42 happy_x_1+ = happyIn25+ (Plus+ )++happyReduce_43 = happySpecReduce_1 21# happyReduction_43+happyReduction_43 happy_x_1+ = happyIn25+ (Ques+ )++happyReduce_44 = happySpecReduce_3 21# happyReduction_44+happyReduction_44 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOutTok happy_x_2 of { (T _ (CharT happy_var_2)) -> + happyIn25+ (repeat_rng (digit happy_var_2) Nothing+ )}++happyReduce_45 = happyReduce 4# 21# happyReduction_45+happyReduction_45 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_2 of { (T _ (CharT happy_var_2)) -> + happyIn25+ (repeat_rng (digit happy_var_2) (Just Nothing)+ ) `HappyStk` happyRest}++happyReduce_46 = happyReduce 5# 21# happyReduction_46+happyReduction_46 (happy_x_5 `HappyStk`+ happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest)+ = case happyOutTok happy_x_2 of { (T _ (CharT happy_var_2)) -> + case happyOutTok happy_x_4 of { (T _ (CharT happy_var_4)) -> + happyIn25+ (repeat_rng (digit happy_var_2) (Just (Just (digit happy_var_4)))+ ) `HappyStk` happyRest}}++happyReduce_47 = happySpecReduce_2 22# happyReduction_47+happyReduction_47 happy_x_2+ happy_x_1+ = happyIn26+ (Eps+ )++happyReduce_48 = happySpecReduce_1 22# happyReduction_48+happyReduction_48 happy_x_1+ = case happyOutTok happy_x_1 of { (T _ (StringT happy_var_1)) -> + happyIn26+ (foldr (:%%) Eps + (map (Ch . charSetSingleton) happy_var_1)+ )}++happyReduce_49 = happyMonadReduce 1# 22# happyReduction_49+happyReduction_49 (happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOutTok happy_x_1 of { (T _ (RMacT happy_var_1)) -> + ( lookupRMac happy_var_1)}+ ) (\r -> happyReturn (happyIn26 r))++happyReduce_50 = happySpecReduce_1 22# happyReduction_50+happyReduction_50 happy_x_1+ = case happyOut27 happy_x_1 of { happy_var_1 -> + happyIn26+ (Ch happy_var_1+ )}++happyReduce_51 = happySpecReduce_3 22# happyReduction_51+happyReduction_51 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut22 happy_x_2 of { happy_var_2 -> + happyIn26+ (happy_var_2+ )}++happyReduce_52 = happySpecReduce_3 23# happyReduction_52+happyReduction_52 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut27 happy_x_1 of { happy_var_1 -> + case happyOut28 happy_x_3 of { happy_var_3 -> + happyIn27+ (happy_var_1 `charSetMinus` happy_var_3+ )}}++happyReduce_53 = happySpecReduce_1 23# happyReduction_53+happyReduction_53 happy_x_1+ = case happyOut28 happy_x_1 of { happy_var_1 -> + happyIn27+ (happy_var_1+ )}++happyReduce_54 = happySpecReduce_1 24# happyReduction_54+happyReduction_54 happy_x_1+ = case happyOutTok happy_x_1 of { (T _ (CharT happy_var_1)) -> + happyIn28+ (charSetSingleton happy_var_1+ )}++happyReduce_55 = happySpecReduce_3 24# happyReduction_55+happyReduction_55 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOutTok happy_x_1 of { (T _ (CharT happy_var_1)) -> + case happyOutTok happy_x_3 of { (T _ (CharT happy_var_3)) -> + happyIn28+ (charSetRange happy_var_1 happy_var_3+ )}}++happyReduce_56 = happyMonadReduce 1# 24# happyReduction_56+happyReduction_56 (happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOut30 happy_x_1 of { happy_var_1 -> + ( lookupSMac happy_var_1)}+ ) (\r -> happyReturn (happyIn28 r))++happyReduce_57 = happySpecReduce_3 24# happyReduction_57+happyReduction_57 happy_x_3+ happy_x_2+ happy_x_1+ = case happyOut29 happy_x_2 of { happy_var_2 -> + happyIn28+ (foldr charSetUnion emptyCharSet happy_var_2+ )}++happyReduce_58 = happyMonadReduce 4# 24# happyReduction_58+happyReduction_58 (happy_x_4 `HappyStk`+ happy_x_3 `HappyStk`+ happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_3 of { happy_var_3 -> + ( do { dot <- lookupSMac (tokPosn happy_var_1, ".");+ return (dot `charSetMinus`+ foldr charSetUnion emptyCharSet happy_var_3) })}}+ ) (\r -> happyReturn (happyIn28 r))++happyReduce_59 = happyMonadReduce 2# 24# happyReduction_59+happyReduction_59 (happy_x_2 `HappyStk`+ happy_x_1 `HappyStk`+ happyRest) tk+ = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut28 happy_x_2 of { happy_var_2 -> + ( do { dot <- lookupSMac (tokPosn happy_var_1, ".");+ return (dot `charSetMinus` happy_var_2) })}}+ ) (\r -> happyReturn (happyIn28 r))++happyReduce_60 = happySpecReduce_2 25# happyReduction_60+happyReduction_60 happy_x_2+ happy_x_1+ = case happyOut27 happy_x_1 of { happy_var_1 -> + case happyOut29 happy_x_2 of { happy_var_2 -> + happyIn29+ (happy_var_1 : happy_var_2+ )}}++happyReduce_61 = happySpecReduce_0 25# happyReduction_61+happyReduction_61 = happyIn29+ ([]+ )++happyReduce_62 = happySpecReduce_1 26# happyReduction_62+happyReduction_62 happy_x_1+ = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn30+ ((tokPosn happy_var_1, ".")+ )}++happyReduce_63 = happySpecReduce_1 26# happyReduction_63+happyReduction_63 happy_x_1+ = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn30+ (case happy_var_1 of T p (SMacT s) -> (p, s)+ )}++happyNewToken action sts stk+ = lexer(\tk -> + let cont i = happyDoAction i tk action sts stk in+ case tk of {+ T _ EOFT -> happyDoAction 33# tk action sts stk;+ T _ (SpecialT '.') -> cont 1#;+ T _ (SpecialT ';') -> cont 2#;+ T _ (SpecialT '<') -> cont 3#;+ T _ (SpecialT '>') -> cont 4#;+ T _ (SpecialT ',') -> cont 5#;+ T _ (SpecialT '$') -> cont 6#;+ T _ (SpecialT '|') -> cont 7#;+ T _ (SpecialT '*') -> cont 8#;+ T _ (SpecialT '+') -> cont 9#;+ T _ (SpecialT '?') -> cont 10#;+ T _ (SpecialT '{') -> cont 11#;+ T _ (SpecialT '}') -> cont 12#;+ T _ (SpecialT '(') -> cont 13#;+ T _ (SpecialT ')') -> cont 14#;+ T _ (SpecialT '#') -> cont 15#;+ T _ (SpecialT '~') -> cont 16#;+ T _ (SpecialT '-') -> cont 17#;+ T _ (SpecialT '[') -> cont 18#;+ T _ (SpecialT ']') -> cont 19#;+ T _ (SpecialT '^') -> cont 20#;+ T _ (SpecialT '/') -> cont 21#;+ T _ ZeroT -> cont 22#;+ T _ (StringT happy_dollar_dollar) -> cont 23#;+ T _ (BindT happy_dollar_dollar) -> cont 24#;+ T _ (IdT happy_dollar_dollar) -> cont 25#;+ T _ (CodeT _) -> cont 26#;+ T _ (CharT happy_dollar_dollar) -> cont 27#;+ T _ (SMacT _) -> cont 28#;+ T _ (RMacT happy_dollar_dollar) -> cont 29#;+ T _ (SMacDefT happy_dollar_dollar) -> cont 30#;+ T _ (RMacDefT happy_dollar_dollar) -> cont 31#;+ T _ WrapperT -> cont 32#;+ _ -> happyError' tk+ })++happyError_ tk = happyError' tk++happyThen :: () => P a -> (a -> P b) -> P b+happyThen = ((>>=))+happyReturn :: () => a -> P a+happyReturn = (return)+happyThen1 = happyThen+happyReturn1 :: () => a -> P a+happyReturn1 = happyReturn+happyError' :: () => Token -> P a+happyError' tk = (\token -> happyError) tk++parse = happySomeParser where+ happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut4 x))++happySeq = happyDontSeq+++happyError :: P a+happyError = failP "parse error"++-- -----------------------------------------------------------------------------+-- Utils++digit c = ord c - ord '0'++repeat_rng :: Int -> Maybe (Maybe Int) -> (RExp->RExp)+repeat_rng n (Nothing) re = foldr (:%%) Eps (replicate n re)+repeat_rng n (Just Nothing) re = foldr (:%%) (Star re) (replicate n re)+repeat_rng n (Just (Just m)) re = intl :%% rst+ where+ intl = repeat_rng n Nothing re+ rst = foldr (\re re'->Ques(re :%% re')) Eps (replicate (m-n) re)++replaceCodes codes rectx = rectx{ reCtxStartCodes = codes }+{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 28 "GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList++++++{-# LINE 49 "GenericTemplate.hs" #-}++{-# LINE 59 "GenericTemplate.hs" #-}++{-# LINE 68 "GenericTemplate.hs" #-}++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser). We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+ happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+ = {- nothing -}+++ case action of+ 0# -> {- nothing -}+ happyFail i tk st+ -1# -> {- nothing -}+ happyAccept i tk st+ n | (n <# (0# :: Int#)) -> {- nothing -}++ (happyReduceArr ! rule) i tk st+ where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+ n -> {- nothing -}+++ happyShift new_state i tk st+ where new_state = (n -# (1# :: Int#))+ where off = indexShortOffAddr happyActOffsets st+ off_i = (off +# i)+ check = if (off_i >=# (0# :: Int#))+ then (indexShortOffAddr happyCheck off_i ==# i)+ else False+ action | check = indexShortOffAddr happyTable off_i+ | otherwise = indexShortOffAddr happyDefActions st++{-# LINE 127 "GenericTemplate.hs" #-}+++indexShortOffAddr (HappyA# arr) off =+#if __GLASGOW_HASKELL__ > 500+ narrow16Int# i+#elif __GLASGOW_HASKELL__ == 500+ intToInt16# i+#else+ (i `iShiftL#` 16#) `iShiftRA#` 16#+#endif+ where+#if __GLASGOW_HASKELL__ >= 503+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+#else+ i = word2Int# ((high `shiftL#` 8#) `or#` low)+#endif+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+ let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+-- trace "shifting the error token" $+ happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+ happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+ = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+ = let r = fn v1 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+ = let r = fn v1 v2 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+ = let r = fn v1 v2 v3 in+ happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+ = case happyDrop (k -# (1# :: Int#)) sts of+ sts1@((HappyCons (st1@(action)) (_))) ->+ let r = fn stk in -- it doesn't hurt to always seq here...+ happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+ where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ drop_stk = happyDropStk k stk++happyMonad2Reduce k nt fn 0# tk st sts stk+ = happyFail 0# tk st sts stk+happyMonad2Reduce k nt fn j tk st sts stk =+ happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))+ where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+ drop_stk = happyDropStk k stk++ off = indexShortOffAddr happyGotoOffsets st1+ off_i = (off +# nt)+ new_state = indexShortOffAddr happyTable off_i+++++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = + {- nothing -}+ happyDoAction j tk new_state+ where off = indexShortOffAddr happyGotoOffsets st+ off_i = (off +# nt)+ new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail 0# tk old_st _ stk =+-- trace "failing" $ + happyError_ tk++{- We don't need state discarding for our restricted implementation of+ "error". In fact, it can cause some bogus parses, so I've disabled it+ for now --SDM++-- discard a state+happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) =+-- trace ("discarding state, depth " ++ show (length stk)) $+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+-- save the old token and carry on.+happyFail i tk (action) sts stk =+-- trace "entering error recovery" $+ happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq+-- otherwise it emits+-- happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template. GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ src/Parser.y view
@@ -0,0 +1,218 @@+{+-- -----------------------------------------------------------------------------+-- +-- Parser.y, part of Alex+--+-- (c) Simon Marlow 2003+--+-- -----------------------------------------------------------------------------++module Parser ( parse, P ) where+import AbsSyn+import Scan+import CharSet+import ParseMonad hiding ( StartCode )++import Data.Char+--import Debug.Trace+}++%tokentype { Token }++%name parse++%monad { P } { (>>=) } { return }+%lexer { lexer } { T _ EOFT }++%token+ '.' { T _ (SpecialT '.') }+ ';' { T _ (SpecialT ';') }+ '<' { T _ (SpecialT '<') }+ '>' { T _ (SpecialT '>') }+ ',' { T _ (SpecialT ',') }+ '$' { T _ (SpecialT '$') }+ '|' { T _ (SpecialT '|') }+ '*' { T _ (SpecialT '*') }+ '+' { T _ (SpecialT '+') }+ '?' { T _ (SpecialT '?') }+ '{' { T _ (SpecialT '{') }+ '}' { T _ (SpecialT '}') }+ '(' { T _ (SpecialT '(') }+ ')' { T _ (SpecialT ')') }+ '#' { T _ (SpecialT '#') }+ '~' { T _ (SpecialT '~') }+ '-' { T _ (SpecialT '-') }+ '[' { T _ (SpecialT '[') }+ ']' { T _ (SpecialT ']') }+ '^' { T _ (SpecialT '^') }+ '/' { T _ (SpecialT '/') }+ ZERO { T _ ZeroT }+ STRING { T _ (StringT $$) }+ BIND { T _ (BindT $$) }+ ID { T _ (IdT $$) }+ CODE { T _ (CodeT _) }+ CHAR { T _ (CharT $$) }+ SMAC { T _ (SMacT _) }+ RMAC { T _ (RMacT $$) }+ SMAC_DEF { T _ (SMacDefT $$) }+ RMAC_DEF { T _ (RMacDefT $$) }+ WRAPPER { T _ WrapperT }+%%++alex :: { (Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code)) }+ : maybe_code directives macdefs scanner maybe_code { ($1,$2,$4,$5) }++maybe_code :: { Maybe (AlexPosn,Code) }+ : CODE { case $1 of T pos (CodeT code) -> + Just (pos,code) }+ | {- empty -} { Nothing }++directives :: { [Directive] }+ : directive directives { $1 : $2 }+ | {- empty -} { [] }++directive :: { Directive }+ : WRAPPER STRING { WrapperDirective $2 }++macdefs :: { () }+ : macdef macdefs { () }+ | {- empty -} { () }++-- hack: the lexer looks for the '=' in a macro definition, because there+-- doesn't seem to be a way to formulate the grammar here to avoid a+-- conflict (it needs LR(2) rather than LR(1) to find the '=' and distinguish+-- an SMAC/RMAC at the beginning of a definition from an SMAC/RMAC that is+-- part of a regexp in the previous definition).+macdef :: { () }+ : SMAC_DEF set {% newSMac $1 $2 }+ | RMAC_DEF rexp {% newRMac $1 $2 }++scanner :: { Scanner }+ : BIND tokendefs { Scanner $1 $2 }++tokendefs :: { [RECtx] }+ : tokendef tokendefs { $1 ++ $2 }+ | {- empty -} { [] }++tokendef :: { [RECtx] }+ : startcodes rule { [ replaceCodes $1 $2 ] }+ | startcodes '{' rules '}' { map (replaceCodes $1) $3 }+ | rule { [ $1 ] }++rule :: { RECtx }+ : context rhs { let (l,e,r) = $1 in + RECtx [] l e r $2 }++rules :: { [RECtx] }+ : rule rules { $1 : $2 }+ | {- empty -} { [] }++startcodes :: { [(String,StartCode)] }+ : '<' startcodes0 '>' { $2 }++startcodes0 :: { [(String,StartCode)] }+ : startcode ',' startcodes0 { ($1,0) : $3 }+ | startcode { [($1,0)] }++startcode :: { String }+ : ZERO { "0" }+ | ID { $1 }++rhs :: { Maybe Code }+ : CODE { case $1 of T _ (CodeT code) -> Just code }+ | ';' { Nothing }++context :: { Maybe CharSet, RExp, RightContext RExp }+ : left_ctx rexp right_ctx { (Just $1,$2,$3) }+ | rexp right_ctx { (Nothing,$1,$2) }++left_ctx :: { CharSet }+ : '^' { charSetSingleton '\n' }+ | set '^' { $1 }++right_ctx :: { RightContext RExp }+ : '$' { RightContextRExp (Ch (charSetSingleton '\n')) }+ | '/' rexp { RightContextRExp $2 }+ | '/' CODE { RightContextCode (case $2 of + T _ (CodeT code) -> code) }+ | {- empty -} { NoRightContext }++rexp :: { RExp }+ : alt '|' rexp { $1 :| $3 }+ | alt { $1 }++alt :: { RExp }+ : alt term { $1 :%% $2 }+ | term { $1 }++term :: { RExp }+ : rexp0 rep { $2 $1 }+ | rexp0 { $1 }++rep :: { RExp -> RExp }+ : '*' { Star }+ | '+' { Plus }+ | '?' { Ques }+ -- TODO: these don't check for digits+ -- properly.+ | '{' CHAR '}' { repeat_rng (digit $2) Nothing }+ | '{' CHAR ',' '}' { repeat_rng (digit $2) (Just Nothing) }+ | '{' CHAR ',' CHAR '}' { repeat_rng (digit $2) (Just (Just (digit $4))) }++rexp0 :: { RExp }+ : '(' ')' { Eps }+ | STRING { foldr (:%%) Eps + (map (Ch . charSetSingleton) $1) }+ | RMAC {% lookupRMac $1 }+ | set { Ch $1 }+ | '(' rexp ')' { $2 }++set :: { CharSet }+ : set '#' set0 { $1 `charSetMinus` $3 }+ | set0 { $1 }++set0 :: { CharSet }+ : CHAR { charSetSingleton $1 }+ | CHAR '-' CHAR { charSetRange $1 $3 }+ | smac {% lookupSMac $1 }+ | '[' sets ']' { foldr charSetUnion emptyCharSet $2 }++ -- [^sets] is the same as '. # [sets]'+ -- The upshot is that [^set] does *not* match a newline character,+ -- which seems much more useful than just taking the complement.+ | '[' '^' sets ']' + {% do { dot <- lookupSMac (tokPosn $1, ".");+ return (dot `charSetMinus`+ foldr charSetUnion emptyCharSet $3) }}++ -- ~set is the same as '. # set'+ | '~' set0 {% do { dot <- lookupSMac (tokPosn $1, ".");+ return (dot `charSetMinus` $2) } }++sets :: { [CharSet] }+ : set sets { $1 : $2 }+ | {- empty -} { [] }++smac :: { (AlexPosn,String) }+ : '.' { (tokPosn $1, ".") }+ | SMAC { case $1 of T p (SMacT s) -> (p, s) }++{+happyError :: P a+happyError = failP "parse error"++-- -----------------------------------------------------------------------------+-- Utils++digit c = ord c - ord '0'++repeat_rng :: Int -> Maybe (Maybe Int) -> (RExp->RExp)+repeat_rng n (Nothing) re = foldr (:%%) Eps (replicate n re)+repeat_rng n (Just Nothing) re = foldr (:%%) (Star re) (replicate n re)+repeat_rng n (Just (Just m)) re = intl :%% rst+ where+ intl = repeat_rng n Nothing re+ rst = foldr (\re re'->Ques(re :%% re')) Eps (replicate (m-n) re)++replaceCodes codes rectx = rectx{ reCtxStartCodes = codes }+}
+ src/Scan.hs view
@@ -0,0 +1,354 @@+{-# OPTIONS -cpp #-}+{-# LINE 13 "Scan.x" #-}+module Scan(lexer, AlexPosn(..), Token(..), Tkn(..), tokPosn) where++import Data.Char+import ParseMonad+--import Debug.Trace++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#else+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+alex_base :: Array Int Int+alex_base = listArray (0,76) [-8,110,137,119,124,-4,-3,-37,-36,0,128,129,0,114,-35,115,-34,251,365,256,116,117,-33,0,138,0,423,0,-106,-100,-82,-96,-95,-83,-94,222,331,515,594,617,341,649,0,0,655,770,884,644,968,1052,1113,1227,1341,1455,1453,1537,1598,0,135,396,167,168,-26,0,169,801,170,281,-24,0,0,1682,1766,0,0,0,736]++alex_table :: Array Int Int+alex_table = listArray (0,2021) [0,4,4,4,4,4,-1,-1,5,5,12,12,20,29,30,31,32,33,34,60,27,66,0,0,4,43,10,25,26,28,43,43,25,25,25,25,25,8,25,25,43,43,43,43,43,43,43,43,43,43,16,25,69,43,43,25,44,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,25,37,25,25,43,43,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,24,25,25,25,4,4,4,4,4,-1,-1,-1,-1,4,4,4,4,4,4,4,4,4,4,-1,-1,0,0,4,0,0,-1,4,4,4,4,4,4,0,0,0,7,4,0,0,0,13,0,9,9,7,0,0,0,0,4,0,0,15,15,15,15,0,-1,-1,-1,-1,73,7,0,0,70,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,58,0,0,74,0,0,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,58,58,64,64,0,76,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,71,19,19,19,19,19,19,19,19,19,19,35,35,35,35,35,35,35,35,35,35,0,0,0,19,0,0,0,0,19,0,18,-1,0,0,0,0,22,0,0,18,18,18,18,18,18,18,18,18,18,14,0,0,0,0,14,0,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,64,0,0,0,18,0,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,19,19,19,19,19,35,35,35,35,35,35,35,35,35,35,40,40,40,40,40,40,40,40,19,0,0,0,0,0,0,18,59,59,59,59,59,22,0,0,18,18,18,18,18,18,18,18,18,18,14,0,0,0,0,59,0,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,0,57,0,0,18,0,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,0,0,0,0,0,0,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,45,50,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,36,36,36,36,36,36,36,36,36,36,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,42,41,42,42,42,42,42,42,42,42,39,42,42,42,42,42,42,38,38,38,38,38,38,38,38,38,38,0,59,59,59,59,59,0,38,38,38,38,38,38,38,38,38,38,38,38,38,38,38,38,0,59,0,0,0,0,0,38,38,38,38,38,38,0,62,0,38,38,38,38,38,38,40,40,40,40,40,40,40,40,57,0,0,0,0,0,0,0,0,38,38,38,38,38,38,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,0,0,0,0,0,0,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,51,56,59,59,59,59,59,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,0,59,0,0,0,0,0,0,46,65,65,65,65,65,62,0,0,46,46,46,46,46,46,46,46,46,46,0,0,0,57,0,65,0,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,0,63,0,0,46,0,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,59,59,59,59,59,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,59,0,0,0,0,0,0,46,0,0,0,0,0,62,0,0,46,46,46,46,46,46,46,46,46,46,0,0,0,57,0,0,0,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,0,0,0,0,46,0,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,46,49,0,0,0,0,0,0,0,0,49,49,49,49,49,49,49,49,49,49,0,0,0,0,0,0,0,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,0,0,0,0,49,0,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,0,47,0,0,0,0,0,0,49,49,49,49,49,49,49,49,49,49,0,0,0,0,0,0,0,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,0,0,0,0,49,0,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,49,0,0,47,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,0,0,0,0,0,0,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,65,65,65,65,65,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,65,0,0,0,0,0,0,52,0,0,0,0,0,68,0,0,52,52,52,52,52,52,52,52,52,52,0,0,0,63,0,0,0,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,0,0,0,0,52,0,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,65,65,65,65,65,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,65,0,0,0,0,0,0,52,0,0,0,0,0,68,0,0,52,52,52,52,52,52,52,52,52,52,0,0,0,63,0,0,0,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,0,0,0,0,52,0,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,52,65,65,65,65,65,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,65,0,0,0,0,55,0,0,0,0,0,0,0,68,55,55,55,55,55,55,55,55,55,55,0,0,0,0,0,63,0,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,0,0,0,0,55,0,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,0,53,0,0,0,0,0,0,55,55,55,55,55,55,55,55,55,55,0,0,0,0,0,0,0,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,0,0,0,0,55,0,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,0,0,53,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,0,0,0,0,0,0,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,54,72,0,0,0,0,0,0,0,0,72,72,72,72,72,72,72,72,72,72,0,0,0,0,0,0,0,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,0,0,0,0,72,0,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,0,0,0,0,0,0,0,0,72,72,72,72,72,72,72,72,72,72,0,0,0,0,0,0,0,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,0,0,0,0,72,0,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,72,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]++alex_check :: Array Int Int+alex_check = listArray (0,2021) [-1,9,10,11,12,13,10,10,45,45,45,45,45,119,114,97,112,112,101,45,114,45,-1,-1,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,9,10,11,12,13,10,10,10,10,9,10,11,12,13,9,10,11,12,13,10,10,-1,-1,32,-1,-1,10,9,10,11,12,13,32,-1,-1,-1,45,32,-1,-1,-1,45,-1,34,34,45,-1,-1,-1,-1,32,-1,-1,58,58,58,58,-1,10,10,10,10,44,45,-1,-1,48,48,49,50,51,52,53,54,55,56,57,61,-1,-1,62,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,61,61,61,61,-1,123,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,9,10,11,12,13,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,32,-1,-1,-1,-1,32,-1,39,10,-1,-1,-1,-1,45,-1,-1,48,49,50,51,52,53,54,55,56,57,58,-1,-1,-1,-1,58,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,61,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,32,-1,-1,-1,-1,-1,-1,39,9,10,11,12,13,45,-1,-1,48,49,50,51,52,53,54,55,56,57,58,-1,-1,-1,-1,32,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,61,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,-1,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,48,49,50,51,52,53,54,55,56,57,-1,9,10,11,12,13,-1,65,66,67,68,69,70,48,49,50,51,52,53,54,55,56,57,-1,32,-1,-1,-1,-1,-1,65,66,67,68,69,70,-1,45,-1,97,98,99,100,101,102,48,49,50,51,52,53,54,55,61,-1,-1,-1,-1,-1,-1,-1,-1,97,98,99,100,101,102,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,-1,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,9,10,11,12,13,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,-1,-1,-1,-1,39,9,10,11,12,13,45,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,61,-1,32,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,61,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,45,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,61,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,39,-1,125,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,125,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,-1,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,45,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,61,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,45,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,61,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,9,10,11,12,13,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,32,-1,-1,-1,-1,39,-1,-1,-1,-1,-1,-1,-1,45,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,61,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,39,-1,125,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,125,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,-1,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,39,-1,-1,-1,-1,-1,-1,-1,-1,48,49,50,51,52,53,54,55,56,57,-1,-1,-1,-1,-1,-1,-1,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,-1,-1,-1,-1,95,-1,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]++alex_deflt :: Array Int Int+alex_deflt = listArray (0,76) [-1,-1,-1,-1,-1,6,6,-1,-1,-1,11,11,-1,21,-1,21,-1,-1,-1,-1,21,21,-1,-1,23,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,61,-1,61,61,-1,-1,67,-1,67,67,-1,-1,-1,-1,-1,-1,-1,-1,75]++alex_accept = listArray (0::Int,76) [[],[(AlexAcc (alex_action_21))],[],[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_10))],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[],[],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[],[],[],[],[],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[],[],[],[],[],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[],[],[],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[],[],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[],[],[],[],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_14))],[],[],[],[],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_18))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_20))],[]]+{-# LINE 73 "Scan.x" #-}++-- -----------------------------------------------------------------------------+-- Token type++data Token = T AlexPosn Tkn+ deriving Show++tokPosn (T p _) = p++data Tkn+ = SpecialT Char+ | CodeT String+ | ZeroT+ | IdT String+ | StringT String+ | BindT String+ | CharT Char+ | SMacT String+ | RMacT String + | SMacDefT String+ | RMacDefT String + | NumT Int + | WrapperT+ | EOFT+ deriving Show++-- -----------------------------------------------------------------------------+-- Token functions++special (p,_,str) ln = return $ T p (SpecialT (head str))+zero (p,_,str) ln = return $ T p ZeroT+string (p,_,str) ln = return $ T p (StringT (extract ln str))+bind (p,_,str) ln = return $ T p (BindT (takeWhile isIdChar str))+escape (p,_,str) ln = return $ T p (CharT (esc str))+decch (p,_,str) ln = return $ T p (CharT (do_ech 10 ln (take (ln-1) (tail str))))+hexch (p,_,str) ln = return $ T p (CharT (do_ech 16 ln (take (ln-2) (drop 2 str))))+octch (p,_,str) ln = return $ T p (CharT (do_ech 8 ln (take (ln-2) (drop 2 str))))+char (p,_,str) ln = return $ T p (CharT (head str))+smac (p,_,str) ln = return $ T p (SMacT (mac ln str))+rmac (p,_,str) ln = return $ T p (RMacT (mac ln str))+smacdef (p,_,str) ln = return $ T p (SMacDefT (macdef ln str))+rmacdef (p,_,str) ln = return $ T p (RMacDefT (macdef ln str))+startcode (p,_,str) ln = return $ T p (IdT (take ln str))+wrapper (p,_,str) ln = return $ T p WrapperT++isIdChar c = isAlphaNum c || c `elem` "_'"++extract ln str = take (ln-2) (tail str)+ +do_ech radix ln str = chr (parseInt radix str)++mac ln (_ : str) = take (ln-1) str++macdef ln (_ : str) = takeWhile (not.isSpace) str++esc (_ : x : _) =+ case x of+ 'a' -> '\a'+ 'b' -> '\b'+ 'f' -> '\f'+ 'n' -> '\n'+ 'r' -> '\r'+ 't' -> '\t'+ 'v' -> '\v'+ c -> c++parseInt :: Int -> String -> Int+parseInt radix ds = foldl1 (\n d -> n * radix + d) (map digitToInt ds)++-- In brace-delimited code, we have to be careful to match braces+-- within the code, but ignore braces inside strings and character+-- literals. We do an approximate job (doing it properly requires+-- implementing a large chunk of the Haskell lexical syntax).++code (p,_,inp) len = do+ inp <- getInput+ go inp 1 ""+ where+ go inp 0 cs = do+ setInput inp+ return (T p (CodeT (reverse (tail cs))))+ go inp n cs = do+ case alexGetChar inp of+ Nothing -> err inp+ Just (c,inp) -> + case c of+ '{' -> go inp (n+1) (c:cs) + '}' -> go inp (n-1) (c:cs)+ '\'' -> go_char inp n (c:cs)+ '\"' -> go_str inp n (c:cs) '\"'+ c -> go inp n (c:cs)++ -- try to catch occurrences of ' within an identifier+ go_char inp n (c1:c2:cs) | isAlphaNum c2 = go inp n (c1:c2:cs)+ go_char inp n cs = go_str inp n cs '\''++ go_str inp n cs end = do+ case alexGetChar inp of+ Nothing -> err inp+ Just (c,inp)+ | c == end -> go inp n (c:cs)+ | otherwise -> + case c of+ '\\' -> case alexGetChar inp of+ Nothing -> err inp+ Just (d,inp) -> go_str inp n (d:c:cs) end+ c -> go_str inp n (c:cs) end++ err inp = do setInput inp; lexError "lexical error in code fragment"+ +++lexError s = do+ (p,_,input) <- getInput+ failP (s ++ (if (not (null input))+ then " at " ++ show (head input)+ else " at end of file"))++lexer :: (Token -> P a) -> P a+lexer cont = lexToken >>= cont++lexToken :: P Token+lexToken = do+ inp@(p,_,_) <- getInput+ sc <- getStartCode+ case alexScan inp sc of+ AlexEOF -> return (T p EOFT)+ AlexError _ -> lexError "lexical error"+ AlexSkip inp1 len -> do+ setInput inp1+ lexToken+ AlexToken inp1 len t -> do+ setInput inp1+ t inp len++type Action = AlexInput -> Int -> P Token++skip :: Action+skip _ _ = lexToken++andBegin :: Action -> StartCode -> Action+andBegin act sc inp len = setStartCode sc >> act inp len+++afterstartcodes,startcodes :: Int+afterstartcodes = 1+startcodes = 2+alex_action_0 = skip +alex_action_1 = string +alex_action_2 = bind +alex_action_3 = code +alex_action_4 = special +alex_action_5 = wrapper +alex_action_6 = decch +alex_action_7 = hexch +alex_action_8 = octch +alex_action_9 = escape +alex_action_10 = char +alex_action_11 = smac +alex_action_12 = rmac +alex_action_13 = smacdef +alex_action_14 = rmacdef +alex_action_15 = special `andBegin` startcodes +alex_action_16 = zero +alex_action_17 = startcode +alex_action_18 = special +alex_action_19 = special `andBegin` afterstartcodes +alex_action_20 = special `andBegin` 0 +alex_action_21 = skip `andBegin` 0 +{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 35 "GenericTemplate.hs" #-}++{-# LINE 45 "GenericTemplate.hs" #-}++{-# LINE 66 "GenericTemplate.hs" #-}+alexIndexInt16OffAddr arr off = arr ! off+++{-# LINE 87 "GenericTemplate.hs" #-}+alexIndexInt32OffAddr arr off = arr ! off+++{-# LINE 98 "GenericTemplate.hs" #-}+quickIndex arr i = arr ! i+++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+ = AlexEOF+ | AlexError !AlexInput+ | AlexSkip !AlexInput !Int+ | AlexToken !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (sc)+ = alexScanUser undefined input (sc)++alexScanUser user input (sc)+ = case alex_scan_tkn user input (0) input sc AlexNone of+ (AlexNone, input') ->+ case alexGetChar input of+ Nothing -> ++++ AlexEOF+ Just _ ->++++ AlexError input'++ (AlexLastSkip input len, _) ->++++ AlexSkip input len++ (AlexLastAcc k input len, _) ->++++ AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+ input `seq` -- strict in the input+ let + new_acc = check_accs (alex_accept `quickIndex` (s))+ in+ new_acc `seq`+ case alexGetChar input of+ Nothing -> (new_acc, input)+ Just (c, new_input) -> ++++ let+ base = alexIndexInt32OffAddr alex_base s+ (ord_c) = ord c+ offset = (base + ord_c)+ check = alexIndexInt16OffAddr alex_check offset+ + new_s = if (offset >= (0)) && (check == ord_c)+ then alexIndexInt16OffAddr alex_table offset+ else alexIndexInt16OffAddr alex_deflt s+ in+ case new_s of + (-1) -> (new_acc, input)+ -- on an error, we want to keep the input *before* the+ -- character that failed, not after.+ _ -> alex_scan_tkn user orig_input (len + (1)) + new_input new_s new_acc++ where+ check_accs [] = last_acc+ check_accs (AlexAcc a : _) = AlexLastAcc a input (len)+ check_accs (AlexAccSkip : _) = AlexLastSkip input (len)+ check_accs (AlexAccPred a pred : rest)+ | pred user orig_input (len) input+ = AlexLastAcc a input (len)+ check_accs (AlexAccSkipPred pred : rest)+ | pred user orig_input (len) input+ = AlexLastSkip input (len)+ check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+ = AlexNone+ | AlexLastAcc a !AlexInput !Int+ | AlexLastSkip !AlexInput !Int++data AlexAcc a user+ = AlexAcc a+ | AlexAccSkip+ | AlexAccPred a (AlexAccPred user)+ | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+ = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (sc) user _ _ input = + case alex_scan_tkn user input (0) input sc AlexNone of+ (AlexNone, _) -> False+ _ -> True+ -- TODO: there's no need to find the longest+ -- match when checking the right context, just+ -- the first match will do.++-- used by wrappers+iUnbox (i) = i
+ src/Scan.x view
@@ -0,0 +1,216 @@+-------------------------------------------------------------------------------+-- ALEX SCANNER AND LITERATE PREPROCESSOR+-- +-- This Script defines the grammar used to generate the Alex scanner and a+-- preprocessing scanner for dealing with literate scripts. The actions for+-- the Alex scanner are given separately in the Alex module.+-- +-- See the Alex manual for a discussion of the scanners defined here.+-- +-- Chris Dornan, Aug-95, 4-Jun-96, 10-Jul-96, 29-Sep-97+-------------------------------------------------------------------------------++{+module Scan(lexer, AlexPosn(..), Token(..), Tkn(..), tokPosn) where++import Data.Char+import ParseMonad+--import Debug.Trace+}++$digit = 0-9+$hexdig = [0-9 A-F a-f]+$octal = 0-7+$lower = a-z+$upper = A-Z+$alpha = [$upper $lower]+$alphanum = [$alpha $digit]+$idchar = [$alphanum \_ \']++$special = [\.\;\,\$\|\*\+\?\#\~\-\{\}\(\)\[\]\^\/]+$graphic = $printable # $white+$nonspecial = $graphic # [$special \%]++@id = $alpha $idchar*+@smac = \$ @id | \$ \{ @id \}+@rmac = \@ @id | \@ \{ @id \}++@comment = "--".*+@ws = $white+ | @comment++alex :-++@ws { skip } -- white space; ignore++<0> \" [^\"]* \" { string }+<0> (@id @ws?)? \:\- { bind }+<0> \{ (\n | [^$digit]) { code }+<0> $special { special } -- note: matches {+<0> \% "wrapper" { wrapper }++<0> \\ $digit+ { decch }+<0> \\ x $hexdig+ { hexch }+<0> \\ o $octal+ { octch }+<0> \\ $printable { escape }+<0> $nonspecial # [\<] { char }+<0> @smac { smac }+<0> @rmac { rmac }++<0> @smac @ws? \= { smacdef }+<0> @rmac @ws? \= { rmacdef }++-- identifiers are allowed to be unquoted in startcode lists+<0> \< { special `andBegin` startcodes }+<startcodes> 0 { zero }+<startcodes> @id { startcode }+<startcodes> \, { special }+<startcodes> \> { special `andBegin` afterstartcodes }++-- After a <..> startcode sequence, we can have a {...} grouping of rules,+-- so don't try to interpret the opening { as a code block.+<afterstartcodes> \{ (\n | [^$digit ]) { special `andBegin` 0 }+<afterstartcodes> () { skip `andBegin` 0 } -- note: empty pattern+{++-- -----------------------------------------------------------------------------+-- Token type++data Token = T AlexPosn Tkn+ deriving Show++tokPosn (T p _) = p++data Tkn+ = SpecialT Char+ | CodeT String+ | ZeroT+ | IdT String+ | StringT String+ | BindT String+ | CharT Char+ | SMacT String+ | RMacT String + | SMacDefT String+ | RMacDefT String + | NumT Int + | WrapperT+ | EOFT+ deriving Show++-- -----------------------------------------------------------------------------+-- Token functions++special (p,_,str) ln = return $ T p (SpecialT (head str))+zero (p,_,str) ln = return $ T p ZeroT+string (p,_,str) ln = return $ T p (StringT (extract ln str))+bind (p,_,str) ln = return $ T p (BindT (takeWhile isIdChar str))+escape (p,_,str) ln = return $ T p (CharT (esc str))+decch (p,_,str) ln = return $ T p (CharT (do_ech 10 ln (take (ln-1) (tail str))))+hexch (p,_,str) ln = return $ T p (CharT (do_ech 16 ln (take (ln-2) (drop 2 str))))+octch (p,_,str) ln = return $ T p (CharT (do_ech 8 ln (take (ln-2) (drop 2 str))))+char (p,_,str) ln = return $ T p (CharT (head str))+smac (p,_,str) ln = return $ T p (SMacT (mac ln str))+rmac (p,_,str) ln = return $ T p (RMacT (mac ln str))+smacdef (p,_,str) ln = return $ T p (SMacDefT (macdef ln str))+rmacdef (p,_,str) ln = return $ T p (RMacDefT (macdef ln str))+startcode (p,_,str) ln = return $ T p (IdT (take ln str))+wrapper (p,_,str) ln = return $ T p WrapperT++isIdChar c = isAlphaNum c || c `elem` "_'"++extract ln str = take (ln-2) (tail str)+ +do_ech radix ln str = chr (parseInt radix str)++mac ln (_ : str) = take (ln-1) str++macdef ln (_ : str) = takeWhile (not.isSpace) str++esc (_ : x : _) =+ case x of+ 'a' -> '\a'+ 'b' -> '\b'+ 'f' -> '\f'+ 'n' -> '\n'+ 'r' -> '\r'+ 't' -> '\t'+ 'v' -> '\v'+ c -> c++parseInt :: Int -> String -> Int+parseInt radix ds = foldl1 (\n d -> n * radix + d) (map digitToInt ds)++-- In brace-delimited code, we have to be careful to match braces+-- within the code, but ignore braces inside strings and character+-- literals. We do an approximate job (doing it properly requires+-- implementing a large chunk of the Haskell lexical syntax).++code (p,_,inp) len = do+ inp <- getInput+ go inp 1 ""+ where+ go inp 0 cs = do+ setInput inp+ return (T p (CodeT (reverse (tail cs))))+ go inp n cs = do+ case alexGetChar inp of+ Nothing -> err inp+ Just (c,inp) -> + case c of+ '{' -> go inp (n+1) (c:cs) + '}' -> go inp (n-1) (c:cs)+ '\'' -> go_char inp n (c:cs)+ '\"' -> go_str inp n (c:cs) '\"'+ c -> go inp n (c:cs)++ -- try to catch occurrences of ' within an identifier+ go_char inp n (c1:c2:cs) | isAlphaNum c2 = go inp n (c1:c2:cs)+ go_char inp n cs = go_str inp n cs '\''++ go_str inp n cs end = do+ case alexGetChar inp of+ Nothing -> err inp+ Just (c,inp)+ | c == end -> go inp n (c:cs)+ | otherwise -> + case c of+ '\\' -> case alexGetChar inp of+ Nothing -> err inp+ Just (d,inp) -> go_str inp n (d:c:cs) end+ c -> go_str inp n (c:cs) end++ err inp = do setInput inp; lexError "lexical error in code fragment"+ +++lexError s = do+ (p,_,input) <- getInput+ failP (s ++ (if (not (null input))+ then " at " ++ show (head input)+ else " at end of file"))++lexer :: (Token -> P a) -> P a+lexer cont = lexToken >>= cont++lexToken :: P Token+lexToken = do+ inp@(p,_,_) <- getInput+ sc <- getStartCode+ case alexScan inp sc of+ AlexEOF -> return (T p EOFT)+ AlexError _ -> lexError "lexical error"+ AlexSkip inp1 len -> do+ setInput inp1+ lexToken+ AlexToken inp1 len t -> do+ setInput inp1+ t inp len++type Action = AlexInput -> Int -> P Token++skip :: Action+skip _ _ = lexToken++andBegin :: Action -> StartCode -> Action+andBegin act sc inp len = setStartCode sc >> act inp len+}
+ src/Set.hs view
@@ -0,0 +1,14 @@+module Set ( Set, member, empty, insert ) where++import Data.Set ++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603+member :: Ord a => a -> Set a -> Bool+member = elementOf++empty :: Set a+empty = emptySet++insert :: Ord a => a -> Set a -> Set a+insert = flip addToSet+#endif
+ src/Sort.hs view
@@ -0,0 +1,69 @@+{------------------------------------------------------------------------------+ SORTING LISTS++This module provides properly parameterised insertion and merge sort functions,+complete with associated functions for inserting and merging. `isort' is the+standard lazy version and can be used to the minimum k elements of a list in+linear time. The merge sort is based on a Bob Buckley's (Bob Buckley+18-AUG-95) coding of Knuth's natural merge sort (see Vol. 2). It seems to be+fast in the average case; it makes use of natural runs in the data becomming+linear on ordered data; and it completes in worst time O(n.log(n)). It is+divinely elegant.++`nub'' is an n.log(n) version of `nub' and `group_sort' sorts a list into+strictly ascending order, using a combining function in its arguments to+amalgamate duplicates.++Chris Dornan, 14-Aug-93, 17-Nov-94, 29-Dec-95+------------------------------------------------------------------------------}++module Sort where+++-- `isort' is an insertion sort and is here for historical reasons; msort is+-- better in almost every situation.++isort:: (a->a->Bool) -> [a] -> [a]+isort (<=) = foldr (insrt (<=)) []++insrt:: (a->a->Bool) -> a -> [a] -> [a]+insrt (<=) e [] = [e]+insrt (<=) e l@(h:t) = if e<=h then e:l else h:insrt (<=) e t+++msort :: (a->a->Bool) -> [a] -> [a]+msort (<=) [] = [] -- (foldb f []) is undefined+msort (<=) xs = foldb (mrg (<=)) (runs (<=) xs)++runs :: (a->a->Bool) -> [a] -> [[a]]+runs (<=) xs = foldr op [] xs+ where+ op z xss@(xs@(x:_):xss') | z<=x = (z:xs):xss'+ | otherwise = [z]:xss+ op z xss = [z]:xss++foldb :: (a->a->a) -> [a] -> a+foldb _ [x] = x+foldb f xs = foldb f (fold xs)+ where+ fold (x1:x2:xs) = f x1 x2 : fold xs+ fold xs = xs++mrg:: (a->a->Bool) -> [a] -> [a] -> [a]+mrg (<=) [] l = l+mrg (<=) l@(_:_) [] = l+mrg (<=) l1@(h1:t1) l2@(h2:t2) =+ if h1<=h2+ then h1:mrg (<=) t1 l2+ else h2:mrg (<=) l1 t2+++nub':: (a->a->Bool) -> [a] -> [a]+nub' (<=) l = group_sort (<=) const l+++group_sort:: (a->a->Bool) -> (a->[a]->b) -> [a] -> [b]+group_sort le cmb l = s_m (msort le l)+ where+ s_m [] = []+ s_m (h:t) = cmb h (takeWhile (`le` h) t):s_m (dropWhile (`le` h) t)
+ src/Util.hs view
@@ -0,0 +1,38 @@+-- -----------------------------------------------------------------------------+-- +-- Util.hs, part of Alex+--+-- (c) Simon Marlow 2003+--+-- General utilities used in various parts of Alex+--+-- ----------------------------------------------------------------------------}++module Util where++-- Pretty-printing utilities++str = showString+char c = (c :)++nl = char '\n'++paren s = char '(' . s . char ')'+brack s = char '[' . s . char ']'++interleave_shows s [] = id+interleave_shows s xs = foldr1 (\a b -> a . s . b) xs++space = char ' '++cjustify, ljustify, rjustify :: Int -> String -> String+cjustify n s = spaces halfm ++ s ++ spaces (m - halfm)+ where m = n - length s+ halfm = m `div` 2+ljustify n s = s ++ spaces (max 0 (n - length s))+rjustify n s = spaces (n - length s) ++ s++spaces :: Int -> String+spaces n = replicate n ' '++hline = replicate 77 '-'
+ src/ghc_hooks.c view
@@ -0,0 +1,5 @@+#include <stdio.h>++void ErrorHdrHook(chan)+ FILE *chan;+{}
+ templates/GenericTemplate.hs view
@@ -0,0 +1,221 @@+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++#ifdef ALEX_GHC+#define ILIT(n) n#+#define IBOX(n) (I# (n))+#define FAST_INT Int#+#define LT(n,m) (n <# m)+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#define PLUS(n,m) (n +# m)+#define MINUS(n,m) (n -# m)+#define TIMES(n,m) (n *# m)+#define NEGATE(n) (negateInt# (n))+#define IF_GHC(x) (x)+#else+#define ILIT(n) (n)+#define IBOX(n) (n)+#define FAST_INT Int+#define LT(n,m) (n < m)+#define GTE(n,m) (n >= m)+#define EQ(n,m) (n == m)+#define PLUS(n,m) (n + m)+#define MINUS(n,m) (n - m)+#define TIMES(n,m) (n * m)+#define NEGATE(n) (negate (n))+#define IF_GHC(x)+#endif++#ifdef ALEX_GHC+#undef __GLASGOW_HASKELL__+#define ALEX_IF_GHC_GT_500 #if __GLASGOW_HASKELL__ > 500+#define ALEX_IF_GHC_LT_503 #if __GLASGOW_HASKELL__ < 503+#define ALEX_ELIF_GHC_500 #elif __GLASGOW_HASKELL__ == 500+#define ALEX_IF_BIGENDIAN #ifdef WORDS_BIGENDIAN+#define ALEX_ELSE #else+#define ALEX_ENDIF #endif+#endif++#ifdef ALEX_GHC+data AlexAddr = AlexA# Addr#++ALEX_IF_GHC_LT_503+uncheckedShiftL# = shiftL#+ALEX_ENDIF++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+ALEX_IF_BIGENDIAN+ narrow16Int# i+ where+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#+ALEX_ELSE+ indexInt16OffAddr# arr off+ALEX_ENDIF+#else+alexIndexInt16OffAddr arr off = arr ! off+#endif++#ifdef ALEX_GHC+{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +ALEX_IF_BIGENDIAN+ narrow32Int# i+ where+ i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+ (b2 `uncheckedShiftL#` 16#) `or#`+ (b1 `uncheckedShiftL#` 8#) `or#` b0)+ b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+ b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+ b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ b0 = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 4#+ALEX_ELSE+ indexInt32OffAddr# arr off+ALEX_ENDIF+#else+alexIndexInt32OffAddr arr off = arr ! off+#endif++#ifdef ALEX_GHC+ALEX_IF_GHC_LT_503+quickIndex arr i = arr ! i+ALEX_ELSE+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+ALEX_ENDIF+#else+quickIndex arr i = arr ! i+#endif++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+ = AlexEOF+ | AlexError !AlexInput+ | AlexSkip !AlexInput !Int+ | AlexToken !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input IBOX(sc)+ = alexScanUser undefined input IBOX(sc)++alexScanUser user input IBOX(sc)+ = case alex_scan_tkn user input ILIT(0) input sc AlexNone of+ (AlexNone, input') ->+ case alexGetChar input of+ Nothing -> +#ifdef ALEX_DEBUG+ trace ("End of input.") $+#endif+ AlexEOF+ Just _ ->+#ifdef ALEX_DEBUG+ trace ("Error.") $+#endif+ AlexError input'++ (AlexLastSkip input len, _) ->+#ifdef ALEX_DEBUG+ trace ("Skipping.") $ +#endif+ AlexSkip input len++ (AlexLastAcc k input len, _) ->+#ifdef ALEX_DEBUG+ trace ("Accept.") $ +#endif+ AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+ input `seq` -- strict in the input+ let + new_acc = check_accs (alex_accept `quickIndex` IBOX(s))+ in+ new_acc `seq`+ case alexGetChar input of+ Nothing -> (new_acc, input)+ Just (c, new_input) -> +#ifdef ALEX_DEBUG+ trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c) $+#endif+ let+ base = alexIndexInt32OffAddr alex_base s+ IBOX(ord_c) = ord c+ offset = PLUS(base,ord_c)+ check = alexIndexInt16OffAddr alex_check offset+ + new_s = if GTE(offset,ILIT(0)) && EQ(check,ord_c)+ then alexIndexInt16OffAddr alex_table offset+ else alexIndexInt16OffAddr alex_deflt s+ in+ case new_s of + ILIT(-1) -> (new_acc, input)+ -- on an error, we want to keep the input *before* the+ -- character that failed, not after.+ _ -> alex_scan_tkn user orig_input PLUS(len,ILIT(1)) + new_input new_s new_acc++ where+ check_accs [] = last_acc+ check_accs (AlexAcc a : _) = AlexLastAcc a input IBOX(len)+ check_accs (AlexAccSkip : _) = AlexLastSkip input IBOX(len)+ check_accs (AlexAccPred a pred : rest)+ | pred user orig_input IBOX(len) input+ = AlexLastAcc a input IBOX(len)+ check_accs (AlexAccSkipPred pred : rest)+ | pred user orig_input IBOX(len) input+ = AlexLastSkip input IBOX(len)+ check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+ = AlexNone+ | AlexLastAcc a !AlexInput !Int+ | AlexLastSkip !AlexInput !Int++data AlexAcc a user+ = AlexAcc a+ | AlexAccSkip+ | AlexAccPred a (AlexAccPred user)+ | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+ = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext IBOX(sc) user _ _ input = + case alex_scan_tkn user input ILIT(0) input sc AlexNone of+ (AlexNone, _) -> False+ _ -> True+ -- TODO: there's no need to find the longest+ -- match when checking the right context, just+ -- the first match will do.++-- used by wrappers+iUnbox IBOX(i) = i
+ templates/Makefile view
@@ -0,0 +1,67 @@+TOP = ..+include $(TOP)/mk/boilerplate.mk++TEMPLATES = \+ AlexTemplate \+ AlexTemplate-ghc \+ AlexTemplate-ghc-debug \+ AlexTemplate-debug \+ AlexWrapper-basic \+ AlexWrapper-posn \+ AlexWrapper-monad \+ AlexWrapper-gscan++GENERIC_TEMPLATE = GenericTemplate.hs+EXCLUDED_SRCS = $(GENERIC_TEMPLATE) wrappers.hs++INSTALL_DATAS = $(TEMPLATES)++all :: $(TEMPLATES)++override datadir = $(libdir)++ghc_411_at_least = $(shell expr "$(GhcMajVersion)" = 4 \& \+ "$(GhcMinVersion)" \>= 11 \| \+ "$(GhcMajVersion)" \> 4)++ifeq "$(ghc_411_at_least)" "1"+CPP_IT = $(GHC) -E -cpp -o+else+CPP_IT = $(GHC) -E -cpp >+endif++AlexTemplate.hspp : $(GENERIC_TEMPLATE)+ $(CPP_IT) $@ $(GENERIC_TEMPLATE)++AlexTemplate-ghc.hspp : $(GENERIC_TEMPLATE)+ $(CPP_IT) $@ -DALEX_GHC $(GENERIC_TEMPLATE)++AlexTemplate-ghc-debug.hspp : $(GENERIC_TEMPLATE)+ $(CPP_IT) $@ -DALEX_GHC -DALEX_DEBUG $(GENERIC_TEMPLATE)++AlexTemplate-debug.hspp : $(GENERIC_TEMPLATE)+ $(CPP_IT) $@ -DALEX_DEBUG $(GENERIC_TEMPLATE)++AlexTemplate-monad.hspp : $(GENERIC_TEMPLATE)+ $(CPP_IT) $@ -DALEX_MONAD $(GENERIC_TEMPLATE)++AlexWrapper-basic.hspp : wrappers.hs+ $(CPP_IT) $@ -DALEX_BASIC $<++AlexWrapper-posn.hspp : wrappers.hs+ $(CPP_IT) $@ -DALEX_POSN $<++AlexWrapper-monad.hspp : wrappers.hs+ $(CPP_IT) $@ -DALEX_MONAD $<++AlexWrapper-gscan.hspp : wrappers.hs+ $(CPP_IT) $@ -DALEX_GSCAN $<++# hack to turn cpp-style '# 27 "GenericTemplate.hs"' into +# '{-# LINE 27 "GenericTemplate.hs" #-}'.+% : %.hspp+ perl -pe 's/^#\s+(\d+)\s+(\"[^\"]*\")/{-# LINE \1 \2 #-}/g;s/\$$(Id:.*)\$$/\1/g' < $< > $@++CLEAN_FILES += $(TEMPLATES) $(patsubst %, %.hspp, $(TEMPLATES))++include $(TOP)/mk/target.mk
+ templates/wrappers.hs view
@@ -0,0 +1,180 @@+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- The input type++#if defined(ALEX_POSN) || defined(ALEX_MONAD) || defined(ALEX_GSCAN)+type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ String) -- current input string++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,s) = c++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p,c,[]) = Nothing+alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq`+ Just (c, (p', c, s))++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text. It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.++data AlexPosn = AlexPn !Int !Int !Int+ deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)+#endif++-- -----------------------------------------------------------------------------+-- Default monad++#ifdef ALEX_MONAD+data AlexState = AlexState {+ alex_pos :: !AlexPosn, -- position at current input location+ alex_inp :: String, -- the current input+ alex_chr :: !Char, -- the character before the input+ alex_scd :: !Int -- the current startcode+ }++-- Compile with -funbox-strict-fields for best results!++runAlex :: String -> Alex a -> Either String a+runAlex input (Alex f) + = case f (AlexState {alex_pos = alexStartPos,+ alex_inp = input, + alex_chr = '\n',+ alex_scd = 0}) of Left msg -> Left msg+ Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Monad Alex where+ m >>= k = Alex $ \s -> case unAlex m s of + Left msg -> Left msg+ Right (s',a) -> unAlex (k a) s'+ return a = Alex $ \s -> Right (s,a)++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_inp=inp} -> + Right (s, (pos,c,inp))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,inp)+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_inp=inp} of+ s@(AlexState{}) -> Right (s, ())++alexError :: String -> Alex a+alexError message = Alex $ \s -> Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())++alexMonadScan = do+ inp <- alexGetInput+ sc <- alexGetStartCode+ case alexScan inp sc of+ AlexEOF -> alexEOF+ AlexError inp' -> alexError "lexical error"+ AlexSkip inp' len -> do+ alexSetInput inp'+ alexMonadScan+ AlexToken inp' len action -> do+ alexSetInput inp'+ action inp len++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int -> result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip input len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code input len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+-- andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input len = do alexSetStartCode code; action input len++-- token :: (String -> Int -> token) -> AlexAction token+token t input len = return (t input len)+#endif /* ALEX_MONAD */++-- -----------------------------------------------------------------------------+-- Basic wrapper++#ifdef ALEX_BASIC+type AlexInput = (Char,String)++alexGetChar (_, []) = Nothing+alexGetChar (_, c:cs) = Just (c, (c,cs))++alexInputPrevChar (c,_) = c++-- alexScanTokens :: String -> [token]+alexScanTokens str = go ('\n',str)+ where go inp@(_,str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act (take len str) : go inp'+#endif++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++#ifdef ALEX_POSN+--alexScanTokens :: String -> [token]+alexScanTokens str = go (alexStartPos,'\n',str)+ where go inp@(pos,_,str) =+ case alexScan inp 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp' len -> go inp'+ AlexToken inp' len act -> act pos (take len str) : go inp'+#endif++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++#ifdef ALEX_GSCAN+alexGScan stop state inp = alex_gscan stop alexStartPos '\n' inp (0,state)++alex_gscan stop p c inp (sc,state) =+ case alexScan (p,c,inp) sc of+ AlexEOF -> stop p c inp (sc,state)+ AlexError _ -> stop p c inp (sc,state)+ AlexSkip (p',c',inp') len -> alex_gscan stop p' c' inp' (sc,state)+ AlexToken (p',c',inp') len k ->+ k p c inp len (\scs -> alex_gscan stop p' c' inp' scs)+ (sc,state)+#endif
+ tests/Makefile view
@@ -0,0 +1,39 @@+TOP = ..+include $(TOP)/mk/boilerplate.mk++.PRECIOUS: .hs .o .exe .bin++ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"+HS_PROG_EXT = .exe+else+HS_PROG_EXT = .bin+endif+++TESTS = simple.x tokens.x tokens_posn.x tokens_gscan.x++ALEX=../src/alex-inplace++%.n.hs : %.x+ $(ALEX) $(TEST_ALEX_OPTS) $< -o $@++%.g.hs : %.x+ $(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@++CLEAN_FILES += *.n.hs *.g.hs *.info *.hi *.bin *.exe++ALL_TEST_HS = $(shell echo $(TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs/g')++ALL_TESTS = $(patsubst %.hs, %.run, $(ALL_TEST_HS))++HC_OPTS += -fglasgow-exts -package lang++%.run : %$(HS_PROG_EXT)+ ./$<++%$(HS_PROG_EXT) : %.o+ $(HC) $(HC_OPTS) $($*_LD_OPTS) $< -o $@++all :: $(ALL_TESTS)++include $(TOP)/mk/target.mk
+ tests/simple.x view
@@ -0,0 +1,73 @@+{+-- Tests the basic operation.+module Main where++import Data.Char (toUpper)+import Control.Monad+import System.Exit+import System.IO+}++%wrapper "monad"++@word = [A-Za-z]+++tokens :-++$white+ ;++<0> {+ "magic" { magic } -- should override later patterns+ ^ @word $ { both } -- test both trailing and left context+ @word $ { eol } -- test trailing context+ ^ @word { bol } -- test left context+ @word { word }+}++<0> \( { begin parens }+<parens> [A-Za-z]+ { parenword }+<parens> \) { begin 0 }++{+{- we can now have comments in source code? -}+word (p,_,input) len = return (take len input)++both (p,_,input) len = return ("BOTH:"++ take len input)++eol (p,_,input) len = return ("EOL:"++ take len input)++bol (p,_,input) len = return ("BOL:"++ take len input)++parenword (p,_,input) len = return (map toUpper (take len input))++magic (p,_,input) len = return "PING!"++alexEOF = return "stopped."++scanner str = runAlex str $ do+ let loop = do tok <- alexMonadScan+ if tok == "stopped." || tok == "error." + then return [tok]+ else do toks <- loop+ return (tok:toks)+ loop ++main = do+ let test1 = scanner str1+ when (test1 /= out1) $ + do hPutStrLn stderr "Test 1 failed:"+ print test1+ exitFailure++ let test2 = scanner str2+ when (test2 /= out2) $+ do hPutStrLn stderr "Test 2 failed:"+ print test2+ exitFailure++str1 = "a b c (d e f) magic (magic) eol\nbol \nboth\n"+out1 = Right ["BOL:a","b","c","D","E","F","PING!","MAGIC","EOL:eol", "BOL:bol", "BOTH:both", "stopped."]++str2 = "."+out2 = Left "lexical error"+}
+ tests/tokens.x view
@@ -0,0 +1,40 @@+{+module Main (main) where+import System.Exit+}++%wrapper "basic"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { \s -> Let }+ in { \s -> In }+ $digit+ { \s -> Int (read s) }+ [\=\+\-\*\/\(\)] { \s -> Sym (head s) }+ $alpha [$alpha $digit \_ \']* { \s -> Var s }++{+-- Each right-hand side has type :: String -> Token++-- The token type:+data Token =+ Let |+ In |+ Sym Char |+ Var String |+ Int Int |+ Err + deriving (Eq,Show)++main = if test1 /= result1 then exitFailure+ else exitWith ExitSuccess++test1 = alexScanTokens " let in 012334\n=+*foo bar__'"+result1 = [Let,In,Int 12334,Sym '=',Sym '+',Sym '*',Var "foo",Var "bar__'"]++}
+ tests/tokens_gscan.x view
@@ -0,0 +1,44 @@+{+module Main (main) where+import System.Exit+}++%wrapper "gscan"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { tok (\p s -> Let p) }+ in { tok (\p s -> In p) }+ $digit+ { tok (\p s -> Int p (read s)) }+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head s)) }+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p s) }++{+-- Some action helpers:+tok f p c str len cont (sc,state) = f p (take len str) : cont (sc,state)++-- The token type:+data Token =+ Let AlexPosn |+ In AlexPosn |+ Sym AlexPosn Char |+ Var AlexPosn String |+ Int AlexPosn Int |+ Err AlexPosn+ deriving (Eq,Show)++main = if test1 /= result1 then exitFailure+ else exitWith ExitSuccess++test1 = alexGScan stop undefined " let in 012334\n=+*foo bar__'"++stop p c "" (sc,s) = []+stop p c _ (sc,s) = error "lexical error"++result1 = [Let (AlexPn 2 1 3),In (AlexPn 6 1 7),Int (AlexPn 9 1 10) 12334,Sym (AlexPn 16 2 1) '=',Sym (AlexPn 17 2 2) '+',Sym (AlexPn 18 2 3) '*',Var (AlexPn 19 2 4) "foo",Var (AlexPn 23 2 8) "bar__'"]+}
+ tests/tokens_posn.x view
@@ -0,0 +1,44 @@+{+module Main (main) where+import System.Exit+}++%wrapper "posn"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { tok (\p s -> Let p) }+ in { tok (\p s -> In p) }+ $digit+ { tok (\p s -> Int p (read s)) }+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head s)) }+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p s) }++{+-- Each right-hand side has type :: AlexPosn -> String -> Token++-- Some action helpers:+tok f p s = f p s++-- The token type:+data Token =+ Let AlexPosn |+ In AlexPosn |+ Sym AlexPosn Char |+ Var AlexPosn String |+ Int AlexPosn Int |+ Err AlexPosn+ deriving (Eq,Show)++main = if test1 /= result1 then exitFailure+ else exitWith ExitSuccess++test1 = alexScanTokens " let in 012334\n=+*foo bar__'"+result1 = [Let (AlexPn 2 1 3),In (AlexPn 6 1 7),Int (AlexPn 9 1 10) 12334,Sym (AlexPn 16 2 1) '=',Sym (AlexPn 17 2 2) '+',Sym (AlexPn 18 2 3) '*',Var (AlexPn 19 2 4) "foo",Var (AlexPn 23 2 8) "bar__'"]+++}