packages feed

clafer (empty) → 0.3.5

raw patch · 56 files changed

+14481/−0 lines, 56 filesdep +HUnitdep +HaXmldep +MaybeTsetup-changedbinary-added

Dependencies added: HUnit, HaXml, MaybeT, QuickCheck, array, base, clafer, cmdargs, containers, data-stringmap, directory, executable-path, filepath, glpk-hs, json-builder, mtl, parsec, process, split, string-conversions, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th, transformers

Files

+ CHANGES.md view
@@ -0,0 +1,36 @@+**Clafer Version 0.3.5 released on January 20, 2014**
+
+[Release](https://github.com/gsdlab/clafer/pull/44)
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3.5,clafer/page:1/)
+
+**Clafer Version 0.3.4 released on September 20, 2013**
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3.4,clafer/page:1/)
+
+**Clafer Version 0.3.3 released on August 14, 2013**
+
+[Release](https://github.com/gsdlab/clafer/pull/35)
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3.3,clafer/page:1/)
+
+**Clafer Version 0.3.2 released on April 11, 2013**
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3.2,clafer/page:1/)
+
+**Clafer Version 0.3.1 released on October 17, 2012**
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3.1,clafer/page:1/)
+
+**Clafer Version 0.3 released on July 17, 2012**
+
+This was the first release of Clafer and included all code since the beginning of the project.
+
+[New features and bug fixes](http://gsd.uwaterloo.ca:8888/questions/scope:all/sort:activity-desc/tags:v0.3,clafer/page:1/)
+
+Basic features - See the `README.md`.
+
+
+
+
+
+ IDEs/clafer-README.md view
@@ -0,0 +1,20 @@+IDE Integrations
+================
+
+Sublime Text 2
+--------------
+
+We provide a build system configuration. 
+
+### Usage
+
+Use `<CTRL>+B` to compile a Clafer `.cfr` file. 
+This build system assumes that Clafer executable is in system `PATH` and is automatically selected for files with extension `.cfr`.
+
+### Installation 
+
+1. Copy the folder `User` from `IDEs\sublime-text-2\Packages` to the folder `Packages` in Sublime Text 2 folder inside your home directory.
+
+> Note: 
+> on Windows 7 and 8, the folder is `<user name>\AppData\Roaming\Sublime Text 2\Packages`.
+> on Mac, the folder is `~/Library/Application Support/Sublime Text 2/Packages`
+ IDEs/sublime-text-2/Packages/User/clafer.sublime-build view
@@ -0,0 +1,4 @@+{
+	"cmd": [ "clafer.exe", "$file" ],
+	"selector": "cfr"
+}
+ LICENSE view
@@ -0,0 +1,17 @@+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+ Makefile view
@@ -0,0 +1,102 @@+SRC_DIR  := src
+TEST_DIR := test
+TOOL_DIR := tools
+UNAME := $(shell uname -o | tr "A-Z" "a-z")
+
+ifeq ($(UNAME), cygwin)
+	GPLK_LIBS_INCLUDES := --extra-include-dirs=$(glpk)/src --extra-include-dirs=$(glpk)/src/amd --extra-include-dirs=$(glpk)/src/colamd --extra-include-dirs=$(glpk)/src/minisat --extra-include-dirs=$(glpk)/src/zlib --extra-lib-dirs=$(glpk)/w32	
+endif
+ifeq ($(UNAME), windows)
+	GPLK_LIBS_INCLUDES := --extra-include-dirs=$(glpk)/src --extra-include-dirs=$(glpk)/src/amd --extra-include-dirs=$(glpk)/src/colamd --extra-include-dirs=$(glpk)/src/minisat --extra-include-dirs=$(glpk)/src/zlib --extra-lib-dirs=$(glpk)/w32	
+endif
+ifeq ($(UNAME), msys)
+	GPLK_LIBS_INCLUDES := --extra-include-dirs=$(glpk)/src --extra-include-dirs=$(glpk)/src/amd --extra-include-dirs=$(glpk)/src/colamd --extra-include-dirs=$(glpk)/src/minisat --extra-include-dirs=$(glpk)/src/zlib --extra-lib-dirs=$(glpk)/w32	
+endif
+ifeq ($(UNAME), darwin)
+	MAC_USR_LIB := --extra-lib-dir=/usr/lib
+endif
+
+all: build
+
+build:
+	$(MAKE) -C $(TOOL_DIR)
+	cabal install --only-dependencies $(GPLK_LIBS_INCLUDES) $(MAC_USR_LIB)
+	cabal configure
+	cabal build
+
+install:  
+	mkdir -p $(to)
+	mkdir -p $(to)/tools
+	cp -f README.md $(to)/clafer-README.md
+	cp -f LICENSE $(to)/
+	cp -f CHANGES.md $(to)/clafer-CHANGES.md
+	cp -f tools/alloy4.jar $(to)/tools
+	cp -f tools/alloy4.2.jar $(to)/tools
+	cp -f tools/XsdCheck.class $(to)/tools
+	cp -f tools/ecore2clafer.jar $(to)/tools
+	cp -f -R IDEs $(to)/
+	if test "$(glpk)" ; then cp -f $(glpk)/w32/glpk_4_52.dll $(to); fi
+	cabal install --bindir=$(to) $(GPLK_LIBS_INCLUDES) $(MAC_USR_LIB) --ghc-option="-O"
+
+# Removes current build and makes a clean new one (Don't use if starting from scratch!)
+cleanEnv:
+	make clean
+	ghc-pkg unregister clafer
+	rm `which clafer`
+	make 
+
+# build Schema.hs from ClaferIG.xsd, call after .xsd changed
+Schema.hs:
+	$(MAKE) -C $(SRC_DIR) Schema.hs
+
+# build Css.hs from clafer.css, call after .css changed
+Css.hs:
+	$(MAKE) -C $(SRC_DIR) Css.hs
+
+# enable profiler
+# first remove `cabal` and `ghc` folders (on win: `<User>\AppData\Roaming\cabal` and `<User>\AppData\Roaming\ghc`)
+# this will reinstall everything with profiling support, build clafer, and copy it to .
+prof:
+	cabal update
+	cabal install --only-dependencies -p --enable-executable-profiling $(GPLK_LIBS_INCLUDES) $(MAC_USR_LIB)
+	cabal configure -p --enable-executable-profiling
+	cabal build --ghc-options="-prof -auto-all -rtsopts"
+
+.PHONY : test
+
+test:
+	cabal configure --enable-tests
+	cabal build
+	cabal test	
+	$(MAKE) -C $(TEST_DIR) test
+
+validateAlloy:
+	$(MAKE) -C $(TEST_DIR) validateAlloy
+
+validateXML:	
+	$(MAKE) -C $(TEST_DIR) validateXML
+
+validateClafer:
+#	$(MAKE) -C $(TEST_DIR) validateClafer
+
+generatePython:
+	$(MAKE) -C $(TEST_DIR) generatePython
+
+diffRegressions:
+	$(MAKE) -C $(TEST_DIR) diffRegressions
+
+reg:
+	$(MAKE) -C $(TEST_DIR) reg
+
+clean:
+	rm -f clafer
+	rm -rf dist
+	$(MAKE) -C $(SRC_DIR) clean
+	$(MAKE) -C $(TOOL_DIR) clean
+	find . -type f -name '*.o' -print0 | xargs -0 rm -f
+	find . -type f -name '*.hi' -print0 | xargs -0 rm -f
+	find . -type f -name '*~' -print0 | xargs -0 rm -f
+	$(MAKE) cleanTest
+
+cleanTest:
+	$(MAKE) -C $(TEST_DIR) clean
+ README.md view
@@ -0,0 +1,307 @@+Clafer
+======
+
+v0.3.5.20-01-2014
+
+[Clafer](http://clafer.org) is a general-purpose lightweight structural modeling language developed at [GSD Lab](http://gsd.uwaterloo.ca/), [University of Waterloo](http://uwaterloo.ca). 
+Clafer can be used for modeling of static hierarchical structures but has no support for modeling the change of the structures over time (behavior). 
+The main goal of Clafer is to make modeling more accessible to a wider range of users and domains. 
+
+There are many possible applications of Clafer; however, three are prominent:
+
+1. *Product-Line Modeling* - aims at representing and managing commonality and variability of assets in product lines and creating and verifying product configurations. 
+Clafer naturally supports multi-staged configuration. 
+
+2. *Multi-Objective Product Optimization* - aims at finding a set of products in a given product line that are optimal with respect to a set of objectives. 
+Clafer multi-objective optimizer generates a Pareto front of optimal product configurations.
+
+3. *Domain Modeling* - aims at improving the understanding of the problem domain in the early stages of software development and determining the requirements with fewer defects. 
+This is also known as *Concept Modeling* or *Ontology Modeling*.
+
+Clafer Compiler
+===============
+
+Clafer compiler provides a reference language implementation. 
+It translates models in Clafer to other formats (e.g. Alloy, XML, HTML, DOT) to allow for reasoning and processing with existing tools.
+
+Currently, the compiler is used by 
+Clafer Instance Generator ([ClaferIG](https://github.com/gsdlab/claferIG)), 
+Clafer Integrated Development Environment ([ClaferIDE](https://github.com/gsdlab/claferIDE)),
+Clafer Configurator ([ClaferConfigurator](https://github.com/gsdlab/ClaferConfigurator)), 
+Clafer Multi-Objective Optimizer ([ClaferMOO](https://github.com/gsdlab/ClaferMooStandalone)) and 
+[Visualizer](https://github.com/gsdlab/ClaferMooVisualizer), and 
+Clafer Wiki ([ClaferWiki](https://github.com/gsdlab/claferwiki)).
+
+Contributors
+------------
+
+* [Kacper Bak](http://gsd.uwaterloo.ca/kbak), Ph.D. Candidate. Main developer.
+* [Jimmy Liang](http://gsd.uwaterloo.ca/jliang), MSc. Candidate. Main developer.
+* [Michał Antkiewicz](http://gsd.uwaterloo.ca/mantkiew), Research Engineer. Requirements, development, architecture, testing, technology transfer.
+* [Ed Zulkoski](http://gsd.uwaterloo.ca/ezulkosk), Pd.D. Candidate. Python IR Generator.
+* Luke Michael Brown, co-op student May-Aug 2013. Many improvements.
+* [Rafael Olaechea](http://gsd.uwaterloo.ca/rolaechea), Pd.D. Candidate. Multi-Objective Optimization extensions.
+
+Getting Clafer Tools
+--------------------
+
+Binary distributions of the release 0.3.5 of Clafer Tools for Windows, Mac, and Linux, 
+can be downloaded from [Clafer Tools - Binary Distributions](http://http://gsd.uwaterloo.ca/clafer-tools-binary-distributions). 
+Clafer Wiki requires Haskell Platform and MinGW to run on Windows. 
+
+In case these binaries do not work on your particular machine configuration, the tools can be built from source code, as described below.
+
+### Dependencies for running
+
+* [Java Platform (JDK)](http://www.oracle.com/technetwork/java/javase/downloads/index.html) v6+, 32bit
+* [Python](http://www.python.org/download/) v2.7.*
+  * Needed only by ClaferMOO
+* [Alloy4.1 and/or Alloy4.2](http://alloy.mit.edu/alloy/download.html)
+* [GraphViz](http://graphviz.org/)
+  * `dot` is needed only in the `html` mode for SVG graph generation
+* [GNU Linear Programming Kit](http://www.gnu.org/software/glpk/) v4.52
+
+### Installation
+
+1. download the binaries and unpack `<target directory>` of your choice
+2. add the `<target directory>` to your system path so that the executables can be found
+3. copy alloy's jars to the `<target directory>/tools` folder
+
+On Linux
+
+1. [libglpk-dev](http://www.gnu.org/software/glpk/) v4.52
+  * execute `sudo apt-get install libglpk-dev` on Ubuntu
+2. [libgmp-dev](http://gmplib.org/)
+  * execute `sudo apt-get install libgmp-dev` on Ubuntu
+
+On Windows
+
+1. The binary distribution already includes the GNU Linear Programming Kit DLL `glpk_4_52.dll`.
+
+On Mac
+
+1. install GPLK from [MacPorts](http://www.macports.org/)
+  * execute `sudo port install glpk +universal`
+
+Integration with Sublime Text 2
+-------------------------------
+
+See [IDEs/clafer-README.md](IDEs/clafer-README.md)
+
+Installation From Hackage
+-------------------------
+
+Dependencies
+
+* [The Haskell Platform](http://hackage.haskell.org/platform/) v2013.2.0.0
+* GLPK v4.52
+
+Clafer is now available on [Hackage](http://hackage.haskell.org/package/clafer-0.3.5/) and it can be installed using
+
+* `cabal update`
+* `cabal install clafer`
+* To automatically download Alloy jars, execute `make` in `clafer-0.3.5/tools` inside the Cabal's library folder
+
+You'll still need to install GLPK 4.52 for your operating system as described below.
+
+Building & Installation From Source Code
+----------------------------------------
+
+### Additional dependencies for building
+
+* The dependencies for running
+* [The Haskell Platform](http://hackage.haskell.org/platform/) v2013.2.0.0
+* [Alloy4.1 and/or Alloy4.2](http://alloy.mit.edu/alloy/download.html)
+  * downloaded automatically during build
+* [Git](http://git-scm.com/)
+
+On Linux
+* [libglpk-dev](http://www.gnu.org/software/glpk/) v4.52
+  * `sudo apt-get install libglpk-dev` on Ubuntu
+
+On Windows 
+
+* [MinGW+MSYS](http://mingw.org) 
+  * since the Haskell Platform already contains MinGW, you may choose to install MinGW+MSYS to the same location, e.g., `c:\...\Haskell Platform\2013.2.0.0`
+  * add the `bin` folders of MinGW (`MinGW\bin`) and MSYS (`MinGW\MSYS\1.0\bin`) to your system path
+  * `wget` will be automatically installed 
+* [WinGLPK](http://winglpk.sourceforge.net/) v4.52
+  * inside the `w32` folder, copy `glpk_4_52.dll` to`glpk.dll` so that it can be found when building Haskell package `glpk-hs`
+  * from `w32` folder, copy `glpk_4_52.dll` to `<user>\AppData\Roaming\cabal\bin`
+
+On Mac only
+1. install GPLK 4.52 from [MacPorts](http://www.macports.org/)
+2. execute `sudo port install glpk +universal`
+
+### Important: Branches must correspond
+
+All related projects are following the *simultaneous release model*. 
+The branch `master` contains releases, whereas the branch `develop` contains code under development. 
+When building the tools, the branches should match.
+Releases from branches 'master` are guaranteed to work well together.
+Development versions from branches `develop` should work well together but this might not always be the case.
+
+### Building
+
+1. install the dependencies
+2. open the command line terminal. On Windows, open MinGW.
+3. in some `<source directory>` of your choice, execute 
+  * `git clone git://github.com/gsdlab/clafer.git`
+4. in `<source directory>/clafer`, execute
+  * `cabal update`
+5. On Linux and Mac execute 
+  * `make`
+6. On Windows (in MinGW), execute 
+  * `make glpk="/c/<your WinGLPK install dir>"`
+
+### Installation
+
+1. On Linux and Mac execute 
+  * `make install to=<target directory>` 
+2. On Windows (in MinGW), execute 
+  * `make glpk="/c/<your WinGLPK instal dir>" to=/c/<target directory>`  
+3. add the `<target directory>` to your system PATH
+
+On Windows only
+
+* copy GLPK's dll `glpk-0.4.52.dll` to the `<target directory>` folder or any other folder on the system path
+
+#### Note: 
+> On Windows, use `/` with the `make` command instead of `\`.
+
+Usage
+=====
+
+Clafer Compiler
+---------------
+
+(As printed by `clafer --help`)
+
+```
+Clafer v0.3.5.20-01-2014
+
+clafer [OPTIONS] [FILE]
+
+Common flags:
+  -m --mode=CLAFERMODE                    Generated output type. Available
+                                          CLAFERMODEs are: 'alloy' (default,
+                                          Alloy 4.1); 'alloy42' (Alloy 4.2);
+                                          'xml' (intermediate representation of
+                                          Clafer model); 'clafer' (analyzed and
+                                          desugared clafer model); 'html'
+                                          (original model in HTML); 'graph'
+                                          (graphical representation written in
+                                          DOT language); 'cvlgraph' (cvl
+                                          notation representation written in
+                                          DOT language); 'python' (generates IR
+                                          in python); 'choco' (Choco constraint
+                                          programming solver). Multiple modes
+                                          can be specified at the same time,
+                                          e.g., '-m alloy -m html'.
+  -o --console-output                     Output code on console.
+  -i --flatten-inheritance                Flatten inheritance ('alloy' and
+                                          'alloy42' modes only).
+     --timeout-analysis=INT               Timeout for analysis.
+  -l --no-layout                          Don't resolve off-side rule layout.
+     --nl --new-layout                    Use new fast layout resolver
+                                          (experimental).
+  -c --check-duplicates                   Check duplicated clafer names.
+  -f --skip-resolver                      Skip name resolution.
+  -k --keep-unused                        Keep uninstantated abstract clafers
+                                          ('alloy' and 'alloy42' modes only).
+  -s --no-stats                           Don't print statistics.
+     --schema                             Show Clafer IR (intermediate
+                                          representation) XML schema.
+  -v --validate                           Validate outputs of all modes. Uses
+                                          'tools/XsdCheck.class' for XML,
+                                          'tools/alloy4.jar' and
+                                          'tools/alloy4.2.jar' for Alloy
+                                          models, and Clafer translator for
+                                          desugared Clafer models. Use
+                                          '--tooldir' to override the default
+                                          location of these tools.
+     --nr --noalloyruncommand             For usage with partial instances:
+                                          Don't generate the alloy 'run show
+                                          for ... ' command, and rename @.ref
+                                          with unique names  ('alloy' and
+                                          'alloy42' modes only).
+     --tooldir=DIR                        Specify the tools directory
+                                          ('validate' only). Default: 'tools/'.
+  -a --alloy-mapping                      Generate mapping to Alloy source
+                                          code ('alloy' and 'alloy42' modes
+                                          only).
+     --self-contained                     Generate a self-contained html
+                                          document ('html' mode only).
+     --add-graph                          Add a graph to the generated html
+                                          model ('html' mode only). Requires
+                                          the "dot" executable to be on the
+                                          system path.
+     --sr --show-references               Whether the links for references
+                                          should be rendered. ('html' and
+                                          'graph' modes only).
+     --add-comments                       Include comments from the source
+                                          file in the html output ('html' mode
+                                          only).
+  -e --ecore2clafer                       Translate an ECore model into
+                                          Clafer.
+     --ss=SCOPESTRATEGY --scope-strategy  Use scope computation strategy:
+                                          none, simple (default), or full.
+     --check-afm --afm                    Throws an error if the cardinality
+                                          of any of the clafers is above 1.
+     --sg --skip-goals                    Skip generation of Alloy code for
+                                          goals. Useful for all tools working
+                                          with standard Alloy.
+     --meta-data                          Generate a 'fully qualified
+                                          name'-'least-partially-qualified
+                                          name'-'unique ID' map ('.cfr-map').
+                                          In Alloy, Alloy42, and Choco modes,
+                                          generate the scopes map
+                                          ('.cfr-scope').
+  -? --help                               Display help message
+  -V --version                            Print version information
+```
+
+The dependencies among the command line arguments are described on the [model wiki](http://t3-necsis.cs.uwaterloo.ca:8091/ClaferTools/CommandLineArguments).
+
+Additionally, `[OPTIONS]` can also be specified directly in the model file by inserting the following compiler directive as the first line of the file:
+
+```
+//# [OPTIONS]
+```
+
+for example
+
+```
+//# --keep-unused -m=alloy42
+```
+
+Options given at command line override the options given in the file using `//#` which, in turn, override the defaults.
+
+### Using compiler directives
+
+Compiler directives are comments of the form
+
+```
+//# <directive name>
+```
+
+The following directives are markers of locations in the input files for different purposes:
+
+* `//# FRAGMENT` - marks the beginning of the new [module fragment](http://gsd.uwaterloo.ca:8888/question/463/multi-fragment-modules).
+* `//# GRAPH` - marks the insertion point for a graph rendering. The graph is only produced in HTML mode with the argument `--add-graph`.
+* `//# STATS` - marks the insertion point for module statistics. The statistics can be omitted using the argument `--no-stats`. 
+* `//# SUMMARY` - shorthand for `//# GRAPH` and `//# STATS`
+* `//# QUALITY_ATTRIBUTE` - is used by ClaferMooVisualizer and ClaferConfigurator to distinguish quality attributes, which should be filtered out, from other clafers.
+
+
+Need help?
+==========
+* See [language's website](http://clafer.org) for news, technical reports and more
+  * Check out a [Clafer tutorial](http://t3-necsis.cs.uwaterloo.ca:8091/Tutorial/Intro)
+  * Try a live instance of [ClaferWiki](http://t3-necsis.cs.uwaterloo.ca:8091)
+  * Try a live instance of [ClaferIDE](http://t3-necsis.cs.uwaterloo.ca:8094)
+  * Try a live instance of [ClaferConfigurator](http://t3-necsis.cs.uwaterloo.ca:8093)
+  * Try a live instance of [ClaferMooVisualizer](http://t3-necsis.cs.uwaterloo.ca:8092)
+* Take a look at (incomplete) [Clafer wiki](https://github.com/gsdlab/clafer/wiki)
+* Browse example models in the [test suite](https://github.com/gsdlab/clafer/tree/master/test/positive) and [MOO examples](https://github.com/gsdlab/clafer/tree/master/spl_configurator/dataset)
+* Post questions, report bugs, suggest improvements [GSD Lab Bug Tracker](http://gsd.uwaterloo.ca:8888/questions/). Tag your entries with `clafer` (so that we know what they are related to) and with `jimmy-liang` or `michal` (so that Jimmy or Michał gets a notification).
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
+ clafer.cabal view
@@ -0,0 +1,184 @@+Name:               clafer
+Version:            0.3.5
+Synopsis:           clafer compiles Clafer models to other formats, such as Alloy, XML, HTML, Dot.
+Description:        Clafer is a general purpose, lightweight, structural modeling language developed at GSD Lab, University of Waterloo. Lightweight modeling aims at improving the understanding of the problem domain in the early stages of software development and determining the requirements with fewer defects. Clafer's goal is to make modeling more accessible to a wider range of users and domains. The tool provides a reference language implementation. It translates models to other formats (e.g. Alloy, XML) to allow for reasoning with existing tools.
+Homepage:           http://clafer.org
+License:            MIT
+License-file:       LICENSE
+Author:             Kacper Bak, Jimmy Liang, Michal Antkiewicz, Chris Walker, Luke Michael Brown
+Maintainer:         mantkiew@gsd.uwaterloo.ca
+Stability:          Experimental
+Category:           Model
+Build-type:         Simple
+Cabal-version:      >= 1.16
+data-files:         README.md,
+                    CHANGES.md,
+                    logo.pdf,
+                    IDEs/clafer-README.md,
+                    IDEs/sublime-text-2/Packages/User/clafer.sublime-build
+                    Makefile,
+                    tools/XsdCheck.class,
+                    tools/ecore2clafer.jar,
+                    tools/Makefile
+source-repository head
+    type:           git
+    location:       git://github.com/gsdlab/clafer.git
+Executable clafer
+    build-tools:    ghc >= 7.6.3
+    default-language: 
+                    Haskell2010
+    default-extensions:
+                    DeriveDataTypeable,
+                    RankNTypes
+    main-is:        clafer.hs
+    build-depends:  array >= 0.4.0.1,
+                    base >= 4.6.0.1 && < 5,
+                    containers >= 0.4.2.1,
+                    directory >= 1.2.0.1,
+                    filepath >= 1.3.0.1,
+                    process >= 1.1.0.2,
+
+                    HUnit >= 1.2.5.2,
+                    mtl >= 2.1.2,
+                    parsec >= 3.1.3,
+                    QuickCheck >= 2.5.1.1, 
+                    transformers >= 0.3.0.0,
+
+                    data-stringmap >= 0.9.1,
+                    json-builder >= 0.3,
+                    string-conversions >= 0.3,
+                    cmdargs >= 0.10.5, 
+                    executable-path >= 0.0.3, 
+                    glpk-hs >= 0.3.4,
+                    HaXml >= 1.24,
+                    MaybeT >= 0.1.2,
+                    split >= 0.2.2, 
+                    test-framework >= 0.8, 
+                    test-framework-hunit >= 0.3.0, 
+                    test-framework-quickcheck2 >= 0.3.0.1,
+                    test-framework-th >= 0.2.4,
+
+                    clafer == 0.3.5
+    hs-source-dirs: src
+    other-modules: Paths_clafer
+
+library 
+    build-tools:    ghc >= 7.6.3
+    default-language: 
+                    Haskell2010    
+    default-extensions:
+                    DeriveDataTypeable,
+                    RankNTypes
+    build-depends:  array >= 0.4.0.1,
+                    base >= 4.6.0.1 && < 5,
+                    containers >= 0.4.2.1,
+                    directory >= 1.2.0.1,
+                    filepath >= 1.3.0.1,
+                    process >= 1.1.0.2,
+
+                    HUnit >= 1.2.5.2,
+                    mtl >= 2.1.2,
+                    parsec >= 3.1.3,
+                    QuickCheck >= 2.5.1.1, 
+                    transformers >= 0.3.0.0,
+
+                    data-stringmap >= 0.9.1,
+                    json-builder >= 0.3,
+                    string-conversions >= 0.3,
+                    cmdargs >= 0.10.5, 
+                    executable-path >= 0.0.3, 
+                    glpk-hs >= 0.3.4,
+                    HaXml >= 1.24,
+                    MaybeT >= 0.1.2,
+                    split >= 0.2.2, 
+                    test-framework >= 0.8, 
+                    test-framework-hunit >= 0.3.0, 
+                    test-framework-quickcheck2 >= 0.3.0.1,
+                    test-framework-th >= 0.2.4
+
+    hs-source-dirs:  src
+    ghc-options:     -Wall -fno-warn-unused-do-bind -fno-warn-orphans
+    exposed-modules: 
+                     Language.Clafer,
+                     Language.ClaferT,
+                     Language.Clafer.ClaferArgs,
+                     Language.Clafer.Comments,
+                     Language.Clafer.Common,
+                     Language.Clafer.Css,
+                     Language.Clafer.JSONMetaData,
+                     Language.Clafer.QNameUID,
+                     Language.Clafer.Front.Absclafer,
+                     Language.Clafer.Front.ErrM,
+                     Language.Clafer.Front.LayoutResolver,
+                     Language.Clafer.Front.Lexclafer,
+                     Language.Clafer.Front.Mapper,
+                     Language.Clafer.Front.Parclafer,
+                     Language.Clafer.Front.Printclafer,
+                     Language.Clafer.Generator.Alloy,
+                     Language.Clafer.Generator.Choco,
+                     Language.Clafer.Generator.Graph,
+                     Language.Clafer.Generator.Html,
+                     Language.Clafer.Generator.Python,
+                     Language.Clafer.Generator.Schema,
+                     Language.Clafer.Generator.Stats,
+                     Language.Clafer.Generator.Xml,
+                     Language.Clafer.Intermediate.Analysis,                     
+                     Language.Clafer.Intermediate.Desugarer,
+                     Language.Clafer.Intermediate.Intclafer,
+                     Language.Clafer.Intermediate.Resolver,
+                     Language.Clafer.Intermediate.ResolverInheritance,
+                     Language.Clafer.Intermediate.ResolverName,
+                     Language.Clafer.Intermediate.ResolverType,
+                     Language.Clafer.Intermediate.ScopeAnalysis,
+                     Language.Clafer.Intermediate.SimpleScopeAnalyzer,
+                     Language.Clafer.Intermediate.GLPKScopeAnalyzer,
+                     Language.Clafer.Intermediate.StringAnalyzer,
+                     Language.Clafer.Intermediate.Tracing,
+                     Language.Clafer.Intermediate.Transformer,
+                     Language.Clafer.Optimizer.Optimizer,
+                     Language.Clafer.SplitJoin
+
+Test-Suite test-suite
+    build-tools:    ghc >= 7.6.3
+    default-language: 
+                    Haskell2010    
+    type:           exitcode-stdio-1.0  
+    main-is:        test-suite.hs
+    hs-source-dirs: test
+    build-depends:  
+                    array >= 0.4.0.1,
+                    base >= 4.6.0.1 && < 5,
+                    containers >= 0.4.2.1,
+                    directory >= 1.2.0.1,
+                    filepath >= 1.3.0.1,
+                    process >= 1.1.0.2,
+
+                    HUnit >= 1.2.5.2,
+                    mtl >= 2.1.2,
+                    parsec >= 3.1.3,
+                    QuickCheck >= 2.5.1.1, 
+                    transformers >= 0.3.0.0,
+
+                    data-stringmap >= 0.9.1,
+                    json-builder >= 0.3,
+                    string-conversions >= 0.3,
+                    cmdargs >= 0.10.5, 
+                    executable-path >= 0.0.3, 
+                    glpk-hs >= 0.3.4,
+                    HaXml >= 1.24,
+                    MaybeT >= 0.1.2,
+                    split >= 0.2.2, 
+                    test-framework >= 0.8, 
+                    test-framework-hunit >= 0.3.0, 
+                    test-framework-quickcheck2 >= 0.3.0.1,
+                    test-framework-th >= 0.2.4,
+
+                    clafer == 0.3.5
+
+    ghc-options     -Wall -fno-warn-unused-do-bind -fno-warn-orphans
+
+    other-modules:
+                    Functions,
+                    Suite.Example,
+                    Suite.Positive,
+                    Suite.Negative
+ logo.pdf view

binary file changed (absent → 5890 bytes)

+ src/Language/Clafer.hs view
@@ -0,0 +1,549 @@+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+{- | Top-level interface to the Clafer compiler
+
+Normal usage:
+
+> t :: InputModel -> InputModel -> Either [ClaferErr] [String]
+> t a b =
+>   runClafer defaultClaferArgs $
+>     do
+>       addModuleFragment a
+>       addModuleFragment b
+>       parse
+>       compile
+>       generateFragments
+
+Example of compiling a model consisting of one fragment:
+
+> compileOneFragment :: ClaferArgs -> InputModel -> Either ClaferErr CompilerResult
+> compileOneFragment args model =
+>   runClafer args $
+>     do
+>       addModuleFragment model
+>       parse
+>       compile
+>       generate
+
+Use "generateFragments" instead to generate output based on their fragments.
+
+> compileTwoFragments :: ClaferArgs -> InputModel -> InputModel -> Either ClaferErr [String]
+> compileTwoFragments args frag1 frag2 =
+>   runClafer args $
+>    do
+>      addModuleFragment frag1
+>      addModuleFragment frag2
+>      parse
+>      compile
+>      generateFragments
+
+Use "throwErr" to halt execution:
+
+> runClafer args $
+>   when (notValid args) $ throwErr (ClaferErr "Invalid arguments.")
+
+Use "catchErrs" to catch the errors.
+-}
+module Language.Clafer (addModuleFragment,
+                        compile,
+                        parse,
+                        generate,
+                        generateHtml,
+                        generateFragments,
+                        runClaferT,
+                        runClafer,
+                        ClaferErr,
+                        getEnv,
+                        putEnv,
+                        CompilerResult(..),
+                        claferIRXSD,
+                        VerbosityL,
+                        InputModel,
+                        Token,
+                        Module,
+                        GEnv,
+                        IModule,
+                        voidf,
+                        ClaferEnv(..),
+                        getIr,
+                        getAst,
+                        makeEnv,
+                        Pos(..),
+                        IrTrace(..),
+                        module Language.Clafer.ClaferArgs,
+                        module Language.Clafer.Front.ErrM)
+where
+
+import Data.Either
+import Data.List
+import Data.Maybe
+import qualified Data.Map as Map
+import Data.Ord
+import Control.Monad
+import System.FilePath (takeBaseName)
+
+import Language.ClaferT 
+import Language.Clafer.Common
+import Language.Clafer.Front.ErrM
+import Language.Clafer.ClaferArgs hiding (Clafer)
+import qualified Language.Clafer.ClaferArgs as Mode (ClaferMode (Clafer))
+import Language.Clafer.Comments
+import qualified Language.Clafer.Css as Css
+import Language.Clafer.Front.Lexclafer
+import Language.Clafer.Front.Parclafer
+import Language.Clafer.Front.Printclafer
+import Language.Clafer.Front.Absclafer 
+import Language.Clafer.Front.LayoutResolver
+import Language.Clafer.Front.Mapper
+import Language.Clafer.Intermediate.Tracing
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Intermediate.Desugarer
+import Language.Clafer.Intermediate.Resolver
+import Language.Clafer.Intermediate.StringAnalyzer
+import Language.Clafer.Intermediate.Transformer
+import Language.Clafer.Intermediate.ScopeAnalysis
+import Language.Clafer.Optimizer.Optimizer
+import Language.Clafer.Generator.Alloy
+import Language.Clafer.Generator.Choco
+import Language.Clafer.Generator.Xml
+import Language.Clafer.Generator.Python
+import Language.Clafer.Generator.Schema
+import Language.Clafer.Generator.Stats
+import Language.Clafer.Generator.Html
+import Language.Clafer.Generator.Graph
+
+type VerbosityL = Int
+type InputModel = String
+
+-- | Add a new fragment to the model. Fragments should be added in order.
+addModuleFragment :: Monad m => InputModel -> ClaferT m ()
+addModuleFragment i =
+  do
+    env <- getEnv
+    let modelFrags' = modelFrags env ++ [i]
+    let frags' = frags env ++ [(endPos $ concat modelFrags')]
+    putEnv env{ modelFrags = modelFrags', frags = frags' }
+  where
+  endPos "" = Pos 1 1
+  endPos model =
+    Pos line' column'
+    where
+    input' = lines' model
+    line' = toInteger $ length input'
+    column' = 1 + (toInteger $ length $ last input')
+    -- Can't use the builtin lines because it ignores the last empty lines (as of base 4.5).
+    lines' "" = [""]
+    lines' input'' =
+      line'' : rest'
+      where
+      (line'', rest) = break (== '\n') input''
+      rest' =
+        case rest of
+          "" -> []
+          ('\n' : r) -> lines' r
+          x -> error $ "linesing " ++ x -- How can it be nonempty and not start with a newline after the break? Should never happen.
+      
+-- | Converts the Err monads (created by the BNFC parser generator) to ClaferT
+liftParseErrs :: Monad m => [Err a] -> ClaferT m [a]
+liftParseErrs e =
+  do
+    result <- zipWithM extract [0..] e
+    case partitionEithers result of
+      ([], ok) -> return ok
+      (e',  _) -> throwErrs e'
+  where
+  extract _ (Ok m)  = return $ Right m
+  extract frgId (Bad p s) =
+    do
+      -- Bad maps to ParseErr
+      return $ Left $ ParseErr (ErrFragPos frgId p) s
+
+-- | Converts one Err. liftParseErrs is better if you want to report multiple errors. 
+-- | This method will only report one before ceasing execution.
+liftParseErr :: Monad m => Err a -> ClaferT m a
+liftParseErr e = head `liftM` liftParseErrs [e]
+
+
+-- | Parses the model into AST. Adding more fragments beyond this point will have no effect.
+parse :: Monad m => ClaferT m ()
+parse =
+  do
+    env <- getEnv
+    astsErr <- mapM (parseFrag $ args env) $ modelFrags env
+    asts <- liftParseErrs astsErr
+
+    -- We need to somehow combine all the ASTS together into a complete AST
+    -- However, the source positions inside the ASTs are relative to their
+    -- fragments.
+    --
+    -- For example
+    --   Frag1: "A\nB\n"
+    --   Frag2: "C\n"
+    -- The "C" clafer in Frag2 has position (1, 1) because it is at the start of the fragment.
+    -- However, it should have position (3, 1) since that is its position in the complete model.
+    --
+    -- We can
+    --   1. Traverse the model and update the positions so that they are relative to model rather
+    --      than the fragment.
+    --   2. Reparse the model as a complete model rather in fragments.
+    --
+    -- The second one is easier so that's we'll do for now. There shouldn't be any errors since
+    -- each individual fragment already passed.
+    ast' <- case asts of
+      -- Special case: if there is only one fragment, then the complete model is contained within it.
+      -- Don't need to reparse. This is the common case.
+      [oneFrag] -> return oneFrag
+      _ -> do
+        -- Combine all the fragment syntaxes
+        let completeModel = concat $ modelFrags env
+        completeAst <- (parseFrag $ args env) completeModel
+        liftParseErr completeAst
+
+    
+    let ast = mapModule ast'
+    let env' = env{ cAst = Just ast, astModuleTrace = traceAstModule ast }
+    putEnv env'
+  where
+  parseFrag :: (Monad m) => ClaferArgs -> String -> ClaferT m (Err Module)
+  parseFrag args' =
+    (>>= (return . pModule)) .
+    (if not 
+      ((new_layout args') ||
+      (no_layout args'))
+    then 
+       resolveLayout 
+    else 
+       return) 
+    . myLexer .
+    (if (not $ no_layout args') &&
+        (new_layout args')
+     then 
+       resLayout 
+     else 
+       id)
+
+-- | Compiles the AST into IR.    
+compile :: Monad m => ClaferT m ()
+compile =
+  do
+    env <- getEnv
+    ast' <- getAst
+    let desugaredMod = desugar ast'
+    let clafersWithKeyWords = foldMapIR isKeyWord desugaredMod
+    when (""/=clafersWithKeyWords) $ throwErr (ClaferErr $ ("The model contains clafers with keywords as names in the following places:\n"++) $ clafersWithKeyWords :: CErr Span)
+    ir <- analyze (args env) desugaredMod
+    let (imodule, _, _) = ir
+
+    let spanList = foldMapIR gt1 imodule
+    when ((afm $ args env) && spanList/="") $ throwErr (ClaferErr $ ("The model is not an attributed feature model.\nThe following places contain cardinality larger than 1:\n"++) $ spanList :: CErr Span)
+    putEnv $ env{ cIr = Just ir, irModuleTrace = traceIrModule imodule }
+    where
+      isKeyWord :: Ir -> String
+      isKeyWord (IRClafer IClafer{cinPos = (Span (Pos l c) _) ,ident=i}) = if (i `elem` keyWords) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      isKeyWord (IRClafer IClafer{cinPos = (PosSpan _ (Pos l c) _) ,ident=i}) = if (i `elem` keyWords) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      isKeyWord (IRClafer IClafer{cinPos = (Span (PosPos _ l c) _) ,ident=i}) = if (i `elem` keyWords) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      isKeyWord (IRClafer IClafer{cinPos = (PosSpan _ (PosPos _ l c) _) ,ident=i}) = if (i `elem` keyWords) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      isKeyWord _ = ""
+      gt1 :: Ir -> String
+      gt1 (IRClafer (IClafer (Span (Pos l c) _) False _ _ _ _ (Just (_, m)) _ _)) = if (m > 1 || m < 0) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      gt1 (IRClafer (IClafer (Span (PosPos _ l c) _) False _ _ _ _ (Just (_, m)) _ _)) = if (m > 1 || m < 0) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else "" 
+      gt1 (IRClafer (IClafer (PosSpan _ (Pos l c) _) False _ _ _ _ (Just (_, m)) _ _)) = if (m > 1 || m < 0) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      gt1 (IRClafer (IClafer (PosSpan _ (PosPos _ l c) _) False _ _ _ _ (Just (_, m)) _ _)) = if (m > 1 || m < 0) then ("Line " ++ show l ++ " column " ++ show c ++ "\n") else ""
+      gt1 _ = ""
+
+-- | Splits the IR into their fragments, and generates the output for each fragment.
+-- | Might not generate the entire output (for example, Alloy scope and run commands) because
+-- | they do not belong in fragments.
+generateFragments :: Monad m => ClaferT m [String]
+generateFragments =
+  do
+    env <- getEnv
+    (iModule, _, _) <- getIr
+    fragElems <- fragment (sortBy (comparing rnge) $ mDecls iModule) (frags env)
+    
+    -- Assumes output mode is Alloy for now
+    
+    return $ map (generateFragment $ args env) fragElems
+  where
+  rnge (IEClafer IClafer{cinPos = p}) = p
+  rnge IEConstraint{cpexp = PExp{inPos = p}} = p
+  rnge IEGoal{cpexp = PExp{inPos = p}} = p
+  
+  -- Groups IElements by their fragments.
+  --   elems must be sorted by range.
+  fragment :: (Monad m) => [IElement] -> [Pos] -> ClaferT m [[IElement]]
+  fragment [] [] = return []
+  fragment elems (frag : rest) =
+    fragment restFrags rest >>= return . (curFrag:)
+    where
+    (curFrag, restFrags) = span (`beforePos` frag) elems
+  fragment _ [] = throwErr $ (ClaferErr $ "Unexpected fragment." :: CErr Span) -- Should not happen. Bug.
+  
+  beforePos ele p =
+    case rnge ele of
+      Span _ e -> e <= p
+      PosSpan _ _ e -> e <= p
+  generateFragment :: ClaferArgs -> [IElement] -> String
+  generateFragment args' frag =
+    flatten $ cconcat $ map (genDeclaration args') frag
+
+-- | Splits the AST into their fragments, and generates the output for each fragment.
+generateHtml :: ClaferEnv -> Module -> String
+generateHtml env ast' =
+    let PosModule _ decls' = ast';
+        cargs = args env;
+        irMap = irModuleTrace env;
+        comments = if add_comments cargs then getComments $ unlines $ modelFrags env else [];
+    in (if (self_contained cargs) then Css.header ++ "<style>" ++ Css.css ++ "</style></head>\n<body>\n" else "")
+       ++ (unlines $ genFragments decls' (frags env) irMap comments) ++
+       (if (self_contained cargs) then "</body>\n</html>" else "")
+
+  where
+    lne (PosElementDecl (Span p _) _) = p
+    lne (PosEnumDecl (Span p _) _  _) = p
+    lne _                               = Pos 0 0
+    genFragments :: [Declaration] -> [Pos] -> Map.Map Span [Ir] -> [(Span, String)] -> [String]
+    genFragments []           _            _     comments = printComments comments
+    genFragments (decl:decls') []           irMap comments = let (comments', c) = printPreComment (range decl) comments in
+                                                                   [c] ++ (cleanOutput $ revertLayout $ printDeclaration decl 0 irMap True $ inDecl decl comments') : (genFragments decls' [] irMap $ afterDecl decl comments)
+    genFragments (decl:decls') (frg:frgs) irMap comments = if lne decl < frg
+                                                                 then let (comments', c) = printPreComment (range decl) comments in
+                                                                   [c] ++ (cleanOutput $ revertLayout $ printDeclaration decl 0 irMap True $ inDecl decl comments') : (genFragments decls' (frg:frgs) irMap $ afterDecl decl comments)
+                                                                 else "<!-- # FRAGMENT /-->" : genFragments (decl:decls') frgs irMap comments
+    inDecl :: Declaration -> [(Span, String)] -> [(Span, String)]
+    inDecl decl comments = let s = rnge decl in dropWhile (\x -> fst x < s) comments
+    afterDecl :: Declaration -> [(Span, String)] -> [(Span, String)]
+    afterDecl decl comments = let (Span _ (Pos line' _)) = rnge decl in dropWhile (\(x, _) -> let (Span _ (Pos line'' _)) = x in line'' <= line') comments
+    rnge (EnumDecl _ _) = noSpan
+    rnge (PosEnumDecl s _ _) = s
+    rnge (ElementDecl _) = noSpan
+    rnge (PosElementDecl s _) = s
+    printComments [] = []
+    printComments ((s, comment):cs) = (snd (printComment s [(s, comment)]) ++ "<br>\n"):printComments cs
+
+-- | Generates outputs for the given IR.
+generate :: Monad m => ClaferT m (Map.Map ClaferMode CompilerResult)
+generate =
+  do
+    env <- getEnv
+    ast' <- getAst
+    (iModule, genv, au) <- getIr
+    let 
+      cargs = args env
+      stats = showStats au $ statsModule iModule
+      modes = mode cargs
+      scopes = getScopeStrategy (scope_strategy cargs) iModule
+    return $ Map.fromList ( 
+        -- result for Alloy
+        (if (Alloy `elem` modes)
+          then let 
+                  (imod,strMap) = astrModule iModule
+                  alloyCode = genModule cargs{mode = [Alloy]} (imod, genv) scopes
+                  addCommentStats = if no_stats cargs then const else addStats 
+               in 
+                  [ (Alloy, 
+                    CompilerResult { 
+                     extension = "als", 
+                     outputCode = addCommentStats (fst alloyCode) stats, 
+                     statistics = stats,
+                     claferEnv  = env,
+                     mappingToAlloy = fromMaybe [] (Just $ snd alloyCode),
+                     stringMap = strMap,
+                     scopesList = scopes
+                    })
+                  ]
+          else []
+        ) 
+        ++
+        -- result for Alloy42
+        (if (Alloy42 `elem` modes)
+          then let 
+                  (imod,strMap) = astrModule iModule
+                  alloyCode = genModule cargs{mode = [Alloy42]} (imod, genv) scopes
+                  addCommentStats = if no_stats cargs then const else addStats 
+               in 
+                  [ (Alloy42, 
+                    CompilerResult { 
+                     extension = "als4", 
+                     outputCode = addCommentStats (fst alloyCode) stats, 
+                     statistics = stats,
+                     claferEnv  = env,
+                     mappingToAlloy = fromMaybe [] (Just $ snd alloyCode),
+                     stringMap = strMap,
+                     scopesList = scopes
+                    })
+                  ]
+          else []
+        )   
+        -- result for XML    
+        ++ (if (Xml `elem` modes)
+          then [ (Xml,
+                  CompilerResult { 
+                   extension = "xml", 
+                   outputCode = genXmlModule iModule, 
+                   statistics = stats,
+                   claferEnv  = env,
+                   mappingToAlloy = [],
+                   stringMap = Map.empty,
+                   scopesList = []
+                  }) ]
+          else []
+        )
+        -- result for Clafer
+        ++ (if (Mode.Clafer `elem` modes)
+          then [ (Mode.Clafer,
+                  CompilerResult { 
+                   extension = "des.cfr", 
+                   outputCode = printTree $ sugarModule iModule, 
+                   statistics = stats,
+                   claferEnv  = env,
+                   mappingToAlloy = [],
+                   stringMap = Map.empty,
+                   scopesList = []
+                  }) ]
+          else []
+        )
+        -- result for Html    
+        ++ (if (Html `elem` modes)
+          then [ (Html,
+                  CompilerResult { 
+                   extension = "html", 
+                   outputCode = generateHtml env ast', 
+                   statistics = stats,
+                   claferEnv  = env,
+                   mappingToAlloy = [],
+                   stringMap = Map.empty,
+                   scopesList = []
+                  }) ]
+          else []
+        )
+        ++ (if (Graph `elem` modes)
+          then [ (Graph,
+                  CompilerResult { 
+                     extension = "dot", 
+                     outputCode = genSimpleGraph ast' iModule (takeBaseName $ file cargs) (show_references cargs), 
+                     statistics = stats,
+                     claferEnv  = env,
+                     mappingToAlloy = [],
+                     stringMap = Map.empty,
+                     scopesList = []
+                  }) ]
+          else []
+        )
+        ++ (if (CVLGraph `elem` modes)
+          then [ (CVLGraph,
+                  CompilerResult { 
+                       extension = "cvl.dot", 
+                       outputCode = genCVLGraph ast' iModule (takeBaseName $ file cargs), 
+                       statistics = stats,
+                       claferEnv  = env,
+                       mappingToAlloy = [],
+                       stringMap = Map.empty,
+                       scopesList = []
+                  }) ]
+          else []
+        )
+        -- result for Python    
+        ++ (if (Python `elem` modes)
+          then [ (Python, 
+                  CompilerResult { 
+                   extension = "py", 
+                   outputCode = genPythonModule iModule,
+                   statistics = stats,
+                   claferEnv  = env,
+                   mappingToAlloy = [],
+                   stringMap = Map.empty,
+                   scopesList = scopes
+                  }) ]
+          else []
+        )
+        -- result for Choco    
+        ++ (if (Choco `elem` modes)
+          then let 
+                  (imod,strMap) = astrModule iModule
+               in
+                  [ (Choco, 
+                     CompilerResult { 
+                         extension = "js", 
+                         outputCode = genCModule cargs (imod, genv) scopes, 
+                         statistics = stats,
+                         claferEnv  = env,
+                         mappingToAlloy = [],
+                         stringMap = strMap,
+                         scopesList = scopes
+                      }) ]
+          else []
+        ))
+    
+-- | Result of generation for a given mode
+data CompilerResult = CompilerResult {
+                            -- | output file extension
+                            extension :: String, 
+                            -- | output text
+                            outputCode :: String, 
+                            statistics :: String,
+                            -- | the final environment of the compiler
+                            claferEnv :: ClaferEnv,
+                            -- | Maps source constraint spans in Alloy to the spans in the IR
+                            mappingToAlloy :: [(Span, IrTrace)], 
+                            -- | Map back from Ints used to represent Strings
+                            stringMap :: (Map.Map Int String),
+                            -- | scopes generated by scope inference
+                            scopesList :: [(UID, Integer)]
+                            } deriving Show
+
+desugar :: Module -> IModule  
+desugar tree = desugarModule tree
+
+liftError :: (Monad m, Language.ClaferT.Throwable t) => Either t a -> ClaferT m a
+liftError = either throwErr return
+
+analyze :: Monad m => ClaferArgs -> IModule -> ClaferT m (IModule, GEnv, Bool)
+analyze args' tree = do
+  let dTree' = findDupModule args' tree
+  let au = allUnique dTree'
+  let args'' = args'{skip_resolver = au && (skip_resolver args')}
+  (rTree, genv) <- liftError $ resolveModule args'' dTree'
+  let tTree = transModule rTree
+  return (optimizeModule args'' (tTree, genv), genv, au)
+
+addStats :: String -> String -> String
+addStats code stats = "/*\n" ++ stats ++ "*/\n" ++ code
+
+showStats :: Bool -> Stats -> String
+showStats au (Stats na nr nc nconst ngoals sgl) =
+  unlines [ "All clafers: " ++ (show (na + nr + nc)) ++ " | Abstract: " ++ (show na) ++ " | Concrete: " ++ (show nc) ++ " | References: " ++ (show nr)          , "Constraints: " ++ show nconst
+          , "Goals: " ++ show ngoals  
+          , "Global scope: " ++ showInterval sgl
+          , "Can skip resolver: " ++ show au]
+
+showInterval :: (Integer, Integer) -> String
+showInterval (n, -1) = show n ++ "..*"
+showInterval (n, m) = show n ++ ".." ++ show m
+
+-- | The XML Schema of the IR
+claferIRXSD :: String
+claferIRXSD = Language.Clafer.Generator.Schema.xsd
+
+-- | reserved keywords
+keyWords :: [String]
+keyWords = ["ref","parent","abstract", "else", "in", "no", "opt", "xor", "all", "enum", "lone", "not", "or", "disj", "extends", "mux", "one", "some"]
+ src/Language/Clafer/ClaferArgs.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DeriveDataTypeable #-}
+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+{- | Command Line Arguments of the compiler.
+
+See also <http://t3-necsis.cs.uwaterloo.ca:8091/ClaferTools/CommandLineArguments a model of the arguments in Clafer>,  including constraints and examples.
+-}
+module Language.Clafer.ClaferArgs where
+
+import System.IO ( stdin, hGetContents )
+import System.Console.CmdArgs
+import System.Console.CmdArgs.Explicit hiding (mode)
+import Data.List
+import Data.Maybe
+import Language.Clafer.SplitJoin
+import Paths_clafer (version)
+import Data.Version (showVersion)
+
+-- | Type of output to be generated at the end of compilation
+data ClaferMode = Alloy42 | Alloy | Xml | Clafer | Html | Graph | CVLGraph | Python | Choco
+  deriving (Eq, Show, Ord, Data, Typeable)
+instance Default ClaferMode where
+  def = Alloy
+
+-- | Scope inference strategy
+data ScopeStrategy = None | Simple | Full
+  deriving (Eq, Show, Data, Typeable)
+instance Default ScopeStrategy where
+  def = Simple
+
+data ClaferArgs = ClaferArgs {
+      mode :: [ ClaferMode ],
+      console_output :: Bool,
+      flatten_inheritance :: Bool,
+      timeout_analysis :: Int,
+      no_layout :: Bool,
+      new_layout :: Bool,
+      check_duplicates :: Bool,
+      skip_resolver :: Bool,
+      keep_unused :: Bool,
+      no_stats :: Bool,
+      schema :: Bool,
+      validate :: Bool,
+      noalloyruncommand :: Bool,
+      tooldir :: FilePath,
+      alloy_mapping :: Bool,
+      self_contained :: Bool,
+      add_graph :: Bool,
+      show_references :: Bool,
+      add_comments :: Bool,
+      ecore2clafer :: Bool,
+      scope_strategy :: ScopeStrategy,
+      afm :: Bool,
+      skip_goals :: Bool,
+      meta_data :: Bool,
+      file :: FilePath
+    } deriving (Show, Data, Typeable)
+
+clafer :: ClaferArgs
+clafer = ClaferArgs {
+  mode                = [] &= help "Generated output type. Available CLAFERMODEs are: 'alloy' (default, Alloy 4.1); 'alloy42' (Alloy 4.2); 'xml' (intermediate representation of Clafer model); 'clafer' (analyzed and desugared clafer model); 'html' (original model in HTML); 'graph' (graphical representation written in DOT language); 'cvlgraph' (cvl notation representation written in DOT language); 'python' (generates IR in python); 'choco' (Choco constraint programming solver). Multiple modes can be specified at the same time, e.g., '-m alloy -m html'." &= name "m",
+  console_output      = def &= help "Output code on console." &= name "o",
+  flatten_inheritance = def &= help "Flatten inheritance ('alloy' and 'alloy42' modes only)." &= name "i",
+  timeout_analysis    = def &= help "Timeout for analysis.",
+  no_layout           = def &= help "Don't resolve off-side rule layout." &= name "l",
+  new_layout          = def &= help "Use new fast layout resolver (experimental)." &= name "nl",
+  check_duplicates    = def &= help "Check duplicated clafer names."  &= name "c",
+  skip_resolver       = def &= help "Skip name resolution." &= name "f",
+  keep_unused         = def &= help "Keep uninstantated abstract clafers ('alloy' and 'alloy42' modes only)." &= name "k",
+  no_stats            = def &= help "Don't print statistics." &= name "s",
+  schema              = def &= help "Show Clafer IR (intermediate representation) XML schema.",
+  validate            = def &= help "Validate outputs of all modes. Uses 'tools/XsdCheck.class' for XML,  'tools/alloy4.jar' and 'tools/alloy4.2.jar' for Alloy models, and Clafer translator for desugared Clafer models. Use '--tooldir' to override the default location of these tools." &= name "v",
+  noalloyruncommand   = def &= help "For usage with partial instances: Don't generate the alloy 'run show for ... ' command, and rename @.ref with unique names  ('alloy' and 'alloy42' modes only)." &= name "nr",
+  tooldir             = def &= typDir &= help "Specify the tools directory ('validate' only). Default: 'tools/'.",
+  alloy_mapping       = def &= help "Generate mapping to Alloy source code ('alloy' and 'alloy42' modes only)." &= name "a",
+  self_contained      = def &= help "Generate a self-contained html document ('html' mode only).",
+  add_graph           = def &= help "Add a graph to the generated html model ('html' mode only). Requires the \"dot\" executable to be on the system path.",
+  show_references     = def &= help "Whether the links for references should be rendered. ('html' and 'graph' modes only)." &= name "sr",
+  add_comments        = def &= help "Include comments from the source file in the html output ('html' mode only).",
+  ecore2clafer        = def &= help "Translate an ECore model into Clafer.",
+  scope_strategy      = def &= help "Use scope computation strategy: none, simple (default), or full." &= name "ss",
+  afm                 = def &= help "Throws an error if the cardinality of any of the clafers is above 1." &= name "check-afm",
+  skip_goals          = def &= help "Skip generation of Alloy code for goals. Useful for all tools working with standard Alloy." &= name "sg",
+  meta_data           = def &= help "Generate a 'fully qualified name'-'least-partially-qualified name'-'unique ID' map ('.cfr-map'). In Alloy, Alloy42, and Choco modes, generate the scopes map ('.cfr-scope').",
+  file                = def &= args   &= typ "FILE"
+ } &= summary ("Clafer " ++ showVersion Paths_clafer.version) &= program "clafer"
+
+mergeArgs :: ClaferArgs -> ClaferArgs -> ClaferArgs
+mergeArgs a1 a2  = ClaferArgs (mode a1) (coMergeArg) 
+  (mergeArg flatten_inheritance) (mergeArg timeout_analysis) 
+  (mergeArg no_layout) (mergeArg new_layout) 
+  (mergeArg check_duplicates) (mergeArg skip_resolver) 
+  (mergeArg keep_unused) (mergeArg no_stats) (mergeArg schema)
+  (mergeArg validate) (mergeArg noalloyruncommand) (toolMergeArg) 
+  (mergeArg alloy_mapping) (mergeArg self_contained) 
+  (mergeArg add_graph) (mergeArg show_references) 
+  (mergeArg add_comments) (mergeArg ecore2clafer) 
+  (mergeArg scope_strategy) (mergeArg afm) (mergeArg skip_goals) 
+  (mergeArg meta_data) (mergeArg file)
+  where
+    coMergeArg :: Bool
+    coMergeArg = if (r1 /= False) then r1 else 
+      if (r2 /= False) then r2 else (null $ file a1)
+         where r1 = console_output a1;r2 = console_output a2
+    toolMergeArg :: String
+    toolMergeArg = if (r1 /= "") then r1 else 
+      if (r2 /= "") then r2 else "/tools"
+      where r1 = tooldir a1;r2 = tooldir a2
+    mergeArg :: (Default a, Eq a) => (ClaferArgs -> a) -> a
+    mergeArg f = (\r -> if (r /= def) then r else f a2) $ f a1
+
+mainArgs :: IO (ClaferArgs, String)
+mainArgs = do
+  args' <- cmdArgs clafer 
+  model <- case file args' of
+             "" -> hGetContents stdin
+             f  -> readFile f
+  let firstLine = case lines model of
+               [] -> ""
+               (s:_) -> s
+  let options = fromMaybe "" $ stripPrefix "//# OPTIONS " firstLine
+  let args'' = either (const args') (mergeArgs args' . cmdArgsValue) $
+               process (cmdArgsMode clafer) $ Language.Clafer.SplitJoin.splitArgs options
+  -- Alloy should be the default mode but only if nothing else was specified
+  -- cannot use [ Alloy ] as the default in the definition of `clafer :: ClaferArgs` since 
+  -- Alloy will always be a mode in addition to the other specified modes (it will become mandatory)
+  let args''' = if null $ mode args''
+                then args''{mode = [ Alloy ]}
+                else args''
+  return $ (args''', model)
+
+defaultClaferArgs :: ClaferArgs
+defaultClaferArgs = ClaferArgs [ def ] True False 0 False False False False False False False False False "tools/" False False False False False False Simple False False False ""
+ src/Language/Clafer/Comments.hs view
@@ -0,0 +1,89 @@+{-
+ Copyright (C) 2012 Christopher Walker <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+
+module Language.Clafer.Comments(getOptions, getFragments, getStats, getGraph, getComments) where
+
+import Data.Maybe (fromMaybe)
+import Data.List (stripPrefix)
+import Language.Clafer.Front.Absclafer
+
+type InputModel = String
+
+getOptions :: InputModel -> String
+getOptions model = case lines model of
+  []    -> ""
+  (s:_) -> fromMaybe "" $ stripPrefix "//# OPTIONS " s
+
+getFragments :: InputModel -> [Int]
+getFragments [] = []
+getFragments xs = getFragments' (lines xs) 1
+getFragments' :: [ InputModel ] -> Int -> [Int]
+getFragments' [] _ = []
+getFragments' ("//# FRAGMENT":xs) ln = ln:getFragments' xs (ln + 1)
+getFragments' (_:xs) ln = getFragments' xs $ ln + 1
+
+getStats :: InputModel -> [Int]
+getStats [] = []
+getStats xs = getStats' (lines xs) 1
+getStats' :: [String] -> Int -> [Int]
+getStats' [] _ = []
+getStats' ("//# SUMMARY":xs) ln = ln:getStats' xs (ln + 1)
+getStats' ("//# STATS":xs)   ln = ln:getStats' xs (ln + 1)
+getStats' (_:xs) ln = getStats' xs $ ln + 1
+
+getGraph :: InputModel -> [Int]
+getGraph [] = []
+getGraph xs = getGraph' (lines xs) 1
+getGraph' :: [String] -> Int -> [Int]
+getGraph' [] _ = []
+getGraph' ("//# SUMMARY":xs) ln = ln:getGraph' xs (ln + 1)
+getGraph' ("//# GRAPH":xs)   ln = ln:getGraph' xs (ln + 1)
+getGraph' (_:xs) ln = getGraph' xs $ ln + 1
+
+getComments :: InputModel -> [(Span, String)]
+getComments input = getComments' input 1 1
+getComments' :: String -> Integer -> Integer -> [(Span, String)]
+getComments' []           _   _     = []
+getComments' ('/':'/':xs) row col  = readLine ('/':'/':xs) (Pos row col)
+getComments' ('/':'*':xs) row col  = readBlock ('/':'*':xs) (Pos row col)
+getComments' ('\n':xs)    row _    = getComments' xs (row + 1) 1
+getComments' (_:xs)       row col  = getComments' xs row $ col + 1
+
+readLine :: String -> Pos -> [(Span, String)]
+readLine    [] _                   = []
+readLine    xs start@(Pos row col) = let comment = takeWhile (/= '\n') xs in 
+                                                   ((Span start (Pos row (col + toInteger (length comment)))),
+                                                    comment): getComments' (drop (length comment + 1) xs) (row + 1) 1
+readLine    xs (PosPos _ row col)  = readLine xs (Pos row col)
+
+
+readBlock :: String -> Pos -> [(Span, String)]  
+readBlock   xs start@(Pos row col) = let (end@(Pos row' col'), comment, rest) = readBlock' xs row col id in
+                                      ((Span start end), comment):getComments' rest row' col'                                    
+readBlock  xs (PosPos _ row col) = readBlock xs (Pos row col)
+readBlock' :: String -> Integer
+              -> Integer -> (String -> String)
+              -> (Pos, String,String)
+readBlock' ('*':'/':xs) row col comment = ((Pos row $ col + 2), comment "*/", xs)
+readBlock' ('\n':xs)    row _   comment = readBlock' xs (row + 1) 1 (comment "\n" ++)
+readBlock' (x:xs)       row col comment = readBlock' xs row (col + 1) (comment [x]++)
+readBlock' []           row col comment = ((Pos row col), comment [], [])
+ src/Language/Clafer/Common.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE DeriveDataTypeable, RankNTypes, KindSignatures, FlexibleContexts #-}
+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Common where
+
+import Data.Tree
+import Data.Maybe
+import Data.Char
+import Data.List
+import qualified Data.Map as Map
+
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+
+-- -----------------------------------------------------------------------------
+-- basic functions shared by desugarer, analyzer and code generator
+type Result = String
+
+transIdent :: PosIdent -> Result
+transIdent x = case x of
+  PosIdent str  -> snd str
+
+mkIdent :: String -> PosIdent
+mkIdent str = PosIdent ((0, 0), str)
+
+mkInteger :: Read a => PosInteger -> a
+mkInteger (PosInteger (_, n)) = read n
+
+type Ident = PosIdent
+
+getSuper :: IClafer -> String
+getSuper = getSuperId.supers.super
+
+getSuperNoArr :: IClafer -> String
+
+getSuperNoArr clafer
+  | isOverlapping $ super clafer = "clafer"
+  | otherwise                    = getSuper clafer
+
+getSuperId :: [PExp] -> String
+getSuperId = sident . Language.Clafer.Intermediate.Intclafer.exp . head
+
+isEqClaferId :: String -> IClafer -> Bool
+isEqClaferId = flip $ (==).uid
+
+idToPExp :: String -> Span -> String -> String -> Bool -> PExp
+idToPExp pid' pos modids id' isTop' = PExp (Just $ TClafer [id']) pid' pos (IClaferId modids id' isTop')
+
+mkLClaferId :: String -> Bool -> IExp
+mkLClaferId = IClaferId ""
+
+mkPLClaferId :: String -> Bool -> PExp
+mkPLClaferId id' isTop' = pExpDefPidPos $ mkLClaferId id' isTop'
+
+pExpDefPidPos :: IExp -> PExp
+pExpDefPidPos = pExpDefPid noSpan
+
+pExpDefPid :: Span -> IExp -> PExp
+pExpDefPid = pExpDef ""
+
+pExpDef :: String -> Span -> IExp -> PExp
+pExpDef = PExp Nothing
+
+isParent :: PExp -> Bool
+isParent (PExp _ _ _ (IClaferId _ id' _)) = id' == parent
+isParent _ = False
+
+isClaferName :: PExp -> Bool
+isClaferName (PExp _ _ _ (IClaferId _ id' _)) =
+  id' `notElem` ([this, parent, children, ref] ++ primitiveTypes)
+isClaferName _ = False
+
+isClaferName' :: PExp -> Bool
+isClaferName' (PExp _ _ _ (IClaferId _ _ _)) = True
+isClaferName' _ = False
+
+getClaferName :: PExp -> String
+getClaferName (PExp _ _ _ (IClaferId _ id' _)) = id'
+getClaferName _ = ""
+
+-- -----------------------------------------------------------------------------
+-- conversions
+elemToClafer :: IElement -> Maybe IClafer
+elemToClafer x = case x of
+  IEClafer clafer  -> Just clafer
+  _  -> Nothing
+
+toClafers :: [IElement] -> [IClafer]
+toClafers = mapMaybe elemToClafer
+
+-- -----------------------------------------------------------------------------
+-- finds hierarchy and transforms each element
+mapHierarchy :: (IClafer -> b)
+                -> (IClafer -> String)
+                -> [IClafer]
+                -> IClafer
+                -> [b]
+mapHierarchy f sf = (map f.).(findHierarchy sf)
+
+
+-- returns inheritance hierarchy of a clafer
+
+findHierarchy :: (IClafer -> String)
+                            -> [IClafer]
+                            -> IClafer
+                            -> [IClafer]
+findHierarchy sFun clafers clafer
+  | sFun clafer == "clafer"      = [clafer]
+  | otherwise                    = if clafer `elem` superClafers
+                                   then error $ "Inheritance hierarchy contains a cycle: line " ++ (show $ cinPos clafer)
+                                   else clafer : superClafers
+  where
+  superClafers = unfoldr (\c -> find (isEqClaferId $ sFun c) clafers >>=
+                          Just . (apply id)) clafer
+
+-- -----------------------------------------------------------------------------
+-- generic functions
+
+apply :: forall t t1. (t -> t1) -> t -> (t, t1)
+apply f x = (x, f x)
+
+-- lists all nodes of a tree (BFS). Take a function to extract subforest
+bfs :: forall b b1. (b1 -> (b, [b1])) -> [b1] -> [b]
+bfs toNode seed = map rootLabel $ concat $ takeWhile (not.null) $
+  iterate (concatMap subForest) $ unfoldForest toNode seed
+
+
+toNodeShallow :: IClafer -> (IClafer, [IClafer])
+toNodeShallow = apply (getSubclafers.elements)
+
+
+getSubclafers :: [IElement] -> [IClafer]
+getSubclafers = mapMaybe elemToClafer
+
+
+bfsClafers :: [IClafer] -> [IClafer]
+bfsClafers clafers = bfs toNodeShallow clafers
+
+lurry :: forall t t1. ([t1] -> t) -> t1 -> t1 -> t
+lurry f x y = f [x,y]
+
+fst3 :: forall t t1 t2. (t, t1, t2) -> t
+fst3 (a, _, _) = a
+snd3 :: forall t t1 t2. (t, t1, t2) -> t1
+snd3 (_, b, _) = b
+trd3 :: forall t t1 t2. (t, t1, t2) -> t2
+trd3 (_, _, c) = c
+
+
+toTriple :: forall t t1 t2. t -> (t1, t2) -> (t, t1, t2)
+toTriple a (b,c) = (a, b, c)
+
+toMTriple :: forall t t1 t2. t -> (t1, t2) -> Maybe (t, t1, t2)
+toMTriple a (b,c) = Just (a, b, c)
+
+-- unary operators
+iNot :: String
+iNot          = "!"
+
+iCSet :: String
+iCSet         = "#"
+
+iMin :: String
+iMin          = "-"
+
+iGMax :: String
+iGMax         = "max"
+
+iGMin :: String
+iGMin         = "min"
+
+iSumSet :: String
+iSumSet       = "sum"
+
+unOps :: [String]
+unOps = [iNot, iCSet, iMin, iGMax, iGMin, iSumSet]
+
+-- binary operators
+iIff :: String
+iIff          = "<=>"
+
+iImpl :: String
+iImpl         = "=>"
+
+iOr :: String
+iOr           = "||"
+
+iXor :: String
+iXor          = "xor"
+
+iAnd :: String
+iAnd          = "&&"
+
+logBinOps :: [String]
+logBinOps = [iIff, iImpl, iOr, iXor, iAnd]
+
+iLt :: String
+iLt           = "<"
+
+iGt :: String
+iGt           = ">"
+
+iEq :: String
+iEq           = "="
+
+iLte :: String
+iLte          = "<="
+
+iGte :: String
+iGte          = ">="
+
+iNeq :: String
+iNeq          = "!="
+
+iIn :: String
+iIn           = "in"
+
+iNin :: String
+iNin          = "not in"
+
+relGenBinOps :: [String]
+relGenBinOps = [iLt, iGt, iEq, iLte, iGte, iNeq]
+
+relSetBinOps :: [String]
+relSetBinOps = [iIn, iNin]
+
+relBinOps :: [String]
+relBinOps = relGenBinOps ++ relSetBinOps
+
+iPlus :: String
+iPlus         = "+"
+
+iSub :: String
+iSub          = "-"
+
+iMul :: String
+iMul          = "*"
+
+iDiv :: String
+iDiv          = "/"
+
+iSumSet' :: String
+iSumSet'      = "sum'"
+
+arithBinOps :: [String]
+arithBinOps = [iPlus, iSub, iMul, iDiv, iSumSet']
+
+iUnion :: String
+iUnion        = "++"
+
+iDifference :: String
+iDifference   = "--"
+
+iIntersection :: String
+iIntersection = "&"
+
+iDomain :: String
+iDomain       = "<:"
+
+iRange :: String
+iRange        = ":>"
+
+iJoin :: String
+iJoin         = "."
+
+setBinOps :: [String]
+setBinOps = [iUnion, iDifference, iIntersection, iDomain, iRange, iJoin]
+
+binOps :: [String]
+binOps = logBinOps ++ relBinOps ++ arithBinOps ++ setBinOps
+
+-- ternary operators
+iIfThenElse :: String
+iIfThenElse   = "=>else"
+
+mkIFunExp :: String -> [IExp] -> IExp
+mkIFunExp _ (x:[]) = x
+mkIFunExp op' xs = foldl1 (\x y -> IFunExp op' $ map (PExp (Just $ TClafer []) "" noSpan) [x,y]) xs
+
+toLowerS :: String -> String
+toLowerS "" = ""
+toLowerS (s:ss) = toLower s : ss
+
+-- -----------------------------------------------------------------------------
+-- Constants
+
+this :: String
+this = "this"
+
+parent :: String
+parent = "parent"
+
+children :: String
+children = "children"
+
+ref :: String
+ref = "ref"
+
+specialNames :: [String]
+specialNames = [this, parent, children, ref]
+
+strType :: String
+strType = "string"
+
+intType :: String
+intType = "int"
+
+integerType :: String
+integerType = "integer"
+
+baseClafer :: String
+baseClafer = "clafer"
+
+modSep :: String
+modSep = "\\"
+
+primitiveTypes :: [String]
+primitiveTypes = [strType, intType, integerType]
+
+isPrimitive :: String -> Bool
+isPrimitive = flip elem primitiveTypes
+
+data GEnv = GEnv {
+  identCountMap :: Map.Map String Int,
+  expCount :: Int,
+  stable :: Map.Map UID [[UID]], -- super clafer names of a given clafer
+  sClafers ::[IClafer] -- all clafers (no going through references)
+  } deriving (Eq, Show)
+
+voidf :: Monad m => m t -> m ()
+voidf f = do
+  _ <- f
+  return ()
+ src/Language/Clafer/Css.hs view
@@ -0,0 +1,41 @@+{-
+ Copyright (C) 2012 Christopher Walker <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Css where
+
+header :: String
+header = "<!DOCTYPE html>\n<html>\n<head>\n<meta http-equiv=\"X-UA-Compatible\" content=\"IE=9\">\n"
+
+css :: String
+css = unlines [ 
+  ".identifier{}",
+  ".keyword{font-weight:bold}",
+  ".reference{}",
+  ".code { background-color: lightgray; padding: 5px 5px 5px 5px; border: 1px solid darkgray; margin-bottom: 15px; ",
+  "        font-family: Pragmata, Menlo, 'DejaVu LGC Sans Mono', 'DejaVu Sans Mono', Consolas, 'Everson Mono', 'Lucida Console', 'Andale Mono', 'Nimbus Mono L', 'Liberation Mono', FreeMono, 'Osaka Monospaced', Courier, 'New Courier', monospace; }",
+  ".standalonecomment { color: green; font-style:italic }",
+  ".inlinecomment { color: green; padding-left:20px; font-style:italic }",
+  ".error{background-color: yellow; color: red }",
+  ".indent{padding-left:20px}",
+  "a[href$='Lookup failed'] {color: red}",
+  "a[href$='Uid not found'] {color: red}",
+  "a[href$='Ambiguous name'] {color: yellow}",
+ "" ]
+ src/Language/Clafer/Front/Absclafer.hs view
@@ -0,0 +1,279 @@+-- | Abstract syntax of the Clafer language.
+module Language.Clafer.Front.Absclafer where
+noSpan :: Span
+noSpan = Span noPos noPos
+noPos :: Pos
+noPos = Pos 0 0
+
+-- Haskell module generated by the BNF converter
+
+
+newtype PosInteger = PosInteger ((Int,Int),String) deriving (Eq,Ord,Show)
+newtype PosDouble = PosDouble ((Int,Int),String) deriving (Eq,Ord,Show)
+newtype PosString = PosString ((Int,Int),String) deriving (Eq,Ord,Show)
+newtype PosIdent = PosIdent ((Int,Int),String) deriving (Eq,Ord,Show)
+data Module =
+   Module [Declaration]
+ | PosModule Span [Declaration]
+  deriving (Eq,Ord,Show)
+
+data Declaration =
+   EnumDecl PosIdent [EnumId]
+ | PosEnumDecl Span PosIdent [EnumId]
+ | ElementDecl Element
+ | PosElementDecl Span Element
+  deriving (Eq,Ord,Show)
+
+data Clafer =
+   Clafer Abstract GCard PosIdent Super Card Init Elements
+ | PosClafer Span Abstract GCard PosIdent Super Card Init Elements
+  deriving (Eq,Ord,Show)
+
+data Constraint =
+   Constraint [Exp]
+ | PosConstraint Span [Exp]
+  deriving (Eq,Ord,Show)
+
+data SoftConstraint =
+   SoftConstraint [Exp]
+ | PosSoftConstraint Span [Exp]
+  deriving (Eq,Ord,Show)
+
+data Goal =
+   Goal [Exp]
+ | PosGoal Span [Exp]
+  deriving (Eq,Ord,Show)
+
+data Abstract =
+   AbstractEmpty
+ | PosAbstractEmpty Span
+ | Abstract
+ | PosAbstract Span
+  deriving (Eq,Ord,Show)
+
+data Elements =
+   ElementsEmpty
+ | PosElementsEmpty Span
+ | ElementsList [Element]
+ | PosElementsList Span [Element]
+  deriving (Eq,Ord,Show)
+
+data Element =
+   Subclafer Clafer
+ | PosSubclafer Span Clafer
+ | ClaferUse Name Card Elements
+ | PosClaferUse Span Name Card Elements
+ | Subconstraint Constraint
+ | PosSubconstraint Span Constraint
+ | Subgoal Goal
+ | PosSubgoal Span Goal
+ | Subsoftconstraint SoftConstraint
+ | PosSubsoftconstraint Span SoftConstraint
+  deriving (Eq,Ord,Show)
+
+data Super =
+   SuperEmpty
+ | PosSuperEmpty Span
+ | SuperSome SuperHow SetExp
+ | PosSuperSome Span SuperHow SetExp
+  deriving (Eq,Ord,Show)
+
+data SuperHow =
+   SuperColon
+ | PosSuperColon Span
+ | SuperArrow
+ | PosSuperArrow Span
+ | SuperMArrow
+ | PosSuperMArrow Span
+  deriving (Eq,Ord,Show)
+
+data Init =
+   InitEmpty
+ | PosInitEmpty Span
+ | InitSome InitHow Exp
+ | PosInitSome Span InitHow Exp
+  deriving (Eq,Ord,Show)
+
+data InitHow =
+   InitHow_1
+ | PosInitHow_1 Span
+ | InitHow_2
+ | PosInitHow_2 Span
+  deriving (Eq,Ord,Show)
+
+data GCard =
+   GCardEmpty
+ | PosGCardEmpty Span
+ | GCardXor
+ | PosGCardXor Span
+ | GCardOr
+ | PosGCardOr Span
+ | GCardMux
+ | PosGCardMux Span
+ | GCardOpt
+ | PosGCardOpt Span
+ | GCardInterval NCard
+ | PosGCardInterval Span NCard
+  deriving (Eq,Ord,Show)
+
+data Card =
+   CardEmpty
+ | PosCardEmpty Span
+ | CardLone
+ | PosCardLone Span
+ | CardSome
+ | PosCardSome Span
+ | CardAny
+ | PosCardAny Span
+ | CardNum PosInteger
+ | PosCardNum Span PosInteger
+ | CardInterval NCard
+ | PosCardInterval Span NCard
+  deriving (Eq,Ord,Show)
+
+data NCard =
+   NCard PosInteger ExInteger
+ | PosNCard Span PosInteger ExInteger
+  deriving (Eq,Ord,Show)
+
+data ExInteger =
+   ExIntegerAst
+ | PosExIntegerAst Span
+ | ExIntegerNum PosInteger
+ | PosExIntegerNum Span PosInteger
+  deriving (Eq,Ord,Show)
+
+data Name =
+   Path [ModId]
+ | PosPath Span [ModId]
+  deriving (Eq,Ord,Show)
+
+data Exp =
+   DeclAllDisj Decl Exp
+ | PosDeclAllDisj Span Decl Exp
+ | DeclAll Decl Exp
+ | PosDeclAll Span Decl Exp
+ | DeclQuantDisj Quant Decl Exp
+ | PosDeclQuantDisj Span Quant Decl Exp
+ | DeclQuant Quant Decl Exp
+ | PosDeclQuant Span Quant Decl Exp
+ | EGMax Exp
+ | PosEGMax Span Exp
+ | EGMin Exp
+ | PosEGMin Span Exp
+ | EIff Exp Exp
+ | PosEIff Span Exp Exp
+ | EImplies Exp Exp
+ | PosEImplies Span Exp Exp
+ | EOr Exp Exp
+ | PosEOr Span Exp Exp
+ | EXor Exp Exp
+ | PosEXor Span Exp Exp
+ | EAnd Exp Exp
+ | PosEAnd Span Exp Exp
+ | ENeg Exp
+ | PosENeg Span Exp
+ | ELt Exp Exp
+ | PosELt Span Exp Exp
+ | EGt Exp Exp
+ | PosEGt Span Exp Exp
+ | EEq Exp Exp
+ | PosEEq Span Exp Exp
+ | ELte Exp Exp
+ | PosELte Span Exp Exp
+ | EGte Exp Exp
+ | PosEGte Span Exp Exp
+ | ENeq Exp Exp
+ | PosENeq Span Exp Exp
+ | EIn Exp Exp
+ | PosEIn Span Exp Exp
+ | ENin Exp Exp
+ | PosENin Span Exp Exp
+ | QuantExp Quant Exp
+ | PosQuantExp Span Quant Exp
+ | EAdd Exp Exp
+ | PosEAdd Span Exp Exp
+ | ESub Exp Exp
+ | PosESub Span Exp Exp
+ | EMul Exp Exp
+ | PosEMul Span Exp Exp
+ | EDiv Exp Exp
+ | PosEDiv Span Exp Exp
+ | ESumSetExp Exp
+ | PosESumSetExp Span Exp
+ | ECSetExp Exp
+ | PosECSetExp Span Exp
+ | EMinExp Exp
+ | PosEMinExp Span Exp
+ | EImpliesElse Exp Exp Exp
+ | PosEImpliesElse Span Exp Exp Exp
+ | EInt PosInteger
+ | PosEInt Span PosInteger
+ | EDouble PosDouble
+ | PosEDouble Span PosDouble
+ | EStr PosString
+ | PosEStr Span PosString
+ | ESetExp SetExp
+ | PosESetExp Span SetExp
+  deriving (Eq,Ord,Show)
+
+data SetExp =
+   Union SetExp SetExp
+ | PosUnion Span SetExp SetExp
+ | UnionCom SetExp SetExp
+ | PosUnionCom Span SetExp SetExp
+ | Difference SetExp SetExp
+ | PosDifference Span SetExp SetExp
+ | Intersection SetExp SetExp
+ | PosIntersection Span SetExp SetExp
+ | Domain SetExp SetExp
+ | PosDomain Span SetExp SetExp
+ | Range SetExp SetExp
+ | PosRange Span SetExp SetExp
+ | Join SetExp SetExp
+ | PosJoin Span SetExp SetExp
+ | ClaferId Name
+ | PosClaferId Span Name
+  deriving (Eq,Ord,Show)
+
+data Decl =
+   Decl [LocId] SetExp
+ | PosDecl Span [LocId] SetExp
+  deriving (Eq,Ord,Show)
+
+data Quant =
+   QuantNo
+ | PosQuantNo Span
+ | QuantLone
+ | PosQuantLone Span
+ | QuantOne
+ | PosQuantOne Span
+ | QuantSome
+ | PosQuantSome Span
+  deriving (Eq,Ord,Show)
+
+data EnumId =
+   EnumIdIdent PosIdent
+ | PosEnumIdIdent Span PosIdent
+  deriving (Eq,Ord,Show)
+
+data ModId =
+   ModIdIdent PosIdent
+ | PosModIdIdent Span PosIdent
+  deriving (Eq,Ord,Show)
+
+data LocId =
+   LocIdIdent PosIdent
+ | PosLocIdIdent Span PosIdent
+  deriving (Eq,Ord,Show)
+
+data Pos =
+   Pos Integer Integer
+ | PosPos Span Integer Integer
+  deriving (Eq,Ord,Show)
+
+data Span =
+   Span Pos Pos
+ | PosSpan Span Pos Pos
+  deriving (Eq,Ord,Show)
+
+ src/Language/Clafer/Front/ErrM.hs view
@@ -0,0 +1,28 @@+-- BNF Converter: Error Monad
+-- Copyright (C) 2004  Author:  Aarne Ranta
+
+-- This file comes with NO WARRANTY and may be used FOR ANY PURPOSE.
+module Language.Clafer.Front.ErrM where
+
+import Language.Clafer.Front.Absclafer
+
+-- the Error monad: like Maybe type with error msgs
+
+import Control.Monad (MonadPlus(..), liftM)
+
+data Err a = Ok a | Bad Pos String
+  deriving (Show, Eq, Ord)
+
+instance Monad Err where
+  return      = Ok
+  fail        = Bad noPos
+  Ok a  >>= f = f a
+  Bad p s >>= _ = Bad p s
+
+instance Functor Err where
+  fmap = liftM
+
+instance MonadPlus Err where
+  mzero = Bad noPos "Err.mzero"
+  mplus (Bad _ _) y = y
+  mplus x       _ = x
+ src/Language/Clafer/Front/LayoutResolver.hs view
@@ -0,0 +1,388 @@+{-# LANGUAGE FlexibleContexts #-}
+{-
+ Copyright (C) 2012 Kacper Bak, Christopher Walker <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Resolves indentation into explicit nesting using { }
+module Language.Clafer.Front.LayoutResolver where
+
+-- very simple layout resolver
+import Control.Monad.State
+import Data.Functor.Identity (Identity)
+import Language.Clafer.Common
+import Language.ClaferT
+
+import Language.Clafer.Front.Lexclafer
+import Data.Maybe
+
+data LayEnv = LayEnv {
+      level :: Int,
+      levels :: [Int],
+      input :: String,
+      output :: String,
+      brCtr :: Int
+    } deriving Show
+
+
+-- | ident level of new line, current level or parenthesis
+type LastNl = (Int, Int)
+
+type Position = Posn
+
+data ExToken = NewLine LastNl | ExToken Token deriving Show
+
+-- | ident level stack, last new line
+data LEnv = LEnv [Int] (Maybe LastNl)
+
+getToken :: (Monad m) => ExToken -> ClaferT m Token
+getToken (ExToken t) = return t
+getToken (NewLine (x, y)) = throwErr $ ParseErr (ErrPos 0 fPos fPos) $ "LayoutResolver.getToken: Cannot get ExToken NewLine"-- this shoud never happen
+  where
+    fPos = Pos (fromIntegral x) (fromIntegral y)
+
+
+layoutOpen :: String
+layoutOpen  = "{"
+layoutClose :: String
+layoutClose = "}"
+
+resolveLayout :: (Monad m) => [Token] -> ClaferT m  [Token]
+resolveLayout xs = addNewLines xs >>= (resolve (LEnv [1] Nothing)) >>= adjust
+
+resolve :: (Monad m) => LEnv -> [ExToken] -> ClaferT m [Token]
+resolve (LEnv st _) [] = return $ replicate (length st - 1) dedent
+resolve (LEnv st _) ((NewLine lastNl):ts) = resolve (LEnv st (Just lastNl)) ts
+resolve env@(LEnv st lastNl) (t:ts)
+  | isJust lastNl && parLev > 0 = do
+    r <- resolve env ts
+    t' >>= return . (:r)
+  | isJust lastNl && newLev > head st = do
+    r <- resolve (LEnv (newLev : st) Nothing) ts
+    t' >>=  return . (indent:) . (:r)
+  | isJust lastNl && newLev == head st = do
+    r <- resolve (LEnv st Nothing) ts
+    t' >>= return . (:r)
+  | isJust lastNl = do
+    r <- resolve (LEnv st' Nothing) ts
+    t' >>= return . (replicate (length st - length st') dedent ++) . (:r)
+  | otherwise = do
+    r <- resolve env ts
+    t' >>= return . (:r)
+  where
+  t' = getToken t
+  (newLev, parLev) = fromJust lastNl
+  st' = dropWhile (newLev <) st
+
+indent :: Token
+indent = PT (Pn 0 0 0) (TS "{" $ tokenLookup "{")
+dedent :: Token
+dedent = PT (Pn 0 0 0) (TS "}" $ tokenLookup "}") 
+
+toToken :: ExToken -> [Token]
+toToken (NewLine _) = []
+toToken (ExToken t) = [t]
+
+isExTokenIn :: [String] -> ExToken -> Bool
+isExTokenIn l (ExToken t) = isTokenIn l t
+isExTokenIn _ _ = False
+
+
+isNewLine :: Token -> Token -> Bool
+isNewLine t1 t2 = line t1 < line t2
+
+-- | Add to the global and column positions of a token.
+-- | The column position is only changed if the token is on
+-- | the same line as the given position.
+incrGlobal :: (Monad m) => Position -- ^ If the token is on the same line
+                       --   as this position, update the column position.
+           -> Int      -- ^ Number of characters to add to the position.
+           -> Token -> ClaferT m Token
+incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) =
+  return $ if l /= l0 then PT (Pn (g + i) l c) t
+             else PT (Pn (g + i) l (c + i)) t
+incrGlobal _ _ (Err (Pn z x y)) = do
+  env <- getEnv
+  let claferModel = lines $ unlines $ modelFrags env
+  throwErr $ ParseErr (ErrPos z fPos fPos) $ "Cannot add token at '" ++ (take y $ claferModel !! (x-1)) ++ "'"
+  where
+    fPos = Pos (fromIntegral x) (fromIntegral y)
+
+
+tokenLookup :: String -> Int
+tokenLookup s = i
+  where
+    i = case s of
+      "!" -> 1
+      "!=" -> 2
+      "#" -> 3
+      "&" -> 4
+      "&&" -> 5
+      "(" -> 6
+      ")" -> 7
+      "*" -> 8
+      "+" -> 9
+      "++" -> 10
+      "," -> 11
+      "-" -> 12
+      "--" -> 13
+      "->" -> 14
+      "->>" -> 15
+      "." -> 16
+      ".." -> 17
+      "/" -> 18
+      ":" -> 19
+      ":=" -> 20
+      ":>" -> 21
+      ";" -> 22
+      "<" -> 23
+      "<:" -> 24
+      "<<" -> 25
+      "<=" -> 26      
+      "<=>" -> 27
+      "=" -> 28
+      "=>" -> 29
+      ">" -> 30
+      ">=" -> 31
+      ">>" -> 32
+      "?" -> 33
+      "[" -> 34
+      "\\" -> 35
+      "]" -> 36
+      "`" -> 37
+      "abstract" -> 38
+      "all" -> 39
+      "disj" -> 40
+      "else" -> 41
+      "enum" -> 42
+      "if" -> 43
+      "in" -> 44
+      "lone" -> 45
+      "max" -> 46
+      "min" -> 47
+      "mux" -> 48
+      "no" -> 49
+      "not" -> 50
+      "one" -> 51
+      "opt" -> 52
+      "or" -> 53
+      "some" -> 54
+      "sum" -> 55       
+      "then" -> 56
+      "xor" -> 57
+      "{" -> 58
+      "|" -> 59
+      "||" -> 60
+      "}" -> 61
+      _ -> 0
+
+-- | Get the position of a token.
+position :: Token -> Position
+position t = case t of
+  PT p _ -> p
+  Err p -> p
+
+-- | Get the line number of a token.
+line :: Token -> Int
+line t = case position t of Pn _ l _ -> l
+
+-- | Get the column number of a token.
+column :: Token -> Int
+column t = case position t of Pn _ _ c -> c
+
+-- | Check if a token is one of the given symbols.
+isTokenIn :: [String] -> Token -> Bool
+isTokenIn ts t = case t of
+  PT _ (TS r _) | elem r ts -> True
+  _ -> False
+
+-- | Check if a token is the layout open token.
+isLayoutOpen :: Token -> Bool
+isLayoutOpen = isTokenIn [layoutOpen]
+
+isBracketOpen :: Token -> Bool
+isBracketOpen = isTokenIn ["["]
+
+-- | Check if a token is the layout close token.
+isLayoutClose :: Token -> Bool
+isLayoutClose = isTokenIn [layoutClose]
+
+isBracketClose :: Token -> Bool
+isBracketClose = isTokenIn ["]"]
+
+-- | Get the number of characters in the token.
+tokenLength :: Token -> Int
+tokenLength t = length $ prToken t
+
+-- data ExToken = NewLine (Int, Int) | ExToken Token
+addNewLines :: (Monad m) => [Token] -> ClaferT m [ExToken]
+addNewLines []    = return []
+addNewLines ts@(t:_) = addNewLines' (if isBracketOpen t then 1 else 0) ts
+
+addNewLines' :: (Monad m) => Int -> [Token] -> ClaferT m [ExToken]
+addNewLines' _ []                     = return []
+addNewLines' 0 (t:[])                 = return [ExToken t]
+addNewLines' _ ((PT (Pn z x y) t):[]) = throwErr $ ParseErr (ErrPos z fPos fPos) $ "']' bracket missing for (" ++ show t ++ ")"
+  where
+    fPos = (Pos (fromIntegral x) (fromIntegral y))
+addNewLines' n (t0:t1:ts)
+  | isNewLine t0 t1 && isBracketOpen t1 =
+    addNewLines' (n + 1) (t1:ts) >>= (return . (ExToken t0:) . (NewLine (column t1, n):))
+  | isNewLine t0 t1 && isBracketClose t1 =
+    addNewLines' (n - 1) (t1:ts) >>= (return . (ExToken t0:) . (NewLine (column t1, n):))
+  | isLayoutOpen t1  || isBracketOpen t1 =
+    addNewLines' (n + 1) (t1:ts) >>= (return . (ExToken t0:))
+  | isLayoutClose t1 || isBracketClose t1 =
+    addNewLines' (n - 1) (t1:ts) >>= (return . (ExToken t0:)) 
+  | isNewLine t0 t1  = addNewLines' n (t1:ts) >>= (return . (ExToken t0:) . (NewLine (column t1, n):)) 
+  | otherwise        = addNewLines' n (t1:ts) >>= (return . (ExToken t0:)) 
+addNewLines' _ _ = throwErr (ClaferErr "Function addNewLines' from LayoutResolver was given invalid arguments" :: CErr Span) -- This should never happen!
+
+
+adjust :: (Monad m) => [Token] -> ClaferT m [Token]
+adjust [] = return []
+adjust (t:[]) = return [t]
+adjust (t:ts) = ((updToken (t:ts)) >>= adjust) >>= (return . (t:))
+
+updToken :: (Monad m) => [Token] -> ClaferT m [Token]
+updToken (t0:t1:ts)
+  | isLayoutOpen t1 || isLayoutClose t1 = addToken (nextPos t0) sym ts
+  | otherwise = return (t1:ts)
+  where
+  sym = if isLayoutOpen t1 then "{" else "}"
+  -- | Get the position immediately to the right of the given token.
+  nextPos :: Token -> Position 
+  nextPos t = Pn (g + s) l (c + s + 1) 
+    where Pn g l c = position t
+          s = tokenLength t
+updToken [] = return []
+updToken (t:ts) = return (t:ts)
+
+-- | Insert a new symbol token at the begninning of a list of tokens.
+addToken :: (Monad m) => Position -- ^ Position of the new token.
+         -> String   -- ^ Symbol in the new token.
+         -> [Token]  -- ^ The rest of the tokens. These will have their
+                     --   positions updated to make room for the new token.
+         -> ClaferT m [Token]
+addToken p@(Pn z x y) s ts = do
+  when (i==0) $ throwErr $ ParseErr (ErrPos z fPos fPos) $ "not a reserved word: " ++ show s
+  (>>= (return . (PT p (TS s i):))) $ mapM (incrGlobal p (length s)) ts
+  where
+    fPos = Pos (fromIntegral x) (fromIntegral y)
+    i = tokenLookup s
+
+resLayout :: String -> String
+resLayout input' = 
+  reverse $ output $ execState resolveLayout' $ LayEnv 0 [] input'' [] 0
+  where
+  input'' = unlines $ filter (/= "") $ lines input'
+
+
+resolveLayout' :: StateT LayEnv Identity ()
+resolveLayout' = do
+  stop <- isEof
+  when (not stop) $ do
+    c  <- getc
+    c' <- handleIndent c
+    emit c'
+    resolveLayout'
+
+handleIndent :: Char -> StateT LayEnv Identity Char
+handleIndent c = case c of
+  '\n' -> do
+    emit c
+    n  <- eatSpaces
+    c' <- readC n
+    emitIndent n
+    emitDedent n
+    when (c' `elem` ['[', ']','{', '}']) $ voidf $ handleIndent c'
+    return c'
+  '[' -> do
+    modify (\e -> e {brCtr = brCtr e + 1})
+    return c
+  '{' -> do
+    modify (\e -> e {brCtr = brCtr e + 1})
+    return c
+  ']' -> do
+    modify (\e -> e {brCtr = brCtr e - 1})
+    return c
+  '}' -> do
+    modify (\e -> e {brCtr = brCtr e - 1})
+    return c
+  _ ->  return c
+
+
+emit :: MonadState LayEnv m => Char -> m ()
+emit c = modify (\e -> e {output = c : output e})
+
+
+readC :: (Num a, Ord a) => a -> StateT LayEnv Identity Char
+readC n = if n > 0 then getc else return '\n'
+
+
+eatSpaces :: StateT LayEnv Identity Int
+eatSpaces = do
+  cs <- gets input
+  let (sp, rest) = break (/= ' ') cs
+  modify (\e -> e {input = rest, output = sp ++ output e})
+  ctr <- gets brCtr
+  if ctr > 0 then gets level else return $ length sp
+
+
+emitIndent :: MonadState LayEnv m => Int -> m ()
+emitIndent n = do
+  lev <- gets level  
+  when (n > lev) $ do
+    ctr <- gets brCtr
+    when (ctr < 1) $ do
+      emit '{'
+    modify (\e -> e {level = n, levels = lev : levels e})
+
+
+emitDedent :: MonadState LayEnv m => Int -> m ()
+emitDedent n = do
+  lev <- gets level
+  when (n < lev) $ do
+    ctr <- gets brCtr
+    when (ctr < 1) $ emit '}'
+    modify (\e -> e {level = head $ levels e, levels = tail $ levels e})
+    emitDedent n
+
+
+isEof :: StateT LayEnv Identity Bool
+isEof = null `liftM` (gets input)
+
+
+getc :: StateT LayEnv Identity Char
+getc = do
+  c <- gets (head.input)
+  modify (\e -> e {input = tail $ input e})
+  return c
+
+revertLayout :: String -> String
+revertLayout input' = unlines $ revertLayout' (lines input') 0 
+
+revertLayout' :: [String] -> Int -> [String]
+revertLayout' []             _ = []
+revertLayout' ([]:xss)       i = revertLayout' xss i
+revertLayout' (('{':xs):xss) i = (replicate i' ' ' ++ xs):revertLayout' xss i'
+                                    where i' = i + 2
+revertLayout' (('}':xs):xss) i = (replicate i' ' ' ++ xs):revertLayout' xss i'
+                                    where i' = i - 2
+revertLayout' (xs:xss)       i = (replicate i ' ' ++ xs):revertLayout' xss i
+ src/Language/Clafer/Front/Lexclafer.hs view
@@ -0,0 +1,393 @@+{-# LANGUAGE CPP,MagicHash #-}
+{-# OPTIONS_GHC -w #-}
+{-# LINE 3 "Lexclafer.x" #-}
+
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module Language.Clafer.Front.Lexclafer where
+
+
+
+
+#if __GLASGOW_HASKELL__ >= 603
+#include "ghcconfig.h"
+#elif defined(__GLASGOW_HASKELL__)
+#include "config.h"
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+import Data.Char (ord)
+import Data.Array.Base (unsafeAt)
+#else
+import Array
+import Char (ord)
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+alex_base :: AlexAddr
+alex_base = AlexA# "\xf8\xff\xff\xff\x4c\x00\x00\x00\x22\x01\x00\x00\xa2\x01\x00\x00\x22\x02\x00\x00\x22\x03\x00\x00\x92\x00\x00\x00\x00\x00\x00\x00\x13\x03\x00\x00\x13\x04\x00\x00\x34\x00\x00\x00\xd3\x03\x00\x00\xa9\x04\x00\x00\x00\x00\x00\x00\x15\x04\x00\x00\x29\x05\x00\x00\x9e\x05\x00\x00\xd9\xff\xff\xff\x4d\x00\x00\x00\x61\x00\x00\x00\x9e\x06\x00\x00\x5e\x06\x00\x00\x00\x00\x00\x00\x54\x07\x00\x00\x00\x00\x00\x00\x2a\x08\x00\x00\x7e\x00\x00\x00\xed\xff\xff\xff\xdc\xff\xff\xff\x4f\x00\x00\x00\xcb\xff\xff\xff\xd6\xff\xff\xff\x00\x00\x00\x00\x99\xff\xff\xff\xd8\xff\xff\xff\x3d\x00\x00\x00\xef\xff\xff\xff\xf9\xff\xff\xff\x79\x00\x00\x00\x2f\x07\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x03\x09\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA# "\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x13\x00\x20\x00\x20\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x20\x00\x20\x00\x20\x00\x20\x00\x0c\x00\x1a\x00\x1e\x00\x10\x00\x20\x00\x17\x00\x20\x00\x25\x00\x20\x00\x20\x00\x20\x00\x20\x00\x1c\x00\x20\x00\x1d\x00\x24\x00\x1b\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x1f\x00\x20\x00\x23\x00\x22\x00\x1f\x00\x20\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x20\x00\x20\x00\x20\x00\x10\x00\x00\x00\x20\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x20\x00\x21\x00\x20\x00\x02\x00\x20\x00\x00\x00\x20\x00\x22\x00\x18\x00\x20\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x00\x00\x22\x00\x00\x00\x00\x00\x10\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x10\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x29\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x16\x00\x15\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x04\x00\x07\x00\x07\x00\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2d\x00\x2b\x00\x3d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3d\x00\x3e\x00\x7c\x00\x3e\x00\x2a\x00\x20\x00\x21\x00\x22\x00\x23\x00\x2f\x00\x2e\x00\x26\x00\x26\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x22\x00\xff\xff\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x2a\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x2f\x00\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x3e\x00\xff\xff\xff\xff\x5c\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x74\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2a\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\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\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x22\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xff\xff\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\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\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x0a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA# "\xff\xff\x0c\x00\x0c\x00\xff\xff\xff\xff\x0c\x00\x0c\x00\x0d\x00\x0d\x00\x10\x00\xff\xff\x10\x00\x0c\x00\x16\x00\x16\x00\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x17\x00\x17\x00\x17\x00\x17\x00\xff\xff\x0c\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"#
+
+alex_accept :: Array Int [AlexAcc (Posn -> String -> Token) user]
+alex_accept = listArray (0::Int,42) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))]]
+{-# LINE 39 "Lexclafer.x" #-}
+
+
+tok :: (t1 -> t2 -> t) -> t1 -> t2 -> t
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String !Int    -- reserved words and symbols
+ | TL !String         -- string literals
+ | TI !String         -- integer literals
+ | TV !String         -- identifiers
+ | TD !String         -- double precision float literals
+ | TC !String         -- character literals
+ | T_PosInteger !String
+ | T_PosDouble !String
+ | T_PosString !String
+ | T_PosIdent !String
+
+ deriving (Eq,Show,Ord)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving (Eq,Show,Ord)
+
+tokenPos :: [Token] -> String
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+posLineCol :: Posn -> (Int, Int)
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken :: Token -> ((Int, Int), String)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken :: Token -> String
+prToken t = case t of
+  PT _ (TS s _) -> s
+  PT _ (TL s)   -> s
+  PT _ (TI s)   -> s
+  PT _ (TV s)   -> s
+  PT _ (TD s)   -> s
+  PT _ (TC s)   -> s
+  PT _ (T_PosInteger s) -> s
+  PT _ (T_PosDouble s) -> s
+  PT _ (T_PosString s) -> s
+  PT _ (T_PosIdent s) -> s
+
+
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
+
+resWords :: BTree
+resWords = b ">=" 31 (b "." 16 (b "*" 8 (b "&" 4 (b "!=" 2 (b "!" 1 N N) (b "#" 3 N N)) (b "(" 6 (b "&&" 5 N N) (b ")" 7 N N))) (b "-" 12 (b "++" 10 (b "+" 9 N N) (b "," 11 N N)) (b "->" 14 (b "--" 13 N N) (b "->>" 15 N N)))) (b "<:" 24 (b ":=" 20 (b "/" 18 (b ".." 17 N N) (b ":" 19 N N)) (b ";" 22 (b ":>" 21 N N) (b "<" 23 N N))) (b "=" 28 (b "<=" 26 (b "<<" 25 N N) (b "<=>" 27 N N)) (b ">" 30 (b "=>" 29 N N) N)))) (b "min" 47 (b "all" 39 (b "\\" 35 (b "?" 33 (b ">>" 32 N N) (b "[" 34 N N)) (b "`" 37 (b "]" 36 N N) (b "abstract" 38 N N))) (b "if" 43 (b "else" 41 (b "disj" 40 N N) (b "enum" 42 N N)) (b "lone" 45 (b "in" 44 N N) (b "max" 46 N N)))) (b "sum" 55 (b "one" 51 (b "no" 49 (b "mux" 48 N N) (b "not" 50 N N)) (b "or" 53 (b "opt" 52 N N) (b "some" 54 N N))) (b "|" 59 (b "xor" 57 (b "then" 56 N N) (b "{" 58 N N)) (b "}" 61 (b "||" 60 N N) N))))
+   where b s n = let bs = id s
+                  in B bs (TS bs n)
+
+unescapeInitTail :: String -> String
+unescapeInitTail = id . unesc . tail . id where
+  unesc s = case s of
+    '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+    '\\':'n':cs  -> '\n' : unesc cs
+    '\\':'t':cs  -> '\t' : unesc cs
+    '"':[]    -> []
+    c:cs      -> c : unesc cs
+    _         -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+      deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
+alexMove (Pn a l _) '\n' = Pn (a+1) (l+1)   1
+alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
+
+type AlexInput = (Posn,     -- current position,
+                  Char,     -- previous char
+                  String)   -- current input string
+
+tokens :: String -> [Token]
+tokens str = go (alexStartPos, '\n', str)
+    where
+      go :: AlexInput -> [Token]
+      go inp@(pos, _, str') =
+               case alexScan inp 0 of
+                AlexEOF                -> []
+                AlexError (pos', _, _)  -> [Err pos']
+                AlexSkip  inp' _     -> go inp'
+                AlexToken inp' len act -> act pos (take len str') : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p, _, s) =
+  case  s of
+    []  -> Nothing
+    (c:s') ->
+             let p' = alexMove p c
+              in p' `seq` Just (c, (p', c, s'))
+
+alexGetByte :: AlexInput -> Maybe (Int,AlexInput)
+alexGetByte i = fmap f (alexGetChar i)
+  where f (c, i') = (fromEnum c, i')
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (_, c, _) = c
+
+alex_action_3 :: Posn -> String -> Token
+alex_action_3 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_4 :: Posn -> String -> Token
+alex_action_4 =  tok (\p s -> PT p (eitherResIdent (T_PosInteger . share) s)) 
+alex_action_5 :: Posn -> String -> Token
+alex_action_5 =  tok (\p s -> PT p (eitherResIdent (T_PosDouble . share) s)) 
+alex_action_6 :: Posn -> String -> Token
+alex_action_6 =  tok (\p s -> PT p (eitherResIdent (T_PosString . share) s)) 
+alex_action_7 :: Posn -> String -> Token
+alex_action_7 =  tok (\p s -> PT p (eitherResIdent (T_PosIdent . share) s)) 
+alex_action_8 :: Posn -> String -> Token
+alex_action_8 =  tok (\p s -> PT p (eitherResIdent (TV . share) s)) 
+alex_action_9 :: Posn -> String -> Token
+alex_action_9 =  tok (\p s -> PT p (TI $ share s))    
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command-line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+{-# LINE 37 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 47 "templates/GenericTemplate.hs" #-}
+
+
+data AlexAddr = AlexA# Addr#
+
+#if __GLASGOW_HASKELL__ < 503
+uncheckedShiftL# = shiftL#
+#endif
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt16OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+  narrow16Int# i
+  where
+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+        off' = off *# 2#
+#else
+  indexInt16OffAddr# arr off
+#endif
+
+
+
+
+
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt32OffAddr (AlexA# arr) off = 
+#ifdef WORDS_BIGENDIAN
+  narrow32Int# i
+  where
+   !i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
+		     (b2 `uncheckedShiftL#` 16#) `or#`
+		     (b1 `uncheckedShiftL#` 8#) `or#` b0)
+   !b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
+   !b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
+   !b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+   !b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
+   !off' = off *# 4#
+#else
+  indexInt32OffAddr# arr off
+#endif
+
+
+
+
+
+#if __GLASGOW_HASKELL__ < 503
+quickIndex arr i = arr ! i
+#else
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+--quickIndex :: Array Int [AlexAcc (Posn -> String -> Token) (Any *)] -> Int -> [AlexAcc (Posn -> String -> Token) (Any *)]
+quickIndex = unsafeAt
+#endif
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+  = AlexEOF
+  | AlexError  !AlexInput
+  | AlexSkip   !AlexInput !Int
+  | AlexToken  !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan :: AlexInput -> Int -> AlexReturn (Posn -> String -> Token)
+alexScan input (I# (sc))
+  = alexScanUser undefined input (I# (sc))
+
+--alexScanUser :: Any * -> AlexInput -> Int -> AlexReturn (Posn -> String -> Token)
+alexScanUser user input (I# (sc))
+  = case alex_scan_tkn user input 0# input sc AlexNone of
+	(AlexNone, input') ->
+		case alexGetByte 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 :: Any * -> AlexInput -> Int# -> AlexInput -> Int# -> AlexLastAcc (Posn -> String -> Token) -> (AlexLastAcc (Posn -> String -> Token), AlexInput)
+alex_scan_tkn user orig_input len input s last_acc =
+  input `seq` -- strict in the input
+  let 
+	new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))
+  in
+  new_acc `seq`
+  case alexGetByte input of
+     Nothing -> (new_acc, input)
+     Just (c, new_input) -> 
+
+
+
+	let
+		(base) = alexIndexInt32OffAddr alex_base s
+		((I# (ord_c))) = fromIntegral 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 (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)
+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)
+			new_input new_s new_acc
+
+  where
+	check_accs [] = last_acc
+	check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
+	check_accs (AlexAccSkip : _)  = AlexLastSkip  input (I# (len))
+	check_accs (AlexAccPred a predx : _)
+	   | predx user orig_input (I# (len)) input
+	   = AlexLastAcc a input (I# (len))
+	check_accs (AlexAccSkipPred predx : _)
+	   | predx user orig_input (I# (len)) input
+	   = AlexLastSkip input (I# (len))
+	check_accs (_ : rest) = check_accs rest
+
+data AlexLastAcc a
+  = AlexNone
+  | AlexLastAcc a !AlexInput !Int
+  | AlexLastSkip  !AlexInput !Int
+
+instance Functor AlexLastAcc where
+    fmap _ AlexNone = AlexNone
+    fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z
+    fmap _ (AlexLastSkip x y) = AlexLastSkip x y
+
+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 :: (t -> t1 -> t2 -> t3 -> Bool) -> (t -> t1 -> t2 -> t3 -> Bool) -> t -> t1 -> t2 -> t3 -> Bool
+alexAndPred p1 p2 user in1 len in2
+  = p1 user in1 len in2 && p2 user in1 len in2
+
+--alexPrevCharIsPred :: Char -> AlexAccPred _ 
+alexPrevCharIs :: Char -> t -> AlexInput -> t1 -> t2 -> Bool
+alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
+
+alexPrevCharMatches :: (Char -> t3) -> t -> AlexInput -> t1 -> t2 -> t3
+alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input)
+
+--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ 
+alexPrevCharIsOneOf :: Array Char e -> t -> AlexInput -> t1 -> t2 -> e
+alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
+
+--alexRightContext :: Int -> AlexAccPred _
+--alexRightContext :: Int -> Any * -> t -> t1 -> AlexInput -> Bool
+alexRightContext (I# (sc)) user _ _ input = 
+     case alex_scan_tkn user input 0# input sc AlexNone of
+	  (AlexNone, _) -> False
+	  _ -> True
+	-- TODO: there's no need to find the longest
+	-- match when checking the right context, just
+	-- the first match will do.
+
+-- used by wrappers
+iUnbox :: Int -> Int#
+iUnbox (I# (i)) = i
+ src/Language/Clafer/Front/Mapper.hs view
@@ -0,0 +1,450 @@+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Front.Mapper (mapModule, Mappable(..)) where
+
+import Language.Clafer.Front.Absclafer
+
+
+mapModule :: Module -> Module
+mapModule = mapNode
+
+
+(>-) :: Span -> Span -> Span
+(>-) (Span (Pos 0 0) (Pos 0 0)) s = s
+(>-) r (Span (Pos 0 0) (Pos 0 0)) = r
+(>-) (Span m _) (Span _ p) = Span m p
+(>-) _ _ = error "Function '>-' was not given (Span (Pos 0 0) (Pos 0 0)) as one of it's argumented expected one argument of (Span (Pos 0 0) (Pos 0 0))"
+
+doMap :: Mappable n => (Span -> n -> t) -> n -> t
+doMap f e =
+  f (range e') e'
+  where
+  e' = mapNode e
+
+doMapWithSpan :: Mappable n => (Span -> n -> t) -> Span -> n -> t
+doMapWithSpan f s e = 
+  f (s >- range e') e'
+  where
+  e' = mapNode e
+
+doMap2 :: (Mappable n, Mappable n1) => (Span -> n -> n1 -> t) -> n -> n1 -> t
+doMap2 f d e =
+  f (range d' >- range e') d' e'
+  where
+  d' = mapNode d
+  e' = mapNode e
+
+doMap2WithSpan :: (Mappable n, Mappable n1) => (Span -> n -> n1 -> t) -> Span -> n -> n1 -> t
+doMap2WithSpan f s d e =
+  f (s >- range d' >- range e') d' e'
+  where
+  d' = mapNode d
+  e' = mapNode e
+
+doMap3 :: (Mappable n, Mappable n1, Mappable n2) => (Span -> n -> n1 -> n2 -> t) -> n -> n1 -> n2 -> t
+doMap3 f c d e =
+  f (range c' >- range d' >- range e') c' d' e'
+  where
+  c' = mapNode c
+  d' = mapNode d
+  e' = mapNode e
+
+doMap3WithSpan :: (Mappable n, Mappable n1, Mappable n2) => (Span -> n -> n1 -> n2 -> t) -> Span -> n -> n1 -> n2 -> t
+doMap3WithSpan f s c d e =
+  f (s >- range c' >- range d' >- range e') c' d' e'
+  where
+  c' = mapNode c
+  d' = mapNode d
+  e' = mapNode e
+
+doMap7 :: (Mappable n, Mappable n1, Mappable n2, Mappable n3, Mappable n4, Mappable n5, Mappable n6) => (Span -> n -> n1 -> n2 -> n3 -> n4 -> n5 -> n6 -> t) -> n -> n1 -> n2 -> n3 -> n4 -> n5 -> n6 -> t
+doMap7 f t u v w x y z =
+  f (range t' >- range u' >- range v' >- range w' >- range x' >- range y' >- range z') t' u' v' w' x' y' z'
+  where
+  t' = mapNode t
+  u' = mapNode u
+  v' = mapNode v
+  w' = mapNode w
+  x' = mapNode x
+  y' = mapNode y
+  z' = mapNode z
+
+
+class Mappable n where
+  mapNode :: n -> n
+  range :: n -> Span
+  
+  
+instance Mappable s => Mappable [s] where
+  mapNode = map mapNode
+  range = foldr (>-) noSpan . map range
+
+
+instance Mappable Module where
+  mapNode (Module d) = doMap PosModule d
+  mapNode x = errMsgM "(Module d)" x 
+  range (PosModule s _) = s
+  range x = errMsgR "(PosModule s _)" x
+
+
+instance Mappable Declaration where
+  mapNode (PosEnumDecl s p e) = doMap2WithSpan PosEnumDecl s p e
+  mapNode (ElementDecl e)     = doMap PosElementDecl e
+  mapNode x = errMsgM "(PosEnumDecl s p e) or ElementDecl e)" x 
+  range (PosEnumDecl s _ _)  = s
+  range (PosElementDecl s _) = s
+  range x = errMsgR "(PosEnumDecl s p e) or (PosElementDecl s e)" x
+
+
+instance Mappable Elements where
+  mapNode ElementsEmpty         = PosElementsEmpty noSpan
+  -- The span is inaccurate for some apparent reason. Not sure why yet.
+  mapNode (PosElementsList _ e) = doMap PosElementsList e --doMapWithSpan PosElementsList s e
+  mapNode x = errMsgM "ElementsEmpty or (PosElementsList s e)" x
+  range (PosElementsEmpty s)  = s
+  range (PosElementsList s _) = s
+  range x = errMsgR "(PosElementsEmpty s) or (PosElementsList s _)" x
+
+
+instance Mappable Element where
+  mapNode (Subclafer c)          = doMap PosSubclafer c
+  mapNode (PosClaferUse s n c e) = doMap3WithSpan PosClaferUse s n c e
+  mapNode (Subconstraint c)      = doMap PosSubconstraint c
+  mapNode (Subgoal g)            = doMap PosSubgoal g
+  mapNode (Subsoftconstraint c)  = doMap PosSubsoftconstraint c
+  mapNode x = errMsgM "(Subclafer c), (PosClaferUse s n c e), (Subconstraint c), (Subgoal g), or (Subsoftconstraint c)" x
+  range (PosSubclafer s _)         = s
+  range (PosClaferUse s _ _ _)     = s
+  range (PosSubconstraint s _)     = s
+  range (PosSubgoal s _)           = s
+  range (PosSubsoftconstraint s _) = s
+  range x = errMsgR "(PosSubclafer s _), (PosClaferUse s _ _ _), (PosSubconstraint s _), (PosSubgoal s _), (PosSubsoftconstraint s _)" x
+  
+  
+instance Mappable Clafer where
+  mapNode (Clafer a b c d e f g) = doMap7 PosClafer a b c d e f g
+  mapNode x = errMsgM "(Clafer a b c d e f g)" x
+  range (PosClafer s _ _ _ _ _ _ _) = s
+  range x = errMsgR "(PosClafer s _ _ _ _ _ _ _)" x
+  
+  
+instance Mappable Constraint where
+--  mapNode (PosConstraint s e) = doMapWithSpan PosConstraint s e
+--  The span in the PosConstraint contains the span of the "[" after lexing.
+--  However, we don't have the span of the "]". It doesn't make sense to include
+--  one but not the other. Hence, ignore the "[" position and start with the first
+--  expression in the constraint instead.
+  mapNode (PosConstraint _ e) = doMap PosConstraint e
+  mapNode x = errMsgM "(PosConstraint s e)" x
+  range (PosConstraint s _) = s
+  range x = errMsgR "(PosConstraint s _)" x
+
+
+instance Mappable SoftConstraint where
+  mapNode (PosSoftConstraint s e) = doMapWithSpan PosSoftConstraint s e
+  mapNode x = errMsgM "(PosSoftConstraint s e)" x
+  range (PosSoftConstraint s _) = s
+  range x = errMsgR "(PosSoftConstraint s _)" x
+  
+  
+instance Mappable Goal where
+  mapNode (PosGoal s e) = doMapWithSpan PosGoal s e
+  mapNode x = errMsgM "(PosGoal s e)" x
+  range (PosGoal s _) = s
+  range x = errMsgR "(PosGoal s _)" x
+  
+  
+instance Mappable Abstract where
+  mapNode AbstractEmpty   = PosAbstractEmpty noSpan
+  mapNode x@PosAbstract{} = x
+  mapNode x = errMsgM "AbstractEmpty or x@PosAbstract{}"x 
+  range (PosAbstractEmpty s) = s
+  range (PosAbstract s)      = s
+  range x = errMsgR "(PosAbstractEmpty s) or (PosAbstract s)" x
+
+
+instance Mappable Super where
+  mapNode SuperEmpty          = PosSuperEmpty noSpan
+  mapNode (SuperSome how exp'') = doMap2 PosSuperSome how exp''
+  mapNode x = errMsgM "SuperEmpty or (SuperSome how exp')" x
+  range (PosSuperEmpty s)    = s
+  range (PosSuperSome s _ _) = s
+  range x = errMsgR "(PosSuperEmpty s) or (PosSuperSome s _ _)" x
+
+
+instance Mappable SuperHow where
+  mapNode = id
+  range (PosSuperColon s)   = s
+  range (PosSuperArrow s)   = s
+  range (PosSuperMArrow  s) = s
+  range x = errMsgR "(PosSuperColon s), (PosSuperArrow s), or (PosSuperMArrow  s) " x
+
+
+instance Mappable Init where
+  mapNode InitEmpty          = PosInitEmpty noSpan
+  mapNode (InitSome how exp'') = doMap2 PosInitSome how exp''
+  mapNode x = errMsgM "InitEmpty or (InitSome how exp')" x
+  range (PosInitEmpty s)    = s
+  range (PosInitSome s _ _) = s
+  range x = errMsgR "(PosInitEmpty s) or (PosInitSome s _ _)" x
+  
+  
+instance Mappable InitHow where
+  mapNode = id
+  range (PosInitHow_1 s) = s
+  range (PosInitHow_2 s) = s
+  range x = errMsgR "(PosInitHow_1 s) or (PosInitHow_2 s)" x
+
+
+instance Mappable Decl where
+  mapNode (Decl l e) = doMap2 PosDecl l e
+  mapNode x = errMsgM "(Decl l e)" x
+  range (PosDecl s _ _) = s
+  range x = errMsgR "(PosDecl s _ _)" x
+
+
+instance Mappable Exp where
+  mapNode (PosDeclAllDisj s decl exp')    = doMap2WithSpan PosDeclAllDisj s decl exp'
+  mapNode (PosDeclAll s decl exp')        = doMap2WithSpan PosDeclAll s decl exp'
+  mapNode (DeclQuantDisj quant decl exp') = doMap3 PosDeclQuantDisj quant decl exp'
+  mapNode (DeclQuant quant decl exp')     = doMap3 PosDeclQuant quant decl exp'
+  mapNode (PosEGMax s exp')               = doMapWithSpan PosEGMax s exp'
+  mapNode (PosEGMin s exp')               = doMapWithSpan PosEGMin s exp'
+  mapNode (EIff exp0 exp1)               = doMap2 PosEIff exp0 exp1
+  mapNode (EImplies exp0 exp1)           = doMap2 PosEImplies exp0 exp1
+  mapNode (EOr exp0 exp1)                = doMap2 PosEOr exp0 exp1
+  mapNode (EXor exp0 exp1)               = doMap2 PosEXor exp0 exp1
+  mapNode (EAnd exp0 exp1)               = doMap2 PosEAnd exp0 exp1
+  mapNode (PosENeg s exp')                = doMapWithSpan PosENeg s exp'
+  mapNode (ELt exp0 exp1)                = doMap2 PosELt exp0 exp1
+  mapNode (EGt exp0 exp1)                = doMap2 PosEGt exp0 exp1
+  mapNode (EEq exp0 exp1)                = doMap2 PosEEq exp0 exp1
+  mapNode (ELte exp0 exp1)               = doMap2 PosELte exp0 exp1
+  mapNode (EGte exp0 exp1)               = doMap2 PosEGte exp0 exp1
+  mapNode (ENeq exp0 exp1)               = doMap2 PosENeq exp0 exp1
+  mapNode (EIn exp0 exp1)                = doMap2 PosEIn exp0 exp1
+  mapNode (ENin exp0 exp1)               = doMap2 PosENin exp0 exp1
+  mapNode (QuantExp quant exp')           = doMap2 PosQuantExp quant exp'
+  mapNode (EAdd exp0 exp1)               = doMap2 PosEAdd exp0 exp1
+  mapNode (ESub exp0 exp1)               = doMap2 PosESub exp0 exp1
+  mapNode (EMul exp0 exp1)               = doMap2 PosEMul exp0 exp1
+  mapNode (EDiv exp0 exp1)               = doMap2 PosEDiv exp0 exp1
+  mapNode (PosECSetExp s exp')            = doMapWithSpan PosECSetExp s exp'
+  mapNode (PosEMinExp s exp')             = doMapWithSpan PosEMinExp s exp'  
+  mapNode (PosESumSetExp s exp')             = doMapWithSpan PosESumSetExp s exp'
+  mapNode (PosEImpliesElse s exp0 exp1 exp2) = doMap3WithSpan PosEImpliesElse s exp0 exp1 exp2
+  mapNode (EInt posinteger)              = doMap PosEInt posinteger
+  mapNode (EDouble posdouble)            = doMap PosEDouble posdouble
+  mapNode (EStr posstring)               = doMap PosEStr posstring
+  mapNode (ESetExp setexp)               = doMap PosESetExp setexp
+  mapNode x = errMsgM "Exp" x
+  range (PosDeclAllDisj s _ _)    = s
+  range (PosDeclAll s _ _)        = s
+  range (PosDeclQuantDisj s _ _ _) = s
+  range (PosDeclQuant s _ _ _)    = s
+  range (PosEGMax s _)            = s
+  range (PosEGMin s _)            = s
+  range (PosEIff s _ _)           = s
+  range (PosEImplies s _ _)       = s
+  range (PosEOr s _ _)            = s
+  range (PosEXor s _ _)           = s
+  range (PosEAnd s _ _)           = s
+  range (PosENeg s _)             = s
+  range (PosELt s _ _)            = s
+  range (PosEGt s _ _)            = s
+  range (PosEEq s _ _)            = s
+  range (PosELte s _ _)           = s
+  range (PosEGte s _ _)           = s
+  range (PosENeq s _ _)           = s
+  range (PosEIn s _ _)            = s
+  range (PosENin s _ _)           = s
+  range (PosQuantExp s _ _)       = s
+  range (PosEAdd s _ _)           = s
+  range (PosESub s _ _)           = s
+  range (PosEMul s _ _)           = s
+  range (PosEDiv s _ _)           = s
+  range (PosECSetExp s _)         = s
+  range (PosESumSetExp s _)         = s
+  range (PosEMinExp s _)          = s
+  range (PosEImpliesElse s _ _ _) = s
+  range (PosEInt s _)             = s
+  range (PosEDouble s _)          = s
+  range (PosEStr s _)             = s
+  range (PosESetExp s _)          = s
+  range x = error $ "No position for Exp " ++ show x
+  
+  
+instance Mappable SetExp where
+  mapNode (Union e1 e2)        = doMap2 PosUnion e1 e2
+  mapNode (UnionCom e1 e2)     = doMap2 PosUnionCom e1 e2
+  mapNode (Difference e1 e2)   = doMap2 PosDifference e1 e2
+  mapNode (Intersection e1 e2) = doMap2 PosIntersection e1 e2
+  mapNode (Domain e1 e2)       = doMap2 PosDomain e1 e2
+  mapNode (Range e1 e2)        = doMap2 PosRange e1 e2
+  mapNode (Join e1 e2)         = doMap2 PosJoin e1 e2
+  mapNode (ClaferId n)         = doMap PosClaferId n
+  mapNode x = errMsgM "SetExp" x
+  range (PosUnion s _ _)        = s
+  range (PosUnionCom s _ _)     = s
+  range (PosDifference s _ _)   = s
+  range (PosIntersection s _ _) = s
+  range (PosDomain s _ _)       = s
+  range (PosRange s _ _)        = s
+  range (PosJoin s _ _)         = s
+  range (PosClaferId s _)       = s
+  range x = errMsgR "SetExp" x
+  
+
+instance Mappable NCard where
+  mapNode (NCard l h) = doMap2 PosNCard l h
+  mapNode x = errMsgM "(NCard l h)" x
+  range (PosNCard s _ _) = s
+  range x = errMsgR "(PosNCard s _ _)" x
+  
+  
+instance Mappable Card where
+  mapNode CardEmpty        = PosCardEmpty noSpan
+  mapNode x@PosCardLone{}  = x
+  mapNode x@PosCardSome{}  = x
+  mapNode x@PosCardAny{}   = x
+  mapNode (CardNum i)      = doMap PosCardNum i 
+  mapNode (CardInterval c) = doMap PosCardInterval c
+  mapNode x = errMsgM "Card" x
+  range (PosCardEmpty s) = s
+  range (PosCardLone s)  = s
+  range (PosCardSome s)  = s
+  range (PosCardAny s)   = s
+  range (PosCardNum s _) = s
+  range (PosCardInterval s _) = s
+  range x = errMsgR "Card" x
+  
+  
+instance Mappable GCard where
+  mapNode GCardEmpty        = PosGCardEmpty noSpan
+  mapNode x@PosGCardXor{}   = x
+  mapNode x@PosGCardOr{}    = x
+  mapNode x@PosGCardMux{}   = x
+  mapNode x@PosGCardOpt{}   = x
+  mapNode (GCardInterval n) = doMap PosGCardInterval n
+  mapNode x = errMsgM "GCard" x
+  range (PosGCardEmpty s)      = s
+  range (PosGCardXor s)        = s
+  range (PosGCardOr s)         = s
+  range (PosGCardMux s)        = s
+  range (PosGCardOpt s)        = s
+  range (PosGCardInterval s _) = s
+  range x = errMsgR "GCard" x
+
+
+instance Mappable Name where
+  mapNode (Path m) = doMap PosPath m
+  mapNode x = errMsgM "(Path m)" x
+  range (PosPath s _) = s
+  range x = errMsgR "(PosPath s _)" x
+  
+
+instance Mappable LocId where
+  mapNode (LocIdIdent i) = doMap PosLocIdIdent i
+  mapNode x = errMsgM "(LocIdIdent i)" x
+  range (PosLocIdIdent s _) = s
+  range x = errMsgR "(PosLocIdIdent s _)" x
+  
+
+instance Mappable ModId where
+  mapNode (ModIdIdent i) = doMap PosModIdIdent i
+  mapNode x = errMsgM "(ModIdIdent i)" x
+  range (PosModIdIdent s _) = s
+  range x = errMsgR "(PosModIdIdent s _)" x
+
+
+instance Mappable EnumId where
+  mapNode (EnumIdIdent i) = doMap PosEnumIdIdent i
+  mapNode x = errMsgM "(EnumIdIdent i)" x
+  range (PosEnumIdIdent s _) = s
+  range x = errMsgR "(PosEnumIdIdent s _)" x
+  
+  
+instance Mappable Quant where
+  mapNode = id
+  range (PosQuantNo s)   = s
+  range (PosQuantLone s) = s
+  range (PosQuantOne s)  = s
+  range (PosQuantSome s) = s
+  range x = errMsgR "(PosQuantNo s), (PosQuantLone s), (PosQuantOne s), or (PosQuantSome s)" x
+
+
+
+instance Mappable ExInteger where
+  mapNode x@PosExIntegerAst{} = x
+  mapNode (ExIntegerNum i)    = doMap PosExIntegerNum i
+  mapNode x = errMsgM "x@PosExIntegerAst{} or (ExIntegerNum i)" x
+  range (PosExIntegerAst s)   = s
+  range (PosExIntegerNum s _) = s  
+  range x = errMsgR "(PosExIntegerAst s) or (PosExIntegerNum s _)" x
+
+
+instance Mappable PosIdent where
+  mapNode = id
+  range (PosIdent ((c, l), lex')) =
+    Span (Pos c' l') (Pos c' $ l' + len lex')
+    where
+    c' = toInteger c
+    l' = toInteger l
+
+
+instance Mappable PosString where
+  mapNode = id
+  range (PosString ((c, l), lex')) =
+    Span (Pos c' l') (Pos c' $ l' + len lex')
+    where
+    c' = toInteger c
+    l' = toInteger l
+
+  
+instance Mappable PosDouble where
+  mapNode = id  
+  range (PosDouble ((c, l), lex')) =
+    Span (Pos c' l') (Pos c' $ l' + len lex')
+    where
+    c' = toInteger c
+    l' = toInteger l
+
+  
+  
+instance Mappable PosInteger where
+  mapNode = id  
+  range (PosInteger ((c, l), lex')) =
+    Span (Pos c' l') (Pos c' $ l' + len lex')
+    where
+    c' = toInteger c
+    l' = toInteger l
+
+
+len :: [a] -> Integer
+len = toInteger . length
+
+errMsg :: Show a => String -> String -> a -> t
+errMsg function expected actual = error $ "Error: Function '" ++ function ++ "' expected argument of type(s) " ++ expected ++ " got " ++ show actual
+errMsgM :: Show a => String -> a -> t
+errMsgM e a = errMsg "mapNode" e a
+errMsgR :: Show a => String -> a -> t
+errMsgR e a = errMsg "range" e a
+ src/Language/Clafer/Front/Parclafer.hs view
@@ -0,0 +1,1978 @@+{-# OPTIONS_GHC -w #-}
+{-# OPTIONS -fglasgow-exts -cpp #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-}
+module Language.Clafer.Front.Parclafer where
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Front.Lexclafer
+import Language.Clafer.Front.ErrM
+import qualified Data.Array as Happy_Data_Array
+import qualified GHC.Exts as Happy_GHC_Exts
+
+-- parser produced by Happy Version 1.18.9
+
+newtype HappyAbsSyn  = HappyAbsSyn HappyAny
+#if __GLASGOW_HASKELL__ >= 607
+type HappyAny = Happy_GHC_Exts.Any
+#else
+type HappyAny = forall a . a
+#endif
+happyIn4 :: (Integer) -> (HappyAbsSyn )
+happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn4 #-}
+happyOut4 :: (HappyAbsSyn ) -> (Integer)
+happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut4 #-}
+happyIn5 :: (PosInteger) -> (HappyAbsSyn )
+happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn5 #-}
+happyOut5 :: (HappyAbsSyn ) -> (PosInteger)
+happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut5 #-}
+happyIn6 :: (PosDouble) -> (HappyAbsSyn )
+happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn6 #-}
+happyOut6 :: (HappyAbsSyn ) -> (PosDouble)
+happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut6 #-}
+happyIn7 :: (PosString) -> (HappyAbsSyn )
+happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> (PosString)
+happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: (PosIdent) -> (HappyAbsSyn )
+happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> (PosIdent)
+happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Module) -> (HappyAbsSyn )
+happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Module)
+happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: (Declaration) -> (HappyAbsSyn )
+happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> (Declaration)
+happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: (Clafer) -> (HappyAbsSyn )
+happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> (Clafer)
+happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: (Constraint) -> (HappyAbsSyn )
+happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> (Constraint)
+happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: (SoftConstraint) -> (HappyAbsSyn )
+happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> (SoftConstraint)
+happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: (Goal) -> (HappyAbsSyn )
+happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> (Goal)
+happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: (Abstract) -> (HappyAbsSyn )
+happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> (Abstract)
+happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: (Elements) -> (HappyAbsSyn )
+happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> (Elements)
+happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: (Element) -> (HappyAbsSyn )
+happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> (Element)
+happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: (Super) -> (HappyAbsSyn )
+happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> (Super)
+happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: (SuperHow) -> (HappyAbsSyn )
+happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> (SuperHow)
+happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: (Init) -> (HappyAbsSyn )
+happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> (Init)
+happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: (InitHow) -> (HappyAbsSyn )
+happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> (InitHow)
+happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: (GCard) -> (HappyAbsSyn )
+happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> (GCard)
+happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: (Card) -> (HappyAbsSyn )
+happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> (Card)
+happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: (NCard) -> (HappyAbsSyn )
+happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> (NCard)
+happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: (ExInteger) -> (HappyAbsSyn )
+happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> (ExInteger)
+happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Name) -> (HappyAbsSyn )
+happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Name)
+happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: (Exp) -> (HappyAbsSyn )
+happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> (Exp)
+happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: (Exp) -> (HappyAbsSyn )
+happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> (Exp)
+happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (Exp) -> (HappyAbsSyn )
+happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (Exp)
+happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: (Exp) -> (HappyAbsSyn )
+happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> (Exp)
+happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: (Exp) -> (HappyAbsSyn )
+happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> (Exp)
+happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: (Exp) -> (HappyAbsSyn )
+happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> (Exp)
+happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (Exp) -> (HappyAbsSyn )
+happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (Exp)
+happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: (Exp) -> (HappyAbsSyn )
+happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> (Exp)
+happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: (Exp) -> (HappyAbsSyn )
+happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> (Exp)
+happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut35 #-}
+happyIn36 :: (Exp) -> (HappyAbsSyn )
+happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn36 #-}
+happyOut36 :: (HappyAbsSyn ) -> (Exp)
+happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut36 #-}
+happyIn37 :: (Exp) -> (HappyAbsSyn )
+happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn37 #-}
+happyOut37 :: (HappyAbsSyn ) -> (Exp)
+happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut37 #-}
+happyIn38 :: (Exp) -> (HappyAbsSyn )
+happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn38 #-}
+happyOut38 :: (HappyAbsSyn ) -> (Exp)
+happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut38 #-}
+happyIn39 :: (Exp) -> (HappyAbsSyn )
+happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn39 #-}
+happyOut39 :: (HappyAbsSyn ) -> (Exp)
+happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut39 #-}
+happyIn40 :: (Exp) -> (HappyAbsSyn )
+happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn40 #-}
+happyOut40 :: (HappyAbsSyn ) -> (Exp)
+happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut40 #-}
+happyIn41 :: (SetExp) -> (HappyAbsSyn )
+happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn41 #-}
+happyOut41 :: (HappyAbsSyn ) -> (SetExp)
+happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut41 #-}
+happyIn42 :: (SetExp) -> (HappyAbsSyn )
+happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn42 #-}
+happyOut42 :: (HappyAbsSyn ) -> (SetExp)
+happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut42 #-}
+happyIn43 :: (SetExp) -> (HappyAbsSyn )
+happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn43 #-}
+happyOut43 :: (HappyAbsSyn ) -> (SetExp)
+happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut43 #-}
+happyIn44 :: (SetExp) -> (HappyAbsSyn )
+happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn44 #-}
+happyOut44 :: (HappyAbsSyn ) -> (SetExp)
+happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut44 #-}
+happyIn45 :: (SetExp) -> (HappyAbsSyn )
+happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn45 #-}
+happyOut45 :: (HappyAbsSyn ) -> (SetExp)
+happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut45 #-}
+happyIn46 :: (SetExp) -> (HappyAbsSyn )
+happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn46 #-}
+happyOut46 :: (HappyAbsSyn ) -> (SetExp)
+happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut46 #-}
+happyIn47 :: (SetExp) -> (HappyAbsSyn )
+happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn47 #-}
+happyOut47 :: (HappyAbsSyn ) -> (SetExp)
+happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut47 #-}
+happyIn48 :: (Decl) -> (HappyAbsSyn )
+happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn48 #-}
+happyOut48 :: (HappyAbsSyn ) -> (Decl)
+happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut48 #-}
+happyIn49 :: (Quant) -> (HappyAbsSyn )
+happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn49 #-}
+happyOut49 :: (HappyAbsSyn ) -> (Quant)
+happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut49 #-}
+happyIn50 :: (EnumId) -> (HappyAbsSyn )
+happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn50 #-}
+happyOut50 :: (HappyAbsSyn ) -> (EnumId)
+happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut50 #-}
+happyIn51 :: (ModId) -> (HappyAbsSyn )
+happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn51 #-}
+happyOut51 :: (HappyAbsSyn ) -> (ModId)
+happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut51 #-}
+happyIn52 :: (LocId) -> (HappyAbsSyn )
+happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn52 #-}
+happyOut52 :: (HappyAbsSyn ) -> (LocId)
+happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut52 #-}
+happyIn53 :: (Pos) -> (HappyAbsSyn )
+happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn53 #-}
+happyOut53 :: (HappyAbsSyn ) -> (Pos)
+happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut53 #-}
+happyIn54 :: (Span) -> (HappyAbsSyn )
+happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn54 #-}
+happyOut54 :: (HappyAbsSyn ) -> (Span)
+happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut54 #-}
+happyIn55 :: ([Declaration]) -> (HappyAbsSyn )
+happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn55 #-}
+happyOut55 :: (HappyAbsSyn ) -> ([Declaration])
+happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut55 #-}
+happyIn56 :: ([EnumId]) -> (HappyAbsSyn )
+happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn56 #-}
+happyOut56 :: (HappyAbsSyn ) -> ([EnumId])
+happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut56 #-}
+happyIn57 :: ([Element]) -> (HappyAbsSyn )
+happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn57 #-}
+happyOut57 :: (HappyAbsSyn ) -> ([Element])
+happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut57 #-}
+happyIn58 :: ([Exp]) -> (HappyAbsSyn )
+happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn58 #-}
+happyOut58 :: (HappyAbsSyn ) -> ([Exp])
+happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut58 #-}
+happyIn59 :: ([LocId]) -> (HappyAbsSyn )
+happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn59 #-}
+happyOut59 :: (HappyAbsSyn ) -> ([LocId])
+happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut59 #-}
+happyIn60 :: ([ModId]) -> (HappyAbsSyn )
+happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyIn60 #-}
+happyOut60 :: (HappyAbsSyn ) -> ([ModId])
+happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOut60 #-}
+happyInTok :: (Token) -> (HappyAbsSyn )
+happyInTok x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> (Token)
+happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\x00\x00\x1e\x01\x00\x00\x16\x01\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x01\x00\x00\x17\x01\x3b\x01\x00\x00\x00\x00\x06\x00\x35\x01\x00\x00\x4c\x00\x1d\x00\x01\x00\x27\x01\x0f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x01\x1a\x01\xfa\x00\xf5\x00\x26\x01\x00\x00\xdd\x05\x00\x00\x69\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x92\x00\x1d\x01\x24\x01\x0a\x01\x0b\x01\xf9\x00\x00\x00\xa6\x00\x9f\x00\xb2\x00\x68\x00\x00\x00\xb2\x00\xe4\xff\xb2\x00\x00\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x00\xf6\x00\xca\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x00\x00\x00\xc5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x00\xb2\x00\xdd\x00\xc4\x00\x00\x00\xb5\x00\xd5\x00\xd6\x00\xa8\x00\x00\x00\xdc\x00\xd0\x00\x00\x00\xdd\x05\x28\x00\x00\x00\xa7\x00\x97\x00\xfd\xff\xfd\xff\xfd\xff\xfd\xff\xfd\xff\xfd\xff\xfd\xff\xad\x00\xad\x00\xad\x00\xad\x00\x9f\x00\x9f\x00\x9f\x00\x9f\x00\x9f\x00\x9f\x00\x9f\x00\xb0\x00\x84\x00\x84\x00\x84\x00\x84\x00\x84\x00\x00\x00\x00\x00\x00\x00\x06\x00\xfd\xff\x00\x00\x00\x00\x00\x00\x92\x00\xfd\xff\x0e\x00\xae\x00\x93\x00\x8f\x00\xc2\x00\x00\x00\x9f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x00\x4e\x00\x00\x00\x00\x00\xb1\x00\xb1\x00\xb9\x00\x9e\x00\x98\x00\xac\x00\x00\x00\x79\x00\x68\x00\x00\x00\x00\x00\x77\x00\xfd\xff\x6c\x00\x68\x00\xb2\x00\xff\xff\x6c\x00\x00\x00\x00\x00\x00\x00\x7b\x00\x00\x00\x00\x00\x92\x00\x68\x00\x00\x00\x68\x00\x00\x00\x5a\x00\x68\x00\x00\x00\x00\x00\xd0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\x16\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x62\x00\x52\x00\x48\x00\x6b\x00\x00\x00\x74\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x0e\x02\x0e\x02\x0e\x02\x00\x00\x53\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x04\x86\x03\xae\x05\xdf\x01\x00\x00\x97\x05\xfd\x00\x7f\x05\x00\x00\x9b\x02\x6c\x02\x00\x00\x00\x00\x00\x00\x68\x05\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\xff\x00\x00\x00\x00\x00\x00\x50\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x51\x00\x48\x06\x3e\x06\x32\x06\x28\x06\x12\x06\xfc\x05\x21\x05\xf2\x04\x0a\x05\xdb\x04\xaa\x04\x90\x04\x61\x04\x47\x04\x18\x04\xfe\x03\xcf\x03\x00\x00\x57\x03\x28\x03\xf9\x02\xca\x02\x3d\x02\x00\x00\x00\x00\x00\x00\x09\x00\x08\x06\x00\x00\x00\x00\x00\x00\x00\x00\xf2\x05\x4a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x01\x00\x00\x00\x00\x00\x00\xdc\x05\x31\x00\x81\x01\x39\x05\x28\x01\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x52\x01\x00\x00\x23\x01\x00\x00\xf5\xff\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\x05\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\x88\xff\x00\x00\x00\x00\x00\x00\xf2\xff\x87\xff\xee\xff\xec\xff\xea\xff\xeb\xff\xe0\xff\xf7\xff\x82\xff\x82\xff\x82\xff\x00\x00\xf1\xff\x00\x00\x00\x00\xfa\xff\x8c\xff\xda\xff\x7e\xff\xd1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\xff\xdd\xff\xdc\xff\xde\xff\xdf\xff\xfd\xff\xe9\xff\x00\x00\xa6\xff\xa5\xff\xa4\xff\x94\xff\x81\xff\xcc\xff\xc8\xff\xc6\xff\xc4\xff\xc2\xff\xc0\xff\xbe\xff\xb5\xff\xb3\xff\xb0\xff\xad\xff\xa9\xff\xa7\xff\xa3\xff\x9f\xff\x9d\xff\x9b\xff\x99\xff\x97\xff\x95\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\x00\x00\x00\x00\x90\xff\x00\x00\x00\x00\x91\xff\x8f\xff\x8e\xff\x00\x00\xfc\xff\xfb\xff\xf3\xff\xf5\xff\x00\x00\xd6\xff\xf0\xff\xd5\xff\xd7\xff\xd8\xff\xd9\xff\x00\x00\x8d\xff\x86\xff\xf8\xff\xed\xff\x84\xff\x7d\xff\xac\xff\xca\xff\x00\x00\xcb\xff\x00\x00\x8b\xff\x00\x00\x80\xff\x00\x00\x00\x00\xab\xff\x00\x00\xa3\xff\xaa\xff\xbf\xff\x8c\xff\xb4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd2\xff\xd4\xff\xd3\xff\xda\xff\x00\x00\xe6\xff\xe5\xff\xe7\xff\xe8\xff\x00\x00\xe4\xff\xc9\xff\xc7\xff\xc5\xff\xc3\xff\xc1\xff\x00\x00\xb7\xff\xb9\xff\xbc\xff\xbb\xff\xba\xff\xbd\xff\xb8\xff\xb1\xff\xb2\xff\xae\xff\xaf\xff\xa0\xff\xa1\xff\x9e\xff\x9c\xff\x9a\xff\x98\xff\x96\xff\x00\x00\x00\x00\x93\xff\xa2\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xff\x00\x00\x85\xff\x83\xff\xef\xff\x00\x00\xcf\xff\x7f\xff\x92\xff\x00\x00\xcd\xff\x00\x00\xb6\xff\xf0\xff\x00\x00\xe1\xff\xe2\xff\x00\x00\xe3\xff\xf6\xff\xce\xff\xd0\xff\x00\x00\xa8\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x0c\x00\x01\x00\x06\x00\x03\x00\x06\x00\x04\x00\x06\x00\x07\x00\x04\x00\x01\x00\x01\x00\x28\x00\x0c\x00\x08\x00\x09\x00\x08\x00\x35\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x19\x00\x0d\x00\x01\x00\x05\x00\x13\x00\x14\x00\x01\x00\x15\x00\x03\x00\x22\x00\x14\x00\x06\x00\x25\x00\x26\x00\x42\x00\x21\x00\x27\x00\x0c\x00\x1c\x00\x12\x00\x2b\x00\x14\x00\x2d\x00\x2e\x00\x2f\x00\x2f\x00\x31\x00\x2e\x00\x33\x00\x04\x00\x0c\x00\x36\x00\x37\x00\x34\x00\x38\x00\x13\x00\x3d\x00\x20\x00\x16\x00\x42\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x27\x00\x3f\x00\x06\x00\x3f\x00\x2b\x00\x33\x00\x2d\x00\x2e\x00\x2f\x00\x01\x00\x31\x00\x03\x00\x33\x00\x01\x00\x06\x00\x36\x00\x37\x00\x04\x00\x08\x00\x04\x00\x0c\x00\x19\x00\x10\x00\x11\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x12\x00\x30\x00\x22\x00\x13\x00\x14\x00\x25\x00\x26\x00\x16\x00\x37\x00\x01\x00\x2a\x00\x03\x00\x0e\x00\x0f\x00\x06\x00\x04\x00\x24\x00\x13\x00\x09\x00\x27\x00\x0c\x00\x0c\x00\x04\x00\x2b\x00\x04\x00\x2d\x00\x2e\x00\x2f\x00\x2b\x00\x31\x00\x36\x00\x33\x00\x2f\x00\x16\x00\x36\x00\x37\x00\x44\x00\x01\x00\x06\x00\x03\x00\x36\x00\x38\x00\x06\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x27\x00\x0c\x00\x0e\x00\x0f\x00\x2b\x00\x3a\x00\x2d\x00\x2e\x00\x2f\x00\x36\x00\x31\x00\x2f\x00\x33\x00\x0a\x00\x0b\x00\x36\x00\x37\x00\x2e\x00\x04\x00\x03\x00\x38\x00\x29\x00\x06\x00\x34\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x0c\x00\x06\x00\x15\x00\x42\x00\x2b\x00\x03\x00\x2d\x00\x3b\x00\x06\x00\x3b\x00\x31\x00\x18\x00\x33\x00\x06\x00\x0c\x00\x36\x00\x37\x00\x10\x00\x04\x00\x0d\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x05\x00\x39\x00\x2c\x00\x2b\x00\x1d\x00\x2d\x00\x30\x00\x28\x00\x3c\x00\x31\x00\x2b\x00\x33\x00\x04\x00\x37\x00\x36\x00\x37\x00\x07\x00\x2b\x00\x42\x00\x0a\x00\x0b\x00\x2c\x00\x2b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x3b\x00\x07\x00\x37\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x13\x00\x42\x00\x16\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x3b\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x01\x00\x02\x00\x03\x00\x04\x00\x30\x00\x1d\x00\x2c\x00\x38\x00\x34\x00\x35\x00\x30\x00\x3b\x00\x04\x00\x39\x00\x42\x00\x3a\x00\x42\x00\x37\x00\x11\x00\x3f\x00\x10\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x15\x00\x2d\x00\x18\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x04\x00\x2c\x00\x0d\x00\x05\x00\x38\x00\x30\x00\x39\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x37\x00\x0d\x00\x3c\x00\x1d\x00\x11\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x1b\x00\x2d\x00\x42\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x1c\x00\x23\x00\x42\x00\x44\x00\x38\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\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\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x2d\x00\xff\xff\x2f\x00\x16\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\x38\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\x2d\x00\xff\xff\x2f\x00\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\x38\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x16\x00\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x37\x00\x38\x00\xff\xff\xff\xff\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x16\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x16\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x16\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x16\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x16\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x16\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x16\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x16\x00\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\x16\x00\xff\xff\x2f\x00\x01\x00\x02\x00\x03\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xff\xff\xff\xff\x16\x00\x2f\x00\xff\xff\x02\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\xff\xff\xff\xff\xff\xff\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\x17\x00\x2f\x00\x04\x00\x1a\x00\xff\xff\x1c\x00\xff\xff\x1e\x00\x1f\x00\xff\xff\x38\x00\xff\xff\x04\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\x2c\x00\xff\xff\x2f\x00\x04\x00\xff\xff\xff\xff\x32\x00\xff\xff\xff\xff\x16\x00\xff\xff\x38\x00\xff\xff\x04\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\xff\xff\x2f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\x38\x00\x2f\x00\x04\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x38\x00\xff\xff\x04\x00\x2f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\x38\x00\x2f\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\xff\xff\x38\x00\xff\xff\x04\x00\xff\xff\xff\xff\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x16\x00\xff\xff\x38\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\x2a\x00\x2b\x00\x38\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\xff\xff\x38\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x38\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"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\xc9\x00\x40\x00\x94\x00\x41\x00\x0d\x00\x14\x00\x42\x00\x43\x00\x59\x00\x52\x00\x8a\x00\x69\x00\x44\x00\x56\x00\x57\x00\x8d\x00\xb6\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0e\x00\x0b\x00\x1b\x00\x03\x00\x94\x00\x54\x00\x40\x00\x8b\x00\x41\x00\x0f\x00\xc6\x00\x42\x00\x10\x00\x11\x00\x14\x00\x58\x00\x45\x00\x44\x00\xc7\x00\x1c\x00\x46\x00\x1d\x00\x47\x00\x48\x00\x49\x00\x16\x00\x4a\x00\x5a\x00\x4b\x00\x64\x00\x5c\x00\x4c\x00\x4d\x00\xb8\x00\x5e\x00\x8b\xff\xbb\x00\x50\x00\x8b\xff\x14\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x45\x00\x23\x00\x0d\x00\x23\x00\x46\x00\x04\x00\x47\x00\x48\x00\x49\x00\x40\x00\x4a\x00\x41\x00\x4b\x00\x52\x00\x42\x00\x4c\x00\x4d\x00\x14\x00\x7a\x00\x23\x00\x44\x00\x0e\x00\xc3\x00\xc4\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x7b\x00\x66\x00\x0f\x00\x53\x00\x54\x00\x10\x00\x11\x00\x28\x00\xbd\x00\x40\x00\x12\x00\x41\x00\x90\x00\x91\x00\x42\x00\x14\x00\x51\x00\x92\x00\x7c\x00\x45\x00\x44\x00\x7d\x00\x59\x00\x46\x00\x12\x00\x47\x00\x48\x00\x49\x00\xac\x00\x4a\x00\x18\x00\x4b\x00\x16\x00\x15\x00\x4c\x00\x4d\x00\xf9\xff\x40\x00\x42\x00\x41\x00\x19\x00\x17\x00\x42\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x45\x00\x44\x00\x8d\x00\x8e\x00\x46\x00\x5e\x00\x47\x00\x48\x00\x49\x00\x1a\x00\x4a\x00\x16\x00\x4b\x00\x78\x00\x79\x00\x4c\x00\x4d\x00\x5a\x00\x64\x00\x41\x00\x17\x00\xcd\x00\x42\x00\x5b\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x44\x00\x42\x00\x74\x00\x14\x00\x46\x00\x41\x00\x47\x00\xc0\x00\x42\x00\xc2\x00\x4a\x00\x75\x00\x4b\x00\x42\x00\x44\x00\x4c\x00\x4d\x00\x73\x00\x76\x00\x77\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x86\x00\x87\x00\xad\x00\x46\x00\x89\x00\x47\x00\x66\x00\x72\x00\x88\x00\x4a\x00\x46\x00\x4b\x00\x64\x00\x67\x00\x4c\x00\x4d\x00\xb0\x00\x46\x00\x14\x00\x78\x00\x79\x00\x9b\x00\x46\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\xaf\x00\xb1\x00\x4d\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\xb3\x00\x14\x00\xb4\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\xb5\x00\x23\x00\x4e\x00\x4f\x00\x14\x00\x25\x00\x26\x00\x27\x00\x14\x00\x1f\x00\x89\x00\xb1\x00\xb6\x00\x20\x00\x21\x00\x66\x00\xb8\x00\x64\x00\x22\x00\x14\x00\x5e\x00\x14\x00\x67\x00\x25\x00\x23\x00\x73\x00\x28\x00\xc8\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x74\x00\x3e\x00\x75\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x76\x00\x65\x00\x77\x00\x86\x00\x17\x00\x66\x00\x87\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x67\x00\xb9\x00\x88\x00\x89\x00\x25\x00\x28\x00\xca\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x8a\x00\x3e\x00\x14\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x59\x00\x52\x00\x14\x00\xff\xff\x17\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\x28\x00\xcb\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\xbc\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\xc0\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x6a\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6b\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x95\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x60\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x62\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x96\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x98\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\xc2\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x9b\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\x9c\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x9d\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\x9e\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x9f\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\xa0\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x61\x00\x00\x00\x16\x00\x28\x00\x25\x00\x26\x00\x27\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x17\x00\xa1\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x61\x00\x00\x00\x16\x00\x00\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x17\x00\x6f\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x70\x00\x00\x00\x00\x00\x16\x00\x66\x00\x28\x00\x00\x00\x25\x00\x26\x00\x27\x00\x14\x00\x67\x00\x17\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x28\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\xa4\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x28\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\xa3\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x28\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\xa5\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x28\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\xbb\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x28\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x6f\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x28\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x5f\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x28\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x63\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x28\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x69\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x28\x00\x00\x00\x16\x00\x25\x00\x26\x00\x27\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x6c\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x28\x00\x16\x00\x00\x00\x7e\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\xcd\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x7f\x00\x16\x00\x14\x00\x80\x00\x00\x00\x81\x00\x00\x00\x82\x00\x83\x00\x00\x00\x17\x00\x00\x00\x14\x00\xbe\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x84\x00\x00\x00\x16\x00\x14\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x28\x00\x00\x00\x17\x00\x00\x00\x14\x00\xc7\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x00\x00\x16\x00\xa6\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x17\x00\x16\x00\x14\x00\x92\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x17\x00\x00\x00\x14\x00\x16\x00\xa7\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x17\x00\x16\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x17\x00\x00\x00\x14\x00\x00\x00\x00\x00\xa8\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\xa9\x00\x3b\x00\x3c\x00\x3d\x00\x28\x00\x00\x00\x17\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaa\x00\x3c\x00\x3d\x00\x17\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x3d\x00\x00\x00\x00\x00\x17\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\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 = Happy_Data_Array.array (1, 130) [
+	(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),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68),
+	(69 , happyReduce_69),
+	(70 , happyReduce_70),
+	(71 , happyReduce_71),
+	(72 , happyReduce_72),
+	(73 , happyReduce_73),
+	(74 , happyReduce_74),
+	(75 , happyReduce_75),
+	(76 , happyReduce_76),
+	(77 , happyReduce_77),
+	(78 , happyReduce_78),
+	(79 , happyReduce_79),
+	(80 , happyReduce_80),
+	(81 , happyReduce_81),
+	(82 , happyReduce_82),
+	(83 , happyReduce_83),
+	(84 , happyReduce_84),
+	(85 , happyReduce_85),
+	(86 , happyReduce_86),
+	(87 , happyReduce_87),
+	(88 , happyReduce_88),
+	(89 , happyReduce_89),
+	(90 , happyReduce_90),
+	(91 , happyReduce_91),
+	(92 , happyReduce_92),
+	(93 , happyReduce_93),
+	(94 , happyReduce_94),
+	(95 , happyReduce_95),
+	(96 , happyReduce_96),
+	(97 , happyReduce_97),
+	(98 , happyReduce_98),
+	(99 , happyReduce_99),
+	(100 , happyReduce_100),
+	(101 , happyReduce_101),
+	(102 , happyReduce_102),
+	(103 , happyReduce_103),
+	(104 , happyReduce_104),
+	(105 , happyReduce_105),
+	(106 , happyReduce_106),
+	(107 , happyReduce_107),
+	(108 , happyReduce_108),
+	(109 , happyReduce_109),
+	(110 , happyReduce_110),
+	(111 , happyReduce_111),
+	(112 , happyReduce_112),
+	(113 , happyReduce_113),
+	(114 , happyReduce_114),
+	(115 , happyReduce_115),
+	(116 , happyReduce_116),
+	(117 , happyReduce_117),
+	(118 , happyReduce_118),
+	(119 , happyReduce_119),
+	(120 , happyReduce_120),
+	(121 , happyReduce_121),
+	(122 , happyReduce_122),
+	(123 , happyReduce_123),
+	(124 , happyReduce_124),
+	(125 , happyReduce_125),
+	(126 , happyReduce_126),
+	(127 , happyReduce_127),
+	(128 , happyReduce_128),
+	(129 , happyReduce_129),
+	(130 , happyReduce_130)
+	]
+
+happy_n_terms = 69 :: Int
+happy_n_nonterms = 57 :: Int
+
+happyReduce_1 = happySpecReduce_1  0# happyReduction_1
+happyReduction_1 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (PT _ (TI happy_var_1)) -> 
+	happyIn4
+		 ((read ( happy_var_1)) :: Integer
+	)}
+
+happyReduce_2 = happySpecReduce_1  1# happyReduction_2
+happyReduction_2 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn5
+		 (PosInteger (mkPosToken happy_var_1)
+	)}
+
+happyReduce_3 = happySpecReduce_1  2# happyReduction_3
+happyReduction_3 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn6
+		 (PosDouble (mkPosToken happy_var_1)
+	)}
+
+happyReduce_4 = happySpecReduce_1  3# happyReduction_4
+happyReduction_4 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn7
+		 (PosString (mkPosToken happy_var_1)
+	)}
+
+happyReduce_5 = happySpecReduce_1  4# happyReduction_5
+happyReduction_5 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn8
+		 (PosIdent (mkPosToken happy_var_1)
+	)}
+
+happyReduce_6 = happySpecReduce_1  5# happyReduction_6
+happyReduction_6 happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	happyIn9
+		 (Module (reverse happy_var_1)
+	)}
+
+happyReduce_7 = happyReduce 4# 6# happyReduction_7
+happyReduction_7 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut8 happy_x_2 of { happy_var_2 -> 
+	case happyOut56 happy_x_4 of { happy_var_4 -> 
+	happyIn10
+		 (PosEnumDecl (gp happy_var_1) happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_8 = happySpecReduce_1  6# happyReduction_8
+happyReduction_8 happy_x_1
+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (ElementDecl happy_var_1
+	)}
+
+happyReduce_9 = happyReduce 7# 7# happyReduction_9
+happyReduction_9 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	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 happyOut22 happy_x_2 of { happy_var_2 -> 
+	case happyOut8 happy_x_3 of { happy_var_3 -> 
+	case happyOut18 happy_x_4 of { happy_var_4 -> 
+	case happyOut23 happy_x_5 of { happy_var_5 -> 
+	case happyOut20 happy_x_6 of { happy_var_6 -> 
+	case happyOut16 happy_x_7 of { happy_var_7 -> 
+	happyIn11
+		 (Clafer happy_var_1 happy_var_2 happy_var_3 happy_var_4 happy_var_5 happy_var_6 happy_var_7
+	) `HappyStk` happyRest}}}}}}}
+
+happyReduce_10 = happySpecReduce_3  8# happyReduction_10
+happyReduction_10 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut58 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (PosConstraint (gp happy_var_1) (reverse happy_var_2)
+	)}}
+
+happyReduce_11 = happySpecReduce_3  9# happyReduction_11
+happyReduction_11 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut58 happy_x_2 of { happy_var_2 -> 
+	happyIn13
+		 (PosSoftConstraint (gp happy_var_1) (reverse happy_var_2)
+	)}}
+
+happyReduce_12 = happySpecReduce_3  10# happyReduction_12
+happyReduction_12 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut58 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 (PosGoal (gp happy_var_1) (reverse happy_var_2)
+	)}}
+
+happyReduce_13 = happySpecReduce_0  11# happyReduction_13
+happyReduction_13  =  happyIn15
+		 (AbstractEmpty
+	)
+
+happyReduce_14 = happySpecReduce_1  11# happyReduction_14
+happyReduction_14 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn15
+		 (PosAbstract (gp happy_var_1)
+	)}
+
+happyReduce_15 = happySpecReduce_0  12# happyReduction_15
+happyReduction_15  =  happyIn16
+		 (ElementsEmpty
+	)
+
+happyReduce_16 = happySpecReduce_3  12# happyReduction_16
+happyReduction_16 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut57 happy_x_2 of { happy_var_2 -> 
+	happyIn16
+		 (PosElementsList (gp happy_var_1) (reverse happy_var_2)
+	)}}
+
+happyReduce_17 = happySpecReduce_1  13# happyReduction_17
+happyReduction_17 happy_x_1
+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 (Subclafer happy_var_1
+	)}
+
+happyReduce_18 = happyReduce 4# 13# happyReduction_18
+happyReduction_18 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut26 happy_x_2 of { happy_var_2 -> 
+	case happyOut23 happy_x_3 of { happy_var_3 -> 
+	case happyOut16 happy_x_4 of { happy_var_4 -> 
+	happyIn17
+		 (PosClaferUse (gp happy_var_1) happy_var_2 happy_var_3 happy_var_4
+	) `HappyStk` happyRest}}}}
+
+happyReduce_19 = happySpecReduce_1  13# happyReduction_19
+happyReduction_19 happy_x_1
+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 (Subconstraint happy_var_1
+	)}
+
+happyReduce_20 = happySpecReduce_1  13# happyReduction_20
+happyReduction_20 happy_x_1
+	 =  case happyOut14 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 (Subgoal happy_var_1
+	)}
+
+happyReduce_21 = happySpecReduce_1  13# happyReduction_21
+happyReduction_21 happy_x_1
+	 =  case happyOut13 happy_x_1 of { happy_var_1 -> 
+	happyIn17
+		 (Subsoftconstraint happy_var_1
+	)}
+
+happyReduce_22 = happySpecReduce_0  14# happyReduction_22
+happyReduction_22  =  happyIn18
+		 (SuperEmpty
+	)
+
+happyReduce_23 = happySpecReduce_2  14# happyReduction_23
+happyReduction_23 happy_x_2
+	happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	case happyOut41 happy_x_2 of { happy_var_2 -> 
+	happyIn18
+		 (SuperSome happy_var_1 happy_var_2
+	)}}
+
+happyReduce_24 = happySpecReduce_1  15# happyReduction_24
+happyReduction_24 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 (PosSuperColon (gp happy_var_1)
+	)}
+
+happyReduce_25 = happySpecReduce_1  15# happyReduction_25
+happyReduction_25 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 (PosSuperArrow (gp happy_var_1)
+	)}
+
+happyReduce_26 = happySpecReduce_1  15# happyReduction_26
+happyReduction_26 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn19
+		 (PosSuperMArrow (gp happy_var_1)
+	)}
+
+happyReduce_27 = happySpecReduce_0  16# happyReduction_27
+happyReduction_27  =  happyIn20
+		 (InitEmpty
+	)
+
+happyReduce_28 = happySpecReduce_2  16# happyReduction_28
+happyReduction_28 happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (InitSome happy_var_1 happy_var_2
+	)}}
+
+happyReduce_29 = happySpecReduce_1  17# happyReduction_29
+happyReduction_29 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (PosInitHow_1 (gp happy_var_1)
+	)}
+
+happyReduce_30 = happySpecReduce_1  17# happyReduction_30
+happyReduction_30 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 (PosInitHow_2 (gp happy_var_1)
+	)}
+
+happyReduce_31 = happySpecReduce_0  18# happyReduction_31
+happyReduction_31  =  happyIn22
+		 (GCardEmpty
+	)
+
+happyReduce_32 = happySpecReduce_1  18# happyReduction_32
+happyReduction_32 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (PosGCardXor (gp happy_var_1)
+	)}
+
+happyReduce_33 = happySpecReduce_1  18# happyReduction_33
+happyReduction_33 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (PosGCardOr (gp happy_var_1)
+	)}
+
+happyReduce_34 = happySpecReduce_1  18# happyReduction_34
+happyReduction_34 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (PosGCardMux (gp happy_var_1)
+	)}
+
+happyReduce_35 = happySpecReduce_1  18# happyReduction_35
+happyReduction_35 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (PosGCardOpt (gp happy_var_1)
+	)}
+
+happyReduce_36 = happySpecReduce_1  18# happyReduction_36
+happyReduction_36 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn22
+		 (GCardInterval happy_var_1
+	)}
+
+happyReduce_37 = happySpecReduce_0  19# happyReduction_37
+happyReduction_37  =  happyIn23
+		 (CardEmpty
+	)
+
+happyReduce_38 = happySpecReduce_1  19# happyReduction_38
+happyReduction_38 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (PosCardLone (gp happy_var_1)
+	)}
+
+happyReduce_39 = happySpecReduce_1  19# happyReduction_39
+happyReduction_39 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (PosCardSome (gp happy_var_1)
+	)}
+
+happyReduce_40 = happySpecReduce_1  19# happyReduction_40
+happyReduction_40 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (PosCardAny (gp happy_var_1)
+	)}
+
+happyReduce_41 = happySpecReduce_1  19# happyReduction_41
+happyReduction_41 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (CardNum happy_var_1
+	)}
+
+happyReduce_42 = happySpecReduce_1  19# happyReduction_42
+happyReduction_42 happy_x_1
+	 =  case happyOut24 happy_x_1 of { happy_var_1 -> 
+	happyIn23
+		 (CardInterval happy_var_1
+	)}
+
+happyReduce_43 = happySpecReduce_3  20# happyReduction_43
+happyReduction_43 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	case happyOut25 happy_x_3 of { happy_var_3 -> 
+	happyIn24
+		 (NCard happy_var_1 happy_var_3
+	)}}
+
+happyReduce_44 = happySpecReduce_1  21# happyReduction_44
+happyReduction_44 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 (PosExIntegerAst (gp happy_var_1)
+	)}
+
+happyReduce_45 = happySpecReduce_1  21# happyReduction_45
+happyReduction_45 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 (ExIntegerNum happy_var_1
+	)}
+
+happyReduce_46 = happySpecReduce_1  22# happyReduction_46
+happyReduction_46 happy_x_1
+	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
+	happyIn26
+		 (Path happy_var_1
+	)}
+
+happyReduce_47 = happyReduce 5# 23# happyReduction_47
+happyReduction_47 (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_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	case happyOut27 happy_x_5 of { happy_var_5 -> 
+	happyIn27
+		 (PosDeclAllDisj (gp happy_var_1) happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_48 = happyReduce 4# 23# happyReduction_48
+happyReduction_48 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut27 happy_x_4 of { happy_var_4 -> 
+	happyIn27
+		 (PosDeclAll (gp happy_var_1) happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_49 = happyReduce 5# 23# happyReduction_49
+happyReduction_49 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	case happyOut27 happy_x_5 of { happy_var_5 -> 
+	happyIn27
+		 (DeclQuantDisj happy_var_1 happy_var_3 happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_50 = happyReduce 4# 23# happyReduction_50
+happyReduction_50 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut27 happy_x_4 of { happy_var_4 -> 
+	happyIn27
+		 (DeclQuant happy_var_1 happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}}
+
+happyReduce_51 = happySpecReduce_1  23# happyReduction_51
+happyReduction_51 happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	happyIn27
+		 (happy_var_1
+	)}
+
+happyReduce_52 = happySpecReduce_2  24# happyReduction_52
+happyReduction_52 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut29 happy_x_2 of { happy_var_2 -> 
+	happyIn28
+		 (PosEGMax (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_53 = happySpecReduce_2  24# happyReduction_53
+happyReduction_53 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut29 happy_x_2 of { happy_var_2 -> 
+	happyIn28
+		 (PosEGMin (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_54 = happySpecReduce_3  24# happyReduction_54
+happyReduction_54 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut29 happy_x_3 of { happy_var_3 -> 
+	happyIn28
+		 (EIff happy_var_1 happy_var_3
+	)}}
+
+happyReduce_55 = happySpecReduce_1  24# happyReduction_55
+happyReduction_55 happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn28
+		 (happy_var_1
+	)}
+
+happyReduce_56 = happySpecReduce_3  25# happyReduction_56
+happyReduction_56 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	case happyOut30 happy_x_3 of { happy_var_3 -> 
+	happyIn29
+		 (EImplies happy_var_1 happy_var_3
+	)}}
+
+happyReduce_57 = happySpecReduce_1  25# happyReduction_57
+happyReduction_57 happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	happyIn29
+		 (happy_var_1
+	)}
+
+happyReduce_58 = happySpecReduce_3  26# happyReduction_58
+happyReduction_58 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn30
+		 (EOr happy_var_1 happy_var_3
+	)}}
+
+happyReduce_59 = happySpecReduce_1  26# happyReduction_59
+happyReduction_59 happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 (happy_var_1
+	)}
+
+happyReduce_60 = happySpecReduce_3  27# happyReduction_60
+happyReduction_60 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	case happyOut32 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 (EXor happy_var_1 happy_var_3
+	)}}
+
+happyReduce_61 = happySpecReduce_1  27# happyReduction_61
+happyReduction_61 happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	happyIn31
+		 (happy_var_1
+	)}
+
+happyReduce_62 = happySpecReduce_3  28# happyReduction_62
+happyReduction_62 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut33 happy_x_3 of { happy_var_3 -> 
+	happyIn32
+		 (EAnd happy_var_1 happy_var_3
+	)}}
+
+happyReduce_63 = happySpecReduce_1  28# happyReduction_63
+happyReduction_63 happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 (happy_var_1
+	)}
+
+happyReduce_64 = happySpecReduce_2  29# happyReduction_64
+happyReduction_64 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn33
+		 (PosENeg (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_65 = happySpecReduce_1  29# happyReduction_65
+happyReduction_65 happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	happyIn33
+		 (happy_var_1
+	)}
+
+happyReduce_66 = happySpecReduce_3  30# happyReduction_66
+happyReduction_66 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (ELt happy_var_1 happy_var_3
+	)}}
+
+happyReduce_67 = happySpecReduce_3  30# happyReduction_67
+happyReduction_67 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (EGt happy_var_1 happy_var_3
+	)}}
+
+happyReduce_68 = happySpecReduce_3  30# happyReduction_68
+happyReduction_68 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (EEq happy_var_1 happy_var_3
+	)}}
+
+happyReduce_69 = happySpecReduce_3  30# happyReduction_69
+happyReduction_69 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (ELte happy_var_1 happy_var_3
+	)}}
+
+happyReduce_70 = happySpecReduce_3  30# happyReduction_70
+happyReduction_70 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (EGte happy_var_1 happy_var_3
+	)}}
+
+happyReduce_71 = happySpecReduce_3  30# happyReduction_71
+happyReduction_71 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (ENeq happy_var_1 happy_var_3
+	)}}
+
+happyReduce_72 = happySpecReduce_3  30# happyReduction_72
+happyReduction_72 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (EIn happy_var_1 happy_var_3
+	)}}
+
+happyReduce_73 = happyReduce 4# 30# happyReduction_73
+happyReduction_73 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut35 happy_x_4 of { happy_var_4 -> 
+	happyIn34
+		 (ENin happy_var_1 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_74 = happySpecReduce_1  30# happyReduction_74
+happyReduction_74 happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (happy_var_1
+	)}
+
+happyReduce_75 = happySpecReduce_2  31# happyReduction_75
+happyReduction_75 happy_x_2
+	happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_2 of { happy_var_2 -> 
+	happyIn35
+		 (QuantExp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_76 = happySpecReduce_1  31# happyReduction_76
+happyReduction_76 happy_x_1
+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
+	happyIn35
+		 (happy_var_1
+	)}
+
+happyReduce_77 = happySpecReduce_3  32# happyReduction_77
+happyReduction_77 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn36
+		 (EAdd happy_var_1 happy_var_3
+	)}}
+
+happyReduce_78 = happySpecReduce_3  32# happyReduction_78
+happyReduction_78 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn36
+		 (ESub happy_var_1 happy_var_3
+	)}}
+
+happyReduce_79 = happySpecReduce_1  32# happyReduction_79
+happyReduction_79 happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	happyIn36
+		 (happy_var_1
+	)}
+
+happyReduce_80 = happySpecReduce_3  33# happyReduction_80
+happyReduction_80 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn37
+		 (EMul happy_var_1 happy_var_3
+	)}}
+
+happyReduce_81 = happySpecReduce_3  33# happyReduction_81
+happyReduction_81 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn37
+		 (EDiv happy_var_1 happy_var_3
+	)}}
+
+happyReduce_82 = happySpecReduce_1  33# happyReduction_82
+happyReduction_82 happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 (happy_var_1
+	)}
+
+happyReduce_83 = happySpecReduce_2  34# happyReduction_83
+happyReduction_83 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_2 of { happy_var_2 -> 
+	happyIn38
+		 (PosESumSetExp (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_84 = happySpecReduce_2  34# happyReduction_84
+happyReduction_84 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_2 of { happy_var_2 -> 
+	happyIn38
+		 (PosEMinExp (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_85 = happySpecReduce_2  34# happyReduction_85
+happyReduction_85 happy_x_2
+	happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_2 of { happy_var_2 -> 
+	happyIn38
+		 (PosECSetExp (gp happy_var_1) happy_var_2
+	)}}
+
+happyReduce_86 = happySpecReduce_1  34# happyReduction_86
+happyReduction_86 happy_x_1
+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
+	happyIn38
+		 (happy_var_1
+	)}
+
+happyReduce_87 = happyReduce 6# 35# happyReduction_87
+happyReduction_87 (happy_x_6 `HappyStk`
+	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_1 of { happy_var_1 -> 
+	case happyOut39 happy_x_2 of { happy_var_2 -> 
+	case happyOut39 happy_x_4 of { happy_var_4 -> 
+	case happyOut40 happy_x_6 of { happy_var_6 -> 
+	happyIn39
+		 (PosEImpliesElse (gp happy_var_1) happy_var_2 happy_var_4 happy_var_6
+	) `HappyStk` happyRest}}}}
+
+happyReduce_88 = happySpecReduce_1  35# happyReduction_88
+happyReduction_88 happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	happyIn39
+		 (happy_var_1
+	)}
+
+happyReduce_89 = happySpecReduce_1  36# happyReduction_89
+happyReduction_89 happy_x_1
+	 =  case happyOut5 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 (EInt happy_var_1
+	)}
+
+happyReduce_90 = happySpecReduce_1  36# happyReduction_90
+happyReduction_90 happy_x_1
+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 (EDouble happy_var_1
+	)}
+
+happyReduce_91 = happySpecReduce_1  36# happyReduction_91
+happyReduction_91 happy_x_1
+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 (EStr happy_var_1
+	)}
+
+happyReduce_92 = happySpecReduce_1  36# happyReduction_92
+happyReduction_92 happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 (ESetExp happy_var_1
+	)}
+
+happyReduce_93 = happySpecReduce_3  36# happyReduction_93
+happyReduction_93 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn40
+		 (happy_var_2
+	)}
+
+happyReduce_94 = happySpecReduce_3  37# happyReduction_94
+happyReduction_94 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut42 happy_x_3 of { happy_var_3 -> 
+	happyIn41
+		 (Union happy_var_1 happy_var_3
+	)}}
+
+happyReduce_95 = happySpecReduce_3  37# happyReduction_95
+happyReduction_95 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	case happyOut42 happy_x_3 of { happy_var_3 -> 
+	happyIn41
+		 (UnionCom happy_var_1 happy_var_3
+	)}}
+
+happyReduce_96 = happySpecReduce_1  37# happyReduction_96
+happyReduction_96 happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (happy_var_1
+	)}
+
+happyReduce_97 = happySpecReduce_3  38# happyReduction_97
+happyReduction_97 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut43 happy_x_3 of { happy_var_3 -> 
+	happyIn42
+		 (Difference happy_var_1 happy_var_3
+	)}}
+
+happyReduce_98 = happySpecReduce_1  38# happyReduction_98
+happyReduction_98 happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	happyIn42
+		 (happy_var_1
+	)}
+
+happyReduce_99 = happySpecReduce_3  39# happyReduction_99
+happyReduction_99 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_3 of { happy_var_3 -> 
+	happyIn43
+		 (Intersection happy_var_1 happy_var_3
+	)}}
+
+happyReduce_100 = happySpecReduce_1  39# happyReduction_100
+happyReduction_100 happy_x_1
+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
+	happyIn43
+		 (happy_var_1
+	)}
+
+happyReduce_101 = happySpecReduce_3  40# happyReduction_101
+happyReduction_101 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
+	case happyOut45 happy_x_3 of { happy_var_3 -> 
+	happyIn44
+		 (Domain happy_var_1 happy_var_3
+	)}}
+
+happyReduce_102 = happySpecReduce_1  40# happyReduction_102
+happyReduction_102 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn44
+		 (happy_var_1
+	)}
+
+happyReduce_103 = happySpecReduce_3  41# happyReduction_103
+happyReduction_103 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (Range happy_var_1 happy_var_3
+	)}}
+
+happyReduce_104 = happySpecReduce_1  41# happyReduction_104
+happyReduction_104 happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (happy_var_1
+	)}
+
+happyReduce_105 = happySpecReduce_3  42# happyReduction_105
+happyReduction_105 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_1 of { happy_var_1 -> 
+	case happyOut47 happy_x_3 of { happy_var_3 -> 
+	happyIn46
+		 (Join happy_var_1 happy_var_3
+	)}}
+
+happyReduce_106 = happySpecReduce_1  42# happyReduction_106
+happyReduction_106 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn46
+		 (happy_var_1
+	)}
+
+happyReduce_107 = happySpecReduce_1  43# happyReduction_107
+happyReduction_107 happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn47
+		 (ClaferId happy_var_1
+	)}
+
+happyReduce_108 = happySpecReduce_3  43# happyReduction_108
+happyReduction_108 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut41 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (happy_var_2
+	)}
+
+happyReduce_109 = happySpecReduce_3  44# happyReduction_109
+happyReduction_109 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	case happyOut41 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (Decl happy_var_1 happy_var_3
+	)}}
+
+happyReduce_110 = happySpecReduce_1  45# happyReduction_110
+happyReduction_110 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (PosQuantNo (gp happy_var_1)
+	)}
+
+happyReduce_111 = happySpecReduce_1  45# happyReduction_111
+happyReduction_111 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (PosQuantLone (gp happy_var_1)
+	)}
+
+happyReduce_112 = happySpecReduce_1  45# happyReduction_112
+happyReduction_112 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (PosQuantOne (gp happy_var_1)
+	)}
+
+happyReduce_113 = happySpecReduce_1  45# happyReduction_113
+happyReduction_113 happy_x_1
+	 =  case happyOutTok happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (PosQuantSome (gp happy_var_1)
+	)}
+
+happyReduce_114 = happySpecReduce_1  46# happyReduction_114
+happyReduction_114 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 (EnumIdIdent happy_var_1
+	)}
+
+happyReduce_115 = happySpecReduce_1  47# happyReduction_115
+happyReduction_115 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 (ModIdIdent happy_var_1
+	)}
+
+happyReduce_116 = happySpecReduce_1  48# happyReduction_116
+happyReduction_116 happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	happyIn52
+		 (LocIdIdent happy_var_1
+	)}
+
+happyReduce_117 = happySpecReduce_2  49# happyReduction_117
+happyReduction_117 happy_x_2
+	happy_x_1
+	 =  case happyOut4 happy_x_1 of { happy_var_1 -> 
+	case happyOut4 happy_x_2 of { happy_var_2 -> 
+	happyIn53
+		 (Pos happy_var_1 happy_var_2
+	)}}
+
+happyReduce_118 = happySpecReduce_2  50# happyReduction_118
+happyReduction_118 happy_x_2
+	happy_x_1
+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> 
+	case happyOut53 happy_x_2 of { happy_var_2 -> 
+	happyIn54
+		 (Span happy_var_1 happy_var_2
+	)}}
+
+happyReduce_119 = happySpecReduce_0  51# happyReduction_119
+happyReduction_119  =  happyIn55
+		 ([]
+	)
+
+happyReduce_120 = happySpecReduce_2  51# happyReduction_120
+happyReduction_120 happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn55
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_121 = happySpecReduce_1  52# happyReduction_121
+happyReduction_121 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn56
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_122 = happySpecReduce_3  52# happyReduction_122
+happyReduction_122 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn56
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_123 = happySpecReduce_0  53# happyReduction_123
+happyReduction_123  =  happyIn57
+		 ([]
+	)
+
+happyReduce_124 = happySpecReduce_2  53# happyReduction_124
+happyReduction_124 happy_x_2
+	happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn57
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_125 = happySpecReduce_0  54# happyReduction_125
+happyReduction_125  =  happyIn58
+		 ([]
+	)
+
+happyReduce_126 = happySpecReduce_2  54# happyReduction_126
+happyReduction_126 happy_x_2
+	happy_x_1
+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn58
+		 (flip (:) happy_var_1 happy_var_2
+	)}}
+
+happyReduce_127 = happySpecReduce_1  55# happyReduction_127
+happyReduction_127 happy_x_1
+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> 
+	happyIn59
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_128 = happySpecReduce_3  55# happyReduction_128
+happyReduction_128 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> 
+	case happyOut59 happy_x_3 of { happy_var_3 -> 
+	happyIn59
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyReduce_129 = happySpecReduce_1  56# happyReduction_129
+happyReduction_129 happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 ((:[]) happy_var_1
+	)}
+
+happyReduce_130 = happySpecReduce_3  56# happyReduction_130
+happyReduction_130 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	case happyOut60 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 ((:) happy_var_1 happy_var_3
+	)}}
+
+happyNewToken action sts stk [] =
+	happyDoAction 68# notHappyAtAll action sts stk []
+
+happyNewToken action sts stk (tk:tks) =
+	let cont i = happyDoAction i tk action sts stk tks in
+	case tk of {
+	PT _ (TS _ 1) -> cont 1#;
+	PT _ (TS _ 2) -> cont 2#;
+	PT _ (TS _ 3) -> cont 3#;
+	PT _ (TS _ 4) -> cont 4#;
+	PT _ (TS _ 5) -> cont 5#;
+	PT _ (TS _ 6) -> cont 6#;
+	PT _ (TS _ 7) -> cont 7#;
+	PT _ (TS _ 8) -> cont 8#;
+	PT _ (TS _ 9) -> cont 9#;
+	PT _ (TS _ 10) -> cont 10#;
+	PT _ (TS _ 11) -> cont 11#;
+	PT _ (TS _ 12) -> cont 12#;
+	PT _ (TS _ 13) -> cont 13#;
+	PT _ (TS _ 14) -> cont 14#;
+	PT _ (TS _ 15) -> cont 15#;
+	PT _ (TS _ 16) -> cont 16#;
+	PT _ (TS _ 17) -> cont 17#;
+	PT _ (TS _ 18) -> cont 18#;
+	PT _ (TS _ 19) -> cont 19#;
+	PT _ (TS _ 20) -> cont 20#;
+	PT _ (TS _ 21) -> cont 21#;
+	PT _ (TS _ 22) -> cont 22#;
+	PT _ (TS _ 23) -> cont 23#;
+	PT _ (TS _ 24) -> cont 24#;
+	PT _ (TS _ 25) -> cont 25#;
+	PT _ (TS _ 26) -> cont 26#;
+	PT _ (TS _ 27) -> cont 27#;
+	PT _ (TS _ 28) -> cont 28#;
+	PT _ (TS _ 29) -> cont 29#;
+	PT _ (TS _ 30) -> cont 30#;
+	PT _ (TS _ 31) -> cont 31#;
+	PT _ (TS _ 32) -> cont 32#;
+	PT _ (TS _ 33) -> cont 33#;
+	PT _ (TS _ 34) -> cont 34#;
+	PT _ (TS _ 35) -> cont 35#;
+	PT _ (TS _ 36) -> cont 36#;
+	PT _ (TS _ 37) -> cont 37#;
+	PT _ (TS _ 38) -> cont 38#;
+	PT _ (TS _ 39) -> cont 39#;
+	PT _ (TS _ 40) -> cont 40#;
+	PT _ (TS _ 41) -> cont 41#;
+	PT _ (TS _ 42) -> cont 42#;
+	PT _ (TS _ 43) -> cont 43#;
+	PT _ (TS _ 44) -> cont 44#;
+	PT _ (TS _ 45) -> cont 45#;
+	PT _ (TS _ 46) -> cont 46#;
+	PT _ (TS _ 47) -> cont 47#;
+	PT _ (TS _ 48) -> cont 48#;
+	PT _ (TS _ 49) -> cont 49#;
+	PT _ (TS _ 50) -> cont 50#;
+	PT _ (TS _ 51) -> cont 51#;
+	PT _ (TS _ 52) -> cont 52#;
+	PT _ (TS _ 53) -> cont 53#;
+	PT _ (TS _ 54) -> cont 54#;
+	PT _ (TS _ 55) -> cont 55#;
+	PT _ (TS _ 56) -> cont 56#;
+	PT _ (TS _ 57) -> cont 57#;
+	PT _ (TS _ 58) -> cont 58#;
+	PT _ (TS _ 59) -> cont 59#;
+	PT _ (TS _ 60) -> cont 60#;
+	PT _ (TS _ 61) -> cont 61#;
+	PT _ (TI happy_dollar_dollar) -> cont 62#;
+	PT _ (T_PosInteger _) -> cont 63#;
+	PT _ (T_PosDouble _) -> cont 64#;
+	PT _ (T_PosString _) -> cont 65#;
+	PT _ (T_PosIdent _) -> cont 66#;
+	_ -> cont 67#;
+	_ -> happyError' (tk:tks)
+	}
+
+happyError_ 68# tk tks = happyError' tks
+happyError_ _ tk tks = happyError' (tk:tks)
+
+happyThen :: () => Err a -> (a -> Err b) -> Err b
+happyThen = (thenM)
+happyReturn :: () => a -> Err a
+happyReturn = (returnM)
+happyThen1 m k tks = (thenM) m (\a -> k a tks)
+happyReturn1 :: () => a -> b -> Err a
+happyReturn1 = \a tks -> (returnM) a
+happyError' :: () => [(Token)] -> Err a
+happyError' = happyError
+
+pModule tks = happySomeParser where
+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut9 x))
+
+happySeq = happyDontSeq
+
+
+returnM :: a -> Err a
+returnM = return
+
+thenM :: Err a -> (a -> Err b) -> Err b
+thenM = (>>=)
+
+happyError :: [Token] -> Err a
+
+gp x@(PT (Pn _ l c) _) = Span (Pos (toInteger l) (toInteger c)) (Pos (toInteger l) (toInteger c + toInteger (length $ prToken x)))
+pp (PT (Pn _ l c) _ :_) = Pos (toInteger l) (toInteger c)
+pp (Err (Pn _ l c) :_) = Pos (toInteger l) (toInteger c)
+pp _ = error "EOF" -- End of file. What to do here?
+
+happyError ts =
+  Bad (pp ts) $
+  case ts of
+    [] -> []
+    [Err _] -> "due to lexer error"
+    _ -> "before " ++ unwords (map (id . prToken) (take 4 ts))
+
+myLexer = tokens
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command-line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
+
+{-# LINE 30 "templates/GenericTemplate.hs" #-}
+
+
+data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
+
+
+
+
+
+{-# LINE 51 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 61 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 70 "templates/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 Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+
+				     (happyReduceArr Happy_Data_Array.! rule) i tk st
+				     where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
+   where (off)    = indexShortOffAddr happyActOffsets st
+         (off_i)  = (off Happy_GHC_Exts.+# i)
+	 check  = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))
+			then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==#  i)
+			else False
+         (action)
+          | check     = indexShortOffAddr happyTable off_i
+          | otherwise = indexShortOffAddr happyDefActions st
+
+{-# LINE 130 "templates/GenericTemplate.hs" #-}
+
+
+indexShortOffAddr (HappyA# arr) off =
+	Happy_GHC_Exts.narrow16Int# i
+  where
+        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
+        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
+        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))
+        off' = off Happy_GHC_Exts.*# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 163 "templates/GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.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 Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.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 Happy_GHC_Exts.+# nt)
+             (new_state) = indexShortOffAddr happyTable off_i
+
+
+
+
+happyDrop 0# l = l
+happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.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 Happy_GHC_Exts.+# 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@(x `HappyStk` _) =
+     let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
+--	trace "failing" $ 
+        happyError_ i 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 ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+
+-- Internal happy errors:
+
+notHappyAtAll :: a
+notHappyAtAll = error "Internal Happy error\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+
+happyTcHack :: Happy_GHC_Exts.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/Language/Clafer/Front/Printclafer.hs view
@@ -0,0 +1,410 @@+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module Language.Clafer.Front.Printclafer where
+
+-- pretty-printer generated by the BNF converter
+
+import Language.Clafer.Front.Absclafer
+import Prelude hiding (span, exp, init)
+import Data.Char
+
+
+-- the top-level printing method
+printTree :: Print a => a -> String
+printTree = render . prt 0
+
+type Doc = [ShowS] -> [ShowS]
+
+doc :: ShowS -> Doc
+doc = (:)
+
+render :: Doc -> String
+render d = rend 0 (map ($ "") $ d []) "" where
+  rend i ss = case ss of
+    "["      :ts -> showChar '[' . rend i ts
+    "("      :ts -> showChar '(' . rend i ts
+    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
+    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
+    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
+    ";"      :ts -> showChar ';' . new i . rend i ts
+    t  : "," :ts -> showString t . space "," . rend i ts
+    t  : ")" :ts -> showString t . showChar ')' . rend i ts
+    t  : "]" :ts -> showString t . showChar ']' . rend i ts
+    t        :ts -> space t . rend i ts
+    _            -> id
+  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+  space t = showString t . (\s -> if null s then "" else (' ':s))
+
+parenth :: Doc -> Doc
+parenth ss = doc (showChar '(') . ss . doc (showChar ')')
+
+concatS :: [ShowS] -> ShowS
+concatS = foldr (.) id
+
+concatD :: [Doc] -> Doc
+concatD = foldr (.) id
+
+replicateS :: Int -> ShowS -> ShowS
+replicateS n f = concatS (replicate n f)
+
+-- the printer class does the job
+class Print a where
+  prt :: Int -> a -> Doc
+  prtList :: [a] -> Doc
+  prtList = concatD . map (prt 0)
+
+instance Print a => Print [a] where
+  prt _ = prtList
+
+instance Print Char where
+  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
+  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
+
+mkEsc :: Char -> Char -> ShowS
+mkEsc q s = case s of
+  _ | s == q -> showChar '\\' . showChar s
+  '\\'-> showString "\\\\"
+  '\n' -> showString "\\n"
+  '\t' -> showString "\\t"
+  _ -> showChar s
+
+prPrec :: Int -> Int -> Doc -> Doc
+prPrec i j = if j<i then parenth else id
+
+
+instance Print Integer where
+  prt _ x = doc (shows x)
+
+
+instance Print Double where
+  prt _ x = doc (shows x)
+
+
+
+instance Print PosInteger where
+  prt _ (PosInteger (_,i)) = doc (showString ( i))
+
+
+instance Print PosDouble where
+  prt _ (PosDouble (_,i)) = doc (showString ( i))
+
+
+instance Print PosString where
+  prt _ (PosString (_,i)) = doc (showString ( i))
+
+
+instance Print PosIdent where
+  prt _ (PosIdent (_,i)) = doc (showString ( i))
+
+
+
+instance Print Module where
+  prt i e = case e of
+   Module declarations -> prPrec i 0 (concatD [prt 0 declarations])
+   PosModule span declarations -> prPrec i 0 (concatD [prt 0 span , prt 0 declarations])
+
+
+instance Print Declaration where
+  prt i e = case e of
+   EnumDecl posident enumids -> prPrec i 0 (concatD [doc (showString "enum") , prt 0 posident , doc (showString "=") , prt 0 enumids])
+   PosEnumDecl span posident enumids -> prPrec i 0 (concatD [prt 0 span , doc (showString "enum") , prt 0 posident , doc (showString "=") , prt 0 enumids])
+   ElementDecl element -> prPrec i 0 (concatD [prt 0 element])
+   PosElementDecl span element -> prPrec i 0 (concatD [prt 0 span , prt 0 element])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Clafer where
+  prt i e = case e of
+   Clafer abstract gcard posident super card init elements -> prPrec i 0 (concatD [prt 0 abstract , prt 0 gcard , prt 0 posident , prt 0 super , prt 0 card , prt 0 init , prt 0 elements])
+   PosClafer span abstract gcard posident super card init elements -> prPrec i 0 (concatD [prt 0 span , prt 0 abstract , prt 0 gcard , prt 0 posident , prt 0 super , prt 0 card , prt 0 init , prt 0 elements])
+
+
+instance Print Constraint where
+  prt i e = case e of
+   Constraint exps -> prPrec i 0 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")])
+   PosConstraint span exps -> prPrec i 0 (concatD [prt 0 span , doc (showString "[") , prt 0 exps , doc (showString "]")])
+
+
+instance Print SoftConstraint where
+  prt i e = case e of
+   SoftConstraint exps -> prPrec i 0 (concatD [doc (showString "(") , prt 0 exps , doc (showString ")")])
+   PosSoftConstraint span exps -> prPrec i 0 (concatD [prt 0 span , doc (showString "(") , prt 0 exps , doc (showString ")")])
+
+
+instance Print Goal where
+  prt i e = case e of
+   Goal exps -> prPrec i 0 (concatD [doc (showString "<<") , prt 0 exps , doc (showString ">>")])
+   PosGoal span exps -> prPrec i 0 (concatD [prt 0 span , doc (showString "<<") , prt 0 exps , doc (showString ">>")])
+
+
+instance Print Abstract where
+  prt i e = case e of
+   AbstractEmpty  -> prPrec i 0 (concatD [])
+   PosAbstractEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   Abstract  -> prPrec i 0 (concatD [doc (showString "abstract")])
+   PosAbstract span -> prPrec i 0 (concatD [prt 0 span , doc (showString "abstract")])
+
+
+instance Print Elements where
+  prt i e = case e of
+   ElementsEmpty  -> prPrec i 0 (concatD [])
+   PosElementsEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   ElementsList elements -> prPrec i 0 (concatD [doc (showString "{") , prt 0 elements , doc (showString "}")])
+   PosElementsList span elements -> prPrec i 0 (concatD [prt 0 span , doc (showString "{") , prt 0 elements , doc (showString "}")])
+
+
+instance Print Element where
+  prt i e = case e of
+   Subclafer clafer -> prPrec i 0 (concatD [prt 0 clafer])
+   PosSubclafer span clafer -> prPrec i 0 (concatD [prt 0 span , prt 0 clafer])
+   ClaferUse name card elements -> prPrec i 0 (concatD [doc (showString "`") , prt 0 name , prt 0 card , prt 0 elements])
+   PosClaferUse span name card elements -> prPrec i 0 (concatD [prt 0 span , doc (showString "`") , prt 0 name , prt 0 card , prt 0 elements])
+   Subconstraint constraint -> prPrec i 0 (concatD [prt 0 constraint])
+   PosSubconstraint span constraint -> prPrec i 0 (concatD [prt 0 span , prt 0 constraint])
+   Subgoal goal -> prPrec i 0 (concatD [prt 0 goal])
+   PosSubgoal span goal -> prPrec i 0 (concatD [prt 0 span , prt 0 goal])
+   Subsoftconstraint softconstraint -> prPrec i 0 (concatD [prt 0 softconstraint])
+   PosSubsoftconstraint span softconstraint -> prPrec i 0 (concatD [prt 0 span , prt 0 softconstraint])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print Super where
+  prt i e = case e of
+   SuperEmpty  -> prPrec i 0 (concatD [])
+   PosSuperEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   SuperSome superhow setexp -> prPrec i 0 (concatD [prt 0 superhow , prt 0 setexp])
+   PosSuperSome span superhow setexp -> prPrec i 0 (concatD [prt 0 span , prt 0 superhow , prt 0 setexp])
+
+
+instance Print SuperHow where
+  prt i e = case e of
+   SuperColon  -> prPrec i 0 (concatD [doc (showString ":")])
+   PosSuperColon span -> prPrec i 0 (concatD [prt 0 span , doc (showString ":")])
+   SuperArrow  -> prPrec i 0 (concatD [doc (showString "->")])
+   PosSuperArrow span -> prPrec i 0 (concatD [prt 0 span , doc (showString "->")])
+   SuperMArrow  -> prPrec i 0 (concatD [doc (showString "->>")])
+   PosSuperMArrow span -> prPrec i 0 (concatD [prt 0 span , doc (showString "->>")])
+
+
+instance Print Init where
+  prt i e = case e of
+   InitEmpty  -> prPrec i 0 (concatD [])
+   PosInitEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   InitSome inithow exp -> prPrec i 0 (concatD [prt 0 inithow , prt 0 exp])
+   PosInitSome span inithow exp -> prPrec i 0 (concatD [prt 0 span , prt 0 inithow , prt 0 exp])
+
+
+instance Print InitHow where
+  prt i e = case e of
+   InitHow_1  -> prPrec i 0 (concatD [doc (showString "=")])
+   PosInitHow_1 span -> prPrec i 0 (concatD [prt 0 span , doc (showString "=")])
+   InitHow_2  -> prPrec i 0 (concatD [doc (showString ":=")])
+   PosInitHow_2 span -> prPrec i 0 (concatD [prt 0 span , doc (showString ":=")])
+
+
+instance Print GCard where
+  prt i e = case e of
+   GCardEmpty  -> prPrec i 0 (concatD [])
+   PosGCardEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   GCardXor  -> prPrec i 0 (concatD [doc (showString "xor")])
+   PosGCardXor span -> prPrec i 0 (concatD [prt 0 span , doc (showString "xor")])
+   GCardOr  -> prPrec i 0 (concatD [doc (showString "or")])
+   PosGCardOr span -> prPrec i 0 (concatD [prt 0 span , doc (showString "or")])
+   GCardMux  -> prPrec i 0 (concatD [doc (showString "mux")])
+   PosGCardMux span -> prPrec i 0 (concatD [prt 0 span , doc (showString "mux")])
+   GCardOpt  -> prPrec i 0 (concatD [doc (showString "opt")])
+   PosGCardOpt span -> prPrec i 0 (concatD [prt 0 span , doc (showString "opt")])
+   GCardInterval ncard -> prPrec i 0 (concatD [prt 0 ncard])
+   PosGCardInterval span ncard -> prPrec i 0 (concatD [prt 0 span , prt 0 ncard])
+
+
+instance Print Card where
+  prt i e = case e of
+   CardEmpty  -> prPrec i 0 (concatD [])
+   PosCardEmpty span -> prPrec i 0 (concatD [prt 0 span])
+   CardLone  -> prPrec i 0 (concatD [doc (showString "?")])
+   PosCardLone span -> prPrec i 0 (concatD [prt 0 span , doc (showString "?")])
+   CardSome  -> prPrec i 0 (concatD [doc (showString "+")])
+   PosCardSome span -> prPrec i 0 (concatD [prt 0 span , doc (showString "+")])
+   CardAny  -> prPrec i 0 (concatD [doc (showString "*")])
+   PosCardAny span -> prPrec i 0 (concatD [prt 0 span , doc (showString "*")])
+   CardNum posinteger -> prPrec i 0 (concatD [prt 0 posinteger])
+   PosCardNum span posinteger -> prPrec i 0 (concatD [prt 0 span , prt 0 posinteger])
+   CardInterval ncard -> prPrec i 0 (concatD [prt 0 ncard])
+   PosCardInterval span ncard -> prPrec i 0 (concatD [prt 0 span , prt 0 ncard])
+
+
+instance Print NCard where
+  prt i e = case e of
+   NCard posinteger exinteger -> prPrec i 0 (concatD [prt 0 posinteger , doc (showString "..") , prt 0 exinteger])
+   PosNCard span posinteger exinteger -> prPrec i 0 (concatD [prt 0 span , prt 0 posinteger , doc (showString "..") , prt 0 exinteger])
+
+
+instance Print ExInteger where
+  prt i e = case e of
+   ExIntegerAst  -> prPrec i 0 (concatD [doc (showString "*")])
+   PosExIntegerAst span -> prPrec i 0 (concatD [prt 0 span , doc (showString "*")])
+   ExIntegerNum posinteger -> prPrec i 0 (concatD [prt 0 posinteger])
+   PosExIntegerNum span posinteger -> prPrec i 0 (concatD [prt 0 span , prt 0 posinteger])
+
+
+instance Print Name where
+  prt i e = case e of
+   Path modids -> prPrec i 0 (concatD [prt 0 modids])
+   PosPath span modids -> prPrec i 0 (concatD [prt 0 span , prt 0 modids])
+
+
+instance Print Exp where
+  prt i e = case e of
+   DeclAllDisj decl exp -> prPrec i 0 (concatD [doc (showString "all") , doc (showString "disj") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   PosDeclAllDisj span decl exp -> prPrec i 0 (concatD [prt 0 span , doc (showString "all") , doc (showString "disj") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   DeclAll decl exp -> prPrec i 0 (concatD [doc (showString "all") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   PosDeclAll span decl exp -> prPrec i 0 (concatD [prt 0 span , doc (showString "all") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   DeclQuantDisj quant decl exp -> prPrec i 0 (concatD [prt 0 quant , doc (showString "disj") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   PosDeclQuantDisj span quant decl exp -> prPrec i 0 (concatD [prt 0 span , prt 0 quant , doc (showString "disj") , prt 0 decl , doc (showString "|") , prt 0 exp])
+   DeclQuant quant decl exp -> prPrec i 0 (concatD [prt 0 quant , prt 0 decl , doc (showString "|") , prt 0 exp])
+   PosDeclQuant span quant decl exp -> prPrec i 0 (concatD [prt 0 span , prt 0 quant , prt 0 decl , doc (showString "|") , prt 0 exp])
+   EGMax exp -> prPrec i 1 (concatD [doc (showString "max") , prt 2 exp])
+   PosEGMax span exp -> prPrec i 1 (concatD [prt 0 span , doc (showString "max") , prt 2 exp])
+   EGMin exp -> prPrec i 1 (concatD [doc (showString "min") , prt 2 exp])
+   PosEGMin span exp -> prPrec i 1 (concatD [prt 0 span , doc (showString "min") , prt 2 exp])
+   EIff exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "<=>") , prt 2 exp])
+   PosEIff span exp0 exp -> prPrec i 1 (concatD [prt 0 span , prt 1 exp0 , doc (showString "<=>") , prt 2 exp])
+   EImplies exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , doc (showString "=>") , prt 3 exp])
+   PosEImplies span exp0 exp -> prPrec i 2 (concatD [prt 0 span , prt 2 exp0 , doc (showString "=>") , prt 3 exp])
+   EOr exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "||") , prt 4 exp])
+   PosEOr span exp0 exp -> prPrec i 3 (concatD [prt 0 span , prt 3 exp0 , doc (showString "||") , prt 4 exp])
+   EXor exp0 exp -> prPrec i 4 (concatD [prt 4 exp0 , doc (showString "xor") , prt 5 exp])
+   PosEXor span exp0 exp -> prPrec i 4 (concatD [prt 0 span , prt 4 exp0 , doc (showString "xor") , prt 5 exp])
+   EAnd exp0 exp -> prPrec i 5 (concatD [prt 5 exp0 , doc (showString "&&") , prt 6 exp])
+   PosEAnd span exp0 exp -> prPrec i 5 (concatD [prt 0 span , prt 5 exp0 , doc (showString "&&") , prt 6 exp])
+   ENeg exp -> prPrec i 6 (concatD [doc (showString "!") , prt 7 exp])
+   PosENeg span exp -> prPrec i 6 (concatD [prt 0 span , doc (showString "!") , prt 7 exp])
+   ELt exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "<") , prt 8 exp])
+   PosELt span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "<") , prt 8 exp])
+   EGt exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString ">") , prt 8 exp])
+   PosEGt span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString ">") , prt 8 exp])
+   EEq exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "=") , prt 8 exp])
+   PosEEq span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "=") , prt 8 exp])
+   ELte exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "<=") , prt 8 exp])
+   PosELte span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "<=") , prt 8 exp])
+   EGte exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString ">=") , prt 8 exp])
+   PosEGte span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString ">=") , prt 8 exp])
+   ENeq exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "!=") , prt 8 exp])
+   PosENeq span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "!=") , prt 8 exp])
+   EIn exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "in") , prt 8 exp])
+   PosEIn span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "in") , prt 8 exp])
+   ENin exp0 exp -> prPrec i 7 (concatD [prt 7 exp0 , doc (showString "not") , doc (showString "in") , prt 8 exp])
+   PosENin span exp0 exp -> prPrec i 7 (concatD [prt 0 span , prt 7 exp0 , doc (showString "not") , doc (showString "in") , prt 8 exp])
+   QuantExp quant exp -> prPrec i 8 (concatD [prt 0 quant , prt 12 exp])
+   PosQuantExp span quant exp -> prPrec i 8 (concatD [prt 0 span , prt 0 quant , prt 12 exp])
+   EAdd exp0 exp -> prPrec i 9 (concatD [prt 9 exp0 , doc (showString "+") , prt 10 exp])
+   PosEAdd span exp0 exp -> prPrec i 9 (concatD [prt 0 span , prt 9 exp0 , doc (showString "+") , prt 10 exp])
+   ESub exp0 exp -> prPrec i 9 (concatD [prt 9 exp0 , doc (showString "-") , prt 10 exp])
+   PosESub span exp0 exp -> prPrec i 9 (concatD [prt 0 span , prt 9 exp0 , doc (showString "-") , prt 10 exp])
+   EMul exp0 exp -> prPrec i 10 (concatD [prt 10 exp0 , doc (showString "*") , prt 11 exp])
+   PosEMul span exp0 exp -> prPrec i 10 (concatD [prt 0 span , prt 10 exp0 , doc (showString "*") , prt 11 exp])
+   EDiv exp0 exp -> prPrec i 10 (concatD [prt 10 exp0 , doc (showString "/") , prt 11 exp])
+   PosEDiv span exp0 exp -> prPrec i 10 (concatD [prt 0 span , prt 10 exp0 , doc (showString "/") , prt 11 exp])
+   ESumSetExp exp -> prPrec i 11 (concatD [doc (showString "sum") , prt 12 exp])
+   PosESumSetExp span exp -> prPrec i 11 (concatD [prt 0 span , doc (showString "sum") , prt 12 exp])
+   ECSetExp exp -> prPrec i 11 (concatD [doc (showString "#") , prt 12 exp])
+   PosECSetExp span exp -> prPrec i 11 (concatD [prt 0 span , doc (showString "#") , prt 12 exp])
+   EMinExp exp -> prPrec i 11 (concatD [doc (showString "-") , prt 12 exp])
+   PosEMinExp span exp -> prPrec i 11 (concatD [prt 0 span , doc (showString "-") , prt 12 exp])
+   EImpliesElse exp0 exp1 exp -> prPrec i 12 (concatD [doc (showString "if") , prt 12 exp0 , doc (showString "then") , prt 12 exp1 , doc (showString "else") , prt 13 exp])
+   PosEImpliesElse span exp0 exp1 exp -> prPrec i 12 (concatD [prt 0 span , doc (showString "if") , prt 12 exp0 , doc (showString "then") , prt 12 exp1 , doc (showString "else") , prt 13 exp])
+   EInt posinteger -> prPrec i 13 (concatD [prt 0 posinteger])
+   PosEInt span posinteger -> prPrec i 13 (concatD [prt 0 span , prt 0 posinteger])
+   EDouble posdouble -> prPrec i 13 (concatD [prt 0 posdouble])
+   PosEDouble span posdouble -> prPrec i 13 (concatD [prt 0 span , prt 0 posdouble])
+   EStr posstring -> prPrec i 13 (concatD [prt 0 posstring])
+   PosEStr span posstring -> prPrec i 13 (concatD [prt 0 span , prt 0 posstring])
+   ESetExp setexp -> prPrec i 13 (concatD [prt 0 setexp])
+   PosESetExp span setexp -> prPrec i 13 (concatD [prt 0 span , prt 0 setexp])
+
+  prtList es = case es of
+   [] -> (concatD [])
+   x:xs -> (concatD [prt 0 x , prt 0 xs])
+
+instance Print SetExp where
+  prt i e = case e of
+   Union setexp0 setexp -> prPrec i 0 (concatD [prt 0 setexp0 , doc (showString "++") , prt 1 setexp])
+   PosUnion span setexp0 setexp -> prPrec i 0 (concatD [prt 0 span , prt 0 setexp0 , doc (showString "++") , prt 1 setexp])
+   UnionCom setexp0 setexp -> prPrec i 0 (concatD [prt 0 setexp0 , doc (showString ",") , prt 1 setexp])
+   PosUnionCom span setexp0 setexp -> prPrec i 0 (concatD [prt 0 span , prt 0 setexp0 , doc (showString ",") , prt 1 setexp])
+   Difference setexp0 setexp -> prPrec i 1 (concatD [prt 1 setexp0 , doc (showString "--") , prt 2 setexp])
+   PosDifference span setexp0 setexp -> prPrec i 1 (concatD [prt 0 span , prt 1 setexp0 , doc (showString "--") , prt 2 setexp])
+   Intersection setexp0 setexp -> prPrec i 2 (concatD [prt 2 setexp0 , doc (showString "&") , prt 3 setexp])
+   PosIntersection span setexp0 setexp -> prPrec i 2 (concatD [prt 0 span , prt 2 setexp0 , doc (showString "&") , prt 3 setexp])
+   Domain setexp0 setexp -> prPrec i 3 (concatD [prt 3 setexp0 , doc (showString "<:") , prt 4 setexp])
+   PosDomain span setexp0 setexp -> prPrec i 3 (concatD [prt 0 span , prt 3 setexp0 , doc (showString "<:") , prt 4 setexp])
+   Range setexp0 setexp -> prPrec i 4 (concatD [prt 4 setexp0 , doc (showString ":>") , prt 5 setexp])
+   PosRange span setexp0 setexp -> prPrec i 4 (concatD [prt 0 span , prt 4 setexp0 , doc (showString ":>") , prt 5 setexp])
+   Join setexp0 setexp -> prPrec i 5 (concatD [prt 5 setexp0 , doc (showString ".") , prt 6 setexp])
+   PosJoin span setexp0 setexp -> prPrec i 5 (concatD [prt 0 span , prt 5 setexp0 , doc (showString ".") , prt 6 setexp])
+   ClaferId name -> prPrec i 6 (concatD [prt 0 name])
+   PosClaferId span name -> prPrec i 6 (concatD [prt 0 span , prt 0 name])
+
+
+instance Print Decl where
+  prt i e = case e of
+   Decl locids setexp -> prPrec i 0 (concatD [prt 0 locids , doc (showString ":") , prt 0 setexp])
+   PosDecl span locids setexp -> prPrec i 0 (concatD [prt 0 span , prt 0 locids , doc (showString ":") , prt 0 setexp])
+
+
+instance Print Quant where
+  prt i e = case e of
+   QuantNo  -> prPrec i 0 (concatD [doc (showString "no")])
+   PosQuantNo span -> prPrec i 0 (concatD [prt 0 span , doc (showString "no")])
+   QuantLone  -> prPrec i 0 (concatD [doc (showString "lone")])
+   PosQuantLone span -> prPrec i 0 (concatD [prt 0 span , doc (showString "lone")])
+   QuantOne  -> prPrec i 0 (concatD [doc (showString "one")])
+   PosQuantOne span -> prPrec i 0 (concatD [prt 0 span , doc (showString "one")])
+   QuantSome  -> prPrec i 0 (concatD [doc (showString "some")])
+   PosQuantSome span -> prPrec i 0 (concatD [prt 0 span , doc (showString "some")])
+
+
+instance Print EnumId where
+  prt i e = case e of
+   EnumIdIdent posident -> prPrec i 0 (concatD [prt 0 posident])
+   PosEnumIdIdent span posident -> prPrec i 0 (concatD [prt 0 span , prt 0 posident])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
+
+instance Print ModId where
+  prt i e = case e of
+   ModIdIdent posident -> prPrec i 0 (concatD [prt 0 posident])
+   PosModIdIdent span posident -> prPrec i 0 (concatD [prt 0 span , prt 0 posident])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString "\\") , prt 0 xs])
+
+instance Print LocId where
+  prt i e = case e of
+   LocIdIdent posident -> prPrec i 0 (concatD [prt 0 posident])
+   PosLocIdIdent span posident -> prPrec i 0 (concatD [prt 0 span , prt 0 posident])
+
+  prtList es = case es of
+   [x] -> (concatD [prt 0 x])
+   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
+
+instance Print Pos where
+  prt i e = case e of
+   Pos n0 n -> prPrec i 0 (concatD [prt 0 n0 , prt 0 n])
+   PosPos span n0 n -> prPrec i 0 (concatD [prt 0 span , prt 0 n0 , prt 0 n])
+
+
+instance Print Span where
+  prt i e = case e of
+   Span pos0 pos -> prPrec i 0 (concatD [prt 0 pos0 , prt 0 pos])
+   PosSpan span pos0 pos -> prPrec i 0 (concatD [prt 0 span , prt 0 pos0 , prt 0 pos])
+
+
+
+ src/Language/Clafer/Generator/Alloy.hs view
@@ -0,0 +1,609 @@+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
+{-
+ Copyright (C) 2012-2013 Kacper Bak, Jimmy Liang, Rafael Olaechea <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Generates Alloy4.1 or 4.2 code for a Clafer model
+module Language.Clafer.Generator.Alloy where
+import Data.List
+import Data.Maybe
+import Control.Monad.State
+
+import Language.Clafer.Common
+import Language.Clafer.ClaferArgs
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+
+-- | representation of strings in chunks (for line/column numbering)
+data Concat = CString String | Concat {
+  srcPos :: IrTrace,
+  nodes  :: [Concat]
+  } deriving (Eq, Show)
+type Position = ((LineNo, ColNo), (LineNo, ColNo))
+
+data IrTrace =
+    IrPExp {pUid::String} |
+    LowerCard {pUid::String, isGroup::Bool} |
+    UpperCard {pUid::String, isGroup::Bool} |
+    ExactCard {pUid::String, isGroup::Bool} |
+    NoTrace
+    deriving (Eq, Show)
+
+mkConcat :: IrTrace -> String -> Concat
+mkConcat pos str = Concat pos [CString str]
+
+iscPrimitive :: Concat -> Bool
+iscPrimitive x = isPrimitive $ flatten x
+
+flatten :: Concat -> String
+flatten (CString x)      = x
+flatten (Concat _ nodes') = nodes' >>= flatten
+
+(+++) :: Concat -> Concat -> Concat
+(+++) (CString x)     (CString y)     = CString $ x ++ y
+(+++) (CString "")    y@Concat{}      = y
+(+++) x               y@(Concat src ys)
+    | src == NoTrace = Concat NoTrace $ x : ys
+    | otherwise      = Concat NoTrace $ [x, y]
+(+++) x@Concat{}      (CString "")     = x
+(+++) x@(Concat src xs)  y
+    | src == NoTrace = Concat NoTrace $ xs ++ [y]
+    | otherwise      = Concat NoTrace $ [x, y]
+  
+cconcat :: [Concat] -> Concat  
+cconcat = foldr (+++) (CString "")
+
+cintercalate :: Concat -> [Concat] -> Concat
+cintercalate xs xss = cconcat (intersperse xs xss)
+
+filterNull :: [Concat] -> [Concat]
+filterNull = filter (not.isNull)
+
+isNull :: Concat -> Bool
+isNull (CString "")  = True
+isNull (Concat _ []) = True
+isNull _ = False
+
+cunlines :: [Concat] -> Concat
+cunlines xs = cconcat $ map (+++ (CString "\n")) xs
+
+-- | Alloy code generation
+-- 07th Mayo 2012 Rafael Olaechea 
+--      Added Logic to print a goal block in case there is at least one goal.
+genModule :: ClaferArgs -> (IModule, GEnv) -> [(UID, Integer)] -> (Result, [(Span, IrTrace)])
+genModule    claferargs    (imodule, _)       scopes           = (flatten output, filter ((/= NoTrace) . snd) $ mapLineCol output)
+  where
+  output = header claferargs scopes +++ (cconcat $ map (genDeclaration claferargs) (mDecls imodule)) +++ 
+       if ((not $ skip_goals claferargs) && length goals_list > 0) then 
+                CString "objectives o_global {\n" +++   (cintercalate (CString ",\n") goals_list) +++   CString "\n}" 
+       else  
+                CString "" 
+       where 
+                goals_list = filterNull (map (genDeclarationGoalsOnly claferargs) (mDecls imodule))
+
+header :: ClaferArgs -> [(UID, Integer)] -> Concat
+header    args          scopes       = CString $ unlines
+    [ if Alloy42 `elem` (mode args) then "" else "open util/integer"
+    , "pred show {}"
+    , if (validate args) ||  (noalloyruncommand args)  
+      then "" 
+      else "run show for 1" ++ genScopes scopes
+    , ""]
+    where
+    genScopes [] = ""
+    genScopes scopes' = " but " ++ intercalate ", " (map genScope scopes')
+    
+genScope :: (UID, Integer) -> String
+genScope    (uid', scope)       = show scope ++ " " ++ uid'
+
+
+-- 07th Mayo 2012 Rafael Olaechea
+-- Modified so that we can collect all goals into a single block as required per the way goals are handled in modified alloy.
+genDeclarationGoalsOnly :: ClaferArgs -> IElement -> Concat
+genDeclarationGoalsOnly    claferargs    x         = case x of
+  IEClafer _  -> CString ""
+  IEConstraint _ _  -> CString ""
+  IEGoal _ (PExp _ _ _ innerexp) -> case innerexp of 
+        IFunExp op'  exps' ->  if  op' == iGMax || op' == iGMin then  
+                        mkMetric op' $ genPExp claferargs [] (head exps') 
+                else 
+                        error "unary operator  distinct from (min/max) at the topmost level of a goal element"
+        _ ->  error "no unary operator (min/max) at the topmost level of a goal element."
+
+-- 07th Mayo 2012 Rafael Olaechea
+-- Removed goal from this function as they will now  all be collected into a single block.       
+genDeclaration :: ClaferArgs -> IElement -> Concat
+genDeclaration claferargs x = case x of
+  IEClafer clafer'  -> genClafer claferargs [] clafer'
+  IEConstraint _ pexp  -> mkFact $ genPExp claferargs [] pexp
+  IEGoal _ (PExp _ _ _ innerexp) -> case innerexp of 
+        IFunExp op'  _ ->  if  op' == iGMax || op' == iGMin then  
+                       CString ""
+                else 
+                        error "unary operator  distinct from (min/max) at the topmost level of a goal element"
+        _ ->  error "no unary operator (min/max) at the topmost level of a goal element."
+
+mkFact :: Concat -> Concat
+mkFact  xs = cconcat [CString "fact ", mkSet xs, CString "\n"]
+
+mkMetric :: String -> Concat -> Concat
+mkMetric goalopname xs = cconcat [ if goalopname == iGMax then CString "maximize" else  CString "minimize", CString " ", xs, CString " "]
+
+mkSet :: Concat -> Concat                                               
+mkSet xs = cconcat [CString "{ ", xs, CString " }"]
+
+showSet :: Concat -> [Concat] -> Concat
+showSet delim xs = showSet' delim $ filterNull xs
+  where
+  showSet' _ []     = CString "{}"
+  showSet' delim' xs' = mkSet $ cintercalate delim' xs'
+
+optShowSet :: [Concat] -> Concat
+optShowSet [] = CString ""
+optShowSet xs = CString "\n" +++ showSet (CString "\n  ") xs
+
+-- optimization: top level cardinalities
+-- optimization: if only boolean parents, then set card is known
+genClafer :: ClaferArgs -> [String] -> IClafer -> Concat
+genClafer claferargs resPath oClafer = (cunlines $ filterNull
+  [ cardFact +++ claferDecl clafer'
+        ((showSet (CString "\n, ") $ genRelations claferargs clafer') +++
+        (optShowSet $ filterNull $ genConstraints claferargs resPath clafer'))
+  ]) +++ CString "\n" +++ children'
+  where
+  clafer' = transPrimitive oClafer
+  children' = cconcat $ filterNull $ map
+             (genClafer claferargs ((uid clafer') : resPath)) $
+             getSubclafers $ elements clafer'
+  cardFact
+    | null resPath && (null $ flatten $ genOptCard clafer') =
+        case genCard (uid clafer') $ card clafer' of
+          CString "set" -> CString ""
+          c -> mkFact c
+    | otherwise = CString ""
+
+transPrimitive :: IClafer -> IClafer
+transPrimitive    clafer'   = clafer'{super = toOverlapping $ super clafer'}
+  where
+  toOverlapping x@(ISuper _ [PExp _ _ _ (IClaferId _ id' _)])
+    | isPrimitive id' = x{isOverlapping = True}
+    | otherwise      = x
+  toOverlapping x = x
+
+claferDecl :: IClafer -> Concat -> Concat
+claferDecl    c     rest    = cconcat [genOptCard c,
+  CString $ genAbstract $ isAbstract c, CString "sig ",
+  Concat NoTrace [CString $ uid c, genExtends $ super c, CString "\n", rest]]
+  where
+  genAbstract isAbs = if isAbs then "abstract " else ""
+  genExtends (ISuper False [PExp _ _ _ (IClaferId _ "clafer" _)]) = CString ""
+  genExtends (ISuper False [PExp _ _ _ (IClaferId _ i _)]) = CString " " +++ Concat NoTrace [CString $ "extends " ++ i]
+  -- todo: handle multiple inheritance
+  genExtends _ = CString ""
+
+genOptCard :: IClafer -> Concat
+genOptCard    c
+  | glCard' `elem` ["lone", "one", "some"] = cardConcat (uid c) False [CString glCard'] +++ (CString " ")
+  | otherwise                              = CString ""
+  where
+  glCard' = genIntervalCrude $ glCard c
+    
+
+-- -----------------------------------------------------------------------------
+-- overlapping inheritance is a new clafer with val (unlike only relation)
+-- relations: overlapping inheritance (val rel), children
+-- adds parent relation
+-- 29/March/2012  Rafael Olaechea: ref is now prepended with clafer name to be able to refer to it from partial instances.
+genRelations :: ClaferArgs -> IClafer -> [Concat]
+genRelations claferargs c = maybeToList r ++ (map mkRel $ getSubclafers $ elements c)
+  where
+  r = if isOverlapping $ super c 
+                then
+                        Just $ Concat NoTrace [CString $ genRel (if (noalloyruncommand claferargs) then  (uid c ++ "_ref") else "ref")
+                         c {card = Just (1, 1)} $ 
+                         flatten $ refType claferargs c] 
+                else 
+                        Nothing
+  mkRel c' = Concat NoTrace [CString $ genRel (genRelName $ uid c') c' $ uid c']
+
+genRelName :: String -> String
+genRelName name = "r_" ++ name
+
+genRel :: String -> IClafer -> String -> String
+genRel name c rType = genAlloyRel name (genCardCrude $ card c) rType'
+  where
+  rType' = if isPrimitive rType then "Int" else rType
+
+genAlloyRel :: String -> String -> String -> String
+genAlloyRel name card' rType = concat [name, " : ", card', " ", rType]
+
+refType :: ClaferArgs -> IClafer -> Concat
+refType claferargs c = cintercalate (CString " + ") $ map ((genType claferargs).getTarget) $ supers $ super c
+
+
+getTarget :: PExp -> PExp
+getTarget    x     = case x of
+  PExp _ _ _ (IFunExp op' (_:pexp:_))  -> if op' == iJoin then pexp else x
+  _ -> x
+
+genType :: ClaferArgs -> PExp                              -> Concat
+genType    claferargs    x@(PExp _ _ _ y@(IClaferId _ _ _)) = genPExp claferargs []
+  x{Language.Clafer.Intermediate.Intclafer.exp = y{isTop = True}}
+genType m x = genPExp m [] x
+
+
+-- -----------------------------------------------------------------------------
+-- constraints
+-- user constraints + parent + group constraints + reference
+-- a = NUMBER do all x : a | x = NUMBER (otherwise alloy sums a set)
+genConstraints :: ClaferArgs -> [String]      -> IClafer -> [Concat]
+genConstraints    cargs    resPath c = (genParentConst resPath c) :
+  (genGroupConst c) : genPathConst cargs  (if (noalloyruncommand cargs) then  (uid c ++ "_ref") else "ref") resPath c : constraints 
+  where
+  constraints = map genConst $ elements c
+  genConst x = case x of
+    IEConstraint _ pexp  -> genPExp cargs ((uid c) : resPath) pexp
+    IEClafer c' ->
+        if genCardCrude (card c') `elem` ["one", "lone", "some"]
+        then CString "" else mkCard ({- do not use the genRelName as the constraint name -} uid c') False (genRelName $ uid c') $ fromJust (card c')
+    IEGoal _ _ -> error "getConst function from Alloy generator was given a Goal, this function should only be given a Constrain or Clafer" -- This should never happen
+
+-- optimization: if only boolean features then the parent is unique
+genParentConst :: [String] -> IClafer -> Concat
+genParentConst [] _     = CString ""
+genParentConst _ c =  genOptParentConst c
+
+genOptParentConst :: IClafer -> Concat
+genOptParentConst    c
+  | glCard' == "one"  = CString ""
+  | glCard' == "lone" = Concat NoTrace [CString $ "one " ++ rel]
+  | otherwise         = Concat NoTrace [CString $ "one @" ++ rel ++ ".this"]
+  -- eliminating problems with cyclic containment;
+  -- should be added to cases when cyclic containment occurs
+  --                    , " && no iden & @", rel, " && no ~@", rel, " & @", rel]
+  where
+  rel = genRelName $ uid c
+  glCard' = genIntervalCrude $ glCard c
+
+genGroupConst :: IClafer -> Concat
+genGroupConst    clafer'
+  | null children' || flatten card' == "" = CString ""
+  | otherwise = cconcat [CString "let children = ", brArg id $ CString children', CString" | ", card']
+  where
+  children' = intercalate " + " $ map (genRelName.uid) $
+             getSubclafers $ elements clafer'
+  card'     = mkCard (uid clafer') True "children" $ interval $ fromJust $ gcard $ clafer'
+
+mkCard :: String -> Bool -> String -> (Integer, Integer) -> Concat
+mkCard constraintName group' element crd
+  | crd' == "set" || crd' == ""        = CString ""
+  | crd' `elem` ["one", "lone", "some"] = CString $ crd' ++ " " ++ element
+  | otherwise                            = interval'
+  where
+  interval' = genInterval constraintName group' element crd
+  crd'  = flatten $ interval'
+
+-- generates expression for references that point to expressions (not single clafers)
+genPathConst :: ClaferArgs -> String -> [String] -> IClafer -> Concat
+genPathConst    claferargs    name      resPath     c
+  | isRefPath c = cconcat [CString name, CString " = ",
+                                cintercalate (CString " + ") $
+                                map ((brArg id).(genPExp claferargs resPath)) $
+                                supers $ super c]
+  | otherwise        = CString ""
+
+isRefPath :: IClafer -> Bool
+isRefPath c = (isOverlapping $ super c) &&
+                   ((length s > 1) || (not $ isSimplePath s))
+  where
+  s = supers $ super c
+
+isSimplePath :: [PExp] -> Bool
+isSimplePath    [PExp _ _ _ (IClaferId _ _ _)] = True
+isSimplePath    [PExp _ _ _ (IFunExp op' _)] = op' == iUnion
+isSimplePath    _ = False
+
+-- -----------------------------------------------------------------------------
+-- Not used?
+-- genGCard element gcard = genInterval element  $ interval $ fromJust gcard
+
+
+genCard :: String -> Maybe Interval -> Concat
+genCard    element   crd            = genInterval element False element $ fromJust crd
+
+genCardCrude :: Maybe Interval -> String
+genCardCrude crd = genIntervalCrude $ fromJust crd
+
+genIntervalCrude :: Interval -> String
+genIntervalCrude x = case x of
+  (1, 1)  -> "one"
+  (0, 1)  -> "lone"
+  (1, -1) -> "some"
+  _       -> "set"
+
+
+genInterval :: String      -> Bool -> String -> Interval -> Concat
+genInterval    constraintName group'   element   x         = case x of
+  (1, 1) -> cardConcat constraintName group' [CString "one"]
+  (0, 1) -> cardConcat constraintName group' [CString "lone"]
+  (1, -1)   -> cardConcat constraintName group' [CString "some"]
+  (0, -1)   -> CString "set" -- "set"
+  (n, exinteger)  ->
+    case (s1, s2) of
+      (Just c1, Just c2) -> cconcat [c1, CString " and ", c2]
+      (Just c1, Nothing) -> c1
+      (Nothing, Just c2) -> c2
+      (Nothing, Nothing) -> undefined
+    where
+    s1 = if n == 0 then Nothing else Just $ cardLowerConcat constraintName group' [CString $ concat [show n, " <= #",  element]]
+    s2 =
+        do
+            result <- genExInteger element x exinteger
+            return $ cardUpperConcat constraintName group' [CString result]
+
+
+cardConcat :: String        -> Bool -> [Concat] -> Concat
+cardConcat    constraintName = Concat . ExactCard constraintName
+
+
+cardLowerConcat :: String        -> Bool -> [Concat] -> Concat
+cardLowerConcat    constraintName = Concat . LowerCard constraintName
+
+
+cardUpperConcat :: String        -> Bool -> [Concat] -> Concat
+cardUpperConcat    constraintName = Concat . UpperCard constraintName
+
+
+genExInteger :: String -> Interval -> Integer -> Maybe Result
+genExInteger    element  (y,z) x  =
+  if (y==0 && z==0) then Just $ concat ["#", element, " = ", "0"] else
+    if x == -1 then Nothing else Just $ concat ["#", element, " <= ", show x]
+
+
+-- -----------------------------------------------------------------------------
+-- Generate code for logical expressions
+
+genPExp :: ClaferArgs -> [String] -> PExp -> Concat
+genPExp    claferargs    resPath     x     = genPExp' claferargs resPath $ adjustPExp resPath x
+
+genPExp' :: ClaferArgs -> [String] -> PExp                      -> Concat
+genPExp'    claferargs    resPath     (PExp iType' pid' pos exp') = case exp' of
+  IDeclPExp q d pexp -> Concat (IrPExp pid') $
+    [ CString $ genQuant q, CString " "
+    , cintercalate (CString ", ") $ map ((genDecl claferargs resPath)) d
+    , CString $ optBar d, genPExp' claferargs resPath pexp]
+    where
+    optBar [] = ""
+    optBar _  = " | "
+  IClaferId _ "ref" _ -> CString "@ref"
+  IClaferId _ sid istop -> CString $
+      if head sid == '~' then sid else
+      if isNothing iType' then sid' else case fromJust $ iType' of
+    TInteger -> vsident
+    TReal -> vsident
+    TString -> vsident
+    _ -> sid'
+    where
+    sid' = (if istop then "" else '@' : genRelName "") ++ sid
+    -- 29/March/2012  Rafael Olaechea: ref is now prepended with clafer name to be able to refer to it from partial instances.
+    -- 30/March/2012 Rafael Olaechea added referredClaferUniqeuid to fix problems when having this.x > number  (e.g test/positive/i10.cfr )     
+    vsident = if (noalloyruncommand claferargs) then sid' ++  ".@"  ++ referredClaferUniqeuid ++ "_ref"  else  sid'  ++ ".@ref"
+        where referredClaferUniqeuid = if sid == "this" then (head resPath) else sid
+  IFunExp _ _ -> case exp'' of
+    IFunExp _ _ -> genIFunExp pid' claferargs resPath exp''
+    _ -> genPExp' claferargs resPath $ PExp iType' pid' pos exp''
+    where
+    exp'' = transformExp exp'
+  IInt n -> CString $ show n
+  IDouble _ -> error "no real numbers allowed"
+  IStr _ -> error "no strings allowed"
+
+
+
+-- 3-May-2012 Rafael Olaechea.
+-- Removed transfromation from x = -2 to x = (0-2) as this creates problem with  partial instances.
+-- See http://gsd.uwaterloo.ca:8888/question/461/new-translation-of-negative-number-x-into-0-x-is.
+transformExp :: IExp -> IExp
+transformExp (IFunExp op' (e1:_))
+  | op' == iMin = IFunExp iMul [PExp (iType e1) "" noSpan $ IInt (-1), e1]
+transformExp    x@(IFunExp op' exps'@(e1:e2:_))
+  | op' == iXor = IFunExp iNot [PExp (Just TBoolean) "" noSpan (IFunExp iIff exps')]
+  | op' == iJoin && isClaferName' e1 && isClaferName' e2 &&
+    getClaferName e1 == this && head (getClaferName e2) == '~' =
+        IFunExp op' [e1{iType = Just $ TClafer []}, e2]
+  | otherwise  = x
+transformExp x = x
+
+genIFunExp :: String -> ClaferArgs -> [String] -> IExp             -> Concat
+genIFunExp    pid'       claferargs    resPath     (IFunExp op' exps') = 
+  if (op' == iSumSet) 
+    then genIFunExp pid' claferargs resPath (IFunExp iSumSet' [(removeright (head exps')), (getRight $ head exps')]) 
+    else if (op' == iSumSet') 
+      then Concat (IrPExp pid') $ intl exps'' (map CString $ genOp (Alloy42 `elem` (mode claferargs)) iSumSet)
+      else Concat (IrPExp pid') $ intl exps'' (map CString $ genOp (Alloy42 `elem` (mode claferargs)) op')
+  where
+  intl
+    | op' == iSumSet' = flip $ interleave
+    | op' `elem` arithBinOps && length exps' == 2 = interleave
+    | otherwise = \xs ys -> reverse $ interleave (reverse xs) (reverse ys)
+  exps'' = map (optBrArg claferargs resPath) exps'
+genIFunExp _ _ _ _ = error "Function genIFunExp from Alloy Generator expected a IFunExp as an argument but was given something else" --This should never happen
+
+
+optBrArg :: ClaferArgs -> [String] -> PExp -> Concat
+optBrArg    claferargs    resPath     x     = brFun (genPExp' claferargs resPath) x
+  where
+  brFun = case x of
+    PExp _ _ _ (IClaferId _ _ _) -> ($)
+    PExp _ _ _ (IInt _) -> ($)
+    _  -> brArg
+    
+interleave :: [Concat] -> [Concat] -> [Concat]
+interleave [] [] = []
+interleave (x:xs) [] = x:xs
+interleave [] (x:xs) = x:xs
+interleave (x:xs) ys = x : interleave ys xs
+
+brArg :: (a -> Concat) -> a -> Concat 
+brArg f arg = cconcat [CString "(", f arg, CString ")"]
+
+--     isAlloy42
+genOp :: Bool -> String -> [String]
+genOp    True       op'
+  | op' == iPlus = [".plus[", "]"]
+  | op' == iSub  = [".minus[", "]"]
+  | otherwise   = genOp False op'
+genOp    _             op'
+  | op' == iSumSet = ["sum temp : "," | temp."]
+  | op' `elem` unOps  = [op']
+  | op' == iPlus = [".add[", "]"]
+  | op' == iSub  = [".sub[", "]"]
+  | op' == iMul = [".mul[", "]"]
+  | op' == iDiv = [".div[", "]"]
+  | op' `elem` logBinOps ++ relBinOps ++ arithBinOps = [" " ++ op' ++ " "]
+  | op' == iUnion = [" + "]
+  | op' == iDifference = [" - "]
+  | op' == iIntersection = [" & "]
+  | op' == iDomain = [" <: "]
+  | op' == iRange = [" :> "]
+  | op' == iJoin = ["."]
+  | op' == iIfThenElse = [" => ", " else "]
+genOp _ _ = error "This should never happen"
+
+-- adjust parent
+adjustPExp :: [String] -> PExp -> PExp
+adjustPExp resPath (PExp t pid' pos x) = PExp t pid' pos $ adjustIExp resPath x
+
+adjustIExp :: [String] -> IExp -> IExp 
+adjustIExp resPath x = case x of
+  IDeclPExp q d pexp -> IDeclPExp q d $ adjustPExp resPath pexp
+  IFunExp op' exps' -> adjNav $ IFunExp op' $ map adjExps exps'
+    where
+    (adjNav, adjExps) = if op' == iJoin then (aNav, id)
+                        else (id, adjustPExp resPath)
+  IClaferId _ _ _ -> aNav x
+  _  -> x
+  where
+  aNav = fst.(adjustNav resPath)
+
+adjustNav :: [String] -> IExp -> (IExp, [String]) 
+adjustNav resPath x@(IFunExp op' (pexp0:pexp:_))
+  | op' == iJoin = (IFunExp iJoin
+                   [pexp0{Language.Clafer.Intermediate.Intclafer.exp = iexp0},
+                    pexp{Language.Clafer.Intermediate.Intclafer.exp = iexp}], path')
+  | otherwise   = (x, resPath)
+  where
+  (iexp0, path) = adjustNav resPath (Language.Clafer.Intermediate.Intclafer.exp pexp0)
+  (iexp, path') = adjustNav path    (Language.Clafer.Intermediate.Intclafer.exp pexp)
+adjustNav resPath x@(IClaferId _ id' _)
+  | id' == parent = (x{sident = "~@" ++ (genRelName $ head resPath)}, tail resPath)
+  | otherwise    = (x, resPath)
+adjustNav _ _ = error "Function adjustNav Expect a IFunExp or IClaferID as one of it's argument but it was given a differnt IExp" --This should never happen
+
+genQuant :: IQuant -> String
+genQuant    x       = case x of
+  INo   -> "no"
+  ILone -> "lone"
+  IOne  -> "one"
+  ISome -> "some"
+  IAll -> "all"
+
+
+genDecl :: ClaferArgs -> [String] -> IDecl -> Concat
+genDecl    claferargs    resPath     x      = case x of
+  IDecl disj locids pexp -> cconcat [CString $ genDisj disj, CString " ",
+    CString $ intercalate ", " locids, CString " : ", genPExp claferargs resPath pexp]
+
+
+genDisj :: Bool -> String
+genDisj    x     = case x of
+  False -> ""
+  True  -> "disj"
+
+-- mapping line/columns between Clafer and Alloy code
+
+data AlloyEnv = AlloyEnv {
+  lineCol :: (LineNo, ColNo),
+  mapping :: [(Span, IrTrace)]
+  } deriving (Eq,Show)
+
+mapLineCol :: Concat -> [(Span, IrTrace)]
+mapLineCol code = mapping $ execState (mapLineCol' code) (AlloyEnv (firstLine, firstCol) [])
+
+addCode :: MonadState AlloyEnv m => String -> m () 
+addCode str = modify (\s -> s {lineCol = lineno (lineCol s) str})
+
+mapLineCol' :: MonadState AlloyEnv m => Concat -> m ()
+mapLineCol' (CString str) = addCode str
+mapLineCol' c@(Concat srcPos' n) = do
+  posStart <- gets lineCol
+  _ <- mapM mapLineCol' n
+  posEnd   <- gets lineCol
+
+  {-
+   - Alloy only counts inner parenthesis as part of the constraint, but not outer parenthesis.
+   - ex1. the constraint looks like this in the file
+   -    (constraint a) <=> (constraint b)
+   - But the actual constraint in the API is
+   -    constraint a) <=> (constraint b
+   -
+   - ex2. the constraint looks like this in the file
+   -    (((#((this.@r_c2_Finger).@r_c3_Pinky)).add[(#((this.@r_c2_Finger).@r_c4_Index))]).add[(#((this.@r_c2_Finger).@r_c5_Middle))]) = 0
+   - But the actual constraint in the API is
+   -    #((this.@r_c2_Finger).@r_c3_Pinky)).add[(#((this.@r_c2_Finger).@r_c4_Index))]).add[(#((this.@r_c2_Finger).@r_c5_Middle))]) = 0
+   - 
+   - Seems unintuitive since the brackets are now unbalanced but that's how they work in Alloy. The next
+   - few lines of code is counting the beginning and ending parenthesis's and subtracting them from the
+   - positions in the map file.
+   - Same is true for square brackets.
+   - This next little snippet is rather inefficient since we are retraversing the Concat's to flatten.
+   - But it's the simplest and correct solution I can think of right now.
+   -}
+  let flat = flatten c
+      raiseStart = countLeading "([" flat
+      deductEnd = -(countTrailing ")]" flat)
+  modify (\s -> s {mapping = (Span (uncurry Pos $ posStart `addColumn` raiseStart) (uncurry Pos $ posEnd `addColumn` deductEnd), srcPos') : (mapping s)})
+
+addColumn :: Interval -> Integer -> Interval
+addColumn (x, y) c = (x, y + c)
+countLeading :: String -> String -> Integer
+countLeading c xs = toInteger $ length $ takeWhile (`elem` c) xs
+countTrailing :: String -> String -> Integer
+countTrailing c xs = countLeading c (reverse xs)
+
+lineno :: (Integer, ColNo) -> String -> (Integer, ColNo)
+lineno (l, c) str = (l + newLines, (if newLines > 0 then firstCol else c) + newCol)
+  where
+  newLines = toInteger $ length $ filter (== '\n') str
+  newCol   = toInteger $ length $ takeWhile (/= '\n') $ reverse str
+
+firstCol :: ColNo
+firstCol  = 1 :: ColNo
+firstLine :: LineNo
+firstLine = 1 :: LineNo
+
+removeright :: PExp -> PExp
+removeright (PExp _ _ _ (IFunExp _ (x : (PExp _ _ _ (IClaferId _ _ _)) : _))) = x
+removeright (PExp t id' pos (IFunExp o (x1:x2:xs))) = (PExp t id' pos (IFunExp o (x1:(removeright x2):xs)))
+removeright (PExp _ _ _ _) = error "Function removeright from the AlloyGenerator expects a PExp with a IFunExp inside, was given something else" --This should never happen
+
+getRight :: PExp -> PExp
+getRight (PExp _ _ _ (IFunExp _ (_:x:_))) = getRight x
+getRight p = p
+ src/Language/Clafer/Generator/Choco.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Generates JS representation of IR for the <https://github.com/gsdlab/chocosolver Chocosolver>.
+module Language.Clafer.Generator.Choco (genCModule) where
+
+import Control.Applicative
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Data.Ord
+import Prelude hiding (exp)
+import Language.Clafer.ClaferArgs
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+
+-- | Choco 3 code generation
+genCModule :: ClaferArgs -> (IModule, GEnv) -> [(UID, Integer)] -> Result
+genCModule _ (IModule{mDecls}, _) scopes =
+    genScopes
+    ++ "\n"
+    ++ (genAbstractClafer =<< abstractClafers)
+    ++ (genConcreteClafer =<< concreteClafers)
+    ++ (genRefClafer =<< clafers)
+    ++ (genTopConstraint =<< mDecls)
+    ++ (genConstraint =<< clafers)
+    ++ (genGoal =<< mDecls)
+    where
+    root :: IClafer
+    root = IClafer noSpan False Nothing "root" "root" (ISuper False [PExp Nothing "" noSpan $ IClaferId "clafer" "clafer" True]) (Just (1, 1)) (0, 0) mDecls
+    
+    toplevelClafers = mapMaybe iclafer mDecls
+    -- The sort is so that we encounter sub clafers before super clafers when abstract clafers extend other abstract clafers
+    abstractClafers = sortBy (comparing $ length . supersOf . uid) $ filter isAbstract toplevelClafers
+    parentChildMap = childClafers root
+    clafers = snd <$> parentChildMap
+    claferUids = uid <$> clafers
+    concreteClafers = filter isNotAbstract clafers
+--    minusRoot = filter ((/= "root") . uid)
+    
+    claferWithUid u = fromMaybe (error $ "claferWithUid: \"" ++ u ++ "\" is not a clafer") $ find ((== u) . uid) clafers
+    
+    prims = ["int", "integer", "string", "real"]
+    
+    -- All abstract clafers u inherits
+    supersOf :: String -> [String]
+    supersOf u =
+        case superOf u of
+             Just su -> su : supersOf su
+             Nothing -> []
+        
+--    superHierarchyOf u = u : supersOf u
+            
+    superOf u =
+        case super $ claferWithUid u of
+            ISuper False [PExp{exp = IClaferId{sident}}]
+                | sident == "clafer"  -> Nothing
+                | sident `elem` prims -> Nothing
+                | otherwise           -> Just sident
+            _ -> Nothing
+
+{-    superWithRef u =
+        case mapMaybe refOf $ supersOf u of
+             r : _ -> r
+             _      -> u ++ " does not inherit a ref" -}
+            
+    refOf u =
+        case super $ claferWithUid u of
+            ISuper True [PExp{exp = IClaferId{sident}}] -> Just sident
+            ISuper False [PExp{exp = IClaferId{sident}}]
+                | sident == "int"     -> Just "integer"
+                | sident `elem` prims -> Just sident
+                | otherwise           -> Nothing
+            _ -> Nothing
+            
+    -- All clafers that inherit u
+{-    subOf :: String -> [String]
+    subOf u = [uid | IClafer{uid} <- clafers, Just u == superOf uid]
+    subClaferOf :: String -> [IClafer]
+    subClaferOf = map claferWithUid . subOf
+    
+    subOffsets :: [(String, String, Integer)]
+    subOffsets = [(uid, sub, off) | IClafer{uid} <- clafers, let subs = subOf uid, (sub, off) <- zip subs $ offsets subs]
+    
+    subOffsetOf :: String -> Integer
+    subOffsetOf sub = trd3 $ fromMaybe (error $ "subOffsetOf: " ++ sub) $ find ((== sub) . snd3) subOffsets
+    
+    offsets :: [String] -> [Integer]
+    offsets = scanl (flip $ (+) . scopeOf) 0
+-}        
+
+    parentOf u = fst $ fromMaybe (error $ "parentOf: \"" ++ u ++ "\" is not a clafer") $ find ((== u) . uid . snd) parentChildMap
+{-    parentClaferOf = claferWithUid . parentOf
+    -- Direct childrens
+    childrenOf = map uid . childrenClaferOf
+    childrenClaferOf u = [c | (p, c) <- parentChildMap, p == u] 
+    
+    -- Indirect childrens
+    indirectChildrenOf u = childrenOf =<< supersOf u
+    indirectChildrenClaferOf u = childrenClaferOf =<< supersOf u  
+    
+    isBounded :: Interval -> Bool
+    isBounded (0, -1) = False
+    isBounded _       = True
+-}    
+    genCard :: Interval -> Maybe String
+    genCard (0, -1) = Nothing
+    genCard (low, -1) = return $ show low
+    genCard (low, high) = return $ show low ++ ", " ++ show high
+    
+    
+    genScopes :: Result
+    genScopes =
+        (if null scopeMap then "" else "scope({" ++ intercalate ", " scopeMap ++ "});\n")
+        ++ "defaultScope(1);\n"
+        ++ "intRange(-" ++ show (2 ^ (bitwidth - 1)) ++ ", " ++ show (2 ^ (bitwidth - 1) - 1) ++ ");\n"
+        where
+            scopeMap = [uid ++ ":" ++ show scope | (uid, scope) <- scopes]
+                
+    genConcreteClafer :: IClafer -> Result
+    genConcreteClafer IClafer{uid, card = Just card, gcard = Just (IGCard _ gcard)} =
+            uid ++ " = " ++ constructor ++ "(\"" ++ uid ++ "\")" ++ prop "withCard" (genCard card) ++ prop "withGroupCard" (genCard gcard) ++ prop "extending" (superOf uid) ++ ";\n"
+        where
+            constructor = 
+                case parentOf uid of
+                     "root" -> "Clafer"
+                     puid   -> puid ++ ".addChild"
+                     
+    prop name value =
+        case value of
+                Just value' -> "." ++ name ++ "(" ++ value' ++ ")"
+                Nothing     -> ""
+                
+                
+    genRefClafer :: IClafer -> Result
+    genRefClafer IClafer{uid} =
+        case (refOf uid, uid `elem` uniqueRefs) of
+             (Just target, True)  -> uid ++ ".refToUnique(" ++ genTarget target ++ ");\n"
+             (Just target, False) -> uid ++ ".refTo(" ++ genTarget target ++ ");\n"
+             _                    -> ""
+        where
+            genTarget "integer" = "Int"
+            genTarget target = target
+        
+    genAbstractClafer :: IClafer -> Result
+    genAbstractClafer IClafer{uid, card = Just _} =
+        uid ++ " = Abstract(\"" ++ uid ++ "\")" ++ prop "extending" (superOf uid) ++ ";\n"  
+    genAbstractClafer IClafer{uid, card = Nothing} =
+        uid ++ " = Abstract(\"" ++ uid ++ "\")" ++ prop "extending" (superOf uid) ++ ";\n" 
+
+    -- Is a uniqueness constraint? If so, return the name of unique clafer
+    isUniqueConstraint :: IExp -> Maybe String
+    isUniqueConstraint (IDeclPExp IAll [IDecl True [x, y] PExp{exp = IClaferId {sident}}]
+        PExp{exp = IFunExp "!=" [
+            PExp{exp = IFunExp "." [PExp{exp = IClaferId{sident = xident}}, PExp{exp = IClaferId{sident = "ref"}}]},
+            PExp{exp = IFunExp "." [PExp{exp = IClaferId{sident = yident}}, PExp{exp = IClaferId{sident = "ref"}}]}]})
+                | x == xident && y == yident = return sident
+                | otherwise                  = mzero
+    isUniqueConstraint  (IDeclPExp IAll [IDecl True [x, y] PExp{exp = IFunExp "." [PExp{exp = IClaferId{sident = "this"}}, PExp{exp = IClaferId {sident}}]}]
+        PExp{exp = IFunExp "!=" [
+            PExp{exp = IFunExp "." [PExp{exp = IClaferId{sident = xident}}, PExp{exp = IClaferId{sident = "ref"}}]},
+            PExp{exp = IFunExp "." [PExp{exp = IClaferId{sident = yident}}, PExp{exp = IClaferId{sident = "ref"}}]}]})
+                | x == xident && y == yident = return sident
+                | otherwise                  = mzero
+    isUniqueConstraint _ = mzero
+    
+    uniqueRefs :: [String]
+    uniqueRefs = mapMaybe isUniqueConstraint $ map exp $ mapMaybe iconstraint $ mDecls ++ (clafers >>= elements)
+    
+    genTopConstraint :: IElement -> Result
+    genTopConstraint (IEConstraint _ pexp)
+        | isNothing $ isUniqueConstraint $ exp pexp = "Constraint(" ++ genConstraintPExp pexp ++ ");\n"
+        | otherwise                                 = ""
+    genTopConstraint _ = ""
+    
+    genConstraint :: IClafer -> Result
+    genConstraint IClafer{uid, elements} =
+        unlines [uid ++ ".addConstraint(" ++ genConstraintPExp c ++ ");"
+            | c <- filter (isNothing . isUniqueConstraint . exp) $ mapMaybe iconstraint elements]
+            
+    genGoal :: IElement -> Result
+    genGoal (IEGoal _ PExp{exp = IFunExp{op="max", exps=[expr]}})  = "max(" ++ genConstraintPExp expr ++ ");\n"
+    genGoal (IEGoal _ PExp{exp = IFunExp{op="min", exps=[expr]}})  = "min(" ++ genConstraintPExp expr ++ ");\n"
+    genGoal (IEGoal _ _) = error $ "Unknown objective"
+    genGoal _ = ""
+            
+{-    nameOfType TInteger = "integer"
+    nameOfType (TClafer [t]) = t
+    
+    namesOfType TInteger = ["integer"]
+    namesOfType (TClafer ts) = ts
+
+    getCard uid =
+        case card $ claferWithUid uid of
+                Just (low, -1)   -> (low, scope)
+                Just (low, high) -> (low, high)
+        where
+            scope = scopeOf uid
+    
+    (l1, h1) <*> (l2, h2) = (l1 * l2, h1 * h2)
+    scopeCap scope (l, h) = (min scope l, min scope h)
+-}    
+    rewrite :: PExp -> PExp
+    -- Rearrange right joins to left joins.
+    rewrite p1@PExp{iType = Just _, exp = IFunExp "." [p2, p3@PExp{exp = IFunExp "." _}]} =
+        p1{exp = IFunExp "." [p3{iType = iType p4, exp = IFunExp "." [p2, p4]}, p5]}
+        where
+            PExp{exp = IFunExp "." [p4, p5]} = rewrite p3
+    rewrite p1@PExp{exp = IFunExp{op = "-", exps = [PExp{exp = IInt i}]}} =
+        -- This is so that the output looks cleaner, no other purpose since the Choco optimizer
+        -- in the backend will treat the pre-rewritten expression the same.
+        p1{exp = IInt (-i)}
+    rewrite p = p
+    
+    genConstraintPExp :: PExp -> String
+    genConstraintPExp = genConstraintExp . exp . rewrite
+            
+    genConstraintExp :: IExp -> String
+    genConstraintExp (IDeclPExp quant [] body) =
+        mapQuant quant ++ "(" ++ genConstraintPExp body ++ ")"
+    genConstraintExp (IDeclPExp quant decls body) =
+        mapQuant quant ++ "([" ++ intercalate ", " (map genDecl decls) ++ "], " ++ genConstraintPExp body ++ ")"
+        where
+            genDecl (IDecl isDisj locals body') =
+                (if isDisj then "disjDecl" else "decl") ++ "([" ++ intercalate ", " (map genLocal locals) ++ "], " ++ genConstraintPExp body' ++ ")"
+            genLocal local = 
+                local ++ " = local(\"" ++ local ++ "\")"
+             
+    genConstraintExp (IFunExp "." [e1, PExp{exp = IClaferId{sident = "ref"}}]) =
+        "joinRef(" ++ genConstraintPExp e1 ++ ")"
+    genConstraintExp (IFunExp "." [e1, PExp{exp = IClaferId{sident = "parent"}}]) =
+        "joinParent(" ++ genConstraintPExp e1 ++ ")"
+    genConstraintExp (IFunExp "." [e1, PExp{exp = IClaferId{sident}}]) =
+        "join(" ++ genConstraintPExp e1 ++ ", " ++ sident ++ ")"
+    genConstraintExp (IFunExp "." [_, _]) =
+        error $ "Did not rewrite all joins to left joins."
+    genConstraintExp (IFunExp "-" [arg]) =
+        "minus(" ++ genConstraintPExp arg ++ ")"
+    genConstraintExp (IFunExp "-" [arg1, arg2]) =
+        "minus(" ++ genConstraintPExp arg1 ++ ", " ++ genConstraintPExp arg2 ++ ")"
+    genConstraintExp (IFunExp "sum" args')
+        | [arg] <- args', PExp{exp = IFunExp{exps = [a, PExp{exp = IClaferId{sident = "ref"}}]}} <- rewrite arg =
+            "sum(" ++ genConstraintPExp a ++ ")"
+        | otherwise = error "Unexpected sum argument."
+    genConstraintExp (IFunExp op args') =
+        mapFunc op ++ "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
+    -- this is a keyword in Javascript so use "$this" instead
+    genConstraintExp IClaferId{sident = "this"} = "$this()"
+    genConstraintExp IClaferId{sident}
+        | sident `elem` claferUids = "global(" ++ sident ++ ")"
+        | otherwise                = sident
+    genConstraintExp (IInt val) = "constant(" ++ show val ++ ")"
+    genConstraintExp e = error $ "Unknown expression: " ++ show e
+                
+    mapQuant INo = "none"
+    mapQuant ISome = "some"
+    mapQuant IAll = "all"
+    mapQuant IOne = "one"
+    mapQuant ILone = "lone"
+                
+    mapFunc "!" = "not"
+    mapFunc "#" = "card"
+    mapFunc "<=>" = "ifOnlyIf"
+    mapFunc "=>" = "implies"
+    mapFunc "||" = "or"
+    mapFunc "xor" = "xor"
+    mapFunc "&&" = "and"
+    mapFunc "<" = "lessThan"
+    mapFunc ">" = "greaterThan"
+    mapFunc "=" = "equal"
+    mapFunc "<=" = "lessThanEqual"
+    mapFunc ">=" = "greaterThanEqual"
+    mapFunc "!=" = "notEqual"
+    mapFunc "in" = "$in"
+    mapFunc "nin" = "notIn"
+    mapFunc "+" = "add"
+    mapFunc "*" = "mul"
+    mapFunc "/" = "div"
+    mapFunc "++" = "union"
+    mapFunc "--" = "diff"
+    mapFunc "&" = "inter"
+    mapFunc "=>else" = "ifThenElse"
+    mapFunc op = error $ "Unknown op: " ++ op
+    
+{-    sidentOf u = ident $ claferWithUid u
+    scopeOf "integer" = undefined
+    scopeOf "int" = undefined
+    scopeOf i = fromMaybe 1 $ lookup i scopes -}
+    bitwidth = fromMaybe 4 $ lookup "int" scopes :: Integer
+    
+-- isQuant PExp{exp = IDeclPExp{}} = True
+-- isQuant _ = False
+
+isNotAbstract :: IClafer -> Bool
+isNotAbstract = not . isAbstract
+
+iclafer :: IElement -> Maybe IClafer
+iclafer (IEClafer c) = Just c
+iclafer _ = Nothing
+
+iconstraint :: IElement -> Maybe PExp
+iconstraint (IEConstraint _ pexp) = Just pexp
+iconstraint _ = Nothing
+
+childClafers :: IClafer -> [(String, IClafer)]
+childClafers IClafer{uid, elements} =
+    childClafers' uid =<< mapMaybe iclafer elements
+    where
+    childClafers' parent' c@IClafer{uid, elements} = (parent', c) : (childClafers' uid  =<< mapMaybe iclafer elements)
+ src/Language/Clafer/Generator/Graph.hs view
@@ -0,0 +1,389 @@+{-
+ Copyright (C) 2012 Christopher Walker <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Generates simple graph and CVL graph representation for a Clafer model in GraphViz DOT.
+module Language.Clafer.Generator.Graph (genSimpleGraph, genCVLGraph, traceAstModule, traceIrModule) where
+
+import Language.Clafer.Common(fst3,snd3,trd3)
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Front.Mapper(range)
+import Language.Clafer.Intermediate.Tracing
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Generator.Html(genTooltip)
+import qualified Data.Map as Map
+import Data.Maybe
+import Prelude hiding (exp)
+
+-- | Generate a graph in the simplified notation
+genSimpleGraph :: Module -> IModule -> String -> Bool -> String
+genSimpleGraph m ir name showRefs = cleanOutput $ "digraph \"" ++ name ++ "\"\n{\n\nrankdir=BT;\nranksep=0.3;\nnodesep=0.1;\ngraph [fontname=Sans fontsize=11];\nnode [shape=box color=lightgray fontname=Sans fontsize=11 margin=\"0.02,0.02\" height=0.2 ];\nedge [fontname=Sans fontsize=11];\n" ++ b ++ "}"
+                           where b = graphSimpleModule m (traceIrModule ir) showRefs
+
+-- | Generate a graph in CVL variability abstraction notation
+genCVLGraph :: Module -> IModule -> String -> String                          
+genCVLGraph m ir name = cleanOutput $ "digraph \"" ++ name ++ "\"\n{\nrankdir=BT;\nranksep=0.1;\nnodesep=0.1;\nnode [shape=box margin=\"0.025,0.025\"];\nedge [arrowhead=none];\n" ++ b ++ "}"
+                       where b = graphCVLModule m $ traceIrModule ir
+
+-- Simplified Notation Printer --
+--toplevel: (Top_level (Boolean), Maybe Topmost parent, Maybe immediate parent)         
+graphSimpleModule :: Module -> Map.Map Span [Ir] -> Bool -> String
+graphSimpleModule (Module [])                _     _        = ""
+graphSimpleModule (Module (x:xs))            irMap showRefs = graphSimpleDeclaration x (True, Nothing, Nothing) irMap showRefs ++ graphSimpleModule (Module xs) irMap showRefs
+graphSimpleModule (PosModule _ declarations) irMap showRefs = graphSimpleModule (Module declarations) irMap showRefs
+
+graphSimpleDeclaration :: Declaration
+                          -> (Bool, Maybe String, Maybe String)
+                          -> Map.Map Span [Ir]
+                          -> Bool
+                          -> String
+graphSimpleDeclaration (ElementDecl element)      topLevel irMap showRefs = graphSimpleElement element topLevel irMap showRefs
+graphSimpleDeclaration (PosElementDecl _ element) topLevel irMap showRefs = graphSimpleDeclaration (ElementDecl element) topLevel irMap showRefs
+graphSimpleDeclaration _                          _        _     _        = ""
+
+graphSimpleElement :: Element
+                      -> (Bool, Maybe String, Maybe String)
+                      -> Map.Map Span [Ir]
+                      -> Bool
+                      -> String
+graphSimpleElement (Subclafer clafer)                     topLevel irMap showRefs = graphSimpleClafer clafer topLevel irMap showRefs
+graphSimpleElement (PosSubclafer _ subclafer)             topLevel irMap showRefs = graphSimpleElement (Subclafer subclafer) topLevel irMap showRefs
+graphSimpleElement (ClaferUse name _ _)         topLevel irMap _        = if snd3 topLevel == Nothing then "" else "\"" ++ fromJust (snd3 topLevel) ++ "\" -> \"" ++ graphSimpleName name topLevel irMap ++ "\" [arrowhead=vee arrowtail=diamond dir=both style=solid constraint=true weight=5 minlen=2 arrowsize=0.6 penwidth=0.5 ];\n"
+graphSimpleElement (PosClaferUse s _ _ _) topLevel irMap _        = if snd3 topLevel == Nothing then "" else "\"" ++ fromJust (snd3 topLevel) ++ "\" -> \"" ++ getUseId s irMap ++ "\" [arrowhead=vee arrowtail=diamond dir=both style=solid constraint=true weight=5 minlen=2 arrowsize=0.6 penwidth=0.5 ];\n"
+graphSimpleElement _ _ _ _ = ""
+
+graphSimpleElements :: Elements
+                      -> (Bool, Maybe String, Maybe String)
+                      -> Map.Map Span [Ir]
+                      -> Bool
+                      -> String
+graphSimpleElements ElementsEmpty                _        _     _        = ""
+graphSimpleElements (PosElementsEmpty _)         topLevel irMap showRefs = graphSimpleElements ElementsEmpty topLevel irMap showRefs
+graphSimpleElements (ElementsList es)      topLevel irMap showRefs = concatMap (\x -> graphSimpleElement x topLevel irMap showRefs ++ "\n") es
+graphSimpleElements (PosElementsList _ es) topLevel irMap showRefs = graphSimpleElements (ElementsList es) topLevel irMap showRefs
+
+graphSimpleClafer :: Clafer
+                      -> (Bool, Maybe String, Maybe String)
+                      -> Map.Map Span [Ir]
+                      -> Bool
+                      -> String 
+graphSimpleClafer (Clafer _ _ _ _ _ _ _)         _        _     _ = ""
+graphSimpleClafer (PosClafer s abstract gCard id' super' crd init' es) topLevel irMap showRefs
+  | fst3 topLevel == True = let {tooltip = genTooltip (Module [ElementDecl (Subclafer (Clafer abstract gCard id' super' crd init' es))]) irMap;
+                               uid' = getDivId s irMap} in
+                             "\"" ++ uid' ++ "\" [label=\"" ++ (head $ lines tooltip) ++ "\" URL=\"#" ++ uid' ++ "\" tooltip=\"" ++ htmlNewlines tooltip ++ "\"];\n"
+                             ++ graphSimpleSuper super' (True, Just uid', Just uid') irMap showRefs ++ graphSimpleElements es (False, Just uid', Just uid') irMap showRefs
+  | otherwise             = let (PosIdent (_,ident')) = id' in
+                             graphSimpleSuper super' (fst3 topLevel, snd3 topLevel, Just ident') irMap showRefs ++ graphSimpleElements es (fst3 topLevel, snd3 topLevel, Just ident') irMap showRefs
+
+graphSimpleSuper :: Super
+                  -> (Bool, Maybe String, Maybe String)
+                  -> Map.Map Span [Ir]
+                  -> Bool
+                  -> String
+graphSimpleSuper SuperEmpty _ _ _ = ""
+graphSimpleSuper (PosSuperEmpty _) topLevel irMap showRefs = graphSimpleSuper SuperEmpty topLevel irMap showRefs
+graphSimpleSuper (SuperSome superHow setExp) topLevel irMap showRefs = let {parent [] = "error";
+                                                            parent (uid'@('c':xs):xss) = if '_' `elem` xs then uid' else parent xss;
+                                                            parent (_:xss) = parent xss;
+                                                            super' = parent $ graphSimpleSetExp setExp topLevel irMap} in
+                                                            if super' == "error" then "" else "\"" ++ fromJust (snd3 topLevel) ++ "\" -> \"" ++ parent (graphSimpleSetExp setExp topLevel irMap) ++ "\"" ++ graphSimpleSuperHow superHow topLevel irMap showRefs
+graphSimpleSuper (PosSuperSome _ superHow setExp) topLevel irMap showRefs = graphSimpleSuper (SuperSome superHow setExp) topLevel irMap showRefs
+
+graphSimpleSuperHow :: SuperHow -> (Bool, Maybe String, Maybe String) -> Map.Map Span [Ir] -> Bool -> String
+graphSimpleSuperHow SuperColon topLevel _ _ = " [" ++ if fst3 topLevel == True 
+                                                                 then "arrowhead=onormal constraint=true weight=100];\n" 
+                                                                 else "arrowhead=vee arrowtail=diamond dir=both style=solid weight=10 color=gray arrowsize=0.6 minlen=2 penwidth=0.5 constraint=true];\n"
+graphSimpleSuperHow (PosSuperColon _) topLevel irMap showRefs  = graphSimpleSuperHow SuperColon topLevel irMap showRefs
+graphSimpleSuperHow SuperArrow topLevel _ showRefs = " [arrowhead=vee arrowsize=0.6 penwidth=0.5 constraint=true weight=10 color=" ++ refColour showRefs ++ " fontcolor=" ++ refColour showRefs ++ (if fst3 topLevel == True then "" else " label=" ++ (fromJust $ trd3 topLevel)) ++ "];\n"
+graphSimpleSuperHow (PosSuperArrow _) topLevel irMap showRefs = graphSimpleSuperHow SuperArrow topLevel irMap showRefs
+graphSimpleSuperHow SuperMArrow topLevel _ showRefs = " [arrowhead=veevee arrowsize=0.6 minlen=1.5 penwidth=0.5 constraint=true weight=10 color=" ++ refColour showRefs ++ " fontcolor=" ++ refColour showRefs ++ (if fst3 topLevel == True then "" else " label=" ++ (fromJust $ trd3 topLevel)) ++ "];\n"
+graphSimpleSuperHow (PosSuperMArrow _) topLevel irMap showRefs = graphSimpleSuperHow SuperMArrow topLevel irMap showRefs  
+
+refColour :: Bool -> String 
+refColour True = "lightgray" 
+refColour False = "transparent"
+
+graphSimpleName :: Name -> (Bool, Maybe String, Maybe String) -> Map.Map Span [Ir] -> String
+graphSimpleName (Path modids) topLevel irMap = unwords $ map (\x -> graphSimpleModId x topLevel irMap) modids
+graphSimpleName (PosPath _ modids) topLevel irMap = graphSimpleName (Path modids) topLevel irMap
+
+graphSimpleModId :: ModId -> (Bool, Maybe String, Maybe String) -> Map.Map Span [Ir] -> String
+graphSimpleModId (ModIdIdent posident) _ irMap = graphSimplePosIdent posident irMap
+graphSimpleModId (PosModIdIdent _ posident) topLevel irMap = graphSimpleModId (ModIdIdent posident) topLevel irMap
+
+graphSimplePosIdent :: PosIdent -> Map.Map Span [Ir] -> String
+graphSimplePosIdent (PosIdent (pos, id')) irMap = getUid (PosIdent (pos, id')) irMap
+
+{-graphSimpleCard _ _ _ = ""
+graphSimpleConstraint _ _ _ = ""
+graphSimpleDecl _ _ _ = ""
+graphSimpleInit _ _ _ = ""
+graphSimpleInitHow _ _ _ = ""
+graphSimpleExp _ _ _ = ""
+graphSimpleQuant _ _ _ = ""
+graphSimpleGoal _ _ _ = ""
+graphSimpleSoftConstraint _ _ _ = ""
+graphSimpleAbstract _ _ _ = ""
+graphSimpleGCard _ _ _ = ""
+graphSimpleNCard _ _ _ = ""
+graphSimpleExInteger _ _ _ = ""-}
+
+graphSimpleSetExp :: SetExp -> (Bool, Maybe String, Maybe String) -> Map.Map Span [Ir] -> [String]
+graphSimpleSetExp (ClaferId name) topLevel irMap = [graphSimpleName name topLevel irMap]
+graphSimpleSetExp (PosClaferId _ name) topLevel irMap = graphSimpleSetExp (ClaferId name) topLevel irMap
+graphSimpleSetExp (Union set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosUnion _ set1 set2) topLevel irMap = graphSimpleSetExp (Union set1 set2) topLevel irMap
+graphSimpleSetExp (UnionCom set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosUnionCom _ set1 set2) topLevel irMap = graphSimpleSetExp (UnionCom set1 set2) topLevel irMap
+graphSimpleSetExp (Difference set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosDifference _ set1 set2) topLevel irMap = graphSimpleSetExp (Difference set1 set2) topLevel irMap
+graphSimpleSetExp (Intersection set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosIntersection _ set1 set2) topLevel irMap = graphSimpleSetExp (Intersection set1 set2) topLevel irMap
+graphSimpleSetExp (Domain set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosDomain _ set1 set2) topLevel irMap = graphSimpleSetExp (Domain set1 set2) topLevel irMap
+graphSimpleSetExp (Range set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosRange _ set1 set2) topLevel irMap = graphSimpleSetExp (Range set1 set2) topLevel irMap
+graphSimpleSetExp (Join set1 set2) topLevel irMap = graphSimpleSetExp set1 topLevel irMap ++ graphSimpleSetExp set2 topLevel irMap
+graphSimpleSetExp (PosJoin _ set1 set2) topLevel irMap = graphSimpleSetExp (Join set1 set2) topLevel irMap
+
+{-graphSimpleEnumId :: EnumId -> (Bool, Maybe String, Maybe String) -> Map.Map Span [Ir] -> String
+graphSimpleEnumId (EnumIdIdent posident) _ irMap = graphSimplePosIdent posident irMap
+graphSimpleEnumId (PosEnumIdIdent _ posident) topLevel irMap = graphSimpleEnumId (EnumIdIdent posident) topLevel irMap-}
+
+-- CVL Printer --
+--parent is Maybe the uid of the immediate parent
+graphCVLModule :: Module -> Map.Map Span [Ir] -> String
+graphCVLModule (Module [])     _ = ""
+graphCVLModule (Module (x:xs)) irMap = graphCVLDeclaration x Nothing irMap ++ graphCVLModule (Module xs) irMap
+graphCVLModule (PosModule _ declarations) irMap = graphCVLModule (Module declarations) irMap
+
+graphCVLDeclaration :: Declaration -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLDeclaration (ElementDecl element)      parent irMap = graphCVLElement element parent irMap
+graphCVLDeclaration (PosElementDecl _ element) parent irMap = graphCVLDeclaration (ElementDecl element) parent irMap
+graphCVLDeclaration _                          _        _     = ""
+
+graphCVLElement :: Element -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLElement (Subclafer clafer)  parent irMap = graphCVLClafer clafer parent irMap
+graphCVLElement (PosSubclafer _ subclafer) parent irMap = graphCVLElement (Subclafer subclafer) parent irMap
+graphCVLElement (ClaferUse name _ _) parent irMap = if parent == Nothing then "" else "?" ++ " -> " ++ graphCVLName name parent irMap ++ " [arrowhead = onormal style = dashed constraint = false];\n"
+graphCVLElement (PosClaferUse s _ _ _) parent irMap = if parent == Nothing then "" else "?" ++ " -> " ++ getUseId s irMap ++ " [arrowhead = onormal style = dashed constraint = false];\n"
+graphCVLElement (Subconstraint constraint) parent irMap = graphCVLConstraint constraint parent irMap
+graphCVLElement (PosSubconstraint _ constraint) parent irMap = graphCVLElement (Subconstraint constraint) parent irMap
+graphCVLElement _ _ _ = ""
+
+graphCVLElements :: Elements -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLElements ElementsEmpty _ _ = ""
+graphCVLElements (PosElementsEmpty _) parent irMap = graphCVLElements ElementsEmpty parent irMap
+graphCVLElements (ElementsList es) parent irMap = concatMap (\x -> graphCVLElement x parent irMap  ++ "\n") es
+graphCVLElements (PosElementsList _ es) parent irMap = graphCVLElements (ElementsList es) parent irMap 
+
+graphCVLClafer :: Clafer -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLClafer (Clafer _ _ _ _ _ _ _) _ _ = ""
+graphCVLClafer (PosClafer s _ gCard _ super' crd _ es) parent irMap
+   = let {{-tooltip = genTooltip (Module [ElementDecl (Subclafer (Clafer abstract gCard id' super' crd init' es))]) irMap;-}
+          uid' = getDivId s irMap;
+          gcrd = graphCVLGCard gCard parent irMap;
+          super'' = graphCVLSuper super' parent irMap} in
+     "\"" ++ uid' ++ "\" [URL=\"#" ++ uid' ++ "\" label=\"" ++ dropUid uid' ++ super'' ++ (if choiceCard crd then "\" style=rounded"  else " [" ++ graphCVLCard crd parent irMap ++ "]\"")
+     ++ (if super'' == "" then "" else " shape=oval") ++ "];\n"
+     ++ (if gcrd == "" then "" else "g" ++ uid' ++ " [label=\"" ++ gcrd ++ "\" fontsize=10 shape=triangle];\ng" ++ uid' ++ " -> " ++ uid' ++ " [weight=10];\n")
+     ++ (if parent==Nothing then "" else uid' ++ " -> " ++ fromJust parent ++ (if lowerCard crd == "0" then " [style=dashed]" else "") ++ ";\n")
+     ++ graphCVLElements es (if gcrd == "" then (Just uid') else (Just $ "g" ++ uid')) irMap
+
+graphCVLSuper :: Super -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLSuper SuperEmpty _ _ = ""
+graphCVLSuper (PosSuperEmpty _) parent irMap = graphCVLSuper SuperEmpty parent irMap
+graphCVLSuper (SuperSome superHow setExp) parent irMap = graphCVLSuperHow superHow ++ concat (graphCVLSetExp setExp parent irMap)
+graphCVLSuper (PosSuperSome _ superHow setExp) parent irMap = graphCVLSuper (SuperSome superHow setExp) parent irMap
+
+graphCVLSuperHow :: SuperHow -> String
+graphCVLSuperHow SuperColon = ":"
+graphCVLSuperHow (PosSuperColon _) = ":"
+graphCVLSuperHow SuperArrow = "->"
+graphCVLSuperHow (PosSuperArrow _) = "->"
+graphCVLSuperHow SuperMArrow = "->>"
+graphCVLSuperHow (PosSuperMArrow _) = "->>"
+
+graphCVLName :: Name -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLName (Path modids) parent irMap = unwords $ map (\x -> graphCVLModId x parent irMap) modids
+graphCVLName (PosPath _ modids) parent irMap = graphCVLName (Path modids) parent irMap
+
+graphCVLModId :: ModId -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLModId (ModIdIdent posident) _ irMap = graphCVLPosIdent posident irMap
+graphCVLModId (PosModIdIdent _ posident) parent irMap = graphCVLModId (ModIdIdent posident) parent irMap
+
+graphCVLPosIdent :: PosIdent -> Map.Map Span [Ir] -> String
+graphCVLPosIdent (PosIdent (pos, id')) irMap = getUid (PosIdent (pos, id')) irMap
+
+graphCVLConstraint :: Constraint -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLConstraint (Constraint _) _ _ = ""
+graphCVLConstraint (PosConstraint s exps') parent irMap = let body' = htmlNewlines $ genTooltip (Module [ElementDecl (Subconstraint (Constraint exps'))]) irMap;
+                                                                       uid' = "\"" ++ getExpId s irMap ++ "\""
+                                                                    in uid' ++ " [label=\"" ++ body' ++ "\" shape=parallelogram];\n" ++
+                                                                      if parent == Nothing then "" else uid' ++ " -> \"" ++ fromJust parent ++ "\";\n"
+graphCVLCard :: Card -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLCard  CardEmpty _ _ = "1..1"
+graphCVLCard  CardLone _ _ =  "0..1"
+graphCVLCard  CardSome _ _ =  "1..*"
+graphCVLCard  CardAny _ _ =   "0..*"
+graphCVLCard  (CardNum (PosInteger (_, n))) _ _ = n ++ ".." ++ n
+graphCVLCard  (CardInterval ncard) parent irMap = graphCVLNCard ncard parent irMap
+graphCVLCard  (PosCardEmpty _) _ _ = "1..1"
+graphCVLCard  (PosCardLone _) _ _ =  "0..1"
+graphCVLCard  (PosCardSome _) _ _ =  "1..*"
+graphCVLCard  (PosCardAny _) _ _ =    "0..*"
+graphCVLCard  (PosCardNum _ (PosInteger (_, n))) _ _ = n ++ ".." ++ n
+graphCVLCard  (PosCardInterval _ ncard) parent irMap = graphCVLNCard ncard parent irMap
+
+graphCVLNCard :: NCard -> Maybe String -> Map.Map Span [Ir] -> String 
+graphCVLNCard (NCard (PosInteger (_, num)) exInteger) parent irMap = num ++ ".." ++ graphCVLExInteger exInteger parent irMap
+graphCVLNCard (PosNCard _ posInteger exInteger) parent irMap = graphCVLNCard (NCard posInteger exInteger) parent irMap
+
+graphCVLExInteger :: ExInteger -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLExInteger ExIntegerAst _ _ = "*"
+graphCVLExInteger (PosExIntegerAst _) parent irMap = graphCVLExInteger ExIntegerAst parent irMap
+graphCVLExInteger (ExIntegerNum (PosInteger(_, num))) _ _ = num
+graphCVLExInteger (PosExIntegerNum _ posInteger) parent irMap = graphCVLExInteger (ExIntegerNum posInteger) parent irMap
+
+graphCVLGCard :: GCard -> Maybe String -> Map.Map Span [Ir] -> String
+graphCVLGCard (GCardInterval ncard) parent irMap = graphCVLNCard ncard parent irMap
+graphCVLGCard (PosGCardInterval _ ncard) parent irMap = graphCVLNCard ncard parent irMap
+graphCVLGCard GCardEmpty _ _ = ""
+graphCVLGCard (PosGCardEmpty _) _ _ = ""
+graphCVLGCard GCardXor _ _ = "1..1"
+graphCVLGCard (PosGCardXor _) _ _ = "1..1"
+graphCVLGCard GCardOr _ _= "1..*"
+graphCVLGCard (PosGCardOr _) _ _ = "1..*"
+graphCVLGCard GCardMux _ _ = "0..1"
+graphCVLGCard (PosGCardMux _) _ _ = "0..1"
+graphCVLGCard GCardOpt _ _ = ""
+graphCVLGCard (PosGCardOpt _) _ _ = ""
+
+
+{-graphCVLDecl _ _ _ = ""
+graphCVLInit _ _ _ = ""
+graphCVLInitHow _ _ _ = ""
+graphCVLExp _ _ _ = ""
+graphCVLQuant _ _ _ = ""
+graphCVLGoal _ _ _ = ""
+graphCVLSoftConstraint _ _ _ = ""
+graphCVLAbstract _ _ _ = ""-}
+
+graphCVLSetExp :: SetExp -> Maybe String -> Map.Map Span [Ir] -> [String]
+graphCVLSetExp (ClaferId name) parent irMap = [graphCVLName name parent irMap]
+graphCVLSetExp (PosClaferId _ name) parent irMap = graphCVLSetExp (ClaferId name) parent irMap
+graphCVLSetExp (Union set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosUnion _ set1 set2) parent irMap = graphCVLSetExp (Union set1 set2) parent irMap
+graphCVLSetExp (UnionCom set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosUnionCom _ set1 set2) parent irMap = graphCVLSetExp (UnionCom set1 set2) parent irMap
+graphCVLSetExp (Difference set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosDifference _ set1 set2) parent irMap = graphCVLSetExp (Difference set1 set2) parent irMap
+graphCVLSetExp (Intersection set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosIntersection _ set1 set2) parent irMap = graphCVLSetExp (Intersection set1 set2) parent irMap
+graphCVLSetExp (Domain set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosDomain _ set1 set2) parent irMap = graphCVLSetExp (Domain set1 set2) parent irMap
+graphCVLSetExp (Range set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosRange _ set1 set2) parent irMap = graphCVLSetExp (Range set1 set2) parent irMap
+graphCVLSetExp (Join set1 set2) parent irMap = graphCVLSetExp set1 parent irMap ++ graphCVLSetExp set2 parent irMap
+graphCVLSetExp (PosJoin _ set1 set2) parent irMap = graphCVLSetExp (Join set1 set2) parent irMap
+
+{-graphCVLEnumId (EnumIdIdent posident) _ irMap = graphCVLPosIdent posident irMap
+graphCVLEnumId (PosEnumIdIdent _ posident) parent irMap = graphCVLEnumId (EnumIdIdent posident) parent irMap-}
+
+choiceCard :: Card -> Bool
+choiceCard CardEmpty = True
+choiceCard (PosCardEmpty _) = choiceCard CardEmpty
+choiceCard CardLone = True
+choiceCard (PosCardLone _) = choiceCard CardLone
+choiceCard (CardInterval nCard) = case nCard of
+  PosNCard _ (PosInteger (_, low)) exInteger -> choiceCard' low exInteger
+  NCard (PosInteger (_, low)) exInteger -> choiceCard' low exInteger
+  where choiceCard' low exInteger = if low == "0" || low == "1"
+                                    then case exInteger of
+                                      ExIntegerAst -> False
+                                      PosExIntegerAst _ -> False
+                                      ExIntegerNum (PosInteger (_, high)) -> high == "0" || high == "1"
+                                      PosExIntegerNum _ (PosInteger (_, high)) -> high == "0" || high == "1"
+                                    else False
+choiceCard (PosCardInterval _ nCard) = choiceCard (CardInterval nCard)
+choiceCard _ = False
+
+lowerCard :: Card -> String
+lowerCard crd = takeWhile (/= '.') $ graphCVLCard crd Nothing Map.empty
+
+--Miscellaneous functions
+dropUid :: String -> String
+dropUid uid' = let id' = rest $ dropWhile (\x -> x /= '_') uid' in if id' == "" then uid' else id'
+
+rest :: String -> String
+rest [] = []
+rest (_:xs) = xs
+
+getUid :: PosIdent -> Map.Map Span [Ir] -> String
+getUid (PosIdent (pos, id')) irMap = if Map.lookup (range (PosIdent (pos, id'))) irMap == Nothing
+                        then id'
+                        else let IRPExp pexp = head $ fromJust $ Map.lookup (range (PosIdent (pos, id'))) irMap in
+                          findUid id' $ getIdentPExp pexp
+                          where {getIdentPExp (PExp _ _ _ exp') = getIdentIExp exp';
+                                 getIdentIExp (IFunExp _ exps') = concatMap getIdentPExp exps';
+                                 getIdentIExp (IClaferId _ id'' _) = [id''];
+                                 getIdentIExp (IDeclPExp _ _ pexp) = getIdentPExp pexp;
+                                 getIdentIExp _ = [];
+                                 findUid name (x:xs) = if name == dropUid x then x else findUid name xs;
+                                 findUid name []     = name}
+
+getDivId :: Span -> Map.Map Span [Ir] -> String                  
+getDivId s irMap = if Map.lookup s irMap == Nothing
+                      then "Uid not Found"
+                      else let IRClafer iClafer = head $ fromJust $ Map.lookup s irMap in
+                        uid iClafer
+
+{-getSuperId :: Span -> Map.Map Span [Ir] -> String
+getSuperId s irMap = if Map.lookup s irMap == Nothing
+                        then "Uid not Found"
+                        else let IRPExp pexp = head $ fromJust $ Map.lookup s irMap in
+                          sident $ exp pexp-}
+
+getUseId :: Span -> Map.Map Span [Ir] -> String
+getUseId s irMap = if Map.lookup s irMap == Nothing
+                      then "Uid not Found"
+                      else let IRClafer iClafer = head $ fromJust $ Map.lookup s irMap in
+                        sident $ exp $ head $ supers $ super iClafer
+
+getExpId :: Span -> Map.Map Span [Ir] -> String
+getExpId s irMap = if Map.lookup s irMap == Nothing
+                      then "Uid not Found"
+                      else let IRPExp pexp = head $ fromJust $ Map.lookup s irMap in pid pexp
+
+{-while :: Bool -> [IExp] -> [IExp]
+while bool exp' = if bool then exp' else []-}
+
+htmlNewlines :: String -> String
+htmlNewlines "" = ""
+htmlNewlines ('\n':xs) = "&#10;" ++ htmlNewlines xs
+htmlNewlines (x:xs) = x:htmlNewlines xs
+
+cleanOutput :: String -> String
+cleanOutput "" = ""
+cleanOutput (' ':'\n':xs) = cleanOutput $ '\n':xs
+cleanOutput ('\n':'\n':xs) = cleanOutput $ '\n':xs
+cleanOutput (' ':'<':'b':'r':'>':xs) = "<br>"++cleanOutput xs
+cleanOutput (x:xs) = x : cleanOutput xs
+ src/Language/Clafer/Generator/Html.hs view
@@ -0,0 +1,565 @@+{-
+ Copyright (C) 2012 Christopher Walker, Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Generates HTML and plain text rendering of a Clafer model.
+module Language.Clafer.Generator.Html (genHtml,
+                                       genText,
+                                       genTooltip,
+                                       printModule,
+                                       printDeclaration,
+                                       printDecl,
+                                       traceAstModule,
+                                       traceIrModule,
+                                       cleanOutput,
+                                       revertLayout,
+                                       printComment,
+                                       printPreComment,
+                                       printStandaloneComment,
+                                       printInlineComment,
+                                       highlightErrors) where
+
+import Language.ClaferT
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Front.LayoutResolver(revertLayout)
+import Language.Clafer.Front.Mapper(range)
+import Language.Clafer.Intermediate.Tracing
+import Language.Clafer.Intermediate.Intclafer
+import Data.List (intersperse,genericSplitAt)
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Char (isSpace)
+import Prelude hiding (exp)
+
+
+printPreComment :: Span -> [(Span, String)] -> ([(Span, String)], String)
+printPreComment _ [] = ([], [])
+printPreComment (Span (Pos r _) _) (c@((Span (Pos r' _) _), _):cs)
+  | r > r' = findAll r ((c:cs), [])
+  | otherwise  = (c:cs, "")
+    where findAll _ ([],comments) = ([],comments)
+          findAll row ((c'@((Span (Pos row' col') _), comment):cs'), comments)
+            | row > row' = case take 3 comment of
+                '/':'/':'#':[] -> findAll row (cs', concat [comments, "<!-- " ++ trim (drop 2 comment) ++ " /-->\n"])
+                '/':'/':_:[]   -> if col' == 1
+                                  then findAll row (cs', concat [comments, printStandaloneComment comment ++ "\n"])
+                                  else findAll row (cs', concat [comments, printInlineComment comment ++ "\n"])
+                '/':'*':_:[]   -> findAll row (cs', concat [comments, printStandaloneComment comment ++ "\n"])
+                _      -> (cs', "Improper form of comment.")-- Should not happen. Bug.
+            | otherwise  = ((c':cs'), comments)
+          findAll row ((_:cs'), comments) = findAll row (cs', comments)
+printPreComment _ cs = (cs,"")
+printComment :: Span -> [(Span, String)] -> ([(Span, String)], String)
+printComment _ [] = ([],[])
+printComment (Span (Pos row _) _) (c@(Span (Pos row' col') _, comment):cs)
+  | row == row' = case take 3 comment of
+        '/':'/':'#':[] -> (cs,"<!-- " ++ trim' (drop 2 comment) ++ " /-->\n")
+        '/':'/':_:[]   -> if col' == 1
+                          then (cs, printStandaloneComment comment ++ "\n") 
+                          else (cs, printInlineComment comment ++ "\n")
+        '/':'*':_:[]   -> (cs, printStandaloneComment comment ++ "\n")
+        _      -> (cs, "Improper form of comment.")-- Should not happen. Bug.
+  | otherwise = (c:cs, "")
+  where trim' = let f = reverse. dropWhile isSpace in f . f
+printComment _ cs = (cs,"")
+printStandaloneComment :: String -> String
+printStandaloneComment comment = "<div class=\"standalonecomment\">" ++ comment ++ "</div>"
+printInlineComment :: String -> String
+printInlineComment comment = "<span class=\"inlinecomment\">" ++ comment ++ "</span>"
+
+-- | Generate the model as HTML document
+genHtml :: Module -> IModule -> String
+genHtml x ir = cleanOutput $ revertLayout $ printModule x (traceIrModule ir) True
+-- | Generate the model as plain text 
+-- | This is used by the graph generator for tooltips
+genText :: Module -> IModule -> String
+genText x ir = cleanOutput $ revertLayout $ printModule x (traceIrModule ir) False
+genTooltip :: Module -> Map.Map Span [Ir] -> String
+genTooltip m ir = unlines $ filter (\x -> trim x /= []) $ lines $ cleanOutput $ revertLayout $ printModule m ir False
+
+printModule :: Module -> Map.Map Span [Ir] -> Bool -> String
+printModule (Module [])     _ _ = ""
+printModule (Module (x:xs)) irMap html = (printDeclaration x 0 irMap html []) ++ printModule (Module xs) irMap html
+printModule (PosModule _ declarations) irMap html = printModule (Module declarations) irMap html
+
+printDeclaration :: Declaration -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printDeclaration (EnumDecl posIdent enumIds) indent irMap html comments = 
+  let (PosIdent (_, _)) = posIdent in
+    printIndentId 0 html ++
+    (while html "<span class=\"keyword\">") ++ "enum" ++ (while html "</span>") ++ 
+    " " ++ 
+    (printPosIdent posIdent Nothing html) ++ 
+    " = " ++ 
+    (concat $ intersperse " | " (map (\x -> printEnumId x indent irMap html comments) enumIds)) ++
+    printIndentEnd html
+printDeclaration (PosEnumDecl s posIdent enumIds)  indent irMap html comments = 
+    preComments ++
+    printIndentId 0 html ++
+    (while html "<span class=\"keyword\">") ++ "enum" ++ (while html "</span>") ++ 
+    " " ++ 
+    (printPosIdent posIdent (Just uid') html) ++ 
+    " = " ++ 
+    (concat $ intersperse " | " (map (\x -> printEnumId x indent irMap html comments) enumIds)) ++
+    comment ++
+    printIndentEnd html
+  where
+    uid' = getUid posIdent irMap;
+    (comments', preComments) = printPreComment s comments;
+    (_, comment) = printComment s comments'
+printDeclaration (ElementDecl element)      indent irMap html comments = printElement element indent irMap html comments
+printDeclaration (PosElementDecl _ element) indent irMap html comments = printDeclaration (ElementDecl element) indent irMap html comments
+
+printElement :: Element -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printElement (Subclafer clafer) indent irMap html comments = printClafer clafer indent irMap html comments
+printElement (PosSubclafer _ subclafer) indent irMap html comments = printElement (Subclafer subclafer) indent irMap html comments
+
+printElement (ClaferUse name crd es) indent irMap html comments = 
+  printIndent indent html ++ 
+  "`" ++ printName name indent irMap html comments ++ 
+  printCard crd ++ 
+  printIndentEnd html ++
+  printElements es indent irMap html comments
+printElement (PosClaferUse s name crd es) indent irMap html comments = 
+  preComments ++ 
+  printIndentId indent html ++
+  "`" ++ (while html ("<a href=\"#" ++ superId ++ "\"><span class=\"reference\">")) ++ 
+  printName name indent irMap False [] --trick the printer into only printing the name
+  ++ (while html "</span></a>") ++ 
+  printCard crd ++ 
+  comment ++ 
+  printIndentEnd html ++ 
+  printElements es indent irMap html comments''
+  where
+    (_, superId) = getUseId s irMap;
+    (comments', preComments) = printPreComment s comments;
+    (comments'', comment) = printComment s comments' 
+
+printElement (Subgoal goal) indent irMap html comments = printGoal goal indent irMap html comments
+printElement (PosSubgoal s goal) indent irMap html comments = 
+  preComments ++ 
+  printIndent 0 html ++
+  printElement (Subgoal goal) indent irMap html comments'' ++ 
+  comment ++ 
+  printIndentEnd html
+  where
+   (comments', preComments) = printPreComment s comments; 
+   (comments'', comment) = printComment s comments' 
+
+printElement (Subconstraint constraint) indent irMap html comments =
+    printIndent indent html ++
+    printConstraint constraint indent irMap html comments ++
+    printIndentEnd html
+
+printElement (PosSubconstraint s constraint) indent irMap html comments =
+    preComments ++
+    printIndent indent html ++ 
+    printConstraint constraint indent irMap html comments'' ++
+    comment ++
+    printIndentEnd html  
+  where
+    (comments', preComments) = printPreComment s comments;
+    (comments'', comment) = printComment s comments' 
+
+printElement (Subsoftconstraint constraint) indent irMap html comments =
+    printIndent indent html ++
+    printSoftConstraint constraint indent irMap html comments ++
+    printIndentEnd html
+
+printElement (PosSubsoftconstraint s constraint) indent irMap html comments =
+    preComments ++ 
+    printIndent indent html ++ 
+    printSoftConstraint constraint indent irMap html comments'' ++
+    comment ++
+    printIndentEnd html  
+  where
+    (comments', preComments) = printPreComment s comments;
+    (comments'', comment) = printComment s comments' 
+
+printElements :: Elements -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printElements ElementsEmpty _ _ _ _ = ""
+printElements (PosElementsEmpty _) indent irMap html comments = printElements ElementsEmpty indent irMap html comments
+printElements (ElementsList es) indent irMap html comments = "\n{" ++ mapElements es indent irMap html comments ++ "\n}"
+    where mapElements []     _ _ _ _ = []
+          mapElements (e':es') indent' irMap' html' comments' = if span' e' == noSpan
+                                                          then (printElement e' (indent' + 1) irMap' html' comments' {-++ "\n"-}) ++ mapElements es' indent' irMap' html' comments'
+                                                          else (printElement e' (indent' + 1) irMap' html' comments' {-++ "\n"-}) ++ mapElements es' indent' irMap' html' (afterSpan (span' e') comments')
+          afterSpan s comments' = let (Span _ (Pos line _)) = s in dropWhile (\(x, _) -> let (Span _ (Pos line' _)) = x in line' <= line) comments'
+          span' (PosSubclafer s _) = s
+          span' (PosSubconstraint s _) = s
+          span' (PosClaferUse s _ _ _) = s
+          span' (PosSubgoal s _) = s
+          span' (PosSubsoftconstraint s _) = s
+          span' _ = noSpan
+printElements (PosElementsList _ es) indent irMap html comments = printElements (ElementsList es) indent irMap html comments
+
+printClafer :: Clafer -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printClafer (Clafer abstract gCard id' super' crd init' es) indent irMap html comments =
+  printIndentId indent html ++ 
+  claferDeclaration ++ 
+  printElements es indent irMap html comments ++
+  printIndentEnd html
+  where
+    claferDeclaration = concat [
+      printAbstract abstract html, 
+      printGCard gCard html,
+      printPosIdent id' Nothing html, 
+      printSuper super' indent irMap html comments, 
+      printCard crd, 
+      printInit init' indent irMap html comments]
+
+printClafer (PosClafer s abstract gCard id' super' crd init' es) indent irMap html comments =
+  preComments ++ 
+  printIndentId indent html ++ 
+  claferDeclaration ++ 
+  comment ++ 
+  printElements es indent irMap html comments'' ++
+  printIndentEnd html
+  where
+    uid' = getDivId s irMap;
+    (comments', preComments) = printPreComment s comments;
+    (comments'', comment) = printComment s comments'
+    claferDeclaration = concat [
+      printAbstract abstract html, 
+      printGCard gCard html,
+      printPosIdent id' (Just uid') html, 
+      printSuper super' indent irMap html comments, 
+      printCard crd, 
+      printInit init' indent irMap html comments]
+
+printGoal :: Goal -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String               
+printGoal (Goal exps') indent irMap html comments = 
+  (if html then "&lt;&lt;" else "<<") ++ 
+  concatMap (\x -> printExp x indent irMap html comments) exps' ++ 
+  if html then "&gt;&gt;" else ">>" 
+printGoal (PosGoal _ exps') indent irMap html comments = printGoal (Goal exps') indent irMap html comments
+
+printAbstract :: Abstract -> Bool -> String
+printAbstract Abstract html = (while html "<span class=\"keyword\">") ++ "abstract" ++ (while html "</span>") ++ " "
+printAbstract (PosAbstract _) html = printAbstract Abstract html
+printAbstract AbstractEmpty        _ = ""
+printAbstract (PosAbstractEmpty _) _ = ""
+
+printGCard :: GCard -> Bool -> String
+printGCard gCard html = case gCard of
+  (GCardInterval ncard) -> printNCard ncard
+  (PosGCardInterval _ ncard) -> printNCard ncard
+  GCardEmpty        -> ""
+  (PosGCardEmpty _) -> ""
+  GCardXor          -> (while html "<span class=\"keyword\">") ++ "xor" ++ (while html "</span>") ++ " "
+  (PosGCardXor _)   -> (while html "<span class=\"keyword\">") ++ "xor" ++ (while html "</span>") ++ " "
+  GCardOr           -> (while html "<span class=\"keyword\">") ++ "or"  ++ (while html "</span>") ++ " "
+  (PosGCardOr _)    -> (while html "<span class=\"keyword\">") ++ "or"  ++ (while html "</span>") ++ " "
+  GCardMux          -> (while html "<span class=\"keyword\">") ++ "mux" ++ (while html "</span>") ++ " "
+  (PosGCardMux _)   -> (while html "<span class=\"keyword\">") ++ "mux" ++ (while html "</span>") ++ " "
+  GCardOpt          -> (while html "<span class=\"keyword\">") ++ "opt" ++ (while html "</span>") ++ " "
+  (PosGCardOpt _)   -> (while html "<span class=\"keyword\">") ++ "opt" ++ (while html "</span>") ++ " "
+
+printNCard :: NCard -> String
+printNCard (NCard (PosInteger (_, num)) exInteger) = num ++ ".." ++ printExInteger exInteger ++ " "
+printNCard (PosNCard _ posinteger exinteger) = printNCard (NCard posinteger exinteger)
+  
+printExInteger :: ExInteger -> String    
+printExInteger ExIntegerAst = "*"
+printExInteger (PosExIntegerAst _) = printExInteger ExIntegerAst
+printExInteger (ExIntegerNum (PosInteger(_, num))) = num
+printExInteger (PosExIntegerNum _ posInteger) = printExInteger (ExIntegerNum posInteger)
+
+printName :: Name -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printName (Path modids) indent irMap html comments = unwords $ map (\x -> printModId x indent irMap html comments) modids
+printName (PosPath _ modids) indent irMap html comments = printName (Path modids) indent irMap html comments
+
+printModId :: ModId -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printModId (ModIdIdent posident) _ irMap html _ = printPosIdentRef posident irMap html
+printModId (PosModIdIdent _ posident) indent irMap html comments = printModId (ModIdIdent posident) indent irMap html comments
+
+printPosIdent :: PosIdent -> Maybe String -> Bool -> String
+printPosIdent (PosIdent (_, id')) Nothing _ = id'
+printPosIdent (PosIdent (_, id')) (Just uid') html = (while html $ "<span class=\"claferDecl\" id=\"" ++ uid' ++ "\">") ++ id' ++ (while html "</span>")
+
+printPosIdentRef :: PosIdent -> Map.Map Span [Ir] -> Bool -> String
+printPosIdentRef (PosIdent (p, id')) irMap html
+  = (while html ("<a href=\"#" ++ uid' ++ "\"><span class=\"reference\">")) ++ id' ++ (while html "</span></a>")
+      where uid' = getUid (PosIdent (p, id')) irMap
+
+printSuper :: Super -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printSuper SuperEmpty _ _ _ _ = ""
+printSuper (PosSuperEmpty _) indent irMap html comments = printSuper SuperEmpty indent irMap html comments
+printSuper (SuperSome superHow setExp) indent irMap html comments = printSuperHow superHow indent irMap html comments ++ printSetExp setExp indent irMap html comments
+printSuper (PosSuperSome _ superHow setExp) indent irMap html comments = printSuper (SuperSome superHow setExp) indent irMap html comments
+
+printSuperHow :: SuperHow -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printSuperHow SuperColon  _ _ html _ = (while html "<span class=\"keyword\">") ++ " :" ++ (while html "</span>") ++ " "
+printSuperHow (PosSuperColon _) indent irMap html comments = printSuperHow SuperColon indent irMap html comments
+printSuperHow SuperArrow  _ _ html _ = (while html "<span class=\"keyword\">") ++ " ->" ++ (while html "</span>") ++ " "
+printSuperHow (PosSuperArrow _) indent irMap html comments = printSuperHow SuperArrow indent irMap html comments
+printSuperHow SuperMArrow _ _ html _ = (while html "<span class=\"keyword\">") ++ " ->>" ++ (while html "</span>") ++ " "
+printSuperHow (PosSuperMArrow _) indent irMap html comments = printSuperHow SuperMArrow indent irMap html comments
+
+printCard :: Card -> String
+printCard CardEmpty = ""
+printCard (PosCardEmpty _) = printCard CardEmpty
+printCard CardLone = " ?"
+printCard (PosCardLone _) = printCard CardLone
+printCard CardSome = " +"
+printCard (PosCardSome _) = printCard CardSome
+printCard CardAny = " *"
+printCard (PosCardAny _) = printCard CardAny
+printCard (CardNum (PosInteger (_,num))) = " " ++ num 
+printCard (PosCardNum _ posInteger) = printCard (CardNum posInteger)
+printCard (CardInterval nCard) = " " ++ printNCard nCard
+printCard (PosCardInterval _ nCard) = printCard (CardInterval nCard)
+
+printConstraint ::  Constraint -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printConstraint (Constraint exps') indent irMap html comments = (concatMap (\x -> printConstraint' x indent irMap html comments) exps')
+printConstraint (PosConstraint _ exps') indent irMap html comments = printConstraint (Constraint exps') indent irMap html comments
+printConstraint' :: Exp -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printConstraint' exp' indent irMap html comments = 
+    while html "<span class=\"keyword\">" ++ "[" ++ while html "</span>" ++
+    " " ++ 
+    printExp exp' indent irMap html comments ++ 
+    " " ++ 
+    while html "<span class=\"keyword\">" ++ "]" ++ while html "</span>"
+
+printSoftConstraint :: SoftConstraint -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printSoftConstraint (SoftConstraint exps') indent irMap html comments = concatMap (\x -> printSoftConstraint' x indent irMap html comments) exps'
+printSoftConstraint (PosSoftConstraint _ exps') indent irMap html comments = printSoftConstraint (SoftConstraint exps') indent irMap html comments
+printSoftConstraint' :: Exp -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printSoftConstraint' exp' indent' irMap html comments = 
+    while html "<span class=\"keyword\">" ++ "(" ++ while html "</span>" ++ 
+    " " ++
+    printExp exp' indent' irMap html comments ++ 
+    " " ++ 
+    while html "<span class=\"keyword\">" ++ ")" ++ while html "</span>"
+
+printDecl :: Decl-> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printDecl (Decl locids setExp) indent irMap html comments = 
+  (concat $ intersperse "; " $ map printLocId locids) ++
+  (while html "<span class=\"keyword\">") ++ " : " ++ (while html "</span>") ++ printSetExp setExp indent irMap html comments
+  where
+    printLocId :: LocId -> String
+    printLocId (LocIdIdent (PosIdent (_, ident'))) = ident'
+    printLocId (PosLocIdIdent _ (PosIdent (_, ident'))) = ident'
+printDecl (PosDecl _ locids setExp) indent irMap html comments = printDecl (Decl locids setExp) indent irMap html comments
+
+printInit :: Init -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printInit InitEmpty _ _ _ _ = ""
+printInit (PosInitEmpty _) indent irMap html comments = printInit InitEmpty indent irMap html comments
+printInit (InitSome initHow exp') indent irMap html comments = printInitHow initHow  ++ printExp exp' indent irMap html comments
+printInit (PosInitSome _ initHow exp') indent irMap html comments = printInit (InitSome initHow exp') indent irMap html comments
+
+printInitHow :: InitHow -> String
+printInitHow InitHow_1  = " = "
+printInitHow (PosInitHow_1 _)  = printInitHow InitHow_1
+printInitHow InitHow_2  = " := "
+printInitHow (PosInitHow_2 _)  = printInitHow InitHow_2
+
+printExp :: Exp -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printExp (DeclAllDisj decl exp') indent irMap html comments = "all disj " ++ (printDecl decl indent irMap html comments) ++ " | " ++ (printExp exp' indent irMap html comments)
+printExp (PosDeclAllDisj _ decl exp') indent irMap html comments = printExp (DeclAllDisj decl exp') indent irMap html comments
+printExp (DeclAll     decl exp') indent irMap html comments = "all " ++ (printDecl decl indent irMap html comments) ++ " | " ++ (printExp exp' indent irMap html comments)
+printExp (PosDeclAll _ decl exp') indent irMap html comments = printExp (DeclAll decl exp') indent irMap html comments
+printExp (DeclQuantDisj quant' decl exp') indent irMap html comments = (printQuant quant' html) ++ "disj" ++ (printDecl decl indent irMap html comments) ++ " | " ++ (printExp exp' indent irMap html comments)
+printExp (PosDeclQuantDisj _ quant' decl exp') indent irMap html comments = printExp (DeclQuantDisj quant' decl exp') indent irMap html comments
+printExp (DeclQuant     quant' decl exp') indent irMap html comments = (printQuant quant' html) ++ (printDecl decl indent irMap html comments) ++ " | " ++ (printExp exp' indent irMap html comments)
+printExp (PosDeclQuant _ quant' decl exp') indent irMap html comments = printExp (DeclQuant quant' decl exp') indent irMap html comments
+printExp (EGMax exp')            indent irMap html comments = "max " ++ printExp exp' indent irMap html comments
+printExp (PosEGMax _ exp')     indent irMap html comments = printExp (EGMax exp') indent irMap html comments
+printExp (EGMin exp')            indent irMap html comments = "min " ++ printExp exp' indent irMap html comments
+printExp (PosEGMin _ exp') indent irMap html comments = printExp (EGMin exp') indent irMap html comments
+printExp (ENeq exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " != " ++ (printExp exp'2 indent irMap html comments)
+printExp (PosENeq _ exp'1 exp'2) indent irMap html comments = printExp (ENeq exp'1 exp'2) indent irMap html comments
+printExp (ESetExp setExp)       indent irMap html comments = printSetExp setExp indent irMap html comments
+printExp (PosESetExp _ setExp) indent irMap html comments = printExp (ESetExp setExp) indent irMap html comments
+printExp (QuantExp quant' exp')   indent irMap html comments = printQuant quant' html ++ printExp exp' indent irMap html comments
+printExp (PosQuantExp _ quant' exp') indent irMap html comments = printExp (QuantExp quant' exp') indent irMap html comments
+printExp (EImplies exp'1 exp'2)   indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " => " ++ printExp exp'2 indent irMap html comments
+printExp (PosEImplies _ exp'1 exp'2) indent irMap html comments = printExp (EImplies exp'1 exp'2) indent irMap html comments
+printExp (EAnd exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " && " ++ printExp exp'2 indent irMap html comments
+printExp (PosEAnd _ exp'1 exp'2) indent irMap html comments = printExp (EAnd exp'1 exp'2) indent irMap html comments
+printExp (EOr exp'1 exp'2)        indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " || " ++ printExp exp'2 indent irMap html comments
+printExp (PosEOr _ exp'1 exp'2) indent irMap html comments = printExp (EOr exp'1 exp'2) indent irMap html comments
+printExp (EXor exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " xor " ++ printExp exp'2 indent irMap html comments
+printExp (PosEXor _ exp'1 exp'2) indent irMap html comments = printExp (EXor exp'1 exp'2) indent irMap html comments
+printExp (ENeg exp')             indent irMap html comments = " ! " ++ printExp exp' indent irMap html comments
+printExp (PosENeg _ exp') indent irMap html comments = printExp (ENeg exp') indent irMap html comments
+printExp (ELt exp'1 exp'2)        indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ (if html then " &lt; " else " < ") ++ printExp exp'2 indent irMap html comments
+printExp (PosELt _ exp'1 exp'2) indent irMap html comments = printExp (ELt exp'1 exp'2) indent irMap html comments
+printExp (EGt exp'1 exp'2)        indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " > " ++ printExp exp'2 indent irMap html comments
+printExp (PosEGt _ exp'1 exp'2) indent irMap html comments = printExp (EGt exp'1 exp'2) indent irMap html comments
+printExp (EEq exp'1 exp'2)        indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " = " ++ printExp exp'2 indent irMap html comments
+printExp (PosEEq _ exp'1 exp'2) indent irMap html comments = printExp (EEq exp'1 exp'2) indent irMap html comments
+printExp (ELte exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ (if html then " &lt;= " else " <= ") ++ printExp exp'2 indent irMap html comments
+printExp (PosELte _ exp'1 exp'2) indent irMap html comments = printExp (ELte exp'1 exp'2) indent irMap html comments
+printExp (EGte exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " >= " ++ printExp exp'2 indent irMap html comments
+printExp (PosEGte _ exp'1 exp'2) indent irMap html comments = printExp (EGte exp'1 exp'2) indent irMap html comments
+printExp (EIn exp'1 exp'2)        indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " in " ++ printExp exp'2 indent irMap html comments
+printExp (PosEIn _ exp'1 exp'2) indent irMap html comments = printExp (EIn exp'1 exp'2) indent irMap html comments
+printExp (ENin exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " not in " ++ printExp exp'2 indent irMap html comments
+printExp (PosENin _ exp'1 exp'2) indent irMap html comments = printExp (ENin exp'1 exp'2) indent irMap html comments
+printExp (EIff exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ (if html then " &lt;=&gt; " else " <=> ") ++ printExp exp'2 indent irMap html comments
+printExp (PosEIff _ exp'1 exp'2) indent irMap html comments = printExp (EIff exp'1 exp'2) indent irMap html comments
+printExp (EAdd exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " + " ++ printExp exp'2 indent irMap html comments
+printExp (PosEAdd _ exp'1 exp'2) indent irMap html comments = printExp (EAdd exp'1 exp'2) indent irMap html comments
+printExp (ESub exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " - " ++ printExp exp'2 indent irMap html comments
+printExp (PosESub _ exp'1 exp'2) indent irMap html comments = printExp (ESub exp'1 exp'2) indent irMap html comments
+printExp (EMul exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " * " ++ printExp exp'2 indent irMap html comments
+printExp (PosEMul _ exp'1 exp'2) indent irMap html comments = printExp (EMul exp'1 exp'2) indent irMap html comments
+printExp (EDiv exp'1 exp'2)       indent irMap html comments = (printExp exp'1 indent irMap html comments) ++ " / " ++ printExp exp'2 indent irMap html comments
+printExp (PosEDiv _ exp'1 exp'2) indent irMap html comments = printExp (EDiv exp'1 exp'2) indent irMap html comments
+printExp (ESumSetExp exp') indent irMap html comments = "sum " ++ printExp exp' indent irMap html comments
+printExp (PosESumSetExp _ exp') indent irMap html comments = printExp (ESumSetExp exp') indent irMap html comments
+printExp (ECSetExp exp')         indent irMap html comments = "# " ++ printExp exp' indent irMap html comments
+printExp (PosECSetExp _ exp') indent irMap html comments = printExp (ECSetExp exp') indent irMap html comments
+printExp (EMinExp exp')          indent irMap html comments = "-" ++ printExp exp' indent irMap html comments
+printExp (PosEMinExp _ exp') indent irMap html comments = printExp (EMinExp exp') indent irMap html comments
+printExp (EImpliesElse exp'1 exp'2 exp'3) indent irMap html comments = "if " ++ (printExp exp'1 indent irMap html comments) ++ " then " ++ (printExp exp'2 indent irMap html comments) ++ " else " ++ (printExp exp'3 indent irMap html comments)
+printExp (PosEImpliesElse _ exp'1 exp'2 exp'3) indent irMap html comments = printExp (EImpliesElse exp'1 exp'2 exp'3) indent irMap html comments
+printExp (EInt (PosInteger (_, num))) _ _ _ _ = num
+printExp (PosEInt _ posInteger) indent irMap html comments = printExp (EInt posInteger) indent irMap html comments
+printExp (EDouble (PosDouble (_, num))) _ _ _ _ = num
+printExp (PosEDouble _ posDouble) indent irMap html comments = printExp (EDouble posDouble) indent irMap html comments
+printExp (EStr (PosString (_, str))) _ _ _ _ = str
+printExp (PosEStr _ posString) indent irMap html comments = printExp (EStr posString) indent irMap html comments
+
+printSetExp :: SetExp -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printSetExp (ClaferId name) indent irMap html comments = printName name indent irMap html comments
+printSetExp (PosClaferId _ name) indent irMap html comments = printSetExp (ClaferId name) indent irMap html comments
+printSetExp (Union set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ "++" ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosUnion _ set1 set2) indent irMap html comments = printSetExp (Union set1 set2) indent irMap html comments
+printSetExp (UnionCom set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ ", " ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosUnionCom _ set1 set2) indent irMap html comments = printSetExp (UnionCom set1 set2) indent irMap html comments
+printSetExp (Difference set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ "--" ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosDifference _ set1 set2) indent irMap html comments = printSetExp (Difference set1 set2) indent irMap html comments
+printSetExp (Intersection set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ "&" ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosIntersection _ set1 set2) indent irMap html comments = printSetExp (Intersection set1 set2) indent irMap html comments
+printSetExp (Domain set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ "<:" ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosDomain _ set1 set2) indent irMap html comments = printSetExp (Domain set1 set2) indent irMap html comments
+printSetExp (Range set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ ":>" ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosRange _ set1 set2) indent irMap html comments = printSetExp (Range set1 set2) indent irMap html comments
+printSetExp (Join set1 set2) indent irMap html comments = (printSetExp set1 indent irMap html comments) ++ "." ++ (printSetExp set2 indent irMap html comments)
+printSetExp (PosJoin _ set1 set2) indent irMap html comments = printSetExp (Join set1 set2) indent irMap html comments
+
+printQuant :: Quant -> Bool -> String
+printQuant quant' html = case quant' of
+  QuantNo        -> (while html "<span class=\"keyword\">") ++ "no" ++ (while html "</span>") ++ " "
+  PosQuantNo _   -> (while html "<span class=\"keyword\">") ++ "no" ++ (while html "</span>") ++ " "
+  QuantLone      -> (while html "<span class=\"keyword\">") ++ "lone" ++ (while html "</span>") ++ " "
+  PosQuantLone _ -> (while html "<span class=\"keyword\">") ++ "lone" ++ (while html "</span>") ++ " "
+  QuantOne       -> (while html "<span class=\"keyword\">") ++ "one" ++ (while html "</span>") ++ " "
+  PosQuantOne _  -> (while html "<span class=\"keyword\">") ++ "one" ++ (while html "</span>") ++ " "
+  QuantSome      -> (while html "<span class=\"keyword\">") ++ "some" ++ (while html "</span>") ++ " "
+  PosQuantSome _ -> (while html "<span class=\"keyword\">") ++ "some" ++ (while html "</span>") ++ " "
+
+printEnumId :: EnumId -> Int -> Map.Map Span [Ir] -> Bool -> [(Span, String)] -> String
+printEnumId (EnumIdIdent posident) _ irMap html _ = printPosIdent posident (Just uid') html
+  where
+    uid' = getUid posident irMap
+printEnumId (PosEnumIdIdent _ posident) indent irMap html comments = printEnumId (EnumIdIdent posident) indent irMap html comments
+
+printIndent :: Int -> Bool -> String
+printIndent 0 html = (while html "<div>") ++ "\n"
+printIndent _ html = (while html "<div class=\"indent\">") ++ "\n"
+
+printIndentId :: Int -> Bool -> String
+printIndentId 0 html = while html ("<div>") ++ "\n"
+printIndentId _ html = while html ("<div class=\"indent\">") ++ "\n"
+
+printIndentEnd :: Bool -> String
+printIndentEnd html = (while html "</div>") ++ "\n"
+
+dropUid :: String -> String
+dropUid uid' = let id' = rest $ dropWhile (/= '_') uid' 
+              in if id' == "" 
+                then uid' 
+                else id'
+
+--so it fails more gracefully on empty lists
+{-first :: String -> String
+first [] = []
+first (x:_) = x-}
+rest :: String -> String
+rest [] = []
+rest (_:xs) = xs
+
+getUid :: PosIdent -> Map.Map Span [Ir] -> String
+getUid posIdent@(PosIdent (_, id')) irMap = 
+    if Map.lookup (range posIdent) irMap == Nothing
+    then "Lookup failed"
+    else let IRPExp pexp = head $ fromJust $ Map.lookup (range posIdent) irMap in
+      findUid id' $ getIdentPExp pexp
+      where {getIdentPExp (PExp _ _ _ exp') = getIdentIExp exp';
+             getIdentIExp (IFunExp _ exps') = concatMap getIdentPExp exps';
+             getIdentIExp (IClaferId _ id'' _) = [id''];
+             getIdentIExp (IDeclPExp _ _ pexp) = getIdentPExp pexp;
+             getIdentIExp _ = [];
+             findUid name (x:xs) = if name == dropUid x then x else findUid name xs;
+             findUid _ []     = "Uid not found"}
+
+getDivId :: Span -> Map.Map Span [Ir] -> String
+getDivId s irMap = if Map.lookup s irMap == Nothing
+                      then "Uid not Found"
+                      else let IRClafer iClafer = head $ fromJust $ Map.lookup s irMap in
+                        uid iClafer
+
+{-getSuperId span irMap = if Map.lookup span irMap == Nothing
+                        then "Uid not Found"
+                        else let IRPExp pexp = head $ fromJust $ Map.lookup span irMap in
+                          sident $ exp pexp-}
+
+getUseId :: Span -> Map.Map Span [Ir] -> (String, String)
+getUseId s irMap = if Map.lookup s irMap == Nothing
+                      then ("Uid not Found", "Uid not Found")
+                      else let IRClafer iClafer = head $ fromJust $ Map.lookup s irMap in
+                        (uid iClafer, sident $ exp $ head $ supers $ super iClafer)
+
+while :: Bool -> String -> String
+while bool exp' = if bool then exp' else ""
+
+cleanOutput :: String -> String
+cleanOutput "" = ""
+cleanOutput (' ':'\n':xs) = cleanOutput $ '\n':xs
+cleanOutput ('\n':'\n':xs) = cleanOutput $ '\n':xs
+cleanOutput (' ':'<':'b':'r':'>':xs) = "<br>"++cleanOutput xs
+cleanOutput (x:xs) = x : cleanOutput xs
+
+trim :: String -> String
+trim = let f = reverse . dropWhile isSpace in f . f
+
+highlightErrors :: String -> [ClaferErr] -> String
+highlightErrors model errors = "<pre>\n" ++ unlines (replace "<!-- # FRAGMENT /-->" "</pre>\n<!-- # FRAGMENT /-->\n<pre>" --assumes the fragments have been concatenated
+													  (highlightErrors' (replace "//# FRAGMENT" "<!-- # FRAGMENT /-->" (lines model)) errors)) ++ "</pre>"
+	where
+		replace _ _ []     = []
+		replace x y (z:zs) = (if x == z then y else z):replace x y zs
+		
+highlightErrors' :: [String] -> [ClaferErr] -> [String]
+highlightErrors' model' [] = model'
+highlightErrors' model' ((ClaferErr _):es) = highlightErrors' model' es
+highlightErrors' model' ((ParseErr ErrPos{modelPos = Pos l c, fragId = n} msg'):es) =
+  let (ls, lss) = genericSplitAt (l + toInteger n) model'
+      newLine = fst (genericSplitAt (c - 1) $ last ls) ++ "<span class=\"error\" title=\"Parsing failed at line " ++ show l ++ " column " ++ show c ++
+				   "...\n" ++ msg' ++ "\">" ++ (if snd (genericSplitAt (c - 1) $ last ls) == "" then "&nbsp;" else snd (genericSplitAt (c - 1) $ last ls)) ++ "</span>"
+  in highlightErrors' (init ls ++ [newLine] ++ lss) es
+highlightErrors' model' ((SemanticErr ErrPos{modelPos = Pos l c, fragId = n} msg'):es) = 
+  let (ls, lss) = genericSplitAt (l + toInteger n) model'
+      newLine = fst (genericSplitAt (c - 1) $ last ls) ++ "<span class=\"error\" title=\"Compiling failed at line " ++ show l ++ " column " ++ show c ++
+				   "...\n" ++ msg' ++ "\">" ++ (if snd (genericSplitAt (c - 1) $ last ls) == "" then "&nbsp;" else snd (genericSplitAt (c - 1) $ last ls)) ++ "</span>"
+  in highlightErrors' (init ls ++ [newLine] ++ lss) es
+highlightErrors' _ _ = error "Function highlightErrors' from Html Generator did not expect a Parse/Sematic Err, given one." -- Should never happen
+ src/Language/Clafer/Generator/Python.hs view
@@ -0,0 +1,241 @@+{-
+ Copyright (C) 2012 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Generates Python representation of IR for the <https://github.com/gsdlab/ClaferZ3 ClaferZ3>.
+module Language.Clafer.Generator.Python where
+
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+import Data.Char
+
+tag:: String -> String -> String
+tag name exp' = concat ["<", name, ">", exp', "</", name, ">\n"]
+
+--Maybe a -> (a -> [Char]) -> [Char]
+--optTag elem f = maybe "" f elem
+
+tagType :: String -> String -> String -> String
+tagType name typename exp' = opening ++ rest
+  where
+  opening = concat ["<", name, " xsi:type=\"cl:", typename, "\""]
+  rest
+    | null exp' =" />"
+    | otherwise = concat [">", exp', "</", name, ">"]
+
+genPythonInteger :: Integer -> String
+genPythonInteger n = concat ["IntegerLiteral.IntegerLiteral(", show n, ")" ] -- might need to include IntegerLiteral
+
+isNull :: String -> String
+isNull [] = "\"\""
+isNull x = x
+
+boolHelper:: String -> String
+boolHelper (x:xs) = toUpper x : xs
+boolHelper [] = []
+
+genPythonBoolean :: String -> Bool -> String
+genPythonBoolean label b = concat [label, "=", boolHelper $ toLowerS $ show b]
+
+genPythonString :: String -> String
+genPythonString str = concat [ "StringLiteral.StringLiteral(", show str, ")"] -- might need to include StringLiteral
+
+genPythonIntPair :: (Integer, Integer) -> String
+genPythonIntPair (x, y) = concat
+  [ "(", genPythonInteger x 
+  , ","
+  , genPythonInteger y, ")"]
+
+-- | Generate an API for the IR in Python
+genPythonModule :: IModule -> Result
+genPythonModule imodule = concat
+  [ "from ast import Module\n"
+  , "from ast import GCard\n"
+  , "from ast import Supers\n"
+  , "from ast import Clafer\n"
+  , "from ast import Exp\n"
+  , "from ast import Declaration\n"
+  , "from ast import LocalDeclaration\n"
+  , "from ast import IRConstraint\n"
+  , "from ast import FunExp\n"
+  , "from ast import ClaferId\n"
+  , "from ast import DeclPExp\n"
+  , "from ast import Goal\n\n"
+  , "from ast import IntegerLiteral\n"
+  , "from ast import DoubleLiteral\n"
+  , "from ast import StringLiteral\n"
+  , "def getModule():\n"
+  , "\tstack = []\n"
+  , "\tmodule = Module.Module(\"\")\n"
+  , "\tstack.append(module)\n"
+  , concatMap genPythonElement $ mDecls imodule
+  , "\treturn module"
+  ]
+
+
+genPythonClafer :: IClafer -> Result
+genPythonClafer x = case x of
+  IClafer pos' abstract' gcard' id' uid' super' card' glcard' elements'  ->
+    concat [ "\t", genPythonPosition pos', "\n" 
+           , "\t", genPythonAbstract abstract', "\n"
+           , "\t", maybe "" genPythonGCard gcard', "\n"
+           , "\t", genPythonId id', "\n"
+           , "\t", genPythonUid uid', "\n"
+           , "\t", genPythonSuper super', "\n"
+           , "\t", maybe "" genPythonCard card', "\n"
+           , "\t", genPythonGlCard glcard', "\n"
+           , "\tcurrClafer = Clafer.Clafer(pos=pos, isAbstract=isAbstract, gcard=groupCard, ident=id, uid=uid, my_supers=my_supers, card=card, glCard=globalCard)\n"
+           , "\tstack[-1].addElement(currClafer)\n"
+           , "\tstack.append(currClafer)\n"
+           , concatMap genPythonElement elements'
+           , "\tstack.pop()\n"]
+  
+genPythonAbstract :: Bool -> String
+genPythonAbstract isAbstract' = concat [ genPythonBoolean "isAbstract" isAbstract']
+
+genPythonGCard :: IGCard -> String
+genPythonGCard (IGCard isKeyword' interval') = concat 
+		[ "groupCard = GCard.GCard(", genPythonBoolean "isKeyword" isKeyword', ", " 
+    	, "interval=" , genPythonInterval interval' , ")"]
+
+genPythonInterval :: (Integer, Integer) -> String
+genPythonInterval (nMin, nMax) = concat
+  [ "(", genPythonInteger nMin 
+  , ",", genPythonInteger nMax
+  , ")"]
+
+genPythonId :: String -> String
+genPythonId ident' = concat[ "id=\"", ident', "\""]
+
+genPythonUid :: String -> String
+genPythonUid uid' = concat [ "uid=\"", uid', "\""]
+
+genPythonSuper :: ISuper -> String
+genPythonSuper x = case x of
+  ISuper isOverlapping' pexps' -> concat
+    [ "my_supers = Supers.Supers(", genPythonBoolean "isOverlapping" isOverlapping', ", elements=["
+    , concatMap (genPythonPExp "Super") pexps' , "])"]
+
+genPythonCard :: (Integer, Integer) -> String
+genPythonCard interval' = concat [ "card=" , genPythonInterval interval']
+
+genPythonGlCard :: (Integer, Integer) -> String
+genPythonGlCard interval' = concat ["globalCard=", genPythonInterval interval']
+
+genPythonElement :: IElement -> String
+genPythonElement x = case x of
+  IEClafer clafer'  -> concat ["##### clafer #####\n" ,genPythonClafer clafer']
+  IEConstraint isHard' pexp'  -> concat
+                         [ "##### constraint #####\n", "\tconstraint = IRConstraint.IRConstraint(" , genPythonBoolean "isHard" isHard' , " ,"
+                         , " exp=", genPythonPExp "ParentExp" pexp' , ")\n"
+                         , "\tstack[-1].addElement(constraint)\n"]
+  IEGoal isMaximize' pexp' -> concat 
+                         [ "##### goal #####\n" ,"\tgoal = Goal.Goal(" , genPythonBoolean "isMaximize" isMaximize'
+                         , ", exp=", genPythonPExp "ParentExp" pexp' , ")\n"
+                         , "\tstack[-1].addElement(goal)\n"]
+                         
+                                                         
+{-genPythonAnyOp ft f xs = concatMap
+  (\(tname, texp) -> tagType tname (ft texp) $ f texp) xs -}
+
+
+genPythonPExp :: String -> PExp -> String
+genPythonPExp tagName (PExp iType' pid' pos' iexp') = concat
+  [ "\n\t\tExp.Exp","(expType=\"", tagName, "\", ", maybe "exptype=\"\"" genPythonIType iType'
+  , ", parentId=\"", pid', "\""
+  , ", " , genPythonPosition pos'
+  , ", iExpType=\"" , genPythonIExpType iexp' , "\"" 
+  , ", iExp=[" , genPythonIExp iexp' ,"])"]
+  
+genPythonPosition :: Span -> String
+genPythonPosition (Span (Pos s1 s2) (Pos e1 e2)) = concat
+  [ "pos=(", genPythonIntPair (s1, s2), ", ", genPythonIntPair (e1, e2), ")"]
+genPythonPosition (PosSpan _ s e) = genPythonPosition (Span s e)
+genPythonPosition (Span (PosPos _ s1 s2) e) = genPythonPosition (Span (Pos s1 s2) e)
+genPythonPosition (Span s (PosPos _ e1 e2)) = genPythonPosition (Span s (Pos e1 e2))
+
+genPythonIExpType :: IExp -> String
+genPythonIExpType x = case x of
+  IDeclPExp _ _ _ -> "IDeclarationParentExp"
+  IFunExp _ _ -> "IFunctionExp"
+  IInt _ -> "IIntExp"
+  IDouble _ -> "IDoubleExp"
+  IStr _ -> "IStringExp"
+  IClaferId _ _ _ -> "IClaferId"
+
+
+declHelper :: [IDecl] -> String
+declHelper [] = "None, "
+declHelper x = concatMap genPythonDecl x
+
+genPythonIExp :: IExp -> String
+genPythonIExp x = case x of
+  IDeclPExp quant' decls' pexp' -> concat
+    [ "DeclPExp.DeclPExp(" , "quantifier=\"", (genPythonQuantType quant'), "\", "
+    , "declaration=", declHelper decls'
+    , "bodyParentExp=" , genPythonPExp "BodyParentExp" pexp', ")"]
+  IFunExp op' exps' -> concat
+    [ "FunExp.FunExp(operation=\"" , (if op' == "-" && length exps' == 1 then "UNARY_MINUS" else op') , "\", elements="
+    , "[", concatMap (\y -> genPythonPExp "Argument" y ++",") (init exps') , genPythonPExp "Argument" (last exps') ,"])" ]
+{-    where
+    escape '\"'="&quot;"
+    escape '\''="&apos;"
+    escape '<' ="&lt;"
+    escape '>' ="&gt;"
+    escape '&' ="&amp;"
+    escape x    = [x] -}
+  IInt n -> genPythonInteger n
+  IDouble n ->  concat [ "DoubleLiteral.DoubleLiteral(", show n, ")"] --DoubleLiteral
+  IStr str -> genPythonString str  
+  IClaferId modName' sident' isTop' -> concat
+    [ "ClaferId.ClaferId(moduleName=\"", modName' , "\", "
+    , "my_id=\"", sident' , "\", "
+    , genPythonBoolean "isTop" isTop', ")"]
+
+
+genPythonDecl :: IDecl -> String
+genPythonDecl (IDecl disj locids pexp) = concat
+  [ "\n\t\tDeclaration.Declaration(" , genPythonBoolean "isDisjunct" disj, ", localDeclarations=["
+  , concatMap (\x -> "LocalDeclaration.LocalDeclaration(\"" ++ x ++ "\"), ") (init locids), "LocalDeclaration.LocalDeclaration(\"" , (last locids), "\")], "
+  , " body=", genPythonPExp "Body" pexp , "),"]
+
+
+genPythonQuantType :: IQuant -> String
+genPythonQuantType x = case x of
+  INo   -> "No"
+  ILone -> "Lone"
+  IOne  -> "One"
+  ISome -> "Some"
+  IAll  -> "All"
+
+genPythonITypeType :: IType -> String
+genPythonITypeType x = case x of
+  TBoolean -> "Boolean"
+  TString -> "String"
+  TInteger -> "Integer"
+  TReal -> "Real"
+  TClafer _-> "Set"
+  -- In the future, TRef might be needed in the Python IR.
+  -- For now, keep it simple.
+  --TRef t -> genPythonITypeType t
+
+genPythonIType :: IType -> String
+genPythonIType x = concat [ "exptype=\"", (genPythonITypeType x), "\"" ]
+ src/Language/Clafer/Generator/Schema.hs view
@@ -0,0 +1,435 @@+{-
+ Copyright (C) 2012 Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Generator.Schema where
+xsd :: String
+xsd = concat [ ""
+  , "<!-- ........................................................................ *\n"
+  , "  *   Clafer Project                                                          *\n"
+  , "  *   http://clafer.org                                                       *\n"
+  , "  *                                                                           *\n"
+  , "  *   File description: XML schema of Clafer intermediate representation (IR) *\n"
+  , "  *   Depends on: Haskell IR data types defined for clafer                    *\n"
+  , "  *   Author: Leonardo Passos <lpassos@gsd.uwaterloo.ca>                      *\n"
+  , "  *   Contributors: Jimmy Liang <jliang@gsd.uwaterloo.ca>                     *\n"
+  , "  *   Date: October 19th, 2011                                                *\n"
+  , "  *   Last update: April 16th, 2012                                           *\n"
+  , "  *                                                                           *\n"
+  , "  *   Generate scala classes with:                                            *\n"
+  , "  *   scalaxb -p gsd.clafer.ir ClaferIR.xsd                                   *\n"
+  , "  *           - -protocol-file ClaferIR_XmlProtocol.scala                     *\n"
+  , "  * ......................................................................... *\n"
+  , "  */\n"
+  , "-->\n"
+  , "<xs:schema targetNamespace=\"http://clafer.org/ir\"\n"
+  , "           elementFormDefault=\"qualified\"\n"
+  , "           xmlns=\"http://clafer.org/ir\"\n"
+  , "           xmlns:xs=\"http://www.w3.org/2001/XMLSchema\"\n"
+  , "           xmlns:cl=\"http://clafer.org/ir\">\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!--\n"
+  , "    data IType = TBoolean\n"
+  , "                 | TString\n"
+  , "                 | TInteger\n"
+  , "                 | TReal\n"
+  , "                 | TClafer\n"
+  , "  -->\n"
+  , "  <xs:complexType name=\"IType\" abstract=\"true\"/>\n"
+  , "  <xs:element name=\"Type\" type=\"cl:IType\"/>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IBoolean\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IType\"/>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IString\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IType\"/>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IInteger\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IType\"/>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "  \n"
+  , "  <xs:complexType name=\"IReal\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IType\"/>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"ISet\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IType\"/>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data IModule = IModule {\n"
+  , "      mName :: String,\n"
+  , "      mDecls :: [IElement]\n"
+  , "    }\n"
+  , "  -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IModule\">\n"
+  , "      <xs:sequence>\n"
+  , "          <xs:element name=\"Name\" type=\"xs:string\"/>\n"
+  , "          <xs:element ref=\"Declaration\" minOccurs=\"0\" maxOccurs=\"unbounded\"/>\n"
+  , "      </xs:sequence>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:element name=\"Module\" type=\"cl:IModule\"/>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data IClafer =\n"
+  , "       IClafer {\n"
+  , "          isAbstract :: Bool,     - determines whether it's abstract\n"
+  , "          gcard :: Maybe IGCard,  - group cardinality\n"
+  , "          ident :: String,        - name\n"
+  , "          uid :: String,          - (o) unique identifier\n"
+  , "          super:: ISuper,         - superclafers\n"
+  , "          card :: Maybe Interval, - cardinality\n"
+  , "          glCard :: Interval,     - (o) global cardinality\n"
+  , "          elements :: [IElement]  - subclafers or constraints specified in the context of given clafer\n"
+  , "        }\n"
+  , "  -->\n"
+  , "  <xs:complexType name=\"IClafer\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IElement\">\n"
+  , "            <xs:sequence>\n"
+  , "                <xs:element name=\"Position\">\n"
+  , "                  <xs:complexType>\n"
+  , "                      <xs:sequence>\n"
+  , "                          <xs:element name=\"Start\">\n"
+  , "                              <xs:complexType>\n"
+  , "                                  <xs:sequence>\n"
+  , "                                      <xs:element ref=\"IntLiteral\" minOccurs=\"2\" maxOccurs=\"2\"/>\n"
+  , "                                  </xs:sequence>\n"
+  , "                              </xs:complexType>\n"
+  , "                          </xs:element>\n"
+  , "                          <xs:element name=\"End\">\n"
+  , "                              <xs:complexType>\n"
+  , "                                  <xs:sequence>\n"
+  , "                                      <xs:element ref=\"IntLiteral\" minOccurs=\"2\" maxOccurs=\"2\"/>\n"
+  , "                                  </xs:sequence>\n"
+  , "                              </xs:complexType>\n"
+  , "                          </xs:element>\n"
+  , "                      </xs:sequence>\n"
+  , "                  </xs:complexType>\n"
+  , "                </xs:element>\n"
+  , "                <xs:element name=\"IsAbstract\" type=\"xs:boolean\"/>\n"
+  , "                <xs:element name=\"GroupCard\"  type=\"cl:IGroupCard\" minOccurs=\"0\" maxOccurs=\"1\"/>\n"
+  , "                <xs:element name=\"Id\"         type=\"xs:string\"/>\n"
+  , "                <xs:element name=\"UniqueId\"   type=\"xs:string\"/>\n"
+  , "                <xs:element name=\"Supers\"     type=\"cl:ISuper\"/>\n"
+  , "                <xs:element name=\"Card\"       type=\"cl:IInterval\" minOccurs=\"0\" maxOccurs=\"1\"/>\n"
+  , "                <xs:element name=\"GlobalCard\" type=\"cl:IInterval\"/>\n"
+  , "                <xs:element ref=\"Declaration\" minOccurs=\"0\" maxOccurs=\"unbounded\"/>\n"
+  , "            </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data IElement =\n"
+  , "       IEClafer IClafer\n"
+  , "     | IEConstraint {\n"
+  , "          isHard :: Bool,\n"
+  , "          cpexp :: PExp\n"
+  , "        }\n"
+  , "     | IEGoal {\n"
+  , "       isMaximize :: Bool,\n"
+  , "       cpexp :: PExp\n"
+  , "       }\n"
+  , "   -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IElement\" abstract=\"true\"/>\n"
+  , "  <xs:element name=\"Declaration\" type=\"IElement\"/>\n"
+  , "\n"
+  , "  <!-- No need to create IEClafer type. IClafer is already a subtype\n"
+  , "       of IElement\n"
+  , "    -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IConstraint\">\n"
+  , "    <xs:complexContent>\n"
+  , "      <xs:extension base=\"cl:IElement\">\n"
+  , "          <xs:sequence>\n"
+  , "              <xs:element name=\"IsHard\"    type=\"xs:boolean\"/>\n"
+  , "              <xs:element name=\"ParentExp\" type=\"cl:IParentExp\"/>\n"
+  , "          </xs:sequence>\n"
+  , "      </xs:extension>\n"
+  , "\n"
+  , "    </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IGoal\">\n"
+  , "    <xs:complexContent>\n"
+  , "      <xs:extension base=\"cl:IElement\">\n"
+  , "          <xs:sequence>\n"
+  , "              <xs:element name=\"IsMaximize\"    type=\"xs:boolean\"/>\n"
+  , "              <xs:element name=\"ParentExp\" type=\"cl:IParentExp\"/>\n"
+  , "          </xs:sequence>\n"
+  , "      </xs:extension>\n"
+  , "\n"
+  , "    </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data ISuper =\n"
+  , "       ISuper {\n"
+  , "          isOverlapping :: Bool,\n"
+  , "          supers :: [PExp]\n"
+  , "        }\n"
+  , "  -->\n"
+  , "  <xs:complexType name=\"ISuper\">\n"
+  , "    <xs:sequence>\n"
+  , "        <xs:element name=\"IsOverlapping\" type=\"xs:boolean\"/>\n"
+  , "        <xs:element name=\"Super\"         type=\"cl:IParentExp\" minOccurs=\"0\" maxOccurs=\"unbounded\"/>\n"
+  , "    </xs:sequence>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data IGCard =\n"
+  , "      IGCard {\n"
+  , "          isKeyword :: Bool,\n"
+  , "          interval :: Interval\n"
+  , "        }\n"
+  , "  -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IGroupCard\">\n"
+  , "    <xs:sequence>\n"
+  , "        <xs:element name=\"IsKeyword\" type=\"xs:boolean\"/>\n"
+  , "        <xs:element name=\"Interval\"  type=\"cl:IInterval\"/>\n"
+  , "    </xs:sequence>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- type Interval = (Integer, ExInteger) -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IInterval\">\n"
+  , "      <xs:sequence>\n"
+  , "          <xs:element name=\"Min\">\n"
+  , "            <xs:complexType>\n"
+  , "                <xs:sequence>\n"
+  , "                    <xs:element ref=\"IntLiteral\"/>\n"
+  , "                </xs:sequence>\n"
+  , "            </xs:complexType>\n"
+  , "          </xs:element>\n"
+  , "          <xs:element name=\"Max\">\n"
+  , "            <xs:complexType>\n"
+  , "                <xs:sequence>\n"
+  , "                    <xs:element ref=\"IntLiteral\"/>\n"
+  , "                </xs:sequence>\n"
+  , "            </xs:complexType>\n"
+  , "          </xs:element>\n"
+  , "      </xs:sequence>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .-->\n"
+  , "  <!-- data PExp = PExp {\n"
+  , "      iType :: Maybe IType,\n"
+  , "      pid :: String,\n"
+  , "      exp :: IExp\n"
+  , "    }\n"
+  , "  -->\n"
+  , "\n"
+  , "  <xs:complexType name=\"IParentExp\">\n"
+  , "      <xs:sequence>\n"
+  , "          <xs:element name=\"Type\"     type=\"cl:IType\" minOccurs=\"0\" maxOccurs=\"1\"/>\n"
+  , "          <xs:element name=\"ParentId\" type=\"xs:string\" minOccurs=\"0\" maxOccurs=\"1\"/>\n"
+  , "          <xs:element name=\"Position\">\n"
+  , "              <xs:complexType>\n"
+  , "                  <xs:sequence>\n"
+  , "                      <xs:element name=\"Start\">\n"
+  , "                          <xs:complexType>\n"
+  , "                              <xs:sequence>\n"
+  , "                                  <xs:element ref=\"IntLiteral\" minOccurs=\"2\" maxOccurs=\"2\"/>\n"
+  , "                              </xs:sequence>\n"
+  , "                          </xs:complexType>\n"
+  , "                      </xs:element>\n"
+  , "                      <xs:element name=\"End\">\n"
+  , "                          <xs:complexType>\n"
+  , "                              <xs:sequence>\n"
+  , "                                  <xs:element ref=\"IntLiteral\" minOccurs=\"2\" maxOccurs=\"2\"/>\n"
+  , "                              </xs:sequence>\n"
+  , "                          </xs:complexType>\n"
+  , "                      </xs:element>\n"
+  , "                  </xs:sequence>\n"
+  , "              </xs:complexType>\n"
+  , "          </xs:element>\n"
+  , "          <xs:element name=\"Exp\"      type=\"cl:IExp\"/>\n"
+  , "      </xs:sequence>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "\n"
+  , "  <!-- ......................................................................-->\n"
+  , "  <!--\n"
+  , "    data IExp =\n"
+  , "       - quantified expression  declarations\n"
+  , "       IDeclPExp {quant :: IQuant, oDecls :: [IDecl], bpexp :: PExp}\n"
+  , "     | IFunExp {op :: String, exps :: [PExp]}\n"
+  , "     | IInt Integer                  - integer number\n"
+  , "     | IDouble Double                - real number\n"
+  , "     | IStr String                   - string\n"
+  , "     | IClaferId {                   - clafer name\n"
+  , "          modName :: String,         - module name\n"
+  , "          sident :: String,          - name\n"
+  , "          isTop :: Bool              - identifier refers to a top-level definition\n"
+  , "        }\n"
+  , "   -->\n"
+  , "  <xs:complexType name=\"IExp\" abstract=\"true\"/>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IDeclarationParentExp\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"cl:IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                  <xs:element name=\"Quantifier\"    type=\"cl:IQuantifier\"/>\n"
+  , "                  <xs:element name=\"Declaration\"   type=\"cl:IDeclaration\" minOccurs=\"0\" maxOccurs=\"unbounded\"/>\n"
+  , "                  <xs:element name=\"BodyParentExp\" type=\"cl:IParentExp\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IFunctionExp\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                  <xs:element name=\"Operation\" type=\"xs:string\"/>\n"
+  , "                  <xs:element name=\"Argument\" minOccurs=\"0\" maxOccurs=\"unbounded\" type=\"IParentExp\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IIntExp\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                 <xs:element ref=\"IntLiteral\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IDoubleExp\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                 <xs:element ref=\"DoubleLiteral\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <xs:complexType name=\"IStringExp\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                 <xs:element ref=\"StringLiteral\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "\n"
+  , "  <xs:complexType name=\"IClaferId\">\n"
+  , "      <xs:complexContent>\n"
+  , "          <xs:extension base=\"IExp\">\n"
+  , "              <xs:sequence>\n"
+  , "                  <xs:element name=\"ModuleName\" type=\"xs:string\" minOccurs=\"0\" maxOccurs=\"1\"/>\n"
+  , "                  <xs:element name=\"Id\"         type=\"xs:string\" />\n"
+  , "                  <xs:element name=\"IsTop\"      type=\"xs:boolean\"/>\n"
+  , "              </xs:sequence>\n"
+  , "          </xs:extension>\n"
+  , "      </xs:complexContent>\n"
+  , "  </xs:complexType>\n"
+  , "\n"
+  , "  <!-- ......................................................................-->\n"
+  , "  <!-- data IDecl =\n"
+  , "       IDecl {\n"
+  , "          isDisj :: Bool,     - is disjunct\n"
+  , "          decls :: [String],  - a list of local names\n"
+  , "          body :: PExp        - set to which local names refer to\n"
+  , "        }\n"
+  , "    -->\n"
+  , "\n"
+  , "   <xs:complexType name=\"IDeclaration\">\n"
+  , "       <xs:sequence>\n"
+  , "           <xs:element name=\"IsDisjunct\"       type=\"xs:boolean\"/>\n"
+  , "           <xs:element name=\"LocalDeclaration\" type=\"xs:string\" minOccurs=\"0\" maxOccurs=\"unbounded\"/>\n"
+  , "           <xs:element name=\"Body\"             type=\"cl:IParentExp\"/>\n"
+  , "       </xs:sequence>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , "  <!-- ......................................................................-->\n"
+  , "  <!-- data IQuant =\n"
+  , "        INo\n"
+  , "        | ILone\n"
+  , "        | IOne\n"
+  , "        | ISome\n"
+  , "        | IAll\n"
+  , "   -->\n"
+  , "\n"
+  , "   <xs:complexType name=\"IQuantifier\" abstract=\"true\"/>\n"
+  , "\n"
+  , "   <xs:complexType name=\"INo\">\n"
+  , "       <xs:complexContent>\n"
+  , "           <xs:extension base=\"cl:IQuantifier\"/>\n"
+  , "       </xs:complexContent>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , "   <xs:complexType name=\"ILone\">\n"
+  , "       <xs:complexContent>\n"
+  , "           <xs:extension base=\"cl:IQuantifier\"/>\n"
+  , "       </xs:complexContent>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , "   <xs:complexType name=\"IOne\">\n"
+  , "       <xs:complexContent>\n"
+  , "           <xs:extension base=\"cl:IQuantifier\"/>\n"
+  , "       </xs:complexContent>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , "   <xs:complexType name=\"ISome\">\n"
+  , "       <xs:complexContent>\n"
+  , "           <xs:extension base=\"cl:IQuantifier\"/>\n"
+  , "       </xs:complexContent>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , "   <xs:complexType name=\"IAll\">\n"
+  , "       <xs:complexContent>\n"
+  , "           <xs:extension base=\"cl:IQuantifier\"/>\n"
+  , "       </xs:complexContent>\n"
+  , "   </xs:complexType>\n"
+  , "\n"
+  , " <!-- ......................................................................-->\n"
+  , "\n"
+  , " <xs:element name=\"IntLiteral\"    type=\"xs:integer\"/>\n"
+  , " <xs:element name=\"DoubleLiteral\" type=\"xs:double\"/>\n"
+  , " <xs:element name=\"StringLiteral\" type=\"xs:string\"/>\n"
+  , "\n"
+  , "</xs:schema>\n"
+  , ""]
+ src/Language/Clafer/Generator/Stats.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleContexts #-}
+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Generator.Stats where
+
+import Control.Monad.State
+import Language.Clafer.Intermediate.Intclafer
+
+data Stats = Stats {
+      naClafers :: Int,
+      nrClafers :: Int,
+      ncClafers :: Int,
+      nConstraints :: Int,
+      nGoals :: Int,
+      sglCard :: Interval
+    } deriving Show
+
+
+statsModule :: IModule -> Stats
+statsModule imodule =
+  execState (mapM statsElement $ mDecls imodule) $ Stats 0 0 0 0 0 (1, 1)
+
+statsClafer :: MonadState Stats m => IClafer -> m ()
+statsClafer claf = do
+  if isAbstract claf
+    then modify (\e -> e {naClafers = naClafers e + 1})
+    else
+      if isOverlapping $ super claf
+        then modify (\e -> e {nrClafers = nrClafers e + 1})
+        else modify (\e -> e {ncClafers = ncClafers e + 1})
+  sglCard' <- gets sglCard
+  modify (\e -> e {sglCard = statsCard sglCard' $ glCard claf})
+  mapM_ statsElement $ elements claf
+
+
+statsCard :: Interval -> Interval -> Interval
+statsCard (m1, n1) (m2, n2) = (max m1 m2, maxEx n1 n2)
+  where
+  maxEx m' n' = if m' == -1 || n' == -1 then -1 else max m' n'
+
+statsElement :: MonadState Stats m => IElement -> m ()
+statsElement x = case x of
+  IEClafer clafer -> statsClafer clafer
+  IEConstraint _ _ -> modify (\e -> e {nConstraints = nConstraints e + 1})
+  IEGoal _ _ -> modify (\e -> e {nGoals = nGoals e + 1})
+ src/Language/Clafer/Generator/Xml.hs view
@@ -0,0 +1,202 @@+{-
+ Copyright (C) 2012 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Generates a XML representation of IR conforming to the ClaferIR.xsd.
+module Language.Clafer.Generator.Xml where
+
+-- import Text.XML.HaXml.XmlContent.Haskell hiding (Result)
+
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+
+tag :: String -> String -> String
+tag name exp' = concat ["<", name, ">", exp', "</", name, ">\n"]
+
+optTag :: Maybe a -> (a -> String) -> String
+optTag ele f = maybe "" f ele
+
+tagType :: String -> String -> String -> String
+tagType name typename exp' = opening ++ rest
+  where
+  opening = concat ["<", name, " xsi:type=\"cl:", typename, "\""]
+  rest
+    | null exp'  = " />"
+    | otherwise = concat [">", exp', "</", name, ">"]
+
+genXmlInteger :: Integer -> String
+genXmlInteger n = tag "IntLiteral" $ show n
+
+genXmlBoolean :: String -> Bool -> String
+genXmlBoolean label b = tag label $ toLowerS $ show b
+
+genXmlString :: String -> String
+genXmlString str = tag "StringLiteral" str
+
+genXmlIntPair :: (Integer, Integer) -> String
+genXmlIntPair (x, y) = concat
+  [ genXmlInteger x
+  , genXmlInteger y]
+
+-- | Generate an XML representation of the IR
+genXmlModule :: IModule -> Result
+genXmlModule imodule = concat
+  [ "<?xml version=\"1.0\"?>"
+  , "<Module xmlns=\"http://clafer.org/ir\""
+  , " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\""
+  , " xmlns:cl=\"http://clafer.org/ir\""
+  , " xsi:schemaLocation=\"http://clafer.org/ir https://github.com/gsdlab/clafer/blob/master/src/ClaferIR.xsd\">"
+  , tag "Name" $ mName imodule
+  , concatMap genXmlElement $ mDecls imodule
+  , "</Module>"]
+
+
+genXmlClafer :: IClafer -> Result
+genXmlClafer x = case x of
+  IClafer pos abstract gcrd id' uid' super' crd glcard es  ->
+    concat [ tag "Position" $ genXmlPosition pos
+           , genXmlAbstract abstract
+           , optTag gcrd genXmlGCard
+           , genXmlId id'
+           , genXmlUid uid'
+           , genXmlSuper super'
+           , optTag crd genXmlCard
+           , genXmlGlCard glcard
+           , concatMap genXmlElement es]
+
+genXmlAbstract :: Bool -> String
+genXmlAbstract isAbs = genXmlBoolean "IsAbstract" isAbs
+
+genXmlGCard :: IGCard -> String
+genXmlGCard (IGCard isKeyword' interval') = tag "GroupCard" $ concat
+  [ genXmlBoolean "IsKeyword" isKeyword'
+  , tag "Interval" $ genXmlInterval interval']
+
+genXmlInterval :: (Integer, Integer) -> String
+genXmlInterval (nMin, nMax) = concat
+  [ tag "Min" $ genXmlInteger nMin
+  , tag "Max" $ genXmlInteger nMax]
+
+genXmlId :: String -> String
+genXmlId ident' = tag "Id" ident'
+
+genXmlUid :: String -> String
+genXmlUid uid' = tag "UniqueId" uid'
+
+genXmlSuper :: ISuper -> String
+genXmlSuper x = case x of
+  ISuper isOverlapping' pexps -> tag "Supers" $ concat
+    [ genXmlBoolean "IsOverlapping" isOverlapping'
+    , concatMap (genXmlPExp "Super") pexps]
+
+genXmlCard :: (Integer, Integer) -> String
+genXmlCard interval' = tag "Card" $ genXmlInterval interval'
+
+genXmlGlCard :: (Integer, Integer) -> String
+genXmlGlCard interval' = tag "GlobalCard" $ genXmlInterval interval'
+
+genXmlElement :: IElement -> String
+genXmlElement x = case x of
+  IEClafer clafer  -> tagType "Declaration" "IClafer" $ genXmlClafer clafer
+  IEConstraint isHard' pexp  -> tagType "Declaration" "IConstraint" $ concat
+                         [ genXmlBoolean "IsHard" isHard'
+                         , genXmlPExp "ParentExp" pexp]
+  IEGoal isMaximize' pexp -> tagType "Declaration" "IGoal" $ concat 
+                         [ genXmlBoolean "IsMaximize" isMaximize'
+                         , genXmlPExp "ParentExp" pexp]
+                         
+
+genXmlAnyOp :: (a -> String) -> (a -> String) -> [(String, a)] -> String                                                    
+genXmlAnyOp ft f xs = concatMap
+  (\(tname, texp) -> tagType tname (ft texp) $ f texp) xs
+
+genXmlPExp :: String -> PExp -> String
+genXmlPExp tagName (PExp iType' pid' pos' iexp) = tag tagName $ concat
+  [ optTag iType' genXmlIType
+  , tag "ParentId" pid'
+  , tag "Position" $ genXmlPosition pos'
+  , tagType "Exp" (genXmlIExpType iexp) $ genXmlIExp iexp]
+
+genXmlPosition :: Span -> String
+genXmlPosition (Span (Pos s1 s2) (Pos e1 e2)) = concat
+  [ tag "Start" $ genXmlIntPair (s1, s2)
+  , tag "End"   $ genXmlIntPair (e1, e2)]
+genXmlPosition (PosSpan _ s e) = genXmlPosition (Span s e)
+genXmlPosition (Span (PosPos _ s1 s2) e) = genXmlPosition (Span (Pos s1 s2) e)
+genXmlPosition (Span s (PosPos _ e1 e2)) = genXmlPosition (Span s (Pos e1 e2))
+
+genXmlIExpType :: IExp -> String
+genXmlIExpType x = case x of
+  IDeclPExp _ _ _ -> "IDeclarationParentExp"
+  IFunExp _ _ -> "IFunctionExp"
+  IInt _ -> "IIntExp"
+  IDouble _ -> "IDoubleExp"
+  IStr _ -> "IStringExp"
+  IClaferId _ _ _ -> "IClaferId"
+
+genXmlIExp :: IExp -> String
+genXmlIExp x = case x of
+  IDeclPExp quant' decls' pexp -> concat
+    [ tagType "Quantifier" (genXmlQuantType quant') ""
+    , concatMap genXmlDecl decls'
+    , genXmlPExp "BodyParentExp" pexp]
+  IFunExp op' exps' -> concat
+    [ tag "Operation" $ concatMap escape op'
+    , concatMap (genXmlPExp "Argument") exps']
+    where
+    escape '\"' = "&quot;"
+    escape '\'' = "&apos;"
+    escape '<'  = "&lt;"
+    escape '>'  = "&gt;"
+    escape '&'  = "&amp;"
+    escape y    = [y]
+  IInt n -> genXmlInteger n
+  IDouble n -> tag "DoubleLiteral" $ show n
+  IStr str -> genXmlString str  
+  IClaferId modName' sident' isTop' -> concat
+    [ tag "ModuleName" modName'
+    , tag "Id" sident'
+    , genXmlBoolean "IsTop" isTop']
+
+genXmlDecl :: IDecl -> String
+genXmlDecl (IDecl disj locids pexp) = tag "Declaration" $ concat
+  [ genXmlBoolean "IsDisjunct" disj
+  , concatMap (tag "LocalDeclaration") locids
+  , genXmlPExp "Body" pexp]
+
+genXmlQuantType :: IQuant -> String
+genXmlQuantType x = case x of
+  INo   -> "INo"
+  ILone -> "ILone"
+  IOne  -> "IOne"
+  ISome -> "ISome"
+  IAll  -> "IAll"
+
+genXmlITypeType :: IType -> String
+genXmlITypeType x = case x of
+  TBoolean -> "IBoolean"
+  TString -> "IString"
+  TInteger -> "IInteger"
+  TReal -> "IReal"
+  TClafer _ -> "ISet"
+
+genXmlIType :: IType -> String
+genXmlIType x = tagType "Type" (genXmlITypeType x) ""
+ src/Language/Clafer/Intermediate/Analysis.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE NamedFieldPuns, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, StandaloneDeriving #-}
+
+{-
+ Copyright (C) 2012 Jimmy Liang, Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+
+{-
+ - Common methods for analyzing Clafer model.
+ -}
+module Language.Clafer.Intermediate.Analysis where
+
+import Language.Clafer.Front.Absclafer hiding (Path)
+import qualified Language.Clafer.Intermediate.Intclafer as I
+import Language.Clafer.Intermediate.Desugarer
+import Language.Clafer.Front.Printclafer
+import Control.Applicative
+import Control.Monad.LPMonad.Supply
+import Control.Monad.Error
+import Control.Monad.Identity
+import Control.Monad.List
+import Control.Monad.Maybe
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import Data.Either
+import Data.List
+import Data.Maybe
+
+
+
+newtype AnalysisT m a = AnalysisT (ReaderT Info m a)
+  deriving (Monad, Functor, MonadReader Info, MonadState s, MonadTrans, MonadPlus, MonadError e, Applicative)
+  
+type Analysis = AnalysisT Identity
+
+class (Monad m, Functor m) => MonadAnalysis m where
+  clafers :: m [SClafer]
+  withClafers :: [SClafer] -> m a -> m a
+  
+withExtraClafers :: MonadAnalysis m => [SClafer] -> m a -> m a
+withExtraClafers cs a =
+    do
+        c <- clafers
+        withClafers (cs ++ c) a
+  
+instance (Monad m, Functor m) => MonadAnalysis (AnalysisT m) where
+  clafers = AnalysisT $ asks sclafers
+  withClafers cs = local (const $ Info cs)
+    
+instance (Error e, MonadAnalysis m) => MonadAnalysis (ErrorT e m) where
+  clafers = lift clafers
+  withClafers = mapErrorT . withClafers
+  
+instance MonadAnalysis m => MonadAnalysis (ListT m) where
+  clafers = lift clafers
+  withClafers = mapListT . withClafers
+
+instance MonadAnalysis m => MonadAnalysis (MaybeT m) where
+  clafers = lift clafers
+  withClafers = mapMaybeT . withClafers
+
+instance MonadAnalysis m => MonadAnalysis (ReaderT r m) where
+  clafers = lift clafers
+  withClafers = mapReaderT . withClafers
+
+instance (Monoid w, MonadAnalysis m) => MonadAnalysis (WriterT w m) where
+  clafers = lift clafers
+  withClafers = mapWriterT . withClafers
+  
+instance MonadAnalysis m => MonadAnalysis (VSupplyT m) where
+  clafers = lift clafers
+  withClafers = mapVSupplyT . withClafers
+  
+isConcrete :: SClafer -> Bool
+isConcrete = not . isAbstract
+
+isBase :: SClafer -> Bool
+isBase = (`elem` ["clafer", "string", "real", "int", "integer", "boolean"]) . uid
+
+isDerived :: SClafer -> Bool
+isDerived = not . isBase
+ 
+
+data SSuper = Ref String | Colon String deriving Show
+-- | Easier to work with. IClafers have links from parents to children. SClafers have links from children to parent.
+data SClafer = SClafer {uid::String, origUid::String, isAbstract::Bool, low::Integer, high::Integer, groupLow::Integer, groupHigh::Integer, parent::Maybe String, super::Maybe SSuper, constraints::[I.PExp]} deriving Show
+  
+data Info = Info{sclafers :: [SClafer]} deriving Show 
+
+runAnalysis :: Analysis a -> Info -> a
+runAnalysis r info = runIdentity $ runAnalysisT r info
+
+runAnalysisT :: AnalysisT m a -> Info -> m a
+runAnalysisT (AnalysisT r) info = runReaderT r info
+
+claferWithUid :: MonadAnalysis m => String -> m SClafer
+claferWithUid u =
+  do
+    c <- clafers
+    case find ((==) u . uid) c of
+      Just c' -> return c'
+      Nothing -> error $ "claferWithUid: Unknown uid " ++ u
+      
+parentUid :: Monad m => SClafer -> m String
+parentUid clafer =
+  case parent clafer of
+    Just p  -> return p
+    Nothing -> fail $ "No parent uid for " ++ show clafer
+    
+parentOf :: (Uidable c, MonadAnalysis m) => c -> m c
+parentOf clafer = fromUid =<< parentUid =<< toClafer clafer
+
+parentsOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+parentsOf clafer =
+  do
+    r <- runMaybeT $ parentOf clafer
+    case r of
+         Just r' -> (r' :) <$> parentsOf r'
+         Nothing -> return []
+
+ancestorsOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+ancestorsOf clafer = (clafer :) <$> parentsOf clafer
+
+directChildrenOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+directChildrenOf c =
+  do
+    cs <- (anything |^ c) `select` fst
+    mapM fromClafer cs
+
+directDescendantsOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+directDescendantsOf c =
+  do
+    cs <- (anything |^ c) `select` fst
+    css <- mapM directDescendantsOf cs
+    mapM fromClafer $ cs ++ concat css
+
+topNonRootAncestor :: (Uidable c, MonadAnalysis m) => c -> m c
+topNonRootAncestor clafer =
+  do
+    uid' <- toUid clafer
+    when (uid' == rootUid) $ error "Root does not have a non root ancestor."
+    (head . tail . reverse) <$> ancestorsOf clafer
+
+refUid :: Monad m => SClafer -> m String
+refUid clafer =
+  case super clafer of
+    Just (Ref u)  -> return u
+    _             -> fail $ "No ref uid for " ++ show clafer
+
+refOf :: (Uidable c, MonadAnalysis m) => c -> m c
+refOf clafer = fromUid =<< refUid =<< toClafer clafer
+
+refsOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+refsOf clafer =
+  do
+    r <- runMaybeT $ refOf clafer
+    case r of
+         Just r' -> (r' :) <$> refsOf r'
+         Nothing -> return []
+
+colonUid :: (Uidable c, MonadAnalysis m) => c -> m String
+colonUid c =
+  do
+    clafer <- toClafer c
+    case super clafer of
+      Just (Colon u)  -> return u
+      _               -> fail $ "No colon uid for " ++ show clafer
+
+colonOf :: (Uidable c, MonadAnalysis m) => c -> m c
+colonOf clafer = fromUid =<< colonUid =<< toClafer clafer
+
+colonsOf :: (Uidable c, MonadAnalysis m) => c -> m [c]
+colonsOf clafer =
+  do
+    r <- runMaybeT $ colonOf clafer
+    case r of
+         Just r' -> (r' :) <$> colonsOf r'
+         Nothing -> return []
+
+-- "subclafers"
+colonsTo :: (Uidable c, MonadAnalysis m) => c -> m [c]
+colonsTo clafer =
+    runListT $ do
+        (sub, _) <- foreach $ anything |: clafer
+        fromClafer =<< (return sub `mplus` foreach ( colonsTo sub))
+
+    
+
+hierarchy :: (Uidable c, MonadAnalysis m) => c -> m [c]
+hierarchy t = (t :) <$> colonsOf t
+
+{-
+ - C is a direct child of B.
+ -
+ -  B
+ -    C
+ -}
+isDirectChild :: (Uidable c, MonadAnalysis m) => c -> c -> m Bool
+isDirectChild c p = (not . null) <$> (c |^ p)
+ 
+{-
+ - C is an direct child of B.
+ -
+ -  abstract A
+ -    C
+ -  B : A
+ -}
+isIndirectChild :: (Uidable c, MonadAnalysis m) => c -> c -> m Bool
+isIndirectChild c p =
+  fromMaybeT False $ do
+    child <- toClafer c
+    parent <- toClafer p
+    s <- colonOf parent
+    when (uid s == "clafer") mzero
+    isChild child s
+
+isChild :: (Uidable c, MonadAnalysis m) => c -> c -> m Bool
+isChild child parent =
+  liftM2 (||) (isDirectChild child parent) (isIndirectChild child parent)
+  
+class Matchable c => Uidable c where
+  toClafer :: MonadAnalysis m => c -> m SClafer
+  fromClafer :: MonadAnalysis m => SClafer -> m c
+  toUid :: MonadAnalysis m => c -> m String
+  fromUid :: MonadAnalysis m => String -> m c
+  
+instance Uidable SClafer where
+  toClafer = return
+  fromClafer = return
+  toUid = return . uid
+  fromUid = claferWithUid
+  
+instance Uidable String where
+  toClafer = claferWithUid
+  fromClafer = return . uid
+  toUid = return
+  fromUid = return
+
+data Anything = Anything
+
+class Matchable u where
+  matches :: u -> SClafer -> Bool
+  
+instance Matchable String where
+  matches s c = s == uid c
+  
+instance Matchable Anything where
+  matches _ _ = True
+  
+instance Matchable SClafer where
+  matches c1 c2 = uid c1 == uid c2
+
+anything :: Anything
+anything = Anything
+
+
+-- a is a child of b
+(|^) :: (MonadAnalysis m, Matchable a, Matchable b) => a -> b -> m [(SClafer, SClafer)]
+lower |^ upper = runListT $ do
+    clafer <- foreach clafers
+    guard $ matches lower clafer
+    parent <- parentOf clafer
+    guard $ matches upper parent
+    return (clafer , parent) 
+
+-- a -> b    
+(|->) :: (MonadAnalysis m, Matchable a, Matchable b) => a -> b -> m [(SClafer, SClafer)]
+lower |-> upper = runListT $ do
+    clafer <- foreach clafers
+    guard $ matches lower clafer
+    super  <- refOf clafer
+    guard $ matches upper super
+    return (clafer, super) 
+
+-- a : b
+(|:) :: (MonadAnalysis m, Matchable a, Matchable b) => a -> b -> m [(SClafer, SClafer)]
+lower |: upper = runListT $ do
+    clafer <- foreach clafers
+    guard $ matches lower clafer
+    super  <- colonOf clafer
+    guard $ matches upper super
+    return (clafer, super) 
+
+-- constraints under
+constraintsUnder :: (MonadAnalysis m, Matchable a) => a -> m [(SClafer, I.PExp)]
+constraintsUnder under =
+  do
+    clafers' <- filter (matches under) <$> clafers
+    return [(clafer, constraint) | clafer <- clafers', constraint <- constraints clafer]
+
+
+rootUid :: String
+rootUid = "_root"
+
+
+-- Converts IClafer to SClafer
+convertClafer :: I.IClafer -> [SClafer]
+convertClafer = 
+  convertClafer' Nothing
+  where
+  convertElement' parent (I.IEClafer clafer) = Just $ Left $ convertClafer' parent clafer
+  convertElement' _ (I.IEConstraint _ pexp)   = Just $ Right $ pexp
+  convertElement' _ _ = Nothing
+  
+  convertClafer' parent clafer =
+    sclafer : concat children
+    where
+    sclafer
+      | maybe 1 groupLow parent == 0 && maybe 1 groupHigh parent /= -1 =
+          SClafer (I.uid clafer) (I.uid clafer) (I.isAbstract clafer) 1   high gLow gHigh (uid <$> parent) super constraints
+      | otherwise =
+          SClafer (I.uid clafer) (I.uid clafer) (I.isAbstract clafer) low high gLow gHigh (uid <$> parent) super constraints
+    (children, constraints) = partitionEithers $ mapMaybe (convertElement' $ Just $ sclafer) (I.elements clafer)
+    
+    Just (low, high) = I.card clafer
+    (gLow, gHigh) =
+      case I.gcard clafer of
+        Nothing -> (0, -1)
+        -- TODO: Bug w/ keywords?
+        Just (I.IGCard True _) -> (0, 1)
+        Just (I.IGCard _ i)    -> i
+    super =
+      case I.super clafer of
+        I.ISuper True [I.PExp{I.exp = I.IClaferId{I.sident = superUid}}]  -> Just $ Ref superUid
+        I.ISuper False [I.PExp{I.exp = I.IClaferId{I.sident = superUid}}] ->
+          if superUid `elem` ["string", "real", "int", "integer", "boolean"]
+            then Just $ Ref superUid
+            else Just $ Colon superUid
+        _ -> Nothing
+
+gatherInfo :: I.IModule -> Info
+gatherInfo imodule =
+  Info $ sClafer : sInteger : sInt : sReal : sString : sBoolean : convertClafer root
+  where
+  sClafer = SClafer "clafer" "clafer" False 0 (-1) 0 (-1) Nothing Nothing []
+  sInteger = SClafer "integer" "integer" False 0 (-1) 0 (-1) Nothing Nothing []
+  sInt     = SClafer "int" "int" False 0 (-1) 0 (-1) Nothing Nothing []
+  sReal    = SClafer "real" "real" False 0 (-1) 0 (-1) Nothing Nothing []
+  sString  = SClafer "string" "string" False 0 (-1) 0 (-1) Nothing Nothing []
+  sBoolean = SClafer "boolean" "boolean" False 0 (-1) 0 (-1) Nothing Nothing []
+  
+  root = I.IClafer noSpan False Nothing rootUid rootUid (I.ISuper False [I.PExp Nothing "" noSpan $ I.IClaferId "clafer" "clafer" True]) (Just (1, 1)) (0, 0) $ I.mDecls imodule
+
+
+
+
+
+{-
+ -
+ - Utility functions
+ -
+ -}
+liftMaybe :: Monad m => Maybe a -> MaybeT m a
+liftMaybe = MaybeT . return
+
+liftList :: Monad m => [a] -> ListT m a
+liftList = ListT . return
+ 
+runListT_ :: Monad m => ListT m a -> m ()
+runListT_ l = runListT l >> return ()
+
+foreach :: m[a] -> ListT m a
+foreach = ListT
+
+foreachM :: Monad m => [a] -> ListT m a
+foreachM = ListT . return
+
+subClafers :: (a, b) -> a
+subClafers = fst
+
+superClafers :: (a, b) -> b
+superClafers = snd
+
+findAll :: Monad m => m a -> ListT m a
+findAll = lift
+
+select :: Monad m => m [a] -> (a -> b) -> m [b]
+select from f = from >>= return . map f
+
+suchThat :: Monad m => m [a] -> (a -> Bool) -> m [a]
+suchThat = flip $ liftM . filter
+
+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
+concatMapM f l = concat `liftM` mapM f l
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM a b = a >>= (`when` b)
+
+unlessM :: Monad m => m Bool -> m() -> m()
+unlessM a b = a >>= (`unless` b)
+
+fromMaybeT :: Monad m => a -> MaybeT m a -> m a
+fromMaybeT def m = fromMaybe def `liftM` runMaybeT m
+
+mapMaybeT :: (m1 (Maybe a1) -> m (Maybe a)) -> MaybeT m1 a1 -> MaybeT m a
+mapMaybeT f = MaybeT . f . runMaybeT
+
+mapVSupplyT :: (Monad m, Monad m1) => (m1 a1 -> m a) -> VSupplyT m1 a1 -> VSupplyT m a
+mapVSupplyT f = lift . f . runVSupplyT
+
+mapLeft :: (t -> a) -> Either t b -> Either a b
+mapLeft f (Left l)  = Left $ f l
+mapLeft _ (Right r) = Right r
+
+mapRight :: (t -> b) -> Either a t -> Either a b
+mapRight _ (Left l)  = Left l
+mapRight f (Right r) = Right $ f r
+
+(<:>) :: Monad m => m a -> m [a] -> m [a]
+(<:>) = liftM2 (:)
+
+testing :: Eq b => (a -> b) -> a -> a -> Bool
+testing f a b = f a == f b
+
+comparing :: Ord b => (a -> b) -> a -> a -> Ordering
+comparing f a b = f a `compare` f b
+
+syntaxOf :: I.PExp -> String
+syntaxOf = printTree . sugarExp
+
+-- http://stackoverflow.com/questions/1714006/haskell-grouping-problem
+combine :: Ord a => [(a, b)] -> [(a, [b])]
+combine =
+    map mergeGroup . groupBy (testing fst) . sortBy (comparing fst)
+    where
+    mergeGroup ((a, b):xs) = (a, b : map snd xs)
+    mergeGroup [] = error "Function mergeGroup from Analysis expected a non empty list, but was given an empty one"
+
+-- Returns true iff the left and right expressions are syntactically identical
+sameAs :: I.PExp -> I.PExp -> Bool
+sameAs e1 e2 = syntaxOf e1 == syntaxOf e2 -- Not very efficient but hopefully correct
+ src/Language/Clafer/Intermediate/Desugarer.hs view
@@ -0,0 +1,579 @@+{-# LANGUAGE RankNTypes #-}
+{-
+ Copyright (C) 2012 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+{- | Transforms an Abstract Syntax Tree (AST) from "Language.Clafer.Front.Absclafer" 
+into Intermediate representation (IR) from "Language.Clafer.Intermediate.Intclafer" of a Clafer model.
+-}
+module Language.Clafer.Intermediate.Desugarer where
+
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Front.Mapper
+import Language.Clafer.Intermediate.Intclafer
+
+-- | Transform the AST into the intermediate representation (IR)
+desugarModule :: Module -> IModule
+desugarModule (Module declarations) = desugarModule $ PosModule noSpan declarations
+desugarModule (PosModule _ declarations) = IModule "" $
+      declarations >>= desugarEnums >>= desugarDeclaration
+--      [ImoduleFragment $ declarations >>= desugarEnums >>= desugarDeclaration]
+
+sugarModule :: IModule -> Module
+sugarModule x = Module $ map sugarDeclaration $ mDecls x -- (fragments x >>= mDecls)
+
+-- | desugars enumeration to abstract and global singleton features
+desugarEnums :: Declaration -> [Declaration]
+desugarEnums (EnumDecl id' enumids) = desugarEnums $ PosEnumDecl noSpan id' enumids
+desugarEnums (PosEnumDecl _ id' enumids) = absEnum : map mkEnum enumids
+    where
+    oneToOne = (CardInterval $ NCard (PosInteger ((0,0), "1")) (ExIntegerNum $ PosInteger ((0,0), "1")))
+    absEnum = ElementDecl $ Subclafer $ Clafer
+              Abstract GCardEmpty id' SuperEmpty CardEmpty InitEmpty (ElementsList [])
+    mkEnum (PosEnumIdIdent _ eId) = ElementDecl $ Subclafer $ Clafer AbstractEmpty GCardEmpty
+                                  eId (SuperSome SuperColon (PosClaferId noSpan $ Path [ModIdIdent id'])) oneToOne InitEmpty (ElementsList [])
+    mkEnum (EnumIdIdent eId) = ElementDecl $ Subclafer $ Clafer AbstractEmpty GCardEmpty
+                                  eId (SuperSome SuperColon (PosClaferId noSpan $ Path [ModIdIdent id'])) oneToOne InitEmpty (ElementsList [])
+desugarEnums x = [x]
+
+
+desugarDeclaration :: Declaration -> [IElement]
+desugarDeclaration (ElementDecl element) = desugarDeclaration $ PosElementDecl noSpan element
+desugarDeclaration (PosElementDecl _ element) = desugarElement element
+desugarDeclaration _ = error "desugared"
+
+
+sugarDeclaration :: IElement -> Declaration
+sugarDeclaration (IEClafer clafer) = ElementDecl $ Subclafer $ sugarClafer clafer
+sugarDeclaration (IEConstraint True constraint) =
+      ElementDecl $ Subconstraint $ sugarConstraint constraint
+sugarDeclaration  (IEConstraint False softconstraint) =
+      ElementDecl $ Subsoftconstraint $ sugarSoftConstraint softconstraint
+sugarDeclaration  (IEGoal _ goal) = ElementDecl $ Subgoal $ sugarGoal goal
+
+
+desugarClafer :: Clafer -> [IElement]
+desugarClafer (Clafer abstract gcrd id' super' crd init' es)  = 
+    desugarClafer $ PosClafer noSpan abstract gcrd id' super' crd init' es
+desugarClafer (PosClafer s abstract gcrd id' super' crd init' es)  = 
+    (IEClafer $ IClafer s (desugarAbstract abstract) (desugarGCard gcrd) (transIdent id')
+            "" (desugarSuper super') (desugarCard crd) (0, -1)
+            (desugarElements es)) : (desugarInit id' init')
+
+
+sugarClafer :: IClafer -> Clafer
+sugarClafer (IClafer _ abstract gcard' _ uid' super' crd _ es) = 
+    Clafer (sugarAbstract abstract) (sugarGCard gcard') (mkIdent uid')
+      (sugarSuper super') (sugarCard crd) InitEmpty (sugarElements es)
+
+
+desugarSuper :: Super -> ISuper
+desugarSuper SuperEmpty = desugarSuper $ PosSuperEmpty noSpan
+desugarSuper (SuperSome superhow setexp) = desugarSuper $ PosSuperSome noSpan superhow setexp
+desugarSuper (PosSuperEmpty s) =
+      ISuper False [PExp (Just $ TClafer []) "" s $ mkLClaferId baseClafer True]
+desugarSuper (PosSuperSome _ superhow setexp) =
+      ISuper (desugarSuperHow superhow) [desugarSetExp setexp]
+
+
+desugarSuperHow :: SuperHow -> Bool
+desugarSuperHow SuperColon = desugarSuperHow $ PosSuperColon noSpan
+desugarSuperHow (PosSuperColon _) = False
+desugarSuperHow _  = True
+
+
+desugarInit :: PosIdent -> Init -> [IElement]
+desugarInit id' InitEmpty = desugarInit id' $ PosInitEmpty noSpan
+desugarInit id' (InitSome inithow exp') = desugarInit id' $ PosInitSome noSpan inithow exp'
+desugarInit _ (PosInitEmpty _) = []
+desugarInit id' (PosInitSome s inithow exp') = [IEConstraint (desugarInitHow inithow) 
+  (pExpDefPid s (IFunExp "=" [mkPLClaferId (snd $ getIdent id') False, desugarExp exp']))]
+  where getIdent (PosIdent y) = y
+
+desugarInitHow :: InitHow -> Bool
+desugarInitHow InitHow_1  = desugarInitHow $ PosInitHow_1 noSpan
+desugarInitHow InitHow_2  = desugarInitHow $ PosInitHow_2 noSpan
+desugarInitHow (PosInitHow_1 _) = True
+desugarInitHow (PosInitHow_2 _ )= False
+
+
+desugarName :: Name -> IExp
+desugarName (Path path) = desugarName $ PosPath noSpan path
+desugarName (PosPath _ path) =
+      IClaferId (concatMap ((++ modSep).desugarModId) (init path))
+                (desugarModId $ last path) True
+
+desugarModId :: ModId -> Result
+desugarModId (ModIdIdent id') = desugarModId $ PosModIdIdent noSpan id'
+desugarModId (PosModIdIdent _ id') = transIdent id'
+
+sugarModId :: String -> ModId
+sugarModId modid = ModIdIdent $ mkIdent modid
+
+sugarSuper :: ISuper -> Super
+sugarSuper (ISuper _ []) = SuperEmpty
+sugarSuper (ISuper isOverlapping' [pexp]) = SuperSome (sugarSuperHow isOverlapping') (sugarSetExp pexp)
+sugarSuper _ = error "Function sugarSuper from Desugarer expects an ISuper with a list of length one, but it was given one with a list larger than one" -- Should never happen
+
+sugarSuperHow :: Bool -> SuperHow
+sugarSuperHow False = SuperColon
+sugarSuperHow True  = SuperMArrow
+
+
+sugarInitHow :: Bool -> InitHow
+sugarInitHow True  = InitHow_1
+sugarInitHow False = InitHow_2
+
+
+desugarConstraint :: Constraint -> PExp
+desugarConstraint (Constraint exps') = desugarConstraint $ PosConstraint noSpan exps'
+desugarConstraint (PosConstraint _ exps') = desugarPath $ desugarExp $
+    (if length exps' > 1 then foldl1 (PosEAnd noSpan) else head) exps'
+
+desugarSoftConstraint :: SoftConstraint -> PExp
+desugarSoftConstraint (SoftConstraint exps') = desugarSoftConstraint $ PosSoftConstraint noSpan exps'
+desugarSoftConstraint (PosSoftConstraint _ exps') = desugarPath $ desugarExp $
+    (if length exps' > 1 then foldl1 (PosEAnd noSpan) else head) exps'
+
+desugarGoal :: Goal -> PExp
+desugarGoal (Goal exps') = desugarGoal $ PosGoal noSpan exps'
+desugarGoal (PosGoal _ exps') = desugarPath $ desugarExp $
+    (if length exps' > 1 then foldl1 (PosEAnd noSpan) else head) exps'
+
+sugarConstraint :: PExp -> Constraint
+sugarConstraint pexp = Constraint $ map sugarExp [pexp]
+
+sugarSoftConstraint :: PExp -> SoftConstraint
+sugarSoftConstraint pexp = SoftConstraint $ map sugarExp [pexp]
+
+sugarGoal :: PExp -> Goal
+sugarGoal pexp = Goal $ map sugarExp [pexp]
+
+desugarAbstract :: Abstract -> Bool
+desugarAbstract AbstractEmpty = desugarAbstract $ PosAbstractEmpty noSpan
+desugarAbstract Abstract = desugarAbstract $ PosAbstract noSpan
+desugarAbstract (PosAbstractEmpty _) = False
+desugarAbstract (PosAbstract _) = True
+
+
+sugarAbstract :: Bool -> Abstract
+sugarAbstract False = AbstractEmpty
+sugarAbstract True = Abstract
+
+
+desugarElements :: Elements -> [IElement]
+desugarElements (ElementsEmpty) = desugarElements $ PosElementsEmpty noSpan
+desugarElements (ElementsList es)  = desugarElements $ PosElementsList noSpan es
+desugarElements (PosElementsEmpty _) = []
+desugarElements (PosElementsList _ es)  = es >>= desugarElement
+
+
+sugarElements :: [IElement] -> Elements
+sugarElements x = ElementsList $ map sugarElement x
+
+
+desugarElement :: Element -> [IElement]
+desugarElement x = case x of
+  Subclafer claf  -> desugarElement $ PosSubclafer noSpan claf
+  ClaferUse name crd es  ->
+      desugarElement $ PosClaferUse noSpan name crd es
+  Subconstraint constraint  -> desugarElement $ PosSubconstraint noSpan constraint
+  Subsoftconstraint softconstraint ->
+      desugarElement $ PosSubsoftconstraint noSpan softconstraint
+  Subgoal goal -> desugarElement $ PosSubgoal noSpan goal
+  PosSubclafer _ claf  ->
+      (desugarClafer claf) ++
+      (mkArrowConstraint claf >>= desugarElement)
+  PosClaferUse s name crd es  -> desugarClafer $ PosClafer s
+      AbstractEmpty GCardEmpty (mkIdent $ sident $ desugarName name)
+      (SuperSome SuperColon (PosClaferId noSpan name)) crd InitEmpty es
+  PosSubconstraint _ constraint  ->
+      [IEConstraint True $ desugarConstraint constraint]
+  PosSubsoftconstraint _ softconstraint ->
+      [IEConstraint False $ desugarSoftConstraint softconstraint]
+  PosSubgoal _ goal -> [IEGoal True $ desugarGoal goal]
+
+sugarElement :: IElement -> Element
+sugarElement x = case x of
+  IEClafer claf  -> Subclafer $ sugarClafer claf
+  IEConstraint True constraint -> Subconstraint $ sugarConstraint constraint
+  IEConstraint False softconstraint -> Subsoftconstraint $ sugarSoftConstraint softconstraint
+  IEGoal _ goal -> Subgoal $ sugarGoal goal
+
+mkArrowConstraint :: Clafer -> [Element]
+mkArrowConstraint (Clafer abstract gcard' id' super' crd init' es) =
+    mkArrowConstraint $ PosClafer noSpan abstract gcard' id' super' crd init' es
+mkArrowConstraint (PosClafer _ _ _ ident' super' _ _ _) = 
+  if isSuperSomeArrow super' then  [Subconstraint $
+       Constraint [PosDeclAllDisj noSpan
+       (Decl [LocIdIdent $ mkIdent "x", LocIdIdent $ mkIdent "y"]
+             (PosClaferId noSpan  $ Path [ModIdIdent ident']))
+       (PosENeq noSpan (PosESetExp noSpan $ Join (PosClaferId noSpan $ Path [ModIdIdent $ mkIdent "x"])
+                             (PosClaferId noSpan $ Path [ModIdIdent $ mkIdent "ref"]))
+             (PosESetExp noSpan $ Join (PosClaferId noSpan $ Path [ModIdIdent $ mkIdent "y"])
+                             (PosClaferId noSpan $ Path [ModIdIdent $ mkIdent "ref"])))]]
+  else []
+
+isSuperSomeArrow :: Super -> Bool
+isSuperSomeArrow (SuperSome arrow _) = isSuperArrow arrow
+isSuperSomeArrow (PosSuperSome _ arrow _) = isSuperArrow arrow
+isSuperSomeArrow _ = False
+
+isSuperArrow :: SuperHow -> Bool
+isSuperArrow SuperArrow = True
+isSuperArrow (PosSuperArrow _) = True
+isSuperArrow _ = False
+
+desugarGCard :: GCard -> Maybe IGCard
+desugarGCard x = case x of
+  GCardEmpty  -> desugarGCard $ PosGCardEmpty noSpan
+  GCardXor -> desugarGCard $ PosGCardXor noSpan
+  GCardOr  -> desugarGCard $ PosGCardOr noSpan
+  GCardMux -> desugarGCard $ PosGCardMux noSpan
+  GCardOpt -> desugarGCard $ PosGCardOpt noSpan
+  GCardInterval crd -> desugarGCard $ PosGCardInterval noSpan crd
+  PosGCardEmpty _  -> Nothing
+  PosGCardXor _ -> Just $ IGCard True (1, 1)
+  PosGCardOr _  -> Just $ IGCard True (1, -1)
+  PosGCardMux _ -> Just $ IGCard True (0, 1)
+  PosGCardOpt _ -> Just $ IGCard True (0, -1)
+  PosGCardInterval _ ncard ->
+      Just $ IGCard (isOptionalDef ncard) $ desugarNCard ncard
+
+isOptionalDef :: NCard -> Bool
+isOptionalDef (PosNCard _ m n) = isOptionalDef $ NCard m n
+isOptionalDef (NCard m n) = ((0::Integer) == mkInteger m) && (not $ isExIntegerAst n)
+
+isExIntegerAst :: ExInteger -> Bool
+isExIntegerAst ExIntegerAst = True
+isExIntegerAst (PosExIntegerAst _) = True
+isExIntegerAst _ = False
+
+sugarGCard :: Maybe IGCard -> GCard
+sugarGCard x = case x of
+  Nothing -> GCardEmpty
+  Just (IGCard _ (i, ex)) -> GCardInterval $ NCard (PosInteger ((0, 0), show i)) (sugarExInteger ex)
+
+
+desugarCard :: Card -> Maybe Interval
+desugarCard x = case x of
+  CardEmpty  -> desugarCard $ PosCardEmpty noSpan
+  CardLone  ->  desugarCard $ PosCardLone noSpan
+  CardSome  ->  desugarCard $ PosCardSome noSpan
+  CardAny  -> desugarCard $ PosCardAny noSpan
+  CardNum n  -> desugarCard $ PosCardNum noSpan n
+  CardInterval crd  -> desugarCard $ PosCardInterval noSpan crd
+  PosCardEmpty _  -> Nothing
+  PosCardLone _  ->  Just (0, 1)
+  PosCardSome _  ->  Just (1, -1)
+  PosCardAny _ ->  Just (0, -1)
+  PosCardNum _ n  -> Just (mkInteger n, mkInteger n)
+  PosCardInterval _ ncard  -> Just $ desugarNCard ncard
+
+desugarNCard :: NCard -> (Integer, Integer)
+desugarNCard (NCard i ex) = desugarNCard $ PosNCard noSpan i ex
+desugarNCard (PosNCard _ i ex) = (mkInteger i, desugarExInteger ex)
+
+desugarExInteger :: ExInteger -> Integer
+desugarExInteger ExIntegerAst = -1
+desugarExInteger (PosExIntegerAst _) = -1
+desugarExInteger (ExIntegerNum n) = mkInteger n
+desugarExInteger (PosExIntegerNum _ n) = mkInteger n
+
+sugarCard :: Maybe Interval -> Card
+sugarCard x = case x of
+  Nothing -> CardEmpty
+  Just (i, ex) ->
+      CardInterval $ NCard (PosInteger ((0, 0), show i)) (sugarExInteger ex)
+
+sugarExInteger :: Integer -> ExInteger
+sugarExInteger n = if n == -1 then ExIntegerAst else (ExIntegerNum $ PosInteger ((0, 0), show n))
+
+desugarExp :: Exp -> PExp
+desugarExp x = pExpDefPid (range x) $ desugarExp' x
+
+desugarExp' :: Exp -> IExp
+desugarExp' x = case x of
+  DeclAllDisj decl exp' -> desugarExp' $ PosDeclAllDisj noSpan decl exp'
+  DeclAll decl exp' -> desugarExp' $ PosDeclAll noSpan decl exp'
+  DeclQuantDisj quant' decl exp' ->
+      desugarExp' $ PosDeclQuantDisj noSpan quant' decl exp'
+  DeclQuant quant' decl exp' -> desugarExp' $ PosDeclQuant noSpan quant' decl exp'
+  EIff exp0 exp'  -> desugarExp' $ PosEIff noSpan exp0 exp'
+  EImplies exp0 exp'  -> desugarExp' $ PosEImplies noSpan exp0 exp'
+  EImpliesElse exp0 exp1 exp'  -> desugarExp' $ PosEImpliesElse noSpan exp0 exp1 exp'
+  EOr exp0 exp'  -> desugarExp' $ PosEOr noSpan exp0 exp'
+  EXor exp0 exp'  -> desugarExp' $ PosEXor noSpan exp0 exp'
+  EAnd exp0 exp'  -> desugarExp' $ PosEAnd noSpan exp0 exp'
+  ENeg exp' -> desugarExp' $ PosENeg noSpan exp'
+  QuantExp quant' exp'  -> desugarExp' $ PosQuantExp noSpan quant' exp'
+  ELt  exp0 exp'  -> desugarExp' $ PosELt noSpan exp0 exp'
+  EGt  exp0 exp'  -> desugarExp' $ PosEGt noSpan exp0 exp'
+  EEq  exp0 exp'  -> desugarExp' $ PosEEq noSpan exp0 exp'
+  ELte exp0 exp'  -> desugarExp' $ PosELte noSpan exp0 exp'
+  EGte exp0 exp'  -> desugarExp' $ PosEGte noSpan exp0 exp'
+  ENeq exp0 exp'  -> desugarExp' $ PosENeq noSpan exp0 exp'
+  EIn  exp0 exp'  -> desugarExp' $ PosEIn noSpan exp0 exp'
+  ENin exp0 exp'  -> desugarExp' $ PosENin noSpan exp0 exp'
+  EAdd exp0 exp'  -> desugarExp' $ PosEAdd noSpan exp0 exp'
+  ESub exp0 exp'  -> desugarExp' $ PosESub noSpan exp0 exp'
+  EMul exp0 exp'  -> desugarExp' $ PosEMul noSpan exp0 exp'
+  EDiv exp0 exp'  -> desugarExp' $ PosEDiv noSpan exp0 exp'
+  ECSetExp exp'   -> desugarExp' $ PosECSetExp noSpan exp'
+  ESumSetExp sexp -> desugarExp' $ PosESumSetExp noSpan sexp  
+  EMinExp exp'    -> desugarExp' $ PosEMinExp noSpan exp'
+  EGMax exp' -> desugarExp' $ PosEGMax noSpan exp'
+  EGMin exp' -> desugarExp' $ PosEGMin noSpan exp'
+  EInt n -> desugarExp' $ PosEInt noSpan n
+  EDouble n -> desugarExp' $ PosEDouble noSpan n
+  EStr str  -> desugarExp' $ PosEStr noSpan str
+  ESetExp sexp -> desugarExp' $ PosESetExp noSpan sexp    
+  PosDeclAllDisj _ decl exp' ->
+      IDeclPExp IAll [desugarDecl True decl] (dpe exp')
+  PosDeclAll _ decl exp' -> IDeclPExp IAll [desugarDecl False decl] (dpe exp')
+  PosDeclQuantDisj _ quant' decl exp' ->
+      IDeclPExp (desugarQuant quant') [desugarDecl True decl] (dpe exp')
+  PosDeclQuant _ quant' decl exp' ->
+      IDeclPExp (desugarQuant quant') [desugarDecl False decl] (dpe exp')
+  PosEIff _ exp0 exp'  -> dop iIff [exp0, exp']
+  PosEImplies _ exp0 exp'  -> dop iImpl [exp0, exp']
+  PosEImpliesElse _ exp0 exp1 exp'  -> dop iIfThenElse [exp0, exp1, exp']
+  PosEOr _ exp0 exp'  -> dop iOr   [exp0, exp']
+  PosEXor _ exp0 exp'  -> dop iXor [exp0, exp']
+  PosEAnd _ exp0 exp'  -> dop iAnd [exp0, exp']
+  PosENeg _ exp'  -> dop iNot [exp']
+  PosQuantExp _ quant' exp' ->
+      IDeclPExp (desugarQuant quant') [] (desugarExp exp')
+  PosELt  _ exp0 exp'  -> dop iLt  [exp0, exp']
+  PosEGt  _ exp0 exp'  -> dop iGt  [exp0, exp']
+  PosEEq  _ exp0 exp'  -> dop iEq  [exp0, exp']
+  PosELte _ exp0 exp'  -> dop iLte [exp0, exp']
+  PosEGte _ exp0 exp'  -> dop iGte [exp0, exp']
+  PosENeq _ exp0 exp'  -> dop iNeq [exp0, exp']
+  PosEIn  _ exp0 exp'  -> dop iIn  [exp0, exp']
+  PosENin _ exp0 exp'  -> dop iNin [exp0, exp']
+  PosEAdd _ exp0 exp'  -> dop iPlus [exp0, exp']
+  PosESub _ exp0 exp'  -> dop iSub [exp0, exp']
+  PosEMul _ exp0 exp'  -> dop iMul [exp0, exp']
+  PosEDiv _ exp0 exp'  -> dop iDiv [exp0, exp']
+  PosECSetExp _ exp'   -> dop iCSet [exp']
+  PosESumSetExp _ exp' -> dop iSumSet [exp']
+  PosEMinExp _ exp'    -> dop iMin [exp']  
+  PosEGMax _ exp' -> dop iGMax [exp']
+  PosEGMin _ exp' -> dop iGMin [exp']  
+  PosEInt _ n  -> IInt $ mkInteger n
+  PosEDouble _ (PosDouble n) -> IDouble $ read $ snd n
+  PosEStr _ (PosString str)  -> IStr $ snd str
+  PosESetExp _ sexp -> desugarSetExp' sexp
+  where
+  dop = desugarOp desugarExp
+  dpe = desugarPath.desugarExp
+
+desugarOp :: (a -> PExp) -> String -> [a] -> IExp
+desugarOp f op' exps' = 
+    if (op' == iIfThenElse)
+      then IFunExp op' $ (desugarPath $ head mappedList) : (map reducePExp $ tail mappedList)
+      else IFunExp op' $ map (trans.f) exps'
+    where
+      mappedList = map f exps'
+      trans = if op' `elem` ([iNot, iIfThenElse] ++ logBinOps)
+          then desugarPath else id
+
+
+desugarSetExp :: SetExp -> PExp
+desugarSetExp x = pExpDefPid (range x) $ desugarSetExp' x
+
+
+desugarSetExp' :: SetExp -> IExp
+desugarSetExp' x = case x of
+  Union exp0 exp'        -> desugarSetExp' $ PosUnion noSpan exp0 exp'
+  UnionCom exp0 exp'     -> desugarSetExp' $ PosUnionCom noSpan exp0 exp'
+  Difference exp0 exp'   -> desugarSetExp' $ PosDifference noSpan exp0 exp'
+  Intersection exp0 exp' -> desugarSetExp' $ PosIntersection noSpan exp0 exp'
+  Domain exp0 exp'       -> desugarSetExp' $ PosDomain noSpan exp0 exp'
+  Range exp0 exp'        -> desugarSetExp' $ PosRange noSpan exp0 exp'
+  Join exp0 exp'         -> desugarSetExp' $ PosJoin noSpan exp0 exp'
+  ClaferId name  -> desugarSetExp' $ PosClaferId noSpan name
+  PosUnion _ exp0 exp'        -> dop iUnion        [exp0, exp']
+  PosUnionCom _ exp0 exp'     -> dop iUnion        [exp0, exp']
+  PosDifference _ exp0 exp'   -> dop iDifference   [exp0, exp']
+  PosIntersection _ exp0 exp' -> dop iIntersection [exp0, exp']
+  PosDomain _ exp0 exp'       -> dop iDomain       [exp0, exp']
+  PosRange _ exp0 exp'        -> dop iRange        [exp0, exp']
+  PosJoin _ exp0 exp'         -> dop iJoin         [exp0, exp']
+  PosClaferId _ name  -> desugarName name
+
+  where
+  dop = desugarOp desugarSetExp
+
+
+sugarExp :: PExp -> Exp
+sugarExp x = sugarExp' $ Language.Clafer.Intermediate.Intclafer.exp x
+
+
+sugarExp' :: IExp -> Exp
+sugarExp' x = case x of
+  IDeclPExp quant' [] pexp -> QuantExp (sugarQuant quant') (sugarExp pexp)
+  IDeclPExp IAll (decl@(IDecl True _ _):[]) pexp ->
+    DeclAllDisj   (sugarDecl decl) (sugarExp pexp)
+  IDeclPExp IAll  (decl@(IDecl False _ _):[]) pexp ->
+    DeclAll       (sugarDecl decl) (sugarExp pexp)
+  IDeclPExp quant' (decl@(IDecl True _ _):[]) pexp ->
+    DeclQuantDisj (sugarQuant quant') (sugarDecl decl) (sugarExp pexp)
+  IDeclPExp quant' (decl@(IDecl False _ _):[]) pexp ->
+    DeclQuant     (sugarQuant quant') (sugarDecl decl) (sugarExp pexp)
+  IFunExp op' exps' ->
+    if op' `elem` unOps then (sugarUnOp op') (exps''!!0)
+    else if op' `elem` setBinOps then (ESetExp $ sugarSetExp' x)
+    else if op' `elem` binOps then (sugarOp op') (exps''!!0) (exps''!!1)
+    else (sugarTerOp op') (exps''!!0) (exps''!!1) (exps''!!2)
+    where
+    exps'' = map sugarExp exps'
+  IInt n -> EInt $ PosInteger ((0, 0), show n)
+  IDouble n -> EDouble $ PosDouble ((0, 0), show n)
+  IStr str -> EStr $ PosString ((0, 0), str)
+  IClaferId _ _ _ -> ESetExp $ sugarSetExp' x
+  _ -> error "Function sugarExp' from Desugarer was given an invalid argument" -- This should never happen
+  where
+  sugarUnOp op''
+    | op'' == iNot           = ENeg
+    | op'' == iCSet          = ECSetExp
+    | op'' == iMin           = EMinExp
+    | op'' == iGMax          = EGMax
+    | op'' == iGMin          = EGMin 
+    | op'' == iSumSet        = ESumSetExp
+    | otherwise            = error $ show op'' ++ "is not an op"
+  sugarOp op''
+    | op'' == iIff           = EIff
+    | op'' == iImpl          = EImplies
+    | op'' == iOr            = EOr
+    | op'' == iXor           = EXor
+    | op'' == iAnd           = EAnd 
+    | op'' == iLt            = ELt
+    | op'' == iGt            = EGt
+    | op'' == iEq            = EEq  
+    | op'' == iLte           = ELte
+    | op'' == iGte           = EGte
+    | op'' == iNeq           = ENeq
+    | op'' == iIn            = EIn
+    | op'' == iNin           = ENin
+    | op'' == iPlus          = EAdd
+    | op'' == iSub           = ESub
+    | op'' == iMul           = EMul
+    | op'' == iDiv           = EDiv
+    | otherwise            = error $ show op'' ++ "is not an op"
+  sugarTerOp op''
+    | op'' == iIfThenElse    = EImpliesElse
+    | otherwise            = error $ show op'' ++ "is not an op"
+
+
+sugarSetExp :: PExp -> SetExp
+sugarSetExp x = sugarSetExp' $ Language.Clafer.Intermediate.Intclafer.exp x
+
+
+sugarSetExp' :: IExp -> SetExp
+sugarSetExp' (IFunExp op' exps') = (sugarOp op') (exps''!!0) (exps''!!1)
+    where
+    exps'' = map sugarSetExp exps'
+    sugarOp op''
+      | op'' == iUnion         = Union
+      | op'' == iDifference    = Difference
+      | op'' == iIntersection  = Intersection
+      | op'' == iDomain        = Domain
+      | op'' == iRange         = Range
+      | op'' == iJoin          = Join
+      | otherwise              = error "Invalid argument given to function sygarSetExp' in Desugarer"
+sugarSetExp' (IClaferId "" id' _) = ClaferId $ Path [ModIdIdent $ mkIdent id']
+sugarSetExp' (IClaferId modName' id' _) = ClaferId $ Path $ (sugarModId modName') : [sugarModId id']
+sugarSetExp' _ = error "IDecelPexp, IInt, IDobule, and IStr can not be sugared into a setExp!" --This should never happen
+
+desugarPath :: PExp -> PExp
+desugarPath (PExp iType' pid' pos' x) = reducePExp $ PExp iType' pid' pos' result
+  where
+  result
+    | isSet x     = IDeclPExp ISome [] (pExpDefPid pos' x)
+    | isNegSome x = IDeclPExp INo   [] $ bpexp $ Language.Clafer.Intermediate.Intclafer.exp $ head $ exps x
+    | otherwise   =  x
+  isNegSome (IFunExp op' [PExp _ _ _ (IDeclPExp ISome [] _)]) = op' == iNot
+  isNegSome _ = False
+
+
+isSet :: IExp -> Bool
+isSet (IClaferId _ _ _)  = True
+isSet (IFunExp op' _) = op' `elem` setBinOps
+isSet _ = False
+
+
+-- reduce parent
+reducePExp :: PExp -> PExp
+reducePExp (PExp t pid' pos' x) = PExp t pid' pos' $ reduceIExp x
+
+reduceIExp :: IExp -> IExp
+reduceIExp (IDeclPExp quant' decls' pexp) = IDeclPExp quant' decls' $ reducePExp pexp
+reduceIExp (IFunExp op' exps') = redNav $ IFunExp op' $ map redExps exps'
+    where
+    (redNav, redExps) = if op' == iJoin then (reduceNav, id) else (id, reducePExp) 
+reduceIExp x = x
+
+reduceNav :: IExp -> IExp
+reduceNav x@(IFunExp op' exps'@((PExp _ _ _ iexp@(IFunExp _ (pexp0:pexp:_))):pPexp:_)) = 
+  if op' == iJoin && isParent pPexp && isClaferName pexp
+  then reduceNav $ Language.Clafer.Intermediate.Intclafer.exp pexp0
+  else x{exps = (head exps'){Language.Clafer.Intermediate.Intclafer.exp = reduceIExp iexp} :
+                tail exps'}
+reduceNav x = x
+
+
+desugarDecl :: Bool -> Decl -> IDecl
+desugarDecl isDisj' (Decl locids exp') = desugarDecl isDisj' $ PosDecl noSpan locids exp'
+desugarDecl isDisj' (PosDecl _ locids exp') =
+    IDecl isDisj' (map desugarLocId locids) (desugarSetExp exp')
+
+
+sugarDecl :: IDecl -> Decl
+sugarDecl (IDecl _ locids exp') =
+    Decl (map sugarLocId locids) (sugarSetExp exp')
+
+
+desugarLocId :: LocId -> String
+desugarLocId (LocIdIdent id') = desugarLocId $ PosLocIdIdent noSpan id'
+desugarLocId (PosLocIdIdent _ id') = transIdent id'
+
+
+sugarLocId :: String -> LocId
+sugarLocId x = LocIdIdent $ mkIdent x
+
+desugarQuant :: Quant -> IQuant
+desugarQuant QuantNo = desugarQuant $ PosQuantNo noSpan
+desugarQuant QuantLone = desugarQuant $ PosQuantLone noSpan
+desugarQuant QuantOne = desugarQuant $ PosQuantOne noSpan
+desugarQuant QuantSome = desugarQuant $ PosQuantSome noSpan
+desugarQuant (PosQuantNo _) = INo
+desugarQuant (PosQuantLone _) = ILone
+desugarQuant (PosQuantOne _) = IOne
+desugarQuant (PosQuantSome _) = ISome
+
+sugarQuant :: IQuant -> Quant
+sugarQuant INo = QuantNo
+sugarQuant ILone = QuantLone
+sugarQuant IOne = QuantOne
+sugarQuant ISome = QuantSome
+sugarQuant IAll = error "sugarQaunt was called on IAll, this is not allowed!" --Should never happen
+ src/Language/Clafer/Intermediate/GLPKScopeAnalyzer.hs view
@@ -0,0 +1,1034 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, NamedFieldPuns, TupleSections #-}
+
+{-
+ Copyright (C) 2012-2013 Jimmy Liang, Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.GLPKScopeAnalyzer (glpkScopeAnalysis) where
+
+import Language.Clafer.Front.Absclafer hiding (Path)
+import qualified Language.Clafer.Intermediate.Intclafer as I
+import Language.Clafer.Intermediate.Analysis
+import Language.Clafer.Intermediate.ResolverType
+
+import Control.Applicative (Applicative(..), (<$>))
+import Control.Monad
+import Control.Monad.List
+import Control.Monad.LPMonad
+import Control.Monad.Maybe
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Either
+import Data.LinearProgram hiding (constraints)
+import Data.List
+import Data.Map ()
+import qualified Data.Map as Map
+import Data.Maybe
+import System.IO.Unsafe
+import Text.Parsec.Combinator
+import Text.Parsec.Error
+import Text.Parsec.Pos
+import Text.Parsec.Prim
+import Text.Parsec.String ()
+
+
+{------------------------------------------------------------
+ ---------- Linear programming ------------------------------
+ ------------------------------------------------------------}
+
+-- | Compute scopes for clafers by solving a system of linear equations
+glpkScopeAnalysis :: I.IModule -> [(String, Integer)]
+glpkScopeAnalysis imodule =
+  intScope ++ scopes
+  where
+  intScope = if bitwidth > 4 then return ("int", bitwidth) else fail "Bitwidth less than default."
+  bitwidth = bitwidthAnalysis (constants ++ map snd scopes)
+  
+  scopes = 
+      removeZeroes $ removeRoot $ removeAux $
+      -- unsafePerformIO should be safe (?)
+      -- We aren't modifying any global state.
+      -- If we don't use unsafePerformIO, then we have to be inside the IO monad and
+      -- makes things really ugly. Might as well contain the ugliness in here.
+      case unsafePerformIO solution of
+        (Success, Just (_, s)) -> Map.toList $ Map.map round s
+        _ -> [] -- No solution
+  
+  ((_, constants), analysis) = runScopeAnalysis run $ gatherInfo imodule
+  
+  run =
+    do
+      setConstraints
+      abstracts' <- clafers `suchThat` isAbstract
+      constants' <- constantsAnalysis
+      return (abstracts', constants')
+  
+  solution = {-trace (show $ unsafePerformIO $ writeLP "TESTTT" analysis) $-} glpSolveVars mipDefaults{msgLev = MsgOff} $ analysis
+  -- Any scope that is 0 will take the global scope of 1 instead.
+  removeZeroes = filter ((/= 0) . snd)
+  -- The root is implied and not and not part of the actual solution.
+  removeRoot = filter ((/= rootUid) . fst)
+  -- Auxilary variables are only part of the computation, not the solution.
+  removeAux = filter (not . (uniqNameSpace `isPrefixOf`) . fst)
+  -- The scope for abstract clafers are removed. Alloy doesn't need it. Makes
+  -- it easier use since user can increase the scope of subclafers without
+  -- needing to increase the scope of the abstract Clafer.
+  --removeAbstracts = filter (not . (`elem` map uid abstracts) . fst)
+
+
+bitwidthAnalysis :: [Integer] -> Integer
+bitwidthAnalysis constants =
+  toInteger $ 1 + fromJust (findIndex (\x -> all (`within` x) constants) bitRange)
+  where
+  within a (minB, maxB) = a >= minB && a <= maxB
+  bitRange = [(-2^i, 2^i-1) | i <- ([0..]::[Integer])]
+
+  
+-- Returns all constant literals
+constantsAnalysis :: ScopeAnalysis [Integer]
+constantsAnalysis =
+  do
+    cons <- constraintsUnder anything `select` snd
+    return $ mapMaybe integerConstant [I.exp sub | con <- cons, sub <- subexpressions con]
+  where  
+  integerConstant (I.IInt i) = Just i
+  integerConstant _ = Nothing
+  
+
+-- (-1) for infinity
+data Between =
+    Between Integer Integer
+    deriving Show
+
+--atLeastOne :: Between -> Bool
+--atLeastOne (Between i _) = i >= 1
+{-
+overlap :: Between -> Between -> Maybe Between
+overlap (Between l1 h1) (Between l2 h2)
+    | l1 > h2 && h2 /= -1 = Nothing
+    | l2 > h1 && h1 /= -1 = Nothing
+    | otherwise = Just $ Between (maxx l1 l2) (minn h1 h2)
+    where
+    minn (-1) b = b
+    minn a (-1) = a
+    minn a b = min a b
+    
+    maxx (-1) _ = -1
+    maxx _ (-1) = -1
+    maxx a b = max a b
+
+overlapM :: Maybe Between -> Maybe Between -> Maybe Between
+overlapM a b =
+    do
+        a' <- a
+        b' <- b
+        overlap a' b'
+-} 
+    
+-- Multiplies two positive integers where -1=infinity
+mult :: Integer -> Integer -> Integer
+mult (-1) _ = -1
+mult _ (-1) = -1
+mult a b = a * b
+
+
+
+simpleAnalysis :: ScopeAnalysis [(String, Between)]
+simpleAnalysis =
+    do
+        root <- claferWithUid rootUid
+        analysis <- simpleAnalysis' root (Between 1 1)
+        --moreAnalysis <- simpleConstraintAnalysis analysis
+        return analysis
+    where
+    simpleAnalysis' cur cb@(Between l h) =
+        runListT $ return (uid cur, cb) `mplus` do
+            child <- foreach $ (anything |^ cur) `select` fst
+            let b
+                 | groupLow cur == 0 && groupHigh cur == -1 = Between (low child * l) (high child `mult` h)
+                 | otherwise                                = Between 0 (-1)
+            foreach (simpleAnalysis' child b)
+{-    
+    mergeAnalysis analysis =
+        [(n, fromJust x) | (n, b) <- combine analysis, let x = foldr1 overlapM $ map Just b, isJust x]
+  
+    simpleConstraintAnalysis :: [(String, Between)] -> ScopeAnalysis [(String, Between)]
+    simpleConstraintAnalysis analysis = mergeAnalysis <$> simpleConstraintAnalysis' analysis
+    
+    simpleConstraintAnalysis' analysis =
+        runListT $ do
+            (curThis, cons) <- foreach $ constraintsUnder anything
+            constraintBetween curThis (I.exp cons)
+        where
+        constraintBetween _ I.IDeclPExp {I.quant = I.ISome, I.oDecls = [], I.bpexp} =
+            do
+                let t = map tLexeme $ fromMaybe [] $ unfoldJoins bpexp
+                guard (not $ null t)
+                guard ("this" `notElem` t)
+                guard ("parent" `notElem` t)
+                guard ("ref" `notElem` t)
+                msum $ map someStep t
+        constraintBetween curThis I.IFunExp{I.op = "&&", I.exps = [exp1, exp2]} =
+            constraintBetween curThis (I.exp exp1) `mplus` constraintBetween curThis (I.exp exp2)
+        constraintBetween _ _ = mzero
+        someStep step =
+            do
+                parent <- parentOf step
+                let parentBetween = fromMaybe (error $ "Missing parent " ++ parent) $ lookup parent analysis
+                guard $ atLeastOne parentBetween
+                return (step, Between 1 $ -1)
+-}       
+    
+
+setConstraints :: ScopeAnalysis ()
+setConstraints =
+  do
+    simpleAnalysis
+    p <- flatten
+    withExtraClafers p $ do
+        optFormula
+        colonConstraints
+        refConstraints
+        parentConstraints
+        constraintConstraints
+
+    (var rootUid) `equalTo` 1
+
+
+optFormula :: ScopeAnalysis ()
+optFormula =
+  do
+    setDirection Min
+    c <- clafers
+    let concretes = [uid concrete | concrete <- c, isConcrete concrete, isDerived concrete, not $ uniqNameSpace `isPrefixOf` uid concrete]
+    setObjective $ varSum concretes
+
+parentConstraints :: ScopeAnalysis ()
+parentConstraints =
+  runListT_ $ do
+    -- forall child under parent ...
+    (child, parent) <- foreach $ anything |^ anything
+
+    let uchild = uid child
+    let uparent = uid parent
+    
+    if low child == high child
+        -- Saves us one constraint
+        then do
+            var uchild `equal` (low child *^ var uparent)
+        else do
+            -- ... scope_this <= scope_parent * low-card(this) ...
+            var uchild `geq` (low child *^ var uparent)
+            -- ... scope_this >= scope_parent * high-card(this) ...
+            -- high == -1 implies high card is unbounded
+
+            if high child /= -1
+              then var uchild `leq` (high child *^ var uparent)
+              {-
+               - A
+               -   B *
+               - [#B = 4]
+               -
+               - Need this constraint so that #A=1
+               -}
+              else (smallM *^ var uchild) `leq` var uparent
+            -- Use integer's not doubles
+            setVarKind uchild IntVar
+            setVarKind uparent IntVar
+
+
+refConstraints :: ScopeAnalysis ()
+refConstraints =
+  runListT_ $ do
+    -- for all uids of any clafer the refs another uid ...
+    (sub, sup) <- foreach $ (anything |-> anything) `suchThat` (isDerived . superClafers)
+    let usub = uid sub
+    let usup = uid sup
+    aux <- testPositive usub
+    -- scope_sup >= low-card(sub)
+    var usup `geq` ((max 1 $ low sub) *^ var aux)
+
+
+colonConstraints :: ScopeAnalysis ()
+colonConstraints =
+  runListT_ $ do
+    -- forall c in the set of clafers' uid ...
+    c <- foreach $ clafers `suchThat` isDerived
+    -- ... find all uids of any clafer that extends c (only colons) ...
+    subs <- findAll $ (anything |: c) `select` (uid . subClafers)
+    when (not $ null subs) $
+      -- ... then set the constraint scope_C = sum scope_subs
+      var (uid c) `equal` varSum subs
+
+
+
+flatten :: ScopeAnalysis [SClafer]        
+flatten =
+    runListT $ do
+        abs' <- clafers `suchThat` isAbstract
+        (c, s) <- foreach $ anything |: anything
+        ListT $ runReaderT (addChildren (map uid abs') (Part [uid c, uid s]) (Part [])) []
+        
+addChildren :: MonadAnalysis m => [String] -> Part -> Part -> m [SClafer]        
+addChildren abs' (Part steps) ss@(Part supSteps) =
+    do
+        let parBase = last steps
+        
+        chis <- directChildrenOf parBase
+        achis <- forM chis $
+            \chi -> do
+                let chiP = Part $ init steps ++ [chi]
+                let par  = Part steps
+                let supP = Part $ supSteps ++ [chi]
+                
+                chiC <- claferWithUid chi
+                let s = SClafer (reifyPartName chiP) chi False (low chiC) (high chiC) (groupLow chiC) (groupHigh chiC) (Just $ reifyPartName par) (Just $ Colon $ reifyPartName supP) (constraints chiC)
+                return s <:> addChildren abs' chiP ss
+        
+        col <- runMaybeT $ colonOf parBase
+        case col of
+            Just col' -> do
+                acol <- addChildren abs' (Part $ steps ++ [col']) (Part $ supSteps ++ [parBase])
+                return $ concat achis ++ acol
+            Nothing -> return $ concat achis
+    where
+    notAbs = not . (`elem` abs')
+    reifyPartName (Part (t : target)) = reifyPartName' $ t : filter notAbs target
+    reifyPartName (Part []) = error "Function reifyPartName from GLPKScopeAnalyzer expects a non empty Part, but was given one!" -- This should never happen
+    reifyPartName' [target] = target
+    reifyPartName' target   = uniqNameSpace ++ "reify_" ++ intercalate "_" target        
+
+
+data Path =
+  Path {parts::[Part]}
+  deriving (Eq, Ord, Show)
+
+data Part =
+  Part {steps::[String]}
+  deriving (Eq, Ord, Show)
+
+
+{-data Expr =
+    This {path::Path, eType::I.IType} |
+    Global {path::Path, eType::I.IType} |
+    Const Integer |
+    Concat {paths::[Expr], eType::I.IType} |
+    Positive {allPaths :: [Path], num::Integer, eType::I.IType}
+    deriving Show-}
+
+data Expr =
+    This Path I.IType |
+    Global Path I.IType |
+    Const Integer |
+    Concat [Expr] I.IType |
+    Positive [Path] Integer I.IType
+    deriving Show
+
+eType :: Expr -> I.IType
+eType (This _ e) = e
+eType (Global _ e) = e
+eType (Concat _ e) = e
+eType (Positive _ _ e) = e
+eType (Const _) = error "Function eType from GLPK did not expect a Const"
+
+isThis :: Expr -> Bool
+isThis This{} = True
+isThis _ = False
+isGlobal :: Expr -> Bool
+isGlobal Global{} = True
+isGlobal _ = False
+{-isConst :: Expr -> Bool
+isConst Const{} = True
+isConst _ = False-}
+    
+parentOfPart :: MonadAnalysis m => Part -> m Part
+parentOfPart (Part s) =
+  do
+    s' <- parentOf $ last s
+    cs' <- claferWithUid s'
+    return $ if isAbstract cs'
+      then Part $ init s
+      else Part $ init s ++ [s']
+
+
+{-
+ - Turns constraints that look like:
+ -
+ -  [ A in List
+ -    B in List ]
+ - 
+ - to
+ -
+ -  [ A, B in List ]
+ -}
+optimizeInConstraints :: [I.PExp] -> [I.PExp]
+optimizeInConstraints constraints =
+    noOpt ++ opt
+    where
+    (noOpt, toOpt) = partitionEithers (constraints >>= partitionConstraint)
+    opt = [ unionPExpAll (map fst inSame) `inPExp` snd (head inSame)
+            | inSame <- groupBy (testing' $ syntaxOf . snd) $ sortBy (comparing' snd) toOpt ]
+    inPExp a b = I.PExp (Just I.TBoolean) "" noSpan $ I.IFunExp "in" [a, b]
+    unionPExpAll es = foldr1 unionPExp es
+    unionPExp a b = I.PExp (liftM2 (+++) (I.iType a) (I.iType b)) "" noSpan $ I.IFunExp "++" [a, b]
+    
+    partitionConstraint I.PExp{I.exp = I.IFunExp {I.op = "in", I.exps = [exp1, exp2]}} = return $ Right (exp1, exp2)
+    partitionConstraint I.PExp{I.exp = I.IFunExp {I.op = "&&", I.exps = [exp1, exp2]}} = partitionConstraint exp1 `mplus` partitionConstraint exp2
+    partitionConstraint e = return $ Left e
+
+    testing'   f a b = f a == f b    
+    comparing' f a b = f a `compare` f b
+
+
+{-
+ -   Phone *
+ -
+ -   [all p : Phone | <constraint on p>]
+ -
+ - becomes
+ -
+ -   Phone *
+ -      [<constraint on p/this>]
+ -}
+optimizeAllConstraints :: MonadAnalysis m => SClafer -> [I.PExp] -> m [(SClafer, I.PExp)]
+optimizeAllConstraints curThis constraints =
+    runListT $ partitionConstraint =<< foreachM constraints
+    where
+    partitionConstraint I.PExp{I.exp = I.IDeclPExp I.IAll [I.IDecl _ [decl] I.PExp{I.exp = I.IClaferId{I.sident}}] bpexp} =
+        do
+            under <- claferWithUid sident
+            return (under, rename decl bpexp)
+    partitionConstraint I.PExp{I.exp = I.IFunExp {I.op = "&&", I.exps = [exp1, exp2]}} = partitionConstraint exp1 `mplus` partitionConstraint exp2
+    partitionConstraint e = return (curThis, e)
+    
+    rename :: String -> I.PExp -> I.PExp
+    rename f p@I.PExp{I.exp = exp'} =
+        p{I.exp = renameIExp exp'}
+        where
+        renameIExp (I.IFunExp op exps) = I.IFunExp op $ map (rename f) exps
+        renameIExp (I.IDeclPExp quant oDecls bpexp) = I.IDeclPExp quant (map renameDecl oDecls) $ rename f bpexp
+        renameIExp (I.IClaferId modName sident isTop)
+            | f == sident = I.IClaferId modName "this" isTop
+            | otherwise   = I.IClaferId modName sident isTop
+        renameIExp i = i
+        renameDecl (I.IDecl isDisj decls body)
+            | f `elem` decls = I.IDecl isDisj decls body -- Not a free variable
+            | otherwise      = I.IDecl isDisj decls $ rename f body -- Is a free variable
+
+optConstraintsUnder :: MonadAnalysis m => SClafer -> m [(SClafer, [I.PExp])]
+optConstraintsUnder clafer =
+    do
+        cons <- constraintsUnder clafer `select` snd
+        allCons <- optimizeAllConstraints clafer cons
+        let inCons = [(fst $ head c, optimizeInConstraints $ map snd c) | c <- groupBy (testing' $ uid . fst) $ sortBy (comparing' $ uid . fst) allCons]
+        return inCons
+    where
+    testing' f a b = f a == f b
+    comparing' f a b = f a `compare` f b
+
+
+constraintConstraints :: MonadScope m => m ()
+constraintConstraints =
+  do
+    runListT_ $ do
+      clafer <- foreach clafers
+      (supThis, cons) <- foreach $ optConstraintsUnder clafer
+      
+      con <- foreachM cons
+      curThis <-
+          if isAbstract supThis
+              then
+                  foreach $ colonsTo supThis
+              else
+                  return supThis
+      constraint <- foreach $ scopeConstraint curThis con
+
+      oneConstraint curThis constraint
+  where
+  --base (Part steps) = last steps
+  
+  oneConstraint c (e1, con, e2) =
+    void $ runMaybeT $ oneConstraintOneWay c e1 con e2 `mplus` oneConstraintOneWay c e2 (reverseCon con) e1
+  
+  oneConstraintOneWay c@SClafer{uid} e1 con e2 =
+    oneConstraint' e1 e2
+    where
+    oneConstraint' _ (This (Path []) _) =
+      mzero
+    oneConstraint' _ (Global (Path []) _) =
+      mzero
+    oneConstraint' (This (Path []) _) (This (Path parts) _) =
+      return (var uid) `comp` reifyVar (last parts)
+    oneConstraint' (This (Path []) _) (Global (Path parts) _) =
+      return (var uid) `comp` reifyVar (last parts)
+    oneConstraint' (Positive [Path []] _ _) _ =
+      mzero
+    oneConstraint' _ (Positive [Path []] _ _) =
+      mzero
+    oneConstraint' (Global (Path gParts) _) (Positive allPaths claf _) =
+      do
+        aux <- testPositives (map (reifyVarName . last . parts) allPaths)
+        reifyVar (last gParts) `comp` return (claf *^ var aux)
+    oneConstraint' (This (Path parts) _) (Const constant)
+      | con == EQU            = oneConstraintOneWay c e1 LEQ e2 >> oneConstraintOneWay c e1 GEQ e2
+      | con `elem` [GTH, GEQ] = foldM_ mkCon 1 (reverse parts)
+      | con `elem` [LTH, LEQ] = reifyVar (last parts) `comp` (return $ (fromInteger constant :: Double) *^ var uid)
+      where
+      mkCon :: MonadScope m => Integer -> Part -> m Integer
+      mkCon multiplier part =
+        do
+          let frac = (1 / fromInteger multiplier) * fromInteger constant :: Double
+          (reifyVar part) `comp` return (frac *^ var uid)
+          mult multiplier <$> prod part
+    oneConstraint' (Global (Path parts) _) (Const constant)
+      | con == EQU            = oneConstraintOneWay c e1 LEQ e2 >> oneConstraintOneWay c e1 GEQ e2
+      | con `elem` [GTH, GEQ] =
+          do
+            k <- testPositive uid
+            foldM_ (mkCon k) 1 (reverse parts)
+      | con `elem` [LTH, LEQ] = reifyVar (last parts) `compTo` (return $ fromInteger constant)
+      where
+      mkCon :: MonadScope m => String -> Integer -> Part -> m Integer
+      mkCon pos (-1) part =
+        do
+          (reifyVar part) `comp` return (var pos)
+          return (-1)
+      mkCon pos multiplier part =
+        do
+          let frac = (1 / fromInteger multiplier) * fromInteger constant :: Double
+          (reifyVar part) `comp` return (frac *^ var pos)
+          mult multiplier <$> prod part
+        
+    oneConstraint' (This (Path parts1) _) (This (Path parts2) _) =
+      reifyVar (last parts1) `comp` reifyVar (last parts2)
+    oneConstraint' (Global (Path parts1) _) (Global (Path parts2) _) =
+      reifyVar (last parts1) `comp` reifyVar (last parts2)
+    oneConstraint' (Global (Path parts) _) (Concat exprs _) =
+      if all isGlobal exprs
+        then reifyVar (last parts) `comp` reifyVars [last p | Global (Path p) _ <- exprs]
+        else mzero
+    oneConstraint' (This (Path parts) _) (Concat exprs _) =
+      if all isGlobal exprs
+        then do
+          let vs = [last p | Global (Path p) _ <- exprs]
+          claf <- mapM (claferWithUid . last . steps) $ vs
+          s <- mapM constantCard claf
+          p <- parentOfPart $ last parts
+          reifyVar (last parts) `comp` ((sum s *^) <$> reifyVar p)
+        else if all isThis exprs
+          then reifyVar (last parts) `comp` reifyVars [last p | This (Path p) _ <- exprs]
+          else mzero
+    oneConstraint' _ _ = mzero
+    
+    constantCard SClafer{low, high}
+      | low == high = return low
+      | otherwise   = mzero
+    
+    prod (Part steps) = foldr1 mult <$> mapM (return . high <=< claferWithUid) steps
+    
+    comp x y =
+      do
+        x' <- x
+        y' <- y
+        case con of
+          LTH -> (x' ^-^ y') `leqTo` (-smallM)
+          LEQ -> x' `leq` y'
+          EQU -> x' `equal` y'
+          GTH -> (x' ^-^ y') `geqTo` smallM
+          GEQ -> x' `geq` y'
+    compTo x y =
+      do
+        x' <- x
+        y' <- y
+        case con of
+          LTH -> x' `leqTo` (y' - smallM)
+          LEQ -> x' `leqTo` y'
+          EQU -> x' `equalTo` y'
+          GTH -> x' `geqTo` (y' + smallM)
+          GEQ -> x' `geqTo` y'
+
+  reifyVar p  = return (var $ reifyVarName p)
+  reifyVars p = return (varSum $ map reifyVarName p)
+  reifyVarName (Part [target]) = target
+  reifyVarName (Part target)   = uniqNameSpace ++ "reify_" ++ intercalate "_" target
+{- 
+  isAbstractPart (Part [_]) = False
+  isAbstractPart _ = True
+
+  reifiedSuper (Part steps) =
+    do
+      let (b : s : rest) = reverse steps
+      ss <- colonOf s
+      sss <- runMaybeT $ colonUid ss
+      if isNothing sss
+        then return $ Part $ reverse $ b : rest
+        else return $ Part $ reverse $ b : ss : rest
+  
+  -- TODO: correct?
+
+  siblingParts (Part (conc : abst)) =
+    do
+      conc' <- claferWithUid conc
+      sup   <- runMaybeT $ colonOf conc'
+      case sup of
+        Nothing -> return [Part $ conc : abst]
+        Just sup' -> runListT $ do
+            (sub, _) <- foreach $ anything |: sup'
+            return $ Part $ uid sub : abst
+  siblingParts [] = error "Function siblingParts from GLpkScopeAnalyzer expects a non empty list, given an empty one!" -- This should never happen
+  
+  reifyPart (Part steps) =
+    do
+      as <- claferWithUid (last steps) >>= nonTopAncestors
+      forM as $
+        \a -> return $ Part $ init steps ++ [uid a]
+  
+  nonTopAncestors child =
+    do
+      parent <- parentOf child
+      if uid parent == rootUid
+        then return []
+        else (++ [child]) `fmap` nonTopAncestors parent
+ -} 
+
+data Con = EQU | LTH | LEQ | GTH | GEQ deriving (Eq, Ord, Show)
+
+reverseCon :: Con -> Con
+reverseCon EQU = EQU
+reverseCon LTH = GTH
+reverseCon LEQ = GEQ
+reverseCon GTH = LTH
+reverseCon GEQ = LEQ
+data Limit = Exact {lExpr::Expr} | AtLeast {lExpr::Expr} deriving Show
+
+scopeConstraint :: MonadScope m => SClafer -> I.PExp -> m [(Expr, Con, Expr)]
+scopeConstraint curThis pexp =
+  runListT $ scopeConstraint' $ I.exp pexp
+  where
+  scopeConstraint' I.IFunExp {I.op = "&&", I.exps} = msum $ map (scopeConstraint' . I.exp) exps
+  scopeConstraint' I.IDeclPExp {I.quant = I.ISome, I.oDecls = [], I.bpexp} = parsePath curThis bpexp `greaterThanEqual` constant (1::Integer)
+  scopeConstraint' I.IDeclPExp {I.quant = I.ISome, I.oDecls}               = msum $ map pathAndMultDecl oDecls
+      where
+      pathAndMultDecl I.IDecl {I.isDisj = True, I.decls, I.body} = parsePath curThis body `greaterThanEqual` constant (length decls)
+      pathAndMultDecl I.IDecl {I.isDisj = False, I.body}         = parsePath curThis body `greaterThanEqual` constant (1::Integer)
+  scopeConstraint' I.IDeclPExp {I.quant = I.IOne, I.oDecls = [], I.bpexp} = parsePath curThis bpexp `eqTo` constant (1::Integer)
+  scopeConstraint' I.IDeclPExp {I.quant = I.IOne, I.oDecls} =
+    do
+      oDecl <- foreachM oDecls
+      parsePath curThis (I.body oDecl) `eqTo` constant (1::Integer)
+  scopeConstraint' I.IFunExp {I.op, I.exps = [exp1, exp2]}
+    | op == "in" = inConstraint1 exp1 exp2 `mplus` inConstraint2 exp1 exp2
+    | op == "="  = equalConstraint1 exp1 exp2 `mplus` equalConstraint2 exp1 exp2
+    | op == "<"  = scopeConstraintNum exp1 `lessThan` scopeConstraintNum exp2
+    | op == "<=" = scopeConstraintNum exp1 `lessThanEqual` scopeConstraintNum exp2
+    | op == ">"  = scopeConstraintNum exp1 `greaterThan` scopeConstraintNum exp2
+    | op == ">=" = scopeConstraintNum exp1 `greaterThanEqual` scopeConstraintNum exp2
+    | op == "<=>" = (exp1 `implies` exp2) `mplus` (exp2 `implies` exp1)
+    | op == "=>" = exp1 `implies` exp2
+  scopeConstraint' _ = mzero
+  
+  implies exp1 exp2 =
+    do
+      e1 <- scopeConstraint' $ I.exp exp1
+      e2 <- scopeConstraint' $ I.exp exp2
+
+      case (e1, e2) of
+        ((This thisPath t1, GEQ, Const 1), (Global globalPath t0, comp, Positive allPaths c t2)) ->
+          return $ (Global globalPath t0, comp, Positive (thisPath : allPaths) c $ t1 +++ t2)
+        ((This thisPath e1', GEQ, Const 1), (Global globalPath e2', comp, Const c)) ->
+          return $ (Global globalPath e2', comp, Positive [thisPath] c e1')
+        ((Global path1 t1, GEQ, Const 1), (Global path2 t0, comp, Positive allPaths c t2)) ->
+          return $ (Global path2 t0, comp, Positive (path1 : allPaths) c $ t1 +++ t2)
+        ((Global path1 e1', GEQ, Const 1), (Global path2 e2', comp, Const c)) ->
+          return $ (Global path2 e2', comp, Positive [path1] c e1')
+        ((t1@(This (Path [thisPart1]) _), GEQ, Const 1), (t2@(This (Path [_]) _), GEQ, Const 1)) ->
+            do
+                c <- claferWithUid $ last $ steps thisPart1
+                guard (high c == 1)
+                return (t2, GEQ, t1)
+        _ -> mzero
+
+  equalConstraint1 exp1 exp2 =
+    do
+      l1 <- scopeConstraintSet exp1
+      l2 <- scopeConstraintSet exp2
+      case (l1, l2) of
+        (Exact e1, Exact e2)   -> return e1 `eqTo` return e2
+        (AtLeast e1, Exact e2) -> return e1 `greaterThanEqual` return e2
+        (Exact e1, AtLeast e2) -> return e1 `lessThanEqual` return e2
+        _ -> mzero
+  equalConstraint2 exp1 exp2 = scopeConstraintNum exp1 `eqTo` scopeConstraintNum exp2
+  
+  -- exp1 in exp2
+  inConstraint1 exp1 exp2 =
+    do
+      l1 <- scopeConstraintSet exp1
+      l2 <- scopeConstraintSet exp2
+
+      case l2 of
+        Exact e2 -> return (lExpr l1) `lessThanEqual` return e2
+        _ -> mzero
+  inConstraint2 exp1 exp2 = scopeConstraintNum exp1 `lessThanEqual` scopeConstraintNum exp2
+
+  scopeConstraintSet I.PExp {I.exp = I.IFunExp {I.op = "++", I.exps = [e1, e2]}} =
+    do
+      l1' <- scopeConstraintSet e1
+      l2' <- scopeConstraintSet e2
+      i   <- intersects (eType $ lExpr l1') (eType $ lExpr l2')
+      if i
+        then return $ AtLeast $ lExpr l1'
+        else return $ combineDisjoint l1' l2'
+  scopeConstraintSet x = Exact <$> parsePath curThis x
+  
+  combineDisjoint (Exact e1) (Exact e2) =
+    Exact (Concat ([e1, e2] >>= flattenConcat) $ eType e1 +++ eType e2)
+  combineDisjoint l1 l2 =
+    AtLeast (Concat ([e1, e2] >>= flattenConcat) $ eType e1 +++ eType e2)
+    where
+    e1 = lExpr l1
+    e2 = lExpr l2
+    
+
+  flattenConcat (Concat es _) = es >>= flattenConcat
+  flattenConcat e = [e]
+  
+  scopeConstraintNum I.PExp {I.exp = I.IInt const'} = constant const'
+  scopeConstraintNum I.PExp {I.exp = I.IFunExp {I.op = "#", I.exps = [path]}} = parsePath curThis path
+  scopeConstraintNum _ = mzero
+
+  constant :: (Monad m, Integral i) => i -> m Expr
+  constant = return . Const . toInteger
+
+  greaterThan = liftM2 (,GTH,)
+  greaterThanEqual = liftM2 (,GEQ,)
+  lessThan = liftM2 (,LTH,)
+  lessThanEqual = liftM2 (,LEQ,)
+  eqTo = liftM2 (,EQU,)
+
+
+{-
+ - We use the stack to push every abstraction we traverse through.
+ - For example:
+ - 
+ -  abstract A
+ -    B ?
+ -      C : D ?
+ -  abstract D
+ -    E ?
+ -  F : A
+ -  G : A
+ -  H : A
+ -
+ -  [some F.B.C.E]
+ -  [some G.B.C.E]
+ -
+ - The first constraint's final stack will look like ["C" ,"F"]
+ - Hence the linear programming equation will look like:
+ -
+ -  scope_F_C_E >= scope_root
+ -
+ - Adding the second constraint:
+ -
+ -  scope_G_C_E >= scope_root
+ -  scope_E >= scope_F_C_E + scope_G_C_E (*)
+ -
+ - Solving the minimization should have scope_E = 2 in its solution.
+ - The (*) equation is set in constraintConstraints
+ -}      
+parsePath :: MonadScope m => SClafer -> I.PExp -> m Expr
+parsePath start pexp =
+    do
+        start' <- claferWithUid (origUid start)
+        parsePath2 start' pexp
+ 
+parsePath2 :: MonadScope m => SClafer -> I.PExp -> m Expr
+parsePath2 start pexp =
+  do
+    root <- claferWithUid rootUid
+    case unfoldJoins pexp of
+        Just unfold -> do
+            match <- patternMatch parsePath' (ParseState root []) unfold
+            either (fail . show) return match
+        Nothing     -> fail "Cannot unfold."
+  where
+  asPath :: [[String]] -> Path
+  asPath parts = Path [Part part | part <- parts, not $ null part]
+  
+  parsePath' = (This <$> (asPath <$> parseThisPath) <*> getThisType) <|> (Global <$> (asPath <$> parseNonthisPath) <*> getThisType)
+  
+  getThisType =
+    do
+        t <- getThis
+        return $ fromJust $ fromUnionType [uid t]
+  
+  parseThisPath =
+    do
+      t <- _this_
+      do
+        many1 _parent_
+        return [[uid start]]
+        <|> (follow t >> parseNonthisPath)
+  parseNonthisPath =
+    do
+      paths <- many (step >>= follow)
+      
+      lifo <- popStack
+      let end = if null paths then [] else [last paths]
+      let result = reverse $ end ++ map uid lifo
+      
+      do
+        _ref_ >>= follow
+        -- recurse
+        rec <- parseNonthisPath
+        return $ result : rec
+        <|> return [result]
+      
+  -- Step handles non-this token.
+  step :: MonadScope m => ParseT m String
+  step = _parent_ <|> _directChild_ <|> try (pushThis >> _indirectChild_)
+  
+  -- Update the state of where "this" is.
+  -- Path is one step away from where "this" is.
+  follow :: MonadScope m => String -> ParseT m String
+  follow path =
+    do
+      curThis <- getThis
+      case path of
+        "this" -> putThis start
+        "parent" -> lift (parentOf curThis) >>= putThis -- the parent is now "this"
+        "ref" -> lift (refOf curThis) >>= putThis -- the ref'd Clafer is now "this"
+        u -> lift (claferWithUid u) >>= putThis
+      return path
+
+
+
+      
+      
+{------------------------------------------------------------
+ ---------- Internals ---------------------------------------
+ ------------------------------------------------------------}
+
+newtype ScopeAnalysis a = ScopeAnalysis (VSupplyT (AnalysisT (LPM String Double)) a)
+  deriving (Monad, Functor, MonadState (LP String Double), MonadSupply Var, MonadReader Info, MonadAnalysis)
+
+class (MonadAnalysis m, MonadState (LP String Double) m, MonadSupply Var m) => MonadScope m
+
+instance (MonadAnalysis m, MonadState (LP String Double) m, MonadSupply Var m) => MonadScope m
+
+
+runScopeAnalysis :: ScopeAnalysis a -> Info -> (a, LP String Double)
+runScopeAnalysis (ScopeAnalysis s) info = runLPM $ runAnalysisT (runVSupplyT s) info
+
+-- Unfold joins
+-- If the expression is a tree of only joins, then this function will flatten
+-- the joins into a list.
+-- Otherwise, returns an empty list.
+unfoldJoins :: Monad m => I.PExp -> m [Token]
+unfoldJoins pexp =
+    unfoldJoins' pexp
+    where
+    unfoldJoins' I.PExp{I.exp = (I.IFunExp "." args)} =
+        return $ args >>= (fromMaybe [] . unfoldJoins)
+    unfoldJoins' I.PExp{I.inPos, I.exp = I.IClaferId{I.sident}} =
+        return $ [Token (spanToSourcePos inPos) sident]
+    unfoldJoins' _ =
+        fail "not a join"
+
+
+-- Variables starting with "_aux_" are reserved for creating
+-- new variables at runtime.
+uniqNameSpace :: String
+uniqNameSpace = "_aux_"
+
+uniqVar :: MonadScope m => m String
+uniqVar =
+  do
+    c <- supplyNew
+    return $ uniqNameSpace ++ show (varId c)
+
+{-
+ - Create a new variable "aux". If
+ -   v == 0 -> aux == 0
+ -   v > 0  -> aux == 1
+ -
+ - pre: v >= 0 and v is integer
+ -}
+testPositive :: MonadScope m => String -> m String
+testPositive v =
+  do
+    aux <- uniqVar
+    var aux `leq` var v
+    var aux `geq` (smallM *^ var v)
+    var aux `leqTo` 1
+    setVarKind aux IntVar
+    return aux
+    
+{-
+ - Create a new variable "aux". If
+ -   all v == 0 -> aux == 0
+ -   all v > 0  -> aux == 1
+ -
+ - pre: all v >= 0 and all v is integer
+ -}
+testPositives :: MonadScope m => [String] -> m String
+testPositives [v] = testPositive v
+testPositives vs =
+  do
+    auxs <- mapM testPositive vs
+    aux <- uniqVar
+    (length vs *^ var aux) `equal` varSum auxs
+    
+    a <- uniqVar
+    (var a ^-^ var aux) `geqTo` (-0.9999) -- Buffer for floating point inaccuracies
+    (var a ^-^ var aux) `leqTo` 0.0001    -- Buffer for floating point inaccuracies
+    setVarKind a IntVar
+    return a
+
+{-
+ - smallM cannot be too small. For example, with glpk
+ -   0.000001 * 9 = 0
+ -}
+smallM :: Double
+smallM = 0.0005 -- 0.00001
+
+
+
+
+
+{-
+ -
+ - Parsing
+ -
+ -}
+data Token = Token {tPos::SourcePos, tLexeme::String} deriving Show
+
+data ParseState = ParseState
+  {psThis::SClafer, -- "this"
+   psStack::[SClafer] -- the list of all the abstract Clafers traversed
+   }
+   deriving Show
+type ParseT = ParsecT [Token] ParseState
+
+
+-- Where "this" refers to.
+getThis :: MonadScope m => ParseT m SClafer
+getThis =
+  do
+    s <- getState
+    return (psThis s)
+
+-- Update where "this" refers to.
+putThis :: MonadScope m => SClafer -> ParseT m ()
+putThis newThis = 
+  do
+    state' <- getState
+    putState $ state'{psThis = newThis}
+
+popStack :: MonadScope m => ParseT m [SClafer]
+popStack =
+  do
+    state' <- getState
+    let stack = psStack state'
+    putState state'{psStack = []}
+    return stack
+
+pushThis :: MonadScope m => ParseT m ()
+pushThis =
+  do
+    state' <- getState
+    putState $ state'{psStack = psThis state' : psStack state'}
+
+
+-- Parser combinator for "this"
+_this_ :: MonadScope m => ParseT m String
+_this_ = satisfy (== "this")
+
+-- Parser combinator for "parent"
+_parent_ :: MonadScope m => ParseT m String
+_parent_ = satisfy (== "parent")
+
+-- Parser combinator for "ref"
+_ref_ :: MonadScope m => ParseT m String
+_ref_ = satisfy (== "ref")
+
+-- Parser combinator for a uid that is not "this", "parent", or "ref"
+_child_ :: MonadScope m => ParseT m String
+_child_ = satisfy (not . (`elem` ["this", "parent", "ref"]))
+
+-- Parser combinator for a uid of direct child.
+_directChild_ :: MonadScope m => ParseT m String
+_directChild_ =
+  try $ do
+    curThis <- getThis
+    clafer <- _child_ >>= lift . claferWithUid
+    check <- lift $ isDirectChild clafer curThis
+    when (not check) $ unexpected $ (uid clafer) ++ " is not a direct child of " ++ (uid curThis)
+    return $ uid clafer
+
+-- Parser combinator for a uid of indirect child.
+_indirectChild_ :: MonadScope m => ParseT m String
+_indirectChild_ =
+  try $ do
+    curThis <- getThis
+    clafer <- _child_ >>= lift . claferWithUid
+    check <- lift $ isIndirectChild clafer curThis
+    when (not check) $ unexpected $ (uid clafer) ++ " is not an indirect child of " ++ (uid curThis)
+    return $ uid clafer    
+    
+
+satisfy :: MonadScope m => (String -> Bool) -> ParseT m String
+satisfy f = tLexeme <$> tokenPrim (tLexeme)
+                                  (\_ c _ -> tPos c)
+                                  (\c -> if f $ tLexeme c then Just c else Nothing)
+
+
+spanToSourcePos :: Span -> SourcePos
+spanToSourcePos (Span (Pos l c) _) = (newPos "" (fromInteger l) (fromInteger c))
+spanToSourcePos (PosSpan _ (Pos l c) _) = (newPos "" (fromInteger l) (fromInteger c))
+spanToSourcePos (Span (PosPos _ l c) _) = (newPos "" (fromInteger l) (fromInteger c))
+spanToSourcePos (PosSpan _ (PosPos _ l c) _) = (newPos "" (fromInteger l) (fromInteger c))
+
+patternMatch :: MonadScope m => ParseT m a -> ParseState -> [Token] -> m (Either ParseError a)
+patternMatch parse' state' =
+  runParserT (parse' <* eof) state' ""
+
+{-
+ -
+ - Utility functions
+ -
+ -}
+ 
+subexpressions :: I.PExp -> [I.PExp]
+subexpressions p@I.PExp{I.exp = exp'} =
+  p : subexpressions' exp'
+  where
+  subexpressions' I.IDeclPExp{I.oDecls, I.bpexp} =
+    concatMap (subexpressions . I.body) oDecls ++ subexpressions bpexp
+  subexpressions' I.IFunExp{I.exps} = concatMap subexpressions exps
+  subexpressions' _ = []
+
+instance MonadSupply s m => MonadSupply s (ListT m) where
+  supplyNew = lift supplyNew
+  
+instance MonadSupply s m => MonadSupply s (MaybeT m) where
+  supplyNew = lift supplyNew
+
+instance MonadSupply s m => MonadSupply s (ParsecT a b m) where
+  supplyNew = lift supplyNew
+ src/Language/Clafer/Intermediate/Intclafer.hs view
@@ -0,0 +1,344 @@+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Luke Michael Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Intermediate representation (IR) of a Clafer model
+module Language.Clafer.Intermediate.Intclafer where
+
+import Language.Clafer.Front.Absclafer
+import Data.Monoid
+import Data.Foldable (foldMap)
+
+-- | unique identifier of a clafer
+type UID = String    
+-- | clafer name as declared in the source model
+type CName = String  
+
+-- | A "supertype" of all IR types
+data Ir =
+  IRIModule IModule | 
+  IRIElement IElement |
+  IRIType IType |
+  IRClafer IClafer |
+  IRIExp IExp |
+  IRPExp PExp |
+  IRISuper ISuper |
+  IRIQuant IQuant |
+  IRIDecl IDecl |
+  IRIGCard IGCard
+  deriving (Eq, Show)
+
+data IType = TBoolean
+           | TString
+           | TInteger
+           | TReal
+           | TClafer [String]
+  deriving (Eq,Ord,Show)
+
+-- | each file contains exactly one mode. A module is a list of declarations
+data IModule = IModule {
+      -- | always empty for now because we don't have syntax for declaring modules
+      mName :: String,    
+      -- | List of top-level elements
+      mDecls :: [IElement]
+    }
+  deriving (Eq,Ord,Show)
+
+-- | Clafer has a list of fields that specify its properties. Some fields, marked as (o) are for generating optimized code
+data IClafer =
+   IClafer {
+      -- | the position of the syntax in source code
+      cinPos :: Span,         
+      -- | whether abstract or not (i.e., concrete)
+      isAbstract :: Bool,     
+      -- | group cardinality
+      gcard :: Maybe IGCard,  
+      -- | name declared in the model
+      ident :: CName,         
+      -- | a unique identifier
+      uid :: UID,             
+      -- | superclafers
+      super:: ISuper,         
+      -- | clafer cardinality
+      card :: Maybe Interval,
+       -- | (o) global cardinality 
+      glCard :: Interval,    
+      -- | nested elements
+      elements :: [IElement]  
+    }
+  deriving (Eq,Ord,Show)
+
+-- | Clafer's subelement is either a clafer, a constraint, or a goal (objective)
+--   This is a wrapper type needed to have polymorphic lists of elements
+data IElement =
+   IEClafer IClafer
+ | IEConstraint {
+      -- | whether hard or not (soft)
+      isHard :: Bool,     
+      -- | the container of the actual expression
+      cpexp :: PExp       
+    }
+  -- | Goal (optimization objective)
+ | IEGoal {
+   isMaximize :: Bool,    -- whether maximize or minimize
+   cpexp :: PExp          -- the expression
+   }
+  deriving (Eq,Ord,Show)
+
+-- | A list of superclafers.  
+--   ->    overlaping unique (set)
+--   ->>   overlapping non-unique (bag)
+--   :     non overlapping (disjoint)
+data ISuper =
+   ISuper {
+      isOverlapping :: Bool,  -- whether overlapping or disjoint with other clafers extending given list of superclafers
+      supers :: [PExp]
+    }
+  deriving (Eq,Ord,Show)
+
+-- | Group cardinality is specified as an interval. It may also be given by a keyword.
+--   xor    1..1 isKeyword = True
+--   1..1   1..1 isKeyword = False
+data IGCard =
+  IGCard {
+      isKeyword :: Bool,    -- whether given by keyword: or, xor, mux
+      interval :: Interval
+    }
+  deriving (Eq,Ord,Show)
+
+-- | (Min, Max) integer interval. -1 denotes *
+type Interval = (Integer, Integer)
+
+-- | This is expression container (parent). 
+--   It has meta information about an actual expression 'exp'
+data PExp = PExp {
+      -- | the inferred type
+      iType :: Maybe IType,  
+      -- | non-empty unique id for expressions with span, \"\" for noSpan
+      pid :: String,         
+      -- | position in the input Clafer file
+      inPos :: Span,         
+      -- | the actual expression
+      exp :: IExp            
+    }
+  deriving (Eq,Ord,Show)
+
+
+data IExp = 
+   -- | quantified expression with declarations
+   --   e.g., [ all x1; x2 : X | x1.ref != x2.ref ]
+   IDeclPExp {quant :: IQuant, oDecls :: [IDecl], bpexp :: PExp}
+   -- | expression with a
+   --   unary function, e.g., -1
+   --   binary function, e.g., 2 + 3
+   --   ternary function, e.g., if x then 4 else 5
+ | IFunExp {op :: String, exps :: [PExp]}
+ -- | integer number
+ | IInt Integer
+ -- | real number
+ | IDouble Double
+ -- | string
+ | IStr String
+ -- | a reference to a clafer name
+ | IClaferId {                   
+      -- | module name - currently not used and empty since we have no module system
+      modName :: String,         
+      -- | name of the clafer being referred to
+      sident :: CName,          
+      -- | identifier refers to a top-level definition
+      isTop :: Bool
+    }
+  deriving (Eq,Ord,Show)
+
+{- |
+For IFunExp standard set of operators includes:
+1. Unary operators:
+        !          - not (logical)
+        #          - set counting operator
+        -          - negation (arithmetic)
+        max        - maximum (created for goals)
+        min        - minimum (created for goals)
+2. Binary operators:
+        \<=\>        - equivalence
+        =\>         - implication
+        ||         - disjunction
+        xor        - exclusive or
+        &&         - conjunction
+        \<          - less than
+        \>          - greater than
+        =          - equality
+        \<=         - less than or equal
+        \>=         - greater than or equal
+        !=         - inequality
+        in         - belonging to a set/being a subset
+        nin        - not belonging to a set/not being a subset
+        +          - addition/string concatenation
+        -          - substraction
+        *          - multiplication
+        /          - division
+        ++         - set union
+        \-\-         - set difference
+        &          - set intersection
+        \<:         - domain restriction
+        :\>         - range restriction
+        .          - relational join
+3. Ternary operators
+        ifthenelse -- if then else
+-}
+
+-- | Local declaration
+--   disj x1; x2 : X ++ Y
+--   y1 : Y 
+data IDecl =
+   IDecl {
+      -- | is disjunct
+      isDisj :: Bool,    
+      -- | a list of local names 
+      decls :: [CName],  
+      -- | set to which local names refer to
+      body :: PExp        
+    }
+  deriving (Eq,Ord,Show)
+
+-- | quantifier
+data IQuant =
+ -- | does not exist
+   INo    
+ -- | less than one
+ | ILone  
+ -- | exactly one
+ | IOne   
+ -- | at least one (i.e., exists)
+ | ISome  
+ -- | for all
+ | IAll   
+  deriving (Eq,Ord,Show)
+
+type LineNo = Integer
+type ColNo  = Integer
+
+
+{-Ir Traverse Functions-}
+-------------------------
+
+-- | map over IR
+mapIR :: (Ir -> Ir) -> IModule -> IModule -- fmap/map for IModule
+mapIR f (IModule name decls') = 
+  unWrapIModule $ f $ IRIModule $ IModule name $ map (unWrapIElement . iMap f . IRIElement) decls'
+
+-- | foldMap over IR
+foldMapIR :: (Monoid m) => (Ir -> m) -> IModule -> m -- foldMap for IModule
+foldMapIR f i@(IModule _ decls') = 
+  (f $ IRIModule i) `mappend` foldMap (iFoldMap f . IRIElement) decls'
+
+-- | fold the IR
+foldIR :: (Ir -> a -> a) -> a -> IModule -> a -- a basic fold for IModule
+foldIR f e m = appEndo (foldMapIR (Endo . f) m) e
+
+{-
+Note: even though the above functions take an IModule, 
+the functions they use take an Ir (wrapped version see top of module). 
+Also the bellow functions are just helpers for the above, you may use
+them if you wish to start from somewhere other than IModule.
+-}
+
+iMap :: (Ir -> Ir) -> Ir -> Ir 
+iMap f (IRIElement (IEClafer c)) = 
+  f $ IRIElement $ IEClafer $ unWrapIClafer $ iMap f $ IRClafer c
+iMap f (IRIElement (IEConstraint h pexp)) =
+  f $ IRIElement $ IEConstraint h $ unWrapPExp $ iMap f $ IRPExp pexp
+iMap f (IRIElement (IEGoal m pexp)) =
+  f $ IRIElement $ IEGoal m $ unWrapPExp $ iMap f $ IRPExp pexp 
+iMap f (IRClafer (IClafer p a (Just grc) i u s c goc elems)) =
+  f $ IRClafer $ IClafer p a (Just $ unWrapIGCard $ iMap f $ IRIGCard grc) i u (unWrapISuper $ iMap f $ IRISuper s) c goc $ map (unWrapIElement . iMap f . IRIElement) elems
+iMap f (IRClafer (IClafer p a Nothing i u s c goc elems)) =
+  f $ IRClafer $ IClafer p a Nothing i u (unWrapISuper $ iMap f $ IRISuper s) c goc $ map (unWrapIElement . iMap f . IRIElement) elems
+iMap f (IRIExp (IDeclPExp q decs p)) =
+  f $ IRIExp $ IDeclPExp (unWrapIQuant $ iMap f $ IRIQuant q) (map (unWrapIDecl . iMap f . IRIDecl) decs) $ unWrapPExp $ iMap f $ IRPExp p
+iMap f (IRIExp (IFunExp o pexps)) = 
+  f $ IRIExp $ IFunExp o $ map (unWrapPExp . iMap f . IRPExp) pexps
+iMap f (IRPExp (PExp (Just iType') pID p iExp)) =
+  f $ IRPExp $ PExp (Just $ unWrapIType $ iMap f $ IRIType iType') pID p $ unWrapIExp $ iMap f $ IRIExp iExp
+iMap f (IRPExp (PExp Nothing pID p iExp)) =
+  f $ IRPExp $ PExp Nothing pID p $ unWrapIExp $ iMap f $ IRIExp iExp
+iMap f (IRISuper (ISuper o pexps)) =
+  f $ IRISuper $ ISuper o $ map (unWrapPExp . iMap f . IRPExp) pexps
+iMap f (IRIDecl (IDecl i d body')) = 
+  f $ IRIDecl $ IDecl i d $ unWrapPExp $ iMap f $ IRPExp body'
+iMap f i = f i
+
+iFoldMap :: (Monoid m) => (Ir -> m) -> Ir -> m
+iFoldMap f i@(IRIElement (IEConstraint _ pexp)) =
+  f i `mappend` (iFoldMap f $ IRPExp pexp)
+iFoldMap f i@(IRIElement (IEGoal _ pexp)) =
+  f i `mappend` (iFoldMap f $ IRPExp pexp)
+iFoldMap f i@(IRClafer (IClafer _ _ Nothing _ _ s _ _ elems)) =
+  f i `mappend` (iFoldMap f $ IRISuper s) `mappend` foldMap (iFoldMap f . IRIElement) elems
+iFoldMap f i@(IRClafer (IClafer _ _ (Just grc) _ _ s _ _ elems)) =
+  f i `mappend` (iFoldMap f $ IRISuper s) `mappend` (iFoldMap f $ IRIGCard grc) `mappend` foldMap (iFoldMap f . IRIElement) elems
+iFoldMap f i@(IRIExp (IDeclPExp q decs p)) =
+  f i `mappend` (iFoldMap f $ IRIQuant q) `mappend` (iFoldMap f $ IRPExp p) `mappend` foldMap (iFoldMap f . IRIDecl) decs
+iFoldMap f i@(IRIExp (IFunExp _ pexps)) = 
+  f i `mappend` foldMap (iFoldMap f . IRPExp) pexps
+iFoldMap f i@(IRPExp (PExp (Just iType') _ _ iExp)) =
+  f i `mappend` (iFoldMap f $ IRIType iType') `mappend` (iFoldMap f $ IRIExp iExp)
+iFoldMap f i@(IRPExp (PExp Nothing _ _ iExp)) =
+  f i `mappend` (iFoldMap f $ IRIExp iExp)
+iFoldMap f i@(IRISuper (ISuper _ pexps)) =
+  f i `mappend` foldMap (iFoldMap f . IRPExp) pexps
+iFoldMap f i@(IRIDecl (IDecl _ _ body')) = 
+  f i `mappend` (iFoldMap f $ IRPExp body')
+iFoldMap f (IRIElement (IEClafer c)) = iFoldMap f $ IRClafer c
+iFoldMap f i = f i
+
+iFold :: (Ir -> a -> a) -> a -> Ir -> a
+iFold f e m = appEndo (iFoldMap (Endo . f) m) e
+
+
+unWrapIModule :: Ir -> IModule
+unWrapIModule (IRIModule x) = x
+unWrapIModule x = error $ "Can't call unWarpIModule on " ++ show x
+unWrapIElement :: Ir -> IElement
+unWrapIElement (IRIElement x) = x
+unWrapIElement x = error $ "Can't call unWarpIElement on " ++ show x
+unWrapIType :: Ir -> IType
+unWrapIType (IRIType x) = x
+unWrapIType x = error $ "Can't call unWarpIType on " ++ show x
+unWrapIClafer :: Ir -> IClafer
+unWrapIClafer (IRClafer x) = x
+unWrapIClafer x = error $ "Can't call unWarpIClafer on " ++ show x
+unWrapIExp :: Ir -> IExp
+unWrapIExp (IRIExp x) = x
+unWrapIExp x = error $ "Can't call unWarpIExp on " ++ show x
+unWrapPExp :: Ir -> PExp
+unWrapPExp (IRPExp x) = x
+unWrapPExp x = error $ "Can't call unWarpPExp on " ++ show x
+unWrapISuper :: Ir -> ISuper
+unWrapISuper (IRISuper x) = x
+unWrapISuper x = error $ "Can't call unWarpISuper on " ++ show x
+unWrapIQuant :: Ir -> IQuant
+unWrapIQuant (IRIQuant x) = x
+unWrapIQuant x = error $ "Can't call unWarpIQuant on " ++ show x
+unWrapIDecl :: Ir -> IDecl
+unWrapIDecl (IRIDecl x) = x
+unWrapIDecl x = error $ "Can't call unWarpIDecl on " ++ show x
+unWrapIGCard :: Ir -> IGCard
+unWrapIGCard (IRIGCard x) = x
+unWrapIGCard x = error $ "Can't call unWarpIGcard on " ++ show x
+ src/Language/Clafer/Intermediate/Resolver.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts #-}
+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.Resolver where
+
+import Control.Monad
+import Control.Monad.State
+import qualified Data.Map as Map
+
+import Language.Clafer.Common
+import Language.Clafer.ClaferArgs
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Intermediate.ResolverName
+import Language.Clafer.Intermediate.ResolverType
+import Language.Clafer.Intermediate.ResolverInheritance
+
+-- | Run the various resolvers
+resolveModule :: ClaferArgs -> IModule -> Resolve (IModule, GEnv)
+resolveModule args' declarations =
+  do
+    r <- resolveNModule $ nameModule (skip_resolver args') declarations
+    resolveNamesModule args' =<< (rom' $ rem' r)
+  where
+  rem' = if flatten_inheritance args' then resolveEModule else id
+  rom' = if skip_resolver args' then return . id else resolveOModule
+
+
+-- | Name resolver
+nameModule :: Bool -> IModule -> (IModule, GEnv)
+nameModule skipResolver imodule = (imodule{mDecls = decls'}, genv')
+  where
+  (decls', genv') = runState (mapM (nameElement skipResolver) $ mDecls imodule) $ GEnv Map.empty 0 Map.empty []
+
+nameElement :: MonadState GEnv m => Bool -> IElement -> m IElement
+nameElement skipResolver x = case x of
+  IEClafer claf -> IEClafer `liftM` (nameClafer skipResolver claf)
+  IEConstraint isHard' pexp -> IEConstraint isHard' `liftM` (namePExp pexp)
+  IEGoal isMaximize' pexp -> IEGoal isMaximize' `liftM` (namePExp pexp)
+
+
+nameClafer :: MonadState GEnv m => Bool -> IClafer -> m IClafer
+nameClafer skipResolver claf = do
+  claf' <- if skipResolver then return claf{uid = ident claf} else (renameClafer (not skipResolver)) claf
+  elements' <- mapM (nameElement skipResolver) $ elements claf
+  return $ claf' {elements = elements'}
+
+
+namePExp :: MonadState GEnv m => PExp -> m PExp
+namePExp pexp@(PExp _ _ _ exp') = do
+  n <- gets expCount
+  modify (\e -> e {expCount = 1 + n})
+  exp'' <- nameIExp exp'
+  return $ pexp {pid = concat [ "e", show n, "_"], Language.Clafer.Intermediate.Intclafer.exp = exp''}
+
+nameIExp :: MonadState GEnv m => IExp -> m IExp
+nameIExp x = case x of
+  IDeclPExp quant' decls' pexp -> do
+    decls'' <- mapM nameIDecl decls'
+    pexp'  <- namePExp pexp
+    return $ IDeclPExp quant' decls'' pexp'
+  IFunExp op' pexps -> IFunExp op' `liftM` (mapM namePExp pexps)
+  _ -> return x
+
+nameIDecl :: MonadState GEnv m => IDecl -> m IDecl
+nameIDecl (IDecl isDisj' dels body') = IDecl isDisj' dels `liftM` (namePExp body')
+
+-- -----------------------------------------------------------------------------
+resolveNamesModule :: ClaferArgs -> (IModule, GEnv) -> Resolve (IModule, GEnv)
+resolveNamesModule args' (declarations, genv') =
+  do
+    res <- foldM (flip ($)) declarations $ map (\f -> flip (curry f) genv') funs
+    return (res, genv')
+  where
+  funs :: [(IModule, GEnv) -> Resolve IModule]
+  funs
+    | skip_resolver args' = [return . analyzeModule, resolveTModule]
+    | otherwise = [ return . analyzeModule, resolveModuleNames, resolveTModule]
+ src/Language/Clafer/Intermediate/ResolverInheritance.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE FlexibleContexts #-}
+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.ResolverInheritance where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error
+import Control.Monad.State
+import Data.Maybe
+import Data.Graph
+import Data.Tree
+import Data.List
+import qualified Data.Map as Map
+
+import Language.ClaferT
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Intermediate.ResolverName
+
+
+-- | Resolve Non-overlapping inheritance
+resolveNModule :: (IModule, GEnv) -> Resolve (IModule, GEnv)
+resolveNModule (imodule, genv') =
+  do
+    let decls' = mDecls imodule
+    decls'' <- mapM (resolveNElement decls') decls'
+    return (imodule{mDecls = decls''}, genv' {sClafers = bfs toNodeShallow $ toClafers decls''})
+    
+
+
+resolveNClafer :: [IElement] -> IClafer -> Resolve IClafer
+resolveNClafer declarations clafer =
+  do
+    super'    <- resolveNSuper declarations $ super clafer
+    elements' <- mapM (resolveNElement declarations) $ elements clafer
+    return $ clafer {super = super',
+            elements = elements'}
+
+
+resolveNSuper :: [IElement] -> ISuper -> Resolve ISuper
+resolveNSuper declarations x = case x of
+  ISuper False [PExp _ pid' pos' (IClaferId _ id' isTop')] ->
+    if isPrimitive id' || id' == "clafer"
+      then return x
+      else do
+        r <- resolveN pos' declarations id'
+        id'' <- case r of
+          Nothing -> throwError $ SemanticErr pos' $ "No superclafer found: " ++ id'
+          Just m  -> return $ fst m
+        return $ ISuper False [idToPExp pid' pos' "" id'' isTop']
+  _ -> return x
+
+
+resolveNElement :: [IElement] -> IElement -> Resolve IElement
+resolveNElement declarations x = case x of
+  IEClafer clafer  -> IEClafer <$> resolveNClafer declarations clafer
+  IEConstraint _ _  -> return x
+  IEGoal _ _ -> return x
+
+resolveN :: Span -> [IElement] -> String -> Resolve (Maybe (String, [IClafer]))
+resolveN pos' declarations id' =
+  findUnique pos' id' $ map (\x -> (x, [x])) $ filter isAbstract $ bfsClafers $
+    toClafers declarations
+
+-- | Resolve overlapping inheritance
+resolveOModule :: (IModule, GEnv) -> Resolve (IModule, GEnv)
+resolveOModule (imodule, genv') =
+  do
+    let decls' = mDecls imodule
+    decls'' <- mapM (resolveOElement (defSEnv genv' decls')) decls'
+    return (imodule {mDecls = decls''}, genv' {sClafers = bfs toNodeShallow $ toClafers decls''})
+
+
+resolveOClafer :: SEnv -> IClafer -> Resolve IClafer
+resolveOClafer env clafer =
+  do
+    super' <- resolveOSuper env {context = Just clafer} $ super clafer
+    elements' <- mapM (resolveOElement env {context = Just clafer}) $ elements clafer
+    return $ clafer {super = super', elements = elements'}
+
+
+resolveOSuper :: SEnv -> ISuper -> Resolve ISuper
+resolveOSuper env x = case x of
+  ISuper True exps' -> do
+    exps''     <- mapM (resolvePExp env) exps'
+    let isOverlap = not (length exps'' == 1 && isPrimitive (getSuperId exps''))
+    return $ ISuper isOverlap  exps''
+  _ -> return x
+
+
+resolveOElement :: SEnv -> IElement -> Resolve IElement
+resolveOElement env x = case x of
+  IEClafer clafer  -> IEClafer <$> resolveOClafer env clafer
+  IEConstraint _ _ -> return x
+  IEGoal _ _ -> return x
+  
+
+-- | Resolve inherited and default cardinalities
+analyzeModule :: (IModule, GEnv) -> IModule
+analyzeModule (imodule, genv') =
+  imodule{mDecls = map (analyzeElement (defSEnv genv' decls')) decls'}
+  where
+  decls' = mDecls imodule
+
+
+analyzeClafer :: SEnv -> IClafer -> IClafer
+analyzeClafer env clafer =
+  clafer' {elements = map (analyzeElement env {context = Just clafer'}) $
+           elements clafer'}
+  where
+  clafer' = clafer {gcard = analyzeGCard env clafer,
+                    card  = analyzeCard  env clafer}
+
+
+-- only for non-overlapping
+analyzeGCard :: SEnv -> IClafer -> Maybe IGCard
+analyzeGCard env clafer = gcard' `mplus` (Just $ IGCard False (0, -1))
+  where
+  gcard'
+    | isOverlapping $ super clafer = gcard clafer
+    | otherwise                    = listToMaybe $ mapMaybe gcard $
+                                     findHierarchy getSuper (clafers env) clafer
+
+
+analyzeCard :: SEnv -> IClafer -> Maybe Interval
+analyzeCard env clafer = card clafer `mplus` Just card'
+  where
+  card'
+    | isAbstract clafer = (0, -1)
+    | (isJust $ context env) && pGcard == (0, -1) 
+      || (isTopLevel $ cinPos clafer) = (1, 1) 
+    | otherwise = (0, 1)
+  pGcard = interval $ fromJust $ gcard $ fromJust $ context env
+  isTopLevel (Span (Pos _ c) _) = c==1
+  isTopLevel (Span (PosPos _ _ c) _) = c==1
+  isTopLevel (PosSpan _ (Pos _ c) _) = c==1
+  isTopLevel (PosSpan _ (PosPos _ _ c) _) = c==1
+
+analyzeElement :: SEnv -> IElement -> IElement
+analyzeElement env x = case x of
+  IEClafer clafer  -> IEClafer $ analyzeClafer env clafer
+  IEConstraint _ _ -> x
+  IEGoal _ _ -> x
+
+-- | Expand inheritance
+resolveEModule :: (IModule, GEnv) -> (IModule, GEnv)
+resolveEModule (imodule, genv') = (imodule{mDecls = decls''}, genv'')
+  where
+  decls' = mDecls imodule
+  (decls'', genv'') = runState (mapM (resolveEElement []
+                                    (unrollableModule imodule)
+                                    False decls') decls') genv'
+
+-- -----------------------------------------------------------------------------
+unrollableModule :: IModule -> [String]
+unrollableModule imodule = getDirUnrollables $
+  mapMaybe unrollabeDeclaration $ mDecls imodule
+
+unrollabeDeclaration :: IElement -> Maybe (String, [String])
+unrollabeDeclaration x = case x of
+  IEClafer clafer -> if isAbstract clafer
+                        then Just (uid clafer, unrollableClafer clafer)
+                        else Nothing
+  IEConstraint _ _ -> Nothing
+  IEGoal _ _ -> Nothing
+
+unrollableClafer :: IClafer -> [String]
+unrollableClafer clafer
+  | isOverlapping $ super clafer = []
+  | getSuper clafer == "clafer"  = deps
+  | otherwise                    = getSuper clafer : deps
+  where
+  deps = (toClafers $ elements clafer) >>= unrollableClafer
+
+
+getDirUnrollables :: [(String, [String])] -> [String]
+getDirUnrollables dependencies = (filter isUnrollable $ map (map v2n) $
+                                  map flatten (scc graph)) >>= map fst3
+  where
+  (graph, v2n, _) = graphFromEdges $map (\(c, ss) -> (c, c, ss)) dependencies
+  isUnrollable (x:[]) = fst3 x `elem` trd3 x
+  isUnrollable _ = True
+
+-- -----------------------------------------------------------------------------
+resolveEClafer :: MonadState GEnv m => [String] -> [String] -> Bool -> [IElement] -> IClafer -> m IClafer
+resolveEClafer predecessors unrollables absAncestor declarations clafer = do
+  sClafers' <- gets sClafers
+  clafer' <- renameClafer absAncestor clafer
+  let predecessors' = uid clafer' : predecessors
+  (sElements, super', superList) <-
+      resolveEInheritance predecessors' unrollables absAncestor declarations
+        (findHierarchy getSuper sClafers' clafer)
+  let sClafer = Map.fromList $ zip (map uid superList) $ repeat [predecessors']
+  modify (\e -> e {stable = Map.delete "clafer" $
+                            Map.unionWith ((nub.).(++)) sClafer $
+                            stable e})
+  elements' <-
+      mapM (resolveEElement predecessors' unrollables absAncestor declarations)
+            $ elements clafer
+  return $ clafer' {super = super', elements = elements' ++ sElements}
+
+renameClafer :: MonadState GEnv m => Bool -> IClafer -> m IClafer
+renameClafer False clafer = return clafer
+renameClafer True  clafer = renameClafer' clafer
+
+renameClafer' :: MonadState GEnv m => IClafer -> m IClafer
+renameClafer' clafer = do
+  let claferIdent = ident clafer 
+  identCountMap' <- gets identCountMap
+  let count = Map.findWithDefault 0 claferIdent identCountMap'
+  modify (\e -> e { identCountMap = Map.alter (\_ -> Just (count+1)) claferIdent identCountMap' } )
+  return $ clafer { uid = genId claferIdent count }
+
+genId :: String -> Int -> String
+genId id' count = concat ["c", show count, "_",  id']
+
+resolveEInheritance :: MonadState GEnv m => [String] -> [String] -> Bool -> [IElement] -> [IClafer]  -> m ([IElement], ISuper, [IClafer])
+resolveEInheritance predecessors unrollables absAncestor declarations allSuper
+  | isOverlapping $ super clafer = return ([], super clafer, [clafer])
+  | otherwise = do
+    let superList = (if absAncestor then id else tail) allSuper
+    let unrollSuper = filter (\s -> uid s `notElem` unrollables) $ tail allSuper
+    elements' <-
+        mapM (resolveEElement predecessors unrollables True declarations) $
+             unrollSuper >>= elements
+    let super' = if (getSuper clafer `elem` unrollables)
+                 then super clafer
+                 else ISuper False [idToPExp "" noSpan "" "clafer" False]
+    return (elements', super', superList)
+  where
+  clafer = head allSuper
+
+resolveEElement :: MonadState GEnv m => [String] -> [String] -> Bool -> [IElement] -> IElement -> m IElement
+resolveEElement predecessors unrollables absAncestor declarations x = case x of
+  IEClafer clafer  -> if isAbstract clafer then return x else IEClafer `liftM`
+    resolveEClafer predecessors unrollables absAncestor declarations clafer
+  IEConstraint _ _  -> return x
+  IEGoal _ _ -> return x
+ src/Language/Clafer/Intermediate/ResolverName.hs view
@@ -0,0 +1,358 @@+{-# LANGUAGE FlexibleContexts #-}
+
+{-
+ Copyright (C) 2012 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.ResolverName where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error
+import Control.Monad.Maybe
+import Control.Monad.State
+import Data.Maybe
+import Data.Function
+import Data.List
+
+import Language.ClaferT
+import Language.Clafer.Common
+import Language.Clafer.Intermediate.Intclafer
+import qualified Language.Clafer.Intermediate.Intclafer as I
+
+-- | this environment is created for each clafer 
+data SEnv = SEnv {
+  clafers :: [IClafer],                 -- (constant) top level clafers
+  context :: Maybe IClafer,             -- context of a constraint
+  subClafers :: [(IClafer, [IClafer])], -- descendans (BFS)
+  ancClafers :: [(IClafer, [IClafer])], -- ancesors (BFS)
+  bindings :: [([String], [IClafer])],  -- local names
+  resPath :: [IClafer],                 -- path to the current clafer
+  genv :: GEnv,                         -- (constant)
+  aClafers :: [(IClafer, [IClafer])],   -- (constant) abstract clafers (BFS)
+  cClafers :: [(IClafer, [IClafer])]    -- (constant) all concrete clafers (BFS)
+  } deriving Show
+
+-- | How a given name was resolved
+data HowResolved =
+  -- | "this", "parent", "children"
+    Special     
+  -- | primitive type: integer, string
+  | TypeSpecial 
+  -- | local variable (in constraints)
+  | Binding     
+  -- | clafer's descendant
+  | Subclafers  
+  -- | resolved by a reference
+  | Reference   
+  -- | clafer's ancestor
+  | Ancestor    
+  -- | abstract clafer
+  | AbsClafer   
+  -- | non-abstract top-level clafer
+  | TopClafer   
+  deriving (Eq, Show)
+  
+type Resolve = Either ClaferSErr
+
+-- initialize the cache (env)
+defSEnv :: GEnv -> [IElement] -> SEnv
+defSEnv genv' declarations = env {aClafers = rCl aClafers',
+                                 cClafers = rCl cClafers'}
+  where
+  env = SEnv (toClafers declarations) Nothing [] [] [] [] genv' [] []
+  rCl cs = bfs toNodeDeep $ map (\c -> env{context = Just c, resPath = [c]}) cs
+  (aClafers', cClafers') = partition isAbstract $ clafers env
+
+checkDuplicateSiblings :: IModule -> Resolve [IElement]
+checkDuplicateSiblings tree = let duplicate = checkDuplicateSiblings' $ mDecls tree
+                              in if (isJust duplicate) then let Just(name,pos') = duplicate in throwError $ SemanticErr pos' $ ("Duplicate name: " ++ name) --error
+                                 else return $ mDecls tree
+                                      
+checkDuplicateSiblings' :: [IElement] -> Maybe (String,Span)
+checkDuplicateSiblings' tree =if (isJust check) then check
+                              else checkForJust $ map checkDuplicateSiblings' elementsList
+  where
+    check = checkListDuplicates $ map (\c -> (ident c, cinPos c)) $ map (\(IEClafer eclafer) -> eclafer) $ filter isIEClafer tree
+    elementsList = map (\c -> elements c) $ map (\(IEClafer eclafer) -> eclafer) $ filter isIEClafer tree
+
+
+checkForJust :: [Maybe (String,Span)] -> Maybe (String,Span)
+checkForJust [] = Nothing
+checkForJust (h:rest) = if (isJust h) then
+                          h
+                        else
+                          checkForJust rest
+                          
+checkListDuplicates :: [(String, Span)] -> Maybe (String,Span)
+checkListDuplicates list = checkListDuplicates' $ sortBy (compare `on` fst) list
+
+checkListDuplicates' :: [(String,Span)] -> Maybe (String,Span)
+checkListDuplicates' [] = Nothing
+checkListDuplicates' (_:[]) = Nothing
+checkListDuplicates' ((a,b):(c,d):rest) = if a == c then
+                                    Just (a,b)
+                                  else
+                                    checkListDuplicates' ((c,d):rest)
+                                    
+isIEClafer :: IElement -> Bool
+isIEClafer (IEClafer _) = True
+isIEClafer _            = False
+
+resolveModuleNames :: (IModule, GEnv) -> Resolve IModule
+resolveModuleNames (imodule, genv') =
+  do
+    decls' <- checkDuplicateSiblings imodule
+    mDecls' <- mapM (resolveElement (defSEnv genv' decls')) decls'
+    return $ imodule{mDecls = mDecls'}
+
+resolveClafer :: SEnv -> IClafer -> Resolve IClafer
+resolveClafer env clafer =
+  do
+    elements' <- mapM (resolveElement env'{subClafers = subClafers',
+                                              ancClafers = ancClafers'}) $
+                          elements clafer
+    return $ clafer {elements = elements'}
+  where
+  env' = env {context = Just clafer, resPath = clafer : resPath env}
+  subClafers' = tail $ bfs toNodeDeep [env'{resPath = [clafer]}]
+  ancClafers' = (init $ tails $ resPath env) >>= (mkAncestorList env)
+
+mkAncestorList :: SEnv -> [IClafer] -> [(IClafer, [IClafer])]
+mkAncestorList env rp =
+  bfs toNodeDeep [env{context = Just $ head rp, resPath = rp}]
+
+resolveElement :: SEnv -> IElement -> Resolve IElement
+resolveElement env x = case x of
+  IEClafer clafer  -> IEClafer <$> resolveClafer env clafer
+  IEConstraint isHard' pexp  -> IEConstraint isHard' <$> resolvePExp env pexp
+  IEGoal isMaximize' pexp  -> IEGoal isMaximize' <$> resolvePExp env pexp  
+
+
+resolvePExp :: SEnv -> PExp -> Resolve PExp
+resolvePExp env pexp =
+  do
+    exp' <- resolveIExp (inPos pexp) env $ Language.Clafer.Intermediate.Intclafer.exp pexp
+    return $ pexp {Language.Clafer.Intermediate.Intclafer.exp = exp'}
+
+resolveIExp :: Span -> SEnv -> IExp -> Resolve IExp
+resolveIExp pos' env x = case x of
+  IDeclPExp quant' decls' pexp -> do
+    let (decls'', env') = runState (runErrorT $ (mapM (ErrorT . processDecl) decls')) env
+    IDeclPExp quant' <$> decls'' <*> resolvePExp env' pexp
+
+  IFunExp op' exps' -> if op' == iJoin then resNav else IFunExp op' <$> mapM res exps'
+  IInt _ -> return x
+  IDouble _ -> return x
+  IStr _ -> return x
+  IClaferId _ _ _ -> resNav
+  where
+  res = resolvePExp env
+  resNav = fst <$> resolveNav pos' env x True
+
+liftError :: Monad m => Either e a -> ErrorT e m a
+liftError = ErrorT . return
+
+processDecl :: MonadState SEnv m => IDecl -> m (Resolve IDecl)
+processDecl decl = runErrorT $ do
+  env <- lift $ get
+  (body', path) <- liftError $ resolveNav (inPos $ body decl) env (Language.Clafer.Intermediate.Intclafer.exp $ body decl) True
+  lift $ modify (\e -> e { bindings = (decls decl, path) : bindings e })
+  return $ decl {body = pExpDefPidPos body'}
+
+resolveNav :: Span -> SEnv -> IExp -> Bool -> Resolve (IExp, [IClafer])
+resolveNav pos' env x isFirst = case x of
+  IFunExp _ (pexp0:pexp:_) -> do
+    (exp0', path) <- resolveNav (inPos pexp0) env (Language.Clafer.Intermediate.Intclafer.exp pexp0) True
+    (exp', path') <- resolveNav (inPos pexp) env {context = listToMaybe path, resPath = path}
+                     (Language.Clafer.Intermediate.Intclafer.exp pexp) False
+    return (IFunExp iJoin [pexp0{I.exp=exp0'}, pexp{I.exp=exp'}], path')
+  IClaferId modName' id' _ -> out
+    where
+    out
+      | isFirst   = mkPath env <$> resolveName pos' env id'
+      | otherwise = mkPath' modName' <$> resolveImmName pos' env id'
+  y -> throwError $ SemanticErr pos' $ "Cannot resolve nav of " ++ show y 
+
+-- depending on how resolved construct a path
+mkPath :: SEnv -> (HowResolved, String, [IClafer]) -> (IExp, [IClafer])
+mkPath env (howResolved, id', path) = case howResolved of
+  Binding -> (mkLClaferId id' True, path)
+  Special -> (specIExp, path)
+  TypeSpecial -> (mkLClaferId id' True, path)
+  Subclafers -> (toNav $ tail $ reverse $ map uid path, path)
+  Ancestor -> (toNav' $ adjustAncestor (reverse $ map uid $ resPath env)
+                                       (reverse $ map uid path), path)
+  _ -> (toNav' $ reverse $ map uid path, path)
+  where
+  toNav = foldl
+          (\exp' id'' -> IFunExp iJoin [pExpDefPidPos exp', mkPLClaferId id'' False])
+          (mkLClaferId this True)
+  specIExp = if id' /= this then toNav [id'] else mkLClaferId id' True
+
+toNav' :: [String] -> IExp
+toNav' p = (mkIFunExp iJoin $ map (\c -> mkLClaferId c False) p) :: IExp
+
+
+adjustAncestor :: [String] -> [String] -> [String]
+adjustAncestor cPath rPath = this : parents ++ (fromJust $ stripPrefix prefix rPath)
+  where
+  parents = replicate (length $ fromJust $ stripPrefix prefix cPath) parent
+  prefix  = fst $ unzip $ takeWhile (uncurry (==)) $ zip cPath rPath
+
+
+mkPath' :: String -> (HowResolved, String, [IClafer]) -> (IExp, [IClafer])
+mkPath' modName' (howResolved, id', path) = case howResolved of
+  Reference  -> (toNav' ["ref", id'], path)
+  _ -> (IClaferId modName' id' False, path)
+
+-- -----------------------------------------------------------------------------
+
+resolveName :: Span -> SEnv -> String -> Resolve (HowResolved, String, [IClafer])
+resolveName pos' env id' = resolve env id'
+  [resolveSpecial, resolveBind, resolveDescendants, resolveAncestor pos', resolveTopLevel pos', resolveNone pos']
+
+
+resolveImmName :: Span -> SEnv -> String -> Resolve (HowResolved, String, [IClafer])
+resolveImmName pos' env id' = resolve env id'
+  [resolveSpecial, resolveChildren pos', resolveReference pos', resolveNone pos']
+
+
+-- when one strategy fails, we want to move to the next one
+resolve :: (Monad f, Functor f) => SEnv -> String -> [SEnv -> String -> f (Maybe b)] -> f b
+resolve env id' fs = fromJust <$> (runMaybeT $ msum $ map (\x -> MaybeT $ x env id') fs)
+
+
+-- reports error if clafer not found
+resolveNone :: Span -> SEnv -> String -> Resolve t
+resolveNone pos' env id' =
+  throwError $ SemanticErr pos' $ "resolver: " ++ id' ++ " not found" ++
+  " within " ++ (showPath $ map uid $ resPath env)
+
+
+-- checks if ident is one of special identifiers
+resolveSpecial :: SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveSpecial env id'
+  | id' `elem` [this, children, ref] =
+      return $ Just (Special, id', resPath env)
+  | id' == parent   = return $ Just (Special, id', tail $ resPath env)
+  | isPrimitive id' = return $ Just (TypeSpecial, id', [])
+  | otherwise      = return Nothing 
+
+
+-- checks if ident is bound locally
+resolveBind :: SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveBind env id' = return $ find (\bs -> id' `elem` fst bs) (bindings env) >>=
+  (\x -> Just (Binding, id', snd x))
+
+
+-- searches for a name in all subclafers (BFS)
+resolveDescendants :: SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveDescendants env id' = return $
+  (context env) >> (findFirst id' $ subClafers env) >>= (toMTriple Subclafers)
+
+
+-- searches for a name in immediate subclafers (BFS)
+resolveChildren :: Span -> SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveChildren pos' env id' = resolveChildren' pos' env id' allInhChildren Subclafers
+
+-- searches for a name by dereferencing clafer
+resolveReference :: Span -> SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveReference pos' env id' = resolveChildren' pos' env id' allChildren Reference
+
+resolveChildren' :: Span -> SEnv -> String -> (SEnv -> [IClafer]) -> HowResolved -> Either ClaferSErr (Maybe (HowResolved, String, [IClafer]))
+resolveChildren' pos' env id' f label =
+  runMaybeT $ do
+    liftMaybe $ context env
+    u <- MaybeT $ findUnique pos' id' $ map (\x -> (x, [x,fromJust $ context env])) $ f env
+    liftMaybe $ toMTriple label u
+
+liftMaybe :: Maybe a -> MaybeT (Either ClaferSErr) a
+liftMaybe = MaybeT . return
+
+resolveAncestor :: Span -> SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveAncestor pos' env id' =
+  runMaybeT $ do
+    liftMaybe $ context env
+    u <- MaybeT $ findUnique pos' id' $ ancClafers env
+    liftMaybe $ toMTriple Ancestor u
+
+
+-- searches for a feature starting from local root (BFS) and then continues with
+-- other declarations
+resolveTopLevel :: Span -> SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
+resolveTopLevel pos' env id' = runMaybeT $ foldr1 mplus $ map
+  (\(cs, hr) -> MaybeT (findUnique pos' id' cs) >>= (liftMaybe . toMTriple hr))
+  [(aClafers env, AbsClafer), (cClafers env, TopClafer)]
+
+toNodeDeep :: SEnv -> ((IClafer, [IClafer]), [SEnv])
+              -- ((curr. clafer, resolution path), remaining children to traverse)
+toNodeDeep env
+  | length (clafer `elemIndices` resPath env) > 1 = (result, [])  -- cut bfs recusion in case clafer repeats
+  | otherwise = (result, map (\c -> env {context = Just c,
+                                         resPath = c : resPath env}) $
+                 allInhChildren env)
+  where
+  result = (clafer, resPath env)
+  clafer = fromJust $ context env
+  
+
+-- return children and inherited children but no children of reference targets
+allInhChildren :: SEnv -> [IClafer]
+allInhChildren = selectChildren getSuperNoArr
+
+-- return all children including inherited children children of reference targets
+allChildren :: SEnv -> [IClafer]
+allChildren = selectChildren getSuper
+
+selectChildren :: (IClafer -> String) -> SEnv -> [IClafer]
+selectChildren f env = getSubclafers $ concat $
+                       mapHierarchy elements f (sClafers $ genv env)
+                       (fromJust $ context env)
+
+findUnique :: Span -> String -> [(IClafer, [IClafer])] -> Resolve (Maybe (String, [IClafer]))
+findUnique pos' x xs =
+  case filterPaths x $ nub xs of
+    []     -> return $ Nothing
+    [elem'] -> return $ Just $ (uid $ fst elem', snd elem')
+    xs'    -> throwError $ SemanticErr pos' $ "clafer " ++ show x ++ " " ++ errMsg
+      where
+      xs''   = map ((map uid).snd) xs'
+      errMsg = (if isNamespaceConflict xs''
+               then "cannot be defined because the name should be unique in the same namespace.\n"
+               else "is not unique. ") ++ 
+               "Available paths:\n" ++ (xs'' >>= showPath)
+
+findFirst :: String -> [(IClafer, [IClafer])] -> Maybe (String, [IClafer])
+findFirst x xs =
+  case filterPaths x $ nub xs of
+    []       -> Nothing
+    (ele:_) -> Just $ (uid $ fst ele, snd ele)
+
+showPath :: [String] -> String
+showPath xs = (intercalate "." $ reverse xs) ++ "\n"
+
+isNamespaceConflict :: [[String]] -> Bool
+isNamespaceConflict (xs:ys:_) = tail xs == tail ys
+isNamespaceConflict x         = error $ "isNamespaceConflict must be given a list"
+                                         ++ " of at least two elements, but was given " ++ show x
+
+filterPaths :: String -> [(IClafer, [IClafer])] -> [(IClafer, [IClafer])]
+filterPaths x xs = filter (((==) x).ident.fst) xs
+ src/Language/Clafer/Intermediate/ResolverType.hs view
@@ -0,0 +1,408 @@+{-# LANGUAGE NamedFieldPuns, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-}
+
+{-
+ Copyright (C) 2012-2013 Jimmy Liang, Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.ResolverType (resolveTModule, intersects, (+++), fromUnionType, unionType)  where
+
+import Prelude hiding (exp)
+import Language.ClaferT
+import Language.Clafer.Common
+import Language.Clafer.Intermediate.Analysis
+import Language.Clafer.Intermediate.Intclafer hiding (uid)
+import qualified Language.Clafer.Intermediate.Intclafer as I
+
+import Control.Applicative
+import Control.Monad.Error
+import Control.Monad.List
+import Control.Monad.Reader
+import Data.Either
+import Data.List
+import Data.Maybe
+
+type TypeDecls = [(String, IType)]
+data TypeInfo = TypeInfo {iTypeDecls::TypeDecls, iInfo::Info, iCurThis::SClafer, iCurPath::Maybe IType}
+
+newtype TypeAnalysis a = TypeAnalysis (ReaderT TypeInfo (Either ClaferSErr) a)
+  deriving (MonadError ClaferSErr, Monad, Functor, MonadReader TypeInfo)
+  
+typeOfUid :: MonadTypeAnalysis m => String -> m IType
+typeOfUid uid = (fromMaybe (TClafer [uid]) . lookup uid) <$> typeDecls
+
+class MonadAnalysis m => MonadTypeAnalysis m where
+  -- What "this" refers to
+  curThis :: m SClafer
+  localCurThis :: SClafer -> m a -> m a
+  
+  -- The next path is a child of curPath (or Nothing)
+  curPath :: m (Maybe IType)
+  localCurPath :: IType -> m a -> m a
+  
+  -- Extra declarations
+  typeDecls :: m TypeDecls
+  localDecls :: TypeDecls -> m a -> m a
+
+instance MonadTypeAnalysis TypeAnalysis where
+  curThis = TypeAnalysis $ asks iCurThis
+  localCurThis newThis (TypeAnalysis d) =
+    TypeAnalysis $ local setCurThis d
+    where
+    setCurThis t = t{iCurThis = newThis}
+    
+  curPath = TypeAnalysis $ asks iCurPath
+  localCurPath newPath (TypeAnalysis d) =
+    TypeAnalysis $ local setCurPath d
+    where
+    setCurPath t = t{iCurPath = Just newPath}
+    
+  typeDecls = TypeAnalysis $ asks iTypeDecls
+  localDecls extra (TypeAnalysis d) =
+    TypeAnalysis $ local addTypeDecls d
+    where
+    addTypeDecls t@TypeInfo{iTypeDecls = c} = t{iTypeDecls = extra ++ c}
+    
+instance MonadTypeAnalysis m => MonadTypeAnalysis (ListT m) where
+  curThis = lift $ curThis
+  localCurThis = mapListT . localCurThis
+  curPath = lift $ curPath
+  localCurPath = mapListT . localCurPath
+  typeDecls = lift typeDecls
+  localDecls = mapListT . localDecls
+  
+instance MonadTypeAnalysis m => MonadTypeAnalysis (ErrorT ClaferSErr m) where
+  curThis = lift $ curThis
+  localCurThis = mapErrorT . localCurThis
+  curPath = lift $ curPath
+  localCurPath = mapErrorT . localCurPath
+  typeDecls = lift typeDecls
+  localDecls = mapErrorT . localDecls
+      
+
+instance MonadAnalysis TypeAnalysis where
+  clafers = asks (sclafers . iInfo)
+  withClafers cs r =
+    local setInfo r
+    where
+    setInfo t = t{iInfo = Info cs}
+
+-- | Type inference and checking
+runTypeAnalysis :: TypeAnalysis a -> IModule -> Either ClaferSErr a
+runTypeAnalysis (TypeAnalysis tc) imodule = runReaderT tc $ TypeInfo [] (gatherInfo imodule) undefined Nothing
+
+unionType :: IType -> [String]
+unionType TString  = ["string"]
+unionType TReal    = ["real"]
+unionType TInteger = ["integer"]
+unionType TBoolean = ["boolean"]
+unionType (TClafer u) = u
+
+(+++) :: IType -> IType -> IType
+t1 +++ t2 = fromJust $ fromUnionType $ unionType t1 ++ unionType t2
+
+fromUnionType :: [String] -> Maybe IType
+fromUnionType u =
+    case sort $ nub $ u of
+        ["string"]  -> return TString
+        ["real"]    -> return TReal
+        ["integer"] -> return TInteger
+        ["int"]     -> return TInteger
+        ["boolean"] -> return TBoolean
+        []          -> Nothing
+        u'          -> return $ TClafer u'
+
+closure :: MonadAnalysis m => [String] -> m [String]
+closure ut = concat <$> mapM hierarchy ut
+
+intersection :: MonadAnalysis m => IType -> IType -> m (Maybe IType)
+intersection t1 t2 = 
+  do
+    h1 <- mapM hierarchy $ unionType t1
+    h2 <- mapM hierarchy $ unionType t2
+    let ut = catMaybes [contains (head u1) u2 `mplus` contains (head u2) u1 | u1 <- h1, u2 <- h2]
+    return $ fromUnionType ut
+  where
+  contains i is = if i `elem` is then Just i else Nothing
+
+intersects :: MonadAnalysis m => IType -> IType -> m Bool
+intersects t1 t2 = isJust <$> intersection t1 t2
+
+numeric :: IType -> Bool
+numeric TReal    = True
+numeric TInteger = True
+numeric _        = False
+
+coerce :: IType -> IType -> IType
+coerce TReal TReal       = TReal
+coerce TReal TInteger    = TReal
+coerce TInteger TReal    = TReal
+coerce TInteger TInteger = TInteger
+coerce x y = error $ "Not numeric: " ++ show x ++ ", " ++ show y
+
+str :: IType -> String
+str t =
+  case unionType t of
+    [t'] -> t'
+    ts   -> "[" ++ intercalate "," ts ++ "]"
+
+getIfThenElseType :: MonadAnalysis m => IType -> IType -> m (Maybe IType)
+-- the function is similar to 'intersection', but takes into account more ancestors to be able to combine
+-- clafers of different types, but with a common ancestor:
+-- Inputs:
+-- t1 is of type B
+-- t2 is of type C
+-- B : A
+-- C : A
+-- Outputs:
+-- the resulting type is: A, and the type combination is valid
+getIfThenElseType t1 t2 = 
+  do
+    h1 <- mapM hierarchy $ unionType t1
+    h2 <- mapM hierarchy $ unionType t2
+    let ut = catMaybes [commonHierarchy u1 u2 | u1 <- h1, u2 <- h2]
+    return $ fromUnionType ut
+  where
+  commonHierarchy h1 h2 = filterClafer $ commonHierarchy' (reverse h1) (reverse h2) Nothing
+  commonHierarchy' (x:xs) (y:ys) accumulator = 
+    if (x == y) 
+      then 
+        if (null xs || null ys) 
+          then Just x
+          else commonHierarchy' xs ys $ Just x 
+      else accumulator
+  commonHierarchy' _ _ _ = error "Function commonHierarchy' from ResolverType expects two non empty lists but was given at least one empty list!" -- Should never happen    
+  filterClafer value = 
+    if (value == Just "clafer") then Nothing else value
+
+resolveTModule :: (IModule, GEnv) -> Either ClaferSErr IModule
+resolveTModule (imodule, _) =
+  case runTypeAnalysis (analysis $ mDecls imodule) imodule of
+    Right mDecls' -> return imodule{mDecls = mDecls'}
+    Left err      -> throwError err
+  where
+  analysis decls = mapM (resolveTElement $ rootUid) decls
+
+resolveTElement :: String -> IElement -> TypeAnalysis IElement
+resolveTElement _ (IEClafer iclafer) =
+  do
+    elements' <- mapM (resolveTElement $ I.uid iclafer) (elements iclafer)
+    return $ IEClafer $ iclafer{elements = elements'}
+resolveTElement parent' (IEConstraint isHard pexp) =
+  IEConstraint isHard <$> (testBoolean =<< resolveTConstraint parent' pexp)
+  where
+  testBoolean pexp' =
+    do
+      unless (typeOf pexp' == TBoolean) $
+        throwError $ SemanticErr (inPos pexp') ("Cannot construct constraint on type '" ++ str (typeOf pexp') ++ "'")
+      return pexp'
+resolveTElement parent' (IEGoal isMaximize pexp) =
+  IEGoal isMaximize <$> resolveTConstraint parent' pexp
+
+resolveTConstraint :: String -> PExp -> TypeAnalysis PExp
+resolveTConstraint curThis' constraint = 
+  do
+    curThis'' <- claferWithUid curThis'
+    head <$> (localCurThis curThis'' $ (resolveTPExp constraint :: TypeAnalysis [PExp]))
+    
+
+resolveTPExp :: PExp -> TypeAnalysis [PExp]
+resolveTPExp p = 
+  do
+    x <- resolveTPExp' p
+    case partitionEithers x of
+      (f:_, []) -> throwError f                       -- Case 1: Only fails. Complain about the first one.
+      ([], [])  -> error "No results but no errors."  -- Case 2: No success and no error message. Bug.
+      (_,   xs) -> return xs                          -- Case 3: At least one success.
+
+resolveTPExp' :: PExp -> TypeAnalysis [Either ClaferSErr PExp]
+resolveTPExp' p@PExp{inPos, exp = IClaferId{sident = "ref"}} =
+  runListT $ runErrorT $ do
+    curPath' <- curPath
+    case curPath' of
+      Just curPath'' -> do
+        ut <- closure $ unionType curPath''
+        t <- runListT $ refOf =<< foreachM ut
+        case fromUnionType t of
+          Just t' -> return $ p `withType` t'
+          Nothing -> throwError $ SemanticErr inPos ("Cannot ref from type '" ++ str curPath'' ++ "'")
+      Nothing -> throwError $ SemanticErr inPos ("Cannot ref at the start of a path")
+resolveTPExp' p@PExp{inPos, exp = IClaferId{sident = "parent"}} =
+  runListT $ runErrorT $ do
+    curPath' <- curPath
+    case curPath' of
+      Just curPath'' -> do
+        parent' <- fromUnionType <$> runListT (parentOf =<< liftList (unionType curPath''))
+        when (isNothing parent') $
+          throwError $ SemanticErr inPos "Cannot parent from root"
+        let result = p `withType` fromJust parent'
+        return result -- Case 1: Use the sident
+          <++>
+          addRef result -- Case 2: Dereference the sident 1..* times
+      Nothing -> throwError $ SemanticErr inPos "Cannot parent at the start of a path"
+resolveTPExp' p@PExp{exp = IClaferId{sident = "integer"}} = runListT $ runErrorT $ return $ p `withType` TInteger
+resolveTPExp' p@PExp{inPos, exp = IClaferId{sident}} = 
+  runListT $ runErrorT $ do
+    curPath' <- curPath
+    sident' <- if sident == "this" then uid <$> curThis else return sident
+    when (isJust curPath') $ do
+      c <- mapM (isChild sident') $ unionType $ fromJust curPath'
+      unless (or c) $ throwError $ SemanticErr inPos ("'" ++ sident' ++ "' is not a child of type '" ++ str (fromJust curPath') ++ "'")
+    result <- (p `withType`) <$> typeOfUid sident'
+    return result -- Case 1: Use the sident
+      <++>
+      addRef result -- Case 2: Dereference the sident 1..* times
+  
+  
+resolveTPExp' p@PExp{inPos, exp} =
+  runListT $ runErrorT $ do
+    (iType', exp') <- ErrorT $ ListT $ resolveTExp exp
+    return p{iType = Just iType', exp = exp'}
+  where
+  resolveTExp :: IExp -> TypeAnalysis [Either ClaferSErr (IType, IExp)]
+  resolveTExp e@(IInt _)    = runListT $ runErrorT $ return (TInteger, e)
+  resolveTExp e@(IDouble _) = runListT $ runErrorT $ return (TReal, e)
+  resolveTExp e@(IStr _)    = runListT $ runErrorT $ return (TString, e)
+
+  resolveTExp e@IFunExp {op, exps = [arg]} =
+    runListT $ runErrorT $ do
+      arg' <- lift $ ListT $ resolveTPExp arg
+      let t = typeOf arg'
+      let test c =
+            unless c $
+              throwError $ SemanticErr inPos ("Function '" ++ op ++ "' cannot be performed on " ++ op ++ " '" ++ str t ++ "'")
+      let result
+            | op == iNot = test (t == TBoolean) >> return TBoolean
+            | op == iCSet = return TInteger
+            | op == iSumSet = test (t == TInteger) >> return TInteger
+            | op `elem` [iMin, iGMin, iGMax] = test (numeric t) >> return t
+            | otherwise = error $ "Unknown op '" ++ op ++ "'"
+      result' <- result
+      return (result', e{exps = [arg']})
+
+  resolveTExp e@IFunExp {op = ".", exps = [arg1, arg2]} =
+    do
+      runListT $ runErrorT $ do
+        arg1' <- lift $ ListT $ resolveTPExp arg1
+        localCurPath (typeOf arg1') $ do
+            arg2' <- liftError $ lift $ ListT $ resolveTPExp arg2
+            return (fromJust $ iType arg2', e{exps = [arg1', arg2']})
+      
+  resolveTExp e@IFunExp {op = "++", exps = [arg1, arg2]} =
+    do
+      arg1s' <- resolveTPExp arg1
+      arg2s' <- resolveTPExp arg2
+      let union' a b = typeOf a +++ typeOf b
+      return $ [return (union' arg1' arg2', e{exps = [arg1', arg2']}) | (arg1', arg2') <- sortBy (comparing $ length . unionType . uncurry union') $ liftM2 (,) arg1s' arg2s']
+  resolveTExp e@IFunExp {op, exps = [arg1, arg2]} =
+    runListT $ runErrorT $ do
+      arg1' <- lift $ ListT $ resolveTPExp arg1
+      arg2' <- lift $ ListT $ resolveTPExp arg2
+      let t1 = typeOf arg1'
+      let t2 = typeOf arg2'
+      let testIntersect e1 e2 =
+            do
+              it <- intersection e1 e2
+              case it of
+                Just it' -> return it'
+                Nothing  -> throwError $ SemanticErr inPos ("Function '" ++ op ++ "' cannot be performed on '" ++ str t1 ++ "' " ++ op ++ " '" ++ str t2 ++ "'")
+      let testNotSame e1 e2 =
+            when (e1 `sameAs` e2) $
+              throwError $ SemanticErr inPos ("Function '" ++ op ++ "' is redundant because the two subexpressions are always equivalent")
+      let test c =
+            unless c $
+              throwError $ SemanticErr inPos ("Function '" ++ op ++ "' cannot be performed on '" ++ str t1 ++ "' " ++ op ++ " '" ++ str t2 ++ "'")
+      let result
+            | op `elem` logBinOps = test (t1 == TBoolean && t2 == TBoolean) >> return TBoolean
+            | op `elem` [iLt, iGt, iLte, iGte] = test (numeric t1 && numeric t2) >> return TBoolean
+            | op `elem` [iEq, iNeq] = testNotSame arg1' arg2' >> testIntersect t1 t2 >> return TBoolean
+            | op == iDifference = testNotSame arg1' arg2' >> testIntersect t1 t2 >> return t1
+            | op == iIntersection = testNotSame arg1' arg2' >> testIntersect t1 t2
+            | op `elem` [iDomain, iRange] = testIntersect t1 t2
+            | op `elem` relSetBinOps = testIntersect t1 t2 >> return TBoolean
+            | op `elem` [iSub, iMul, iDiv] = test (numeric t1 && numeric t2) >> return (coerce t1 t2)
+            | op == iPlus =
+                (test (t1 == TString && t2 == TString) >> return TString) -- Case 1: String concatenation
+                `catchError`
+                const (test (numeric t1 && numeric t2) >> return (coerce t1 t2)) -- Case 2: Addition
+            | otherwise = error $ "Unknown op: " ++ show e
+      result' <- result
+      return (result', e{exps = [arg1', arg2']})
+
+  resolveTExp e@(IFunExp "=>else" [arg1, arg2, arg3]) =
+    runListT $ runErrorT $ do
+      arg1' <- lift $ ListT $ resolveTPExp arg1
+      arg2' <- lift $ ListT $ resolveTPExp arg2
+      arg3' <- lift $ ListT $ resolveTPExp arg3
+      let t1 = typeOf arg1'
+      let t2 = typeOf arg2'
+      let t3 = typeOf arg3'
+--      unless (False) $
+--        throwError $ SemanticErr inPos ("The types are: '" ++ str t2 ++ "' and '" ++ str t3 ++ "'")
+
+      unless (t1 == TBoolean) $
+        throwError $ SemanticErr inPos ("Function 'if/else' cannot be performed on 'if' " ++ str t1 ++ " 'then' " ++ str t2 ++ " 'else' " ++ str t3)
+
+      it <- getIfThenElseType t2 t3
+      t <- case it of
+        Just it' -> return it'
+        Nothing  -> throwError $ SemanticErr inPos ("Function '=>else' cannot be performed on if '" ++ str t1 ++ "' then '" ++ str t2 ++ "' else '" ++ str t3 ++ "'")
+
+      return (t, e{exps = [arg1', arg2', arg3']})
+      
+  resolveTExp e@IDeclPExp{oDecls, bpexp} =
+    runListT $ runErrorT $ do
+      oDecls' <- mapM resolveTDecl oDecls
+      let extraDecls = [(decl, typeOf $ body oDecl) | oDecl <- oDecls', decl <- decls oDecl]
+      localDecls extraDecls $ do
+        bpexp' <- liftError $ lift $ ListT $ resolveTPExp bpexp
+        return $ (TBoolean, e{oDecls = oDecls', bpexp = bpexp'})
+    where
+    resolveTDecl d@IDecl{body} =
+      do
+        body' <- lift $ ListT $ resolveTPExp body
+        return $ d{body = body'}
+        
+  resolveTExp e = error $ "Unknown iexp: " ++ show e
+
+-- Adds "refs" at the end, effectively dereferencing Clafers when needed.
+addRef :: PExp -> ErrorT ClaferSErr (ListT TypeAnalysis) PExp
+addRef pexp =
+  do
+    localCurPath (typeOf pexp) $ do
+      deref <- (ErrorT $ ListT $ resolveTPExp' $ newPExp $ IClaferId "" "ref" False) `catchError` const (lift mzero)
+      let result = (newPExp $ IFunExp "." [pexp, deref]) `withType` typeOf deref
+      return result <++> addRef result
+  where
+  newPExp = PExp Nothing "" $ inPos pexp
+  
+typeOf :: PExp -> IType
+typeOf pexp = fromMaybe (error "No type") $ iType pexp
+
+withType :: PExp -> IType -> PExp
+withType p t = p{iType = Just t}
+
+(<++>) :: (Error e, MonadPlus m) => ErrorT e m a -> ErrorT e m a -> ErrorT e m a
+(ErrorT a) <++> (ErrorT b) = ErrorT $ a `mplus` b
+
+liftError :: (MonadError e m, Error e) => ErrorT e m a -> ErrorT e m a
+liftError e =
+  liftCatch catchError e throwError
+  where
+  liftCatch catchError' m h = ErrorT $ runErrorT m `catchError'` (runErrorT . h)
+ src/Language/Clafer/Intermediate/ScopeAnalysis.hs view
@@ -0,0 +1,33 @@+{-
+ Copyright (C) 2013 Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.ScopeAnalysis where
+
+import Language.Clafer.ClaferArgs
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Intermediate.GLPKScopeAnalyzer
+import Language.Clafer.Intermediate.SimpleScopeAnalyzer
+
+-- | Return an appropriate scope analysis for a given strategy 
+getScopeStrategy :: ScopeStrategy -> IModule -> [(String, Integer)]
+getScopeStrategy Simple = simpleScopeAnalysis
+getScopeStrategy Full   = glpkScopeAnalysis 
+getScopeStrategy _             = const []
+ src/Language/Clafer/Intermediate/SimpleScopeAnalyzer.hs view
@@ -0,0 +1,290 @@+{-
+ Copyright (C) 2012-2014 Jimmy Liang, Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.SimpleScopeAnalyzer (simpleScopeAnalysis) where
+
+import Language.Clafer.Common
+import Data.Graph
+import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Ord
+import Data.Ratio
+import Language.Clafer.Intermediate.Intclafer
+import Prelude hiding (exp)
+
+
+isReference :: IClafer -> Bool
+isReference = isOverlapping . super
+isConcrete :: IClafer -> Bool
+isConcrete = not . isReference
+isSuperest :: [IClafer] -> IClafer -> Bool
+isSuperest clafers clafer = isNothing $ directSuper clafers clafer
+
+
+-- Collects the global cardinality and hierarchy information into proper lower bounds.
+-- If the model only has Clafers (ie. no constraints) then the lower bound is tight.
+-- scopeAnalysis :: IModule -> Map IClafer Integer
+simpleScopeAnalysis :: IModule -> [(String, Integer)]
+simpleScopeAnalysis IModule{mDecls = decls'} =
+    [(a, b) | (a, b) <- finalAnalysis, isReferenceOrSuper a, b /= 0]
+    where
+    finalAnalysis = Map.toList $ foldl analyzeComponent supersAnalysis connectedComponents
+    
+    isReferenceOrSuper uid' =
+        isReference clafer || isSuperest clafers clafer
+        where
+        clafer = findClafer uid'
+        
+    isConcrete' uid' = isConcrete $ findClafer uid'
+    
+    upperCards u =
+        Map.findWithDefault (error $ "No upper cardinality for clafer named \"" ++ u ++ "\".") u upperCardsMap
+    upperCardsMap = Map.fromList [(uid c, snd $ fromJust $ card c) | c <- clafers]
+    
+    supersAnalysis = foldl (analyzeSupers clafers) Map.empty decls'
+    constraintAnalysis = analyzeConstraints constraints upperCards
+    (subclaferMap, parentMap) = analyzeHierarchy clafers
+    connectedComponents = analyzeDependencies clafers
+    clafers = concatMap findClafers decls'
+    constraints = concatMap findConstraints decls'
+    findClafer uid' = fromJust $ find (isEqClaferId uid') clafers
+    
+    lowCard clafer =
+        max low constraintLow
+        where
+        low = fst $ fromJust $ card clafer
+        constraintLow = Map.findWithDefault 0 (uid clafer) constraintAnalysis
+    
+    analyzeComponent analysis' component =
+        case flattenSCC component of
+            [uid'] -> analyzeSingleton uid' analysis'
+            uids  ->
+                foldr analyzeSingleton assume uids
+                where
+                -- assume that each of the scopes in the component is 1 while solving
+                assume = foldr (`Map.insert` 1) analysis' uids
+        where
+        analyzeSingleton uid' analysis'' = analyze analysis'' $ findClafer uid'
+    
+    analyze :: Map String Integer -> IClafer -> Map String Integer
+    analyze analysis clafer =
+        -- Take the max between the reference analysis and this analysis
+        Map.insertWith max (uid clafer) scope analysis
+        where
+        scope
+            | isAbstract clafer  = sum subclaferScopes
+            | otherwise          = parentScope * lowCard clafer
+        
+        subclaferScopes = map (findOrError " subclafer scope not found" analysis) $ filter isConcrete' subclafers
+        parentScope  =
+            case parent' of
+                Just parent'' -> findOrError " parent scope not found" analysis parent''
+                Nothing      -> rootScope
+        subclafers = Map.findWithDefault [] (uid clafer) subclaferMap
+        parent'     = Map.lookup (uid clafer) parentMap
+        rootScope = 1
+        findOrError message m key = Map.findWithDefault (error $ key ++ message) key m
+        
+analyzeSupers :: [IClafer] -> Map String Integer -> IElement -> Map String Integer    
+analyzeSupers clafers analysis (IEClafer clafer) =
+    foldl (analyzeSupers clafers) analysis' (elements clafer)
+    where
+    lowerBound = max 1 $ fst (fromJust $ card clafer)
+    analysis' = case (directSuper clafers clafer) of
+            (Just c) -> Map.alter ((if isReference clafer then maxLB else incLB) lowerBound) (uid c) analysis
+            Nothing -> analysis                     
+    incLB lb' Nothing = Just lb'
+    incLB lb' (Just lb) = Just (lb + lb')
+    maxLB lb' Nothing = Just lb'
+    maxLB lb' (Just lb) = Just (max lb lb')
+analyzeSupers _ analysis _ = analysis
+
+
+analyzeConstraints :: [PExp] -> (String -> Integer) -> Map String Integer
+analyzeConstraints constraints upperCards =
+    foldr analyzeConstraint Map.empty $ filter isOneOrSomeConstraint constraints
+    where
+    isOneOrSomeConstraint PExp{exp = IDeclPExp{quant = quant'}} =
+        -- Only these two quantifiers requires an increase in scope to satisfy.
+        case quant' of
+            IOne -> True
+            ISome -> True
+            _     -> False
+    isOneOrSomeConstraint _ = False
+    
+    -- Only considers how quantifiers affect scope. Other types of constraints are not considered.
+    -- Constraints of the type [some path1.path2] or [no path1.path2], etc.
+    analyzeConstraint PExp{exp = IDeclPExp{oDecls = [], bpexp = bpexp'}} analysis =
+        foldr atLeastOne analysis path'
+        where
+        path' = dropThisAndParent $ unfoldJoins bpexp'
+        atLeastOne = Map.insertWith max `flip` 1
+        
+    -- Constraints of the type [all disj a : path1.path2] or [some b : path3.path4], etc.
+    analyzeConstraint PExp{exp = IDeclPExp{oDecls = decls'}} analysis =
+        foldr analyzeDecl analysis decls'
+    analyzeConstraint _ analysis = analysis
+
+    analyzeDecl IDecl{isDisj = isDisj', decls = decls', body = body'} analysis =
+        foldr (uncurry insert') analysis $ zip path' scores
+        where
+        -- Take the first element in the path', and change its effective lower cardinality.
+        -- Can overestimate the scope.
+        path' = dropThisAndParent $ unfoldJoins body'
+        -- "disj a;b;c" implies at least 3 whereas "a;b;c" implies at least one.
+        minScope = if isDisj' then fromIntegral $ length decls' else 1
+        insert' = Map.insertWith max
+        
+        scores = assign path' minScope
+        
+        {-
+         - abstract Z
+         -   C *
+         -     D : integer *
+         -
+         - A : Z
+         -   B : integer
+         -   [some disj a;b;c;d : D | a = 1 && b = 2 && c = 3 && d = B]
+         -}
+         -- Need at least 4 D's per A.
+         -- Either
+         -- a) Make the effective lower cardinality of C=4 and D=1
+         -- b) Make the effective lower cardinality of C=1 and D=4
+         -- c) Some other combination.
+         -- Choose b, a greedy algorithm that starts from the lowest child progressing upwards.
+         
+        {-
+         - abstract Z
+         -   C *
+         -     D : integer 3..*
+         -
+         - A : Z
+         -   B : integer
+         -   [some disj a;b;c;d : D | a = 1 && b = 2 && c = 3 && d = B]
+         -}
+         -- The algorithm we do is greedy so it will chose D=3.
+         -- However, it still needs more D's so it will choose C=2
+         -- C=2, D=3
+         -- This might not be optimum since now the scope allows for 6 D's.
+         -- A better solution might be C=2, D=2.
+         -- Well too bad, we are using the greedy algorithm.
+    assign [] _ = [1]
+    assign (p : ps) score =
+        pScore : ps'
+        where
+        --upper = upperCards p
+        ps' = assign ps score
+        psScore = product $ ps'
+        pDesireScore = ceiling (score % psScore)
+        pMaxScore = upperCards p
+        pScore = min' pDesireScore pMaxScore
+        
+    min' a b = if b == -1 then a else min a b
+        
+    -- The each child has at most one parent. No matter what the path in a quantifier
+    -- looks like, we ignore the parent parts.
+    dropThisAndParent = dropWhile (== "parent") . dropWhile (== "this")
+
+
+analyzeDependencies :: [IClafer] -> [SCC String]
+analyzeDependencies clafers = connComponents
+    where
+    connComponents  = stronglyConnComp [(key, key, depends) | (key, depends) <- dependencyGraph]
+    dependencies    = concatMap (dependency clafers) clafers
+    dependencyGraph = Map.toList $ Map.fromListWith (++) [(a, [b]) | (a, b) <- dependencies]
+
+dependency :: [IClafer] -> IClafer -> [(String, String)]
+dependency clafers clafer =
+    selfDependency : (maybeToList superDependency ++ childDependencies)
+    where
+     -- This is to make the "stronglyConnComp" from Data.Graph play nice. Otherwise,
+     -- clafers with no dependencies will not appear in the result.
+    selfDependency = (uid clafer, uid clafer)
+    superDependency
+        | isReference clafer = Nothing
+        | otherwise =
+            do
+                super' <- directSuper clafers clafer
+                -- Need to analyze clafer before its super
+                return (uid super', uid clafer)
+    -- Need to analyze clafer before its children
+    childDependencies = [(uid child, uid clafer) | child <- childClafers clafer]
+        
+
+analyzeHierarchy :: [IClafer] -> (Map String [String], Map String String)
+analyzeHierarchy clafers =
+    foldl hierarchy (Map.empty, Map.empty) clafers
+    where
+    hierarchy (subclaferMap, parentMap) clafer = (subclaferMap', parentMap')
+        where
+            subclaferMap' = 
+                case super' of
+                    Just super'' -> Map.insertWith (++) (uid super'') [uid clafer] subclaferMap
+                    Nothing     -> subclaferMap
+            super' = directSuper clafers clafer
+            parentMap' = foldr (flip Map.insert $ uid clafer) parentMap (map uid $ childClafers clafer)
+    
+directSuper :: [IClafer] -> IClafer -> Maybe IClafer
+directSuper clafers clafer =
+    second $ findHierarchy getSuper clafers clafer
+    where
+    second [] = Nothing
+    second [_] = Nothing
+    second (_:x:_) = Just x
+    
+
+-- Finds all ancestors
+findClafers :: IElement -> [IClafer]
+findClafers (IEClafer clafer) = clafer : concatMap findClafers (elements clafer)
+findClafers _ = []
+
+
+-- Find all constraints
+findConstraints :: IElement -> [PExp]
+findConstraints IEConstraint{cpexp = c} = [c]
+findConstraints (IEClafer clafer) = concatMap findConstraints (elements clafer)
+findConstraints _ = []
+
+-- Finds all the direct ancestors (ie. children)
+childClafers :: IClafer -> [IClafer]
+childClafers clafer =
+    mapMaybe asClafer (elements clafer)
+    where
+    asClafer (IEClafer claf) = Just claf
+    asClafer _ = Nothing
+    
+    
+-- Unfold joins
+-- If the expression is a tree of only joins, then this function will flatten
+-- the joins into a list.
+-- Otherwise, returns an empty list.
+unfoldJoins :: PExp -> [String]
+unfoldJoins pexp =
+    fromMaybe [] $ unfoldJoins' pexp
+    where
+    unfoldJoins' PExp{exp = (IFunExp "." args)} =
+        return $ args >>= unfoldJoins
+    unfoldJoins' PExp{exp = IClaferId{sident = sident'}} =
+        return $ [sident']
+    unfoldJoins' _ =
+        fail "not a join"
+ src/Language/Clafer/Intermediate/StringAnalyzer.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE RankNTypes, KindSignatures ,FlexibleContexts #-}
+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.StringAnalyzer where
+
+import Data.Map (Map)
+import Data.Tuple
+import qualified Data.Map as Map
+import Control.Monad.State
+
+import Language.Clafer.Common
+import Language.Clafer.Intermediate.Intclafer
+
+-- | Convert all strings into ints for analysis
+-- | Return an inverse map from ints back to strings
+astrModule :: IModule -> (IModule, Map Int String)
+astrModule imodule = (imodule{mDecls = decls''}, flipMap strMap')
+  where
+    decls' = mDecls imodule
+    (decls'', strMap') = runState (mapM astrElement decls') Map.empty
+
+    flipMap :: Map String Int -> Map Int String
+    flipMap = Map.fromList . map swap . Map.toList
+
+
+astrClafer :: MonadState (Map String Int) m => IClafer -> m IClafer
+astrClafer (IClafer s isAbs gcrd ident' uid' super' crd gCard es) =
+    IClafer s isAbs gcrd ident' uid' super' crd gCard `liftM` mapM astrElement es
+
+
+-- astrs single subclafer
+astrElement :: MonadState (Map String Int) m => IElement -> m IElement
+astrElement x = case x of
+  IEClafer clafer -> IEClafer `liftM` astrClafer clafer
+  IEConstraint isHard' pexp -> IEConstraint isHard' `liftM` astrPExp pexp
+  IEGoal isMaximize' pexp -> IEGoal isMaximize' `liftM` astrPExp pexp
+
+astrPExp :: MonadState (Map String Int) m => PExp -> m PExp
+astrPExp (PExp (Just TString) pid' pos' exp') =
+    PExp (Just TInteger) pid' pos' `liftM` astrIExp exp'
+astrPExp (PExp t pid' pos' (IFunExp op' exps')) = PExp t pid' pos' `liftM`
+                              (IFunExp op' `liftM` mapM astrPExp exps')
+astrPExp (PExp t pid' pos' (IDeclPExp quant' oDecls' bpexp')) = PExp t pid' pos' `liftM`
+                              (IDeclPExp quant' oDecls' `liftM` (astrPExp bpexp'))
+astrPExp x = return x
+
+astrIExp :: MonadState (Map String Int) m => IExp -> m IExp
+astrIExp x = case x of
+  IFunExp op' _ -> if op' == iUnion
+                     then astrIExp $ concatStrExp x else return x                    
+  IStr str -> do
+    modify (\e -> Map.insertWith (flip const) str (Map.size e) e)
+    st <- get
+    --lift $ tell $ Map.singleton (toInteger $ (Map.!) st str) str 
+    return $  (IInt $ toInteger $ (Map.!) st str)
+     
+  _ -> return x
+
+
+concatStrExp :: IExp -> IExp
+concatStrExp x = case x of
+  IFunExp _ exps' -> IStr $ s0 ++ s1 
+    where
+    ((IStr s0):(IStr s1):_) = map concatStrExp $ map (Language.Clafer.Intermediate.Intclafer.exp) exps'
+  IStr _ -> x
+  _ -> x
+ src/Language/Clafer/Intermediate/Tracing.hs view
@@ -0,0 +1,339 @@+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.Tracing (traceIrModule, traceAstModule, Ast(..)) where
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Front.Mapper
+import Language.Clafer.Intermediate.Intclafer
+
+traceIrModule :: IModule -> Map Span [Ir] --Map Span [Union (IRClafer IClafer) (IRPExp PExp)]
+traceIrModule = foldMapIR getMap 
+  where
+    insert :: Span -> Ir -> Map Span [Ir] -> Map Span [Ir]
+    insert k a = Map.insertWith (++) k [a]
+    getMap :: Ir -> Map Span [Ir] --Map Span [Union (IRClafer IClafer) (IRPExp PExp)]
+    getMap (IRPExp (p@PExp{inPos = s})) = insert s (IRPExp p) Map.empty
+    getMap (IRClafer (c@IClafer{cinPos = s})) = insert s (IRClafer c) Map.empty
+    getMap _ = Map.empty
+
+traceAstModule :: Module -> Map Span [Ast]
+traceAstModule x =
+  foldr
+    ins
+    Map.empty
+    (traverseModule x)
+  where
+  ins y = Map.insertWith (++) (i y) [y]
+  i (AstModule a) = range a
+  i (AstDeclaration a) = range a
+  i (AstClafer a) = range a
+  i (AstConstraint a) = range a
+  i (AstSoftConstraint a) = range a
+  i (AstGoal a) = range a
+  i (AstAbstract a) = range a
+  i (AstElements a) = range a
+  i (AstElement a) = range a
+  i (AstSuper a) = range a
+  i (AstSuperHow a) = range a
+  i (AstInit a) = range a
+  i (AstInitHow a) = range a
+  i (AstGCard a) = range a
+  i (AstCard a) = range a
+  i (AstNCard a) = range a
+  i (AstExInteger a) = range a
+  i (AstName a) = range a
+  i (AstExp a) = range a
+  i (AstSetExp a) = range a
+  i (AstDecl a) = range a
+  i (AstQuant a) = range a
+  i (AstEnumId a) = range a
+  i (AstModId a) = range a
+  i (AstLocId a) = range a
+
+traverseModule :: Module -> [Ast]
+traverseModule x@(PosModule _ d) = AstModule x : concatMap traverseDeclaration d
+traverseModule x@(Module d) = AstModule x : concatMap traverseDeclaration d -- should never happen
+
+traverseDeclaration :: Declaration -> [Ast]
+traverseDeclaration x =
+  AstDeclaration x :
+    case x of
+    PosEnumDecl _ _ e -> concatMap traverseEnumId e
+    PosElementDecl _ e -> traverseElement e
+    EnumDecl _ e -> concatMap traverseEnumId e  -- These bottom two should not happen
+    ElementDecl e -> traverseElement e          -- should always be given a Pos
+
+traverseClafer :: Clafer -> [Ast]
+traverseClafer x@(PosClafer _ a b _ d e f g) = AstClafer x : (traverseAbstract a ++ traverseGCard b ++ traverseSuper d ++ traverseCard e ++ traverseInit f ++ traverseElements g)
+traverseClafer x@(Clafer a b _ d e f g) = AstClafer x : (traverseAbstract a ++ traverseGCard b ++ traverseSuper d ++ traverseCard e ++ traverseInit f ++ traverseElements g) -- Should never happen
+
+traverseConstraint :: Constraint -> [Ast]
+traverseConstraint x@(PosConstraint _ e) = AstConstraint x : concatMap traverseExp e
+traverseConstraint x@(Constraint e) = AstConstraint x : concatMap traverseExp e -- This should never happen
+
+traverseSoftConstraint :: SoftConstraint -> [Ast]
+traverseSoftConstraint x@(PosSoftConstraint _ e) = AstSoftConstraint x : concatMap traverseExp e
+traverseSoftConstraint x@(SoftConstraint e) = AstSoftConstraint x : concatMap traverseExp e -- This should never happen
+
+traverseGoal :: Goal -> [Ast]
+traverseGoal x@(PosGoal _ e) = AstGoal x : concatMap traverseExp e
+traverseGoal x@(Goal e) = AstGoal x : concatMap traverseExp e -- This should never happen
+
+traverseAbstract :: Abstract -> [Ast]
+traverseAbstract x =
+  AstAbstract x : [{- no other children -}]
+
+traverseElements :: Elements -> [Ast]
+traverseElements x =
+  AstElements x :
+    case x of
+    PosElementsEmpty _ -> []
+    PosElementsList _ e -> concatMap traverseElement e
+    ElementsEmpty -> [] -- These bottom two should not happen, should always be given a Pos
+    ElementsList e -> concatMap traverseElement e
+
+traverseElement :: Element -> [Ast]
+traverseElement x =
+  AstElement x :
+    case x of
+    PosSubclafer _ c -> traverseClafer c
+    PosClaferUse _ n c e -> traverseName n ++ traverseCard c ++ traverseElements e
+    PosSubconstraint _ c -> traverseConstraint c
+    PosSubgoal _ g -> traverseGoal g
+    PosSubsoftconstraint _ c -> traverseSoftConstraint c
+    Subclafer c -> traverseClafer c                                           -- This and bellow should never happen
+    ClaferUse n c e -> traverseName n ++ traverseCard c ++ traverseElements e -- should always be given a Pos
+    Subconstraint c -> traverseConstraint c
+    Subgoal g -> traverseGoal g
+    Subsoftconstraint c -> traverseSoftConstraint c
+
+traverseSuper :: Super -> [Ast]
+traverseSuper x =
+  AstSuper x :
+    case x of
+    PosSuperEmpty _ -> []
+    PosSuperSome _ sh se -> traverseSuperHow sh ++ traverseSetExp se
+    SuperEmpty -> [] -- These bottom two should not happen, should always be given a Pos
+    SuperSome sh se -> traverseSuperHow sh ++ traverseSetExp se
+
+traverseSuperHow :: SuperHow -> [Ast]
+traverseSuperHow x =
+  AstSuperHow x : [{- no other children -}]
+
+traverseInit :: Init -> [Ast]
+traverseInit x =
+  AstInit x :
+    case x of
+    PosInitEmpty _ -> []
+    PosInitSome _ ih e -> traverseInitHow ih ++ traverseExp e
+    InitEmpty -> [] -- These bottom two should not happen, should always be given a Pos
+    InitSome ih e -> traverseInitHow ih ++ traverseExp e
+
+traverseInitHow :: InitHow -> [Ast]
+traverseInitHow x =
+  AstInitHow x : [{- no other children -}]
+
+traverseGCard :: GCard -> [Ast]
+traverseGCard x =
+  AstGCard x :
+    case x of
+    PosGCardEmpty _ -> []
+    PosGCardXor _ -> []
+    PosGCardOr _ -> []
+    PosGCardMux _ -> []
+    PosGCardOpt _ -> []
+    PosGCardInterval _ n -> traverseNCard n
+    GCardEmpty -> [] -- This and bellow should not happen
+    GCardXor -> []   -- should always be given a Pos
+    GCardOr -> []
+    GCardMux -> []
+    GCardOpt -> []
+    GCardInterval n -> traverseNCard n
+
+traverseCard :: Card -> [Ast]
+traverseCard x =
+  AstCard x :
+    case x of
+    PosCardEmpty _ -> []
+    PosCardLone _ -> []
+    PosCardSome _ -> []
+    PosCardAny _ -> []
+    PosCardNum _ _ -> []
+    PosCardInterval _ n -> traverseNCard n
+    CardEmpty -> [] -- This and Bellow Should not happen
+    CardLone -> []  -- Should always been given a Pos
+    CardSome -> []
+    CardAny -> []
+    CardNum _ -> []
+    CardInterval n -> traverseNCard n
+
+traverseNCard :: NCard -> [Ast]
+traverseNCard x@(PosNCard _ _ e) = AstNCard x : traverseExInteger e
+traverseNCard x@(NCard _ e) = AstNCard x : traverseExInteger e -- Should never happen
+
+traverseExInteger :: ExInteger -> [Ast]
+traverseExInteger x =
+  AstExInteger x : [{- no other children -}]
+
+traverseName :: Name -> [Ast]
+traverseName x@(PosPath _ m) = AstName x : concatMap traverseModId m
+traverseName x@(Path m) = AstName x : concatMap traverseModId m -- Should never happen
+
+traverseExp :: Exp -> [Ast]
+traverseExp x =
+  AstExp x :
+    case x of
+    PosDeclAllDisj _ d e -> traverseDecl d ++ traverseExp e
+    PosDeclAll _ d e -> traverseDecl d ++ traverseExp e
+    PosDeclQuantDisj _ q d e -> traverseQuant q ++ traverseDecl d ++ traverseExp e
+    PosDeclQuant _ q d e -> traverseQuant q ++ traverseDecl d ++ traverseExp e
+    PosEGMax _ e -> traverseExp e
+    PosEGMin _ e -> traverseExp e
+    PosEIff _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEImplies _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEOr _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEXor _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEAnd _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosENeg _ e -> traverseExp e
+    PosELt _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEGt _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEEq _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosELte _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEGte _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosENeq _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEIn _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosENin _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosQuantExp _ q e -> traverseQuant q ++ traverseExp e
+    PosEAdd _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosESub _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEMul _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosEDiv _ e1 e2 -> traverseExp e1 ++ traverseExp e2
+    PosECSetExp _ e -> traverseExp e
+    PosEMinExp _ e -> traverseExp e
+    PosEImpliesElse _ e1 e2 e3 -> traverseExp e1 ++ traverseExp e2 ++ traverseExp e3
+    PosEInt _ _ -> []
+    PosEDouble _ _ -> []
+    PosEStr _ _ -> []
+    PosESetExp _ s -> traverseSetExp s
+    DeclAllDisj d e -> traverseDecl d ++ traverseExp e                        -- This and Bellow should not happen
+    DeclAll d e -> traverseDecl d ++ traverseExp e                            -- Should always be given a Pos
+    DeclQuantDisj q d e -> traverseQuant q ++ traverseDecl d ++ traverseExp e
+    DeclQuant q d e -> traverseQuant q ++ traverseDecl d ++ traverseExp e
+    EGMax e -> traverseExp e
+    EGMin e -> traverseExp e
+    EIff e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EImplies e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EOr e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EXor e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EAnd e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ENeg e -> traverseExp e
+    ELt e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EGt e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EEq e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ELte e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EGte e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ENeq e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EIn e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ENin e1 e2 -> traverseExp e1 ++ traverseExp e2
+    QuantExp q e -> traverseQuant q ++ traverseExp e
+    EAdd e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ESub e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EMul e1 e2 -> traverseExp e1 ++ traverseExp e2
+    EDiv e1 e2 -> traverseExp e1 ++ traverseExp e2
+    ECSetExp e -> traverseExp e
+    EMinExp e -> traverseExp e
+    EImpliesElse e1 e2 e3 -> traverseExp e1 ++ traverseExp e2 ++ traverseExp e3
+    EInt _ -> []
+    EDouble _ -> []
+    EStr _ -> []
+    ESetExp s -> traverseSetExp s
+    _ -> error "Invalid argument given to function traverseExp from Tracing" -- Should never happen
+
+traverseSetExp :: SetExp -> [Ast]
+traverseSetExp x =
+  AstSetExp x :
+    case x of
+    PosUnion _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosUnionCom _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosDifference _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosIntersection _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosDomain _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosRange _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosJoin _ s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    PosClaferId _ n -> traverseName n
+    Union s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2    -- This and Bellow Should not happen
+    UnionCom s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2 -- It should also be given a Pos
+    Difference s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    Intersection s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    Domain s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    Range s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    Join s1 s2 -> traverseSetExp s1 ++ traverseSetExp s2
+    ClaferId n -> traverseName n
+
+traverseDecl :: Decl -> [Ast]
+traverseDecl x@(PosDecl _ l s) =
+  AstDecl x : (concatMap traverseLocId l ++ traverseSetExp s)
+traverseDecl x@(Decl l s) = 
+  AstDecl x : (concatMap traverseLocId l ++ traverseSetExp s) -- Should never happen
+
+traverseQuant :: Quant -> [Ast]
+traverseQuant x =
+  AstQuant x : [{- no other children -}]
+
+traverseEnumId :: EnumId -> [Ast]
+traverseEnumId _ = []
+
+traverseModId :: ModId -> [Ast]
+traverseModId _ = []
+
+traverseLocId :: LocId -> [Ast]
+traverseLocId _ = []
+  
+data Ast =
+  AstModule Module |
+  AstDeclaration Declaration |
+  AstClafer Clafer |
+  AstConstraint Constraint |
+  AstSoftConstraint SoftConstraint |
+  AstGoal Goal |
+  AstAbstract Abstract |
+  AstElements Elements |
+  AstElement Element |
+  AstSuper Super |
+  AstSuperHow SuperHow |
+  AstInit Init |
+  AstInitHow InitHow |
+  AstGCard GCard |
+  AstCard Card |
+  AstNCard NCard |
+  AstExInteger ExInteger |
+  AstName Name |
+  AstExp Exp |
+  AstSetExp SetExp |
+  AstDecl Decl |
+  AstQuant Quant |
+  AstEnumId EnumId |
+  AstModId ModId |
+  AstLocId LocId
+  deriving (Eq, Show)
+ src/Language/Clafer/Intermediate/Transformer.hs view
@@ -0,0 +1,52 @@+{-
+ Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Intermediate.Transformer where
+
+import Data.Maybe
+import Language.Clafer.Common
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Intermediate.Desugarer
+
+transModule :: IModule -> IModule
+transModule imodule = imodule{mDecls = map transElement $ mDecls imodule}
+
+transElement :: IElement -> IElement
+transElement x = case x of
+  IEClafer clafer  -> IEClafer $ transClafer clafer
+  IEConstraint isHard' pexp  -> IEConstraint isHard' $ transPExp False pexp
+  IEGoal isMaximize' pexp  -> IEGoal isMaximize' $ transPExp False pexp  
+
+transClafer :: IClafer -> IClafer
+transClafer clafer = clafer{elements = map transElement $ elements clafer}
+
+transPExp :: Bool -> PExp -> PExp
+transPExp some (PExp t pid' pos' x) = trans $ PExp t pid' pos' $ transIExp (fromJust t) x
+  where
+  trans = if some then desugarPath else id
+
+transIExp :: IType -> IExp -> IExp
+transIExp t x = case x of
+  IDeclPExp quant' decls' pexp -> IDeclPExp quant' decls' $ transPExp False pexp
+  IFunExp op' exps' -> IFunExp op' $ map (transPExp cond) exps'
+    where
+    cond = op' == iIfThenElse && t `elem` [TBoolean, TClafer []]
+  _  -> x
+ src/Language/Clafer/JSONMetaData.hs view
@@ -0,0 +1,79 @@+{-
+ Copyright (C) 2014 Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Creates JSON outputs for different kinds of metadata.
+module Language.Clafer.JSONMetaData (
+  generateJSONnameUIDMap,
+  generateJSONScopes
+)
+        
+where
+
+import qualified Data.List as List
+import Data.Maybe
+import Data.Json.Builder
+import Data.String.Conversions
+
+import Language.Clafer.QNameUID
+
+-- | Generate a JSON list of triples containing a fully-qualified-, least-partially-qualified name, and unique id.
+-- | Both the FQNames and UIDs are brittle. LPQNames are the least brittle.
+generateJSONnameUIDMap :: QNameMaps -> String
+generateJSONnameUIDMap    qNameMaps     = 
+    prettyPrintJSON $ convertString $ toJsonBS $ foldl generateQNameUIDArrayEntry mempty sortedTriples 
+    where
+      sortedTriples :: [(FQName, PQName, UID)]
+      sortedTriples = List.sortBy (\(fqName1, _, _) (fqName2, _, _) -> compare fqName1 fqName2) $ getQNameUIDTriples qNameMaps
+
+generateQNameUIDArrayEntry :: Array -> (FQName, PQName, UID) -> Array
+generateQNameUIDArrayEntry    array    (fqName, lpqName, uid) = 
+    mappend array $ element $ mconcat [ 
+        row "fqName" fqName, 
+        row "lpqName" lpqName,
+        row "uid" uid ]
+
+-- | Generate a JSON list of tuples containing a least-partially-qualified name and a scope
+generateJSONScopes :: QNameMaps -> [(UID, Integer)] -> String
+generateJSONScopes    qNameMaps    scopes       =
+    prettyPrintJSON $ convertString $ toJsonBS $ foldl generateLpqNameScopeArrayEntry mempty sortedLpqNameScopeList
+    where
+      lpqNameScopeList = map (\(uid, scope) -> (fromMaybe uid $ getLPQName qNameMaps uid, scope)) scopes
+      sortedLpqNameScopeList :: [(PQName, Integer)]
+      sortedLpqNameScopeList = List.sortBy (\(lpqName1, _) (lpqName2, _) -> compare lpqName1 lpqName2) lpqNameScopeList
+
+
+generateLpqNameScopeArrayEntry :: Array -> (PQName, Integer)   -> Array
+generateLpqNameScopeArrayEntry    array    (lpqName, scope) = 
+    mappend array $ element $ mconcat [ 
+        row "lpqName" lpqName,
+        row "scope" scope ]
+
+-- insert a new line after  [, {, and ,
+prettyPrintJSON :: String -> String
+prettyPrintJSON ('[':line) = '[':'\n':(prettyPrintJSON line)
+prettyPrintJSON ('{':line) = '{':'\n':(prettyPrintJSON line)
+prettyPrintJSON (',':line) = ',':'\n':(prettyPrintJSON line)
+-- insert a new line before ], }
+prettyPrintJSON (']':line) = '\n':']':(prettyPrintJSON line)
+prettyPrintJSON ('}':line) = '\n':'}':(prettyPrintJSON line)
+-- just rewrite and continue
+prettyPrintJSON (c:line) =  c:(prettyPrintJSON line)
+prettyPrintJSON ""         = ""
+ src/Language/Clafer/Optimizer/Optimizer.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE FlexibleContexts #-}
+{-
+ Copyright (C) 2012 Kacper Bak, Jimmy Liang <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Language.Clafer.Optimizer.Optimizer where
+
+import Data.Maybe
+import Data.List
+import Control.Monad.State
+import qualified Data.Map as Map
+
+import Language.Clafer.Common
+import Language.Clafer.ClaferArgs
+import Language.Clafer.Intermediate.Intclafer
+
+-- | Apply optimizations for unused abstract clafers and inheritance flattening
+optimizeModule :: ClaferArgs -> (IModule, GEnv) -> IModule
+optimizeModule args (imodule, genv) =
+  imodule{mDecls = em $ rm $ map (optimizeElement (1, 1)) $
+                   markTopModule $ mDecls imodule}
+  where
+  rm = if keep_unused args then makeZeroUnusedAbs else remUnusedAbs
+  em = if flatten_inheritance args then flip (curry expModule) genv else id
+
+optimizeElement :: Interval -> IElement -> IElement
+optimizeElement interval' x = case x of
+  IEClafer c  -> IEClafer $ optimizeClafer interval' c
+  IEConstraint _ _  -> x
+  IEGoal _ _ -> x
+
+optimizeClafer :: Interval -> IClafer -> IClafer
+optimizeClafer interval' c = c {glCard = glCard',
+  elements = map (optimizeElement glCard') $ elements c}
+  where
+  glCard' = multInt (fromJust $ card c) interval'
+
+
+multInt :: Interval -> Interval -> Interval
+multInt (m, n) (m', n') = (m * m', multExInt n n')
+
+multExInt :: Integer -> Integer -> Integer
+multExInt 0 _ = 0
+multExInt _  0 = 0
+multExInt m n = if m == -1 || n == -1 then -1 else m * n
+
+-- -----------------------------------------------------------------------------
+
+makeZeroUnusedAbs :: [IElement] -> [IElement]
+makeZeroUnusedAbs decls' = map (\x -> if (x `elem` unusedAbs) then IEClafer (getIClafer x){card = Just (0, 0)} else x) decls'
+  where
+  unusedAbs = map IEClafer $ findUnusedAbs clafers $ map uid $
+              filter (not.isAbstract) clafers
+  clafers   = toClafers decls' 
+  getIClafer (IEClafer c) = c
+  getIClafer _ = error "Function makeZeroUnusedAbs from Optimizer expected paramter of type IClafer got a differnt IElement" --This should never happen
+
+remUnusedAbs :: [IElement] -> [IElement]
+remUnusedAbs decls' = decls' \\ unusedAbs
+  where
+  unusedAbs = map IEClafer $ findUnusedAbs clafers $ map uid $
+              filter (not.isAbstract) clafers
+  clafers   = toClafers decls'
+
+
+findUnusedAbs :: [IClafer] -> [String] -> [IClafer]
+findUnusedAbs maybeUsed [] = maybeUsed
+findUnusedAbs [] _   = []
+findUnusedAbs maybeUsed used = findUnusedAbs maybeUsed' $ getUniqExtended used'
+  where
+  (used', maybeUsed') = partition (\c -> uid c `elem` used) maybeUsed
+
+getUniqExtended :: [IClafer] -> [String]
+getUniqExtended used = nub $ used >>= getExtended
+
+
+getExtended :: IClafer -> [String]
+getExtended c =
+  sName ++ ((getSubclafers $ elements c) >>= getExtended)
+  where
+  sName = if not $ isOverlapping $ super c then [getSuper c] else []
+
+-- -----------------------------------------------------------------------------
+-- inheritance  expansions
+
+expModule :: ([IElement], GEnv) -> [IElement]
+expModule (decls', genv) = evalState (mapM expElement decls') genv
+
+expClafer :: MonadState GEnv m => IClafer -> m IClafer
+expClafer claf = do
+  super' <- expSuper $ super claf
+  elements' <- mapM expElement $ elements claf
+  return $ claf {super = super', elements = elements'}
+
+expSuper :: MonadState GEnv m => ISuper -> m ISuper
+expSuper x = case x of
+  ISuper False _ -> return x
+  ISuper True pexps -> ISuper True `liftM` mapM expPExp pexps
+
+expElement :: MonadState GEnv m => IElement -> m IElement
+expElement x = case x of
+  IEClafer claf  -> IEClafer `liftM` expClafer claf
+  IEConstraint isHard' constraint  -> IEConstraint isHard' `liftM` expPExp constraint
+  IEGoal isMaximize' goal -> IEGoal isMaximize' `liftM` expPExp goal
+
+expPExp :: MonadState GEnv m => PExp -> m PExp
+expPExp (PExp t pid' pos' exp') = PExp t pid' pos' `liftM` expIExp exp'
+
+expIExp :: MonadState GEnv m => IExp -> m IExp
+expIExp x = case x of
+  IDeclPExp quant' decls' pexp -> do
+    decls'' <- mapM expDecl decls'
+    pexp' <- expPExp pexp
+    return $ IDeclPExp quant' decls'' pexp'
+  IFunExp op' exps' -> if op' == iJoin
+                     then expNav x else IFunExp op' `liftM` mapM expPExp exps'
+  IClaferId _ _ _ -> expNav x
+  _ -> return x
+
+expDecl :: MonadState GEnv m => IDecl -> m IDecl
+expDecl x = case x of
+  IDecl disj locids pexp -> IDecl disj locids `liftM` expPExp pexp
+
+expNav :: MonadState GEnv m => IExp -> m IExp
+expNav x = do
+  xs <- split' x return
+  xs' <- mapM (expNav' "") xs
+  return $ mkIFunExp iUnion $ map fst xs'
+
+expNav' :: MonadState GEnv m => String -> IExp -> m (IExp, String)
+expNav' context (IFunExp _ (p0:p:_)) = do    
+  (exp0', context') <- expNav' context  $ Language.Clafer.Intermediate.Intclafer.exp p0
+  (exp', context'') <- expNav' context' $ Language.Clafer.Intermediate.Intclafer.exp p
+  return (IFunExp iJoin [ p0 {Language.Clafer.Intermediate.Intclafer.exp = exp0'}
+                        , p  {Language.Clafer.Intermediate.Intclafer.exp = exp'}], context'')
+expNav' context x@(IClaferId modName' id' isTop') = do
+  st <- gets stable
+  if Map.member id' st
+    then do
+      let impls  = (Map.!) st id'
+      let (impls', context') = maybe (impls, "")
+           (\y -> ([[head y]], head y)) $
+           find (\z -> context == (head.tail) z) impls
+      return (mkIFunExp iUnion $ map (\u -> IClaferId modName' u isTop') $
+              map head impls', context')
+    else do
+      return (x, id')
+expNav' _ _ = error "Function expNav' from Optimizer expects an argument of type ClaferId or IFunExp but was given another IExp"
+
+split' :: MonadState GEnv m => IExp -> (IExp -> m IExp) -> m [IExp] 
+split'(IFunExp _ (p:pexp:_)) f =
+    split' (Language.Clafer.Intermediate.Intclafer.exp p) (\s -> f $ IFunExp iJoin
+      [p {Language.Clafer.Intermediate.Intclafer.exp = s}, pexp])
+split' (IClaferId modName' id' isTop') f = do
+    st <- gets stable
+    mapM f $ map (\y -> IClaferId modName' y isTop') $ maybe [id'] (map head) $ Map.lookup id' st
+split' _ _ = error "Function split' from Optimizer expects an argument of type ClaferId or IFunExp but was given another IExp"
+
+-- -----------------------------------------------------------------------------
+-- checking if all clafers have unique names and don't extend other clafers
+
+allUnique :: IModule -> Bool
+allUnique imodule = and un && (null $
+  filter (\xs -> 1 < length xs) $ group $ sort $ concat idents) && identsOk
+  where
+  (un, idents) = unzip $ map allUniqueElement $ mDecls imodule
+  identsOk     = and $ map (checkConstraintElement (concat idents)) $ mDecls imodule
+
+allUniqueClafer :: IClafer -> (Bool, [String])
+allUniqueClafer claf =
+  (getSuper claf `elem` "clafer" : primitiveTypes  && and un,
+   ident claf : concat idents)
+  where
+  (un, idents) = unzip $ map allUniqueElement $ elements claf
+
+allUniqueElement :: IElement -> (Bool, [String])
+allUniqueElement x = case x of
+  IEClafer claf -> allUniqueClafer claf
+  IEConstraint _ _ -> (True, [])
+  IEGoal _ _ -> (True, [])
+
+checkConstraintElement :: [String] -> IElement -> Bool
+checkConstraintElement idents x = case x of
+  IEClafer claf -> and $ map (checkConstraintElement idents) $ elements claf
+  IEConstraint _ pexp -> checkConstraintPExp idents pexp 
+  IEGoal _ _ ->  True
+
+checkConstraintPExp :: [String] -> PExp -> Bool
+checkConstraintPExp idents pexp = checkConstraintIExp idents $
+                                  Language.Clafer.Intermediate.Intclafer.exp pexp
+
+checkConstraintIExp :: [String] -> IExp -> Bool
+checkConstraintIExp idents x = case x of
+   IDeclPExp _ oDecls' pexp ->
+     checkConstraintPExp ((oDecls' >>= (checkConstraintIDecl idents)) ++ idents) pexp
+   IClaferId _ ident' _ -> if ident' `elem` (specialNames ++ idents) then True
+                          else error $ "optimizer: " ++ ident' ++ " not found"
+   _ -> True
+
+checkConstraintIDecl :: [String] -> IDecl -> [String]
+checkConstraintIDecl idents (IDecl _ decls' pexp)
+  | checkConstraintPExp idents pexp = decls'
+  | otherwise                       = []
+
+-- -----------------------------------------------------------------------------
+findDupModule :: ClaferArgs -> IModule -> IModule
+findDupModule args imodule = imodule{mDecls = decls'}
+  where
+  decls'' = mDecls imodule
+  decls'
+    | check_duplicates args = findDupModule' decls''
+    | otherwise                        = decls''
+
+
+findDupModule' :: [IElement] -> [IElement]
+findDupModule' declarations
+  | null dups = map findDupElement declarations
+  | otherwise = error $ show dups
+  where
+  dups = findDuplicates $ toClafers declarations
+
+findDupClafer :: IClafer -> IClafer
+findDupClafer claf = if null dups
+  then claf{elements = map findDupElement $ elements claf}
+  else error $ (show $ ident claf) ++ show dups
+  where
+  dups = findDuplicates $ getSubclafers $ elements claf
+
+findDupElement :: IElement -> IElement
+findDupElement x = case x of
+  IEClafer claf -> IEClafer $ findDupClafer claf
+  IEConstraint _ _ -> x
+  IEGoal _ _ -> x
+
+
+findDuplicates :: [IClafer] -> [String]
+findDuplicates clafers =
+  map head $ filter (\xs -> 1 < length xs) $ group $ sort $ map ident clafers
+
+-- -----------------------------------------------------------------------------
+-- marks top clafers
+
+markTopModule :: [IElement] -> [IElement]
+markTopModule decls' = map (markTopElement (
+      [this, parent, children, strType, intType, integerType] ++
+      (map uid $ toClafers decls'))) decls'
+
+
+markTopClafer :: [String] -> IClafer -> IClafer
+markTopClafer clafers c =
+  c {super = markTopSuper clafers $ super c, 
+          elements = map (markTopElement clafers) $ elements c}
+
+
+markTopSuper :: [String] -> ISuper -> ISuper
+markTopSuper clafers x = x{supers = map (markTopPExp clafers) $ supers x}
+
+
+markTopElement :: [String] -> IElement -> IElement
+markTopElement clafers x = case x of
+  IEClafer c  -> IEClafer $ markTopClafer clafers c
+  IEConstraint isHard' pexp  -> IEConstraint isHard' $ markTopPExp clafers pexp
+  IEGoal isMaximize' pexp -> IEGoal isMaximize' $ markTopPExp clafers pexp
+
+markTopPExp :: [String] -> PExp -> PExp
+markTopPExp clafers pexp =
+  pexp {Language.Clafer.Intermediate.Intclafer.exp = markTopIExp clafers $
+        Language.Clafer.Intermediate.Intclafer.exp pexp}
+
+
+markTopIExp :: [String] -> IExp -> IExp
+markTopIExp clafers x = case x of
+  IDeclPExp quant' decl pexp -> IDeclPExp quant' (map (markTopDecl clafers) decl)
+                                (markTopPExp ((decl >>= decls) ++ clafers) pexp)
+  IFunExp op' exps' -> IFunExp op' $ map (markTopPExp clafers) exps'
+  IClaferId modName' sident' _ ->
+    IClaferId modName' sident' $ sident' `elem` clafers
+  _ -> x
+
+
+markTopDecl :: [String] -> IDecl -> IDecl
+markTopDecl clafers x = case x of
+  IDecl disj locids pexp -> IDecl disj locids $ markTopPExp clafers pexp
+ src/Language/Clafer/QNameUID.hs view
@@ -0,0 +1,162 @@+{-
+ Copyright (C) 2014 Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+-- | Support for dealing with unique IDs (UIDs), fully- and least-partially qualified names.
+module Language.Clafer.QNameUID (
+        QName,
+        FQName,
+        PQName, 
+        QNameMaps,
+        UID,
+        deriveQNameMaps,
+        getUIDs,
+        getFQName,
+        getLPQName,
+        getQNameUIDTriples 
+)
+        
+where
+
+import Data.Maybe
+import Data.List.Split
+import qualified Data.Map as Map
+import qualified Data.StringMap as SMap
+
+import Language.Clafer.Intermediate.Intclafer
+
+-- | a fully- or partially-qualified name
+type QName = String
+
+-- | fully-qualified name, must begin with ::
+-- | e.g., `::Person::name`, `::Company::Department::chair`
+type FQName = String
+
+-- a reversed FQName used as a key in the FQNameUIDMap
+type FQKey = String
+
+-- | partially-qualified name, must not begin with ::
+-- | e.g., `Person::name`, `chair`
+type PQName = String    
+
+-- a map from reversed FQName (FQKey) to UID
+type FQNameUIDMap = SMap.StringMap UID
+
+type UIDFqNameMap = Map.Map UID FQName
+type UIDLpqNameMap = Map.Map UID PQName
+
+-- | maps between fully-, least-partially-qualified names and UIDs
+data QNameMaps =  QNameMaps FQNameUIDMap UIDFqNameMap UIDLpqNameMap
+
+-- | get the UID of a clafer given a fully qualifed name or potentially many UIDs given a partially qualified name
+getUIDs :: QNameMaps                 -> QName -> [UID]
+getUIDs    (QNameMaps fqNameUIDMap _ _) qName = findUIDsByFQName fqNameUIDMap qName
+
+-- | get the fully-qualified name of a clafer given its UID
+getFQName :: QNameMaps                 -> UID -> Maybe FQName
+getFQName    (QNameMaps _ uidFqNameMap _) uid' = Map.lookup uid' uidFqNameMap 
+
+-- | get the least-partially-qualified name of a clafer given its UID
+getLPQName :: QNameMaps                 -> UID -> Maybe PQName
+getLPQName    (QNameMaps _ _ uidLpqNameMap) uid' = Map.lookup uid' uidLpqNameMap 
+
+-- | derive maps between fully-, partially-qualified names, and UIDs
+deriveQNameMaps :: IModule -> QNameMaps
+deriveQNameMaps    iModule = 
+    let
+        (fqNameUIDMap, uidFqNameMap) = deriveFQNameUIDMaps iModule
+        uidLpqNameMap = deriveUidLpqNameMap fqNameUIDMap
+    in 
+        QNameMaps fqNameUIDMap uidFqNameMap uidLpqNameMap
+
+deriveFQNameUIDMaps :: IModule -> (FQNameUIDMap, UIDFqNameMap)
+deriveFQNameUIDMaps    iModule = addElements ["::"] (mDecls iModule) (SMap.empty, Map.empty)
+
+addElements :: [String] -> [IElement] -> (FQNameUIDMap, UIDFqNameMap) -> (FQNameUIDMap, UIDFqNameMap)
+addElements    path        elems         maps                         = foldl (addClafer path) maps elems
+
+addClafer :: [String] -> (FQNameUIDMap, UIDFqNameMap) -> IElement          -> (FQNameUIDMap, UIDFqNameMap)
+addClafer    path        (fqNameUIDMap, uidFqNameMap)    (IEClafer iClafer) = 
+    let 
+        newPath = (ident iClafer) : path 
+        fqKey :: FQKey
+        fqKey = concat newPath
+        fqName :: FQName
+        fqName = getQNameFromKey fqKey
+        fqNameUIDMap' = SMap.insert fqKey (uid iClafer) fqNameUIDMap
+        uidFqNameMap' = Map.insert (uid iClafer) fqName uidFqNameMap
+    in 
+        addElements ("::" : newPath) (elements iClafer) (fqNameUIDMap', uidFqNameMap')
+addClafer    _           maps                            _                  = maps
+
+findUIDsByFQName :: FQNameUIDMap -> FQName            -> [ UID ]
+findUIDsByFQName    fqNameUIDMap    fqName@(':':':':_) = SMap.lookup (getFQKey fqName) fqNameUIDMap
+findUIDsByFQName    fqNameUIDMap    fqName             = SMap.prefixFind (getFQKey fqName) fqNameUIDMap 
+
+reverseOnQualifier :: FQName -> FQName
+reverseOnQualifier fqName = concat $ reverse $ split (onSublist "::") fqName
+
+getFQKey :: FQName -> FQKey
+getFQKey = reverseOnQualifier
+
+getQNameFromKey :: FQKey -> QName
+getQNameFromKey = reverseOnQualifier
+
+
+deriveUidLpqNameMap :: FQNameUIDMap ->  UIDLpqNameMap
+deriveUidLpqNameMap    fqNameUIDMap = 
+    SMap.foldWithKey (generateUIDLpqMapEntry fqNameUIDMap) Map.empty fqNameUIDMap
+
+generateUIDLpqMapEntry :: FQNameUIDMap ->  SMap.Key -> UID -> UIDLpqNameMap -> UIDLpqNameMap
+generateUIDLpqMapEntry    fqNameUIDMap     fqKey       uid'   uidLpqNameMap = 
+    Map.insert uid' lpqName uidLpqNameMap
+    where
+      -- need to reverse the key to get a fully qualified name
+      fqName :: FQName
+      fqName = getQNameFromKey fqKey
+
+      -- name qualified just sufficiently to uniquely identify the clafer
+      -- can be both FQName or PQName
+      lpqName :: QName
+      lpqName = findLeastQualifiedName fqName fqNameUIDMap
+
+      findLeastQualifiedName :: String -> FQNameUIDMap -> String
+      -- handle fully qualified name case
+      findLeastQualifiedName fqName'@(':':':':pqName) fqNameUIDMap' =
+          if (length (findUIDsByFQName fqNameUIDMap' pqName) > 1)
+              then fqName'
+              else findLeastQualifiedName pqName fqNameUIDMap'
+      -- handle partially qualified name case
+      findLeastQualifiedName pqName fqNameUIDMap' =
+         let
+            -- remove one segment of qualification 
+            lessQName =  concat $ drop 2 $ split (onSublist "::") pqName
+         in 
+            if (length (findUIDsByFQName fqNameUIDMap' lessQName) > 1)
+              then pqName
+              else findLeastQualifiedName lessQName fqNameUIDMap'      
+
+getQNameUIDTriples :: QNameMaps -> [(FQName, PQName, UID)]
+getQNameUIDTriples qNameMaps@(QNameMaps _ uidFqNameMap _) =
+    let
+      uidFqNameList :: [(UID, FQName)]
+      uidFqNameList = Map.toList uidFqNameMap
+    in
+      map (\(uid', fqName) -> (fqName, fromMaybe fqName $ getLPQName qNameMaps uid', uid')) uidFqNameList
+ src/Language/Clafer/SplitJoin.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}
+module Language.Clafer.SplitJoin(splitArgs, joinArgs) where
+
+import Data.Char
+import Data.Maybe
+
+
+-- | Given a sequence of arguments, join them together in a manner that could be used on
+-- |  the command line, giving preference to the Windows @cmd@ shell quoting conventions.
+-- | For an alternative version, intended for actual running the result in a shell, see "System.Process.showCommandForUser"
+joinArgs :: [String] -> String
+joinArgs = unwords . map f
+    where
+        f x = q ++ g x ++ q
+            where
+                hasSpace = any isSpace x
+                q = ['\"' | hasSpace || null x]
+
+                g ('\\':'\"':xs') = '\\':'\\':'\\':'\"': g xs'
+                g "\\" | hasSpace = "\\\\"
+                g ('\"':xs') = '\\':'\"': g xs'
+                g (x':xs') = x' : g xs'
+                g [] = []
+
+
+data State = Init -- either I just started, or just emitted something
+           | Norm -- I'm seeing characters
+           | Quot -- I've seen a quote
+
+-- | Given a string, split into the available arguments. The inverse of 'joinArgs'.
+splitArgs :: String -> [String]
+splitArgs = join . f Init
+    where
+        -- Nothing is start a new string
+        -- Just x is accumulate onto the existing string
+        join :: [Maybe Char] -> [String]
+        join [] = []
+        join xs = map fromJust a : join (drop 1 b)
+            where (a,b) = break isNothing xs
+
+        f Init (x:xs) | isSpace x = f Init xs
+        f Init "\"\"" = [Nothing]
+        f Init "\"" = [Nothing]
+        f Init xs = f Norm xs
+        f m ('\"':'\"':'\"':xs) = Just '\"' : f m xs
+        f m ('\\':'\"':xs) = Just '\"' : f m xs
+        f m ('\\':'\\':'\"':xs) = Just '\\' : f m ('\"':xs)
+        f Norm ('\"':xs) = f Quot xs
+        f Quot ('\"':'\"':xs) = Just '\"' : f Norm xs
+        f Quot ('\"':xs) = f Norm xs
+        f Norm (x:xs) | isSpace x = Nothing : f Init xs
+        f m (x:xs) = Just x : f m xs
+        f _ [] = []
+ src/Language/ClaferT.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE RankNTypes #-}
+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+
+{- |
+This is in a separate module from the module "Language.Clafer" so that other modules that require
+ClaferEnv can just import this module without all the parsing/compiline/generating functionality.
+ -}
+module Language.ClaferT (
+                         ClaferEnv(..), 
+                         makeEnv, 
+                         getAst, 
+                         getIr, 
+                         ClaferM, 
+                         ClaferT, 
+                         CErr(..), 
+                         CErrs(..), 
+                         ClaferErr, 
+                         ClaferErrs, 
+                         ClaferSErr, 
+                         ClaferSErrs, 
+                         ErrPos(..), 
+                         PartialErrPos(..), 
+                         throwErrs, 
+                         throwErr, 
+                         catchErrs, 
+                         getEnv, 
+                         getsEnv, 
+                         modifyEnv, 
+                         putEnv, 
+                         runClafer, 
+                         runClaferT, 
+                         Throwable(..), 
+                         Span(..), 
+                         Pos(..)
+) where
+
+import Control.Monad.Error
+import Control.Monad.State
+import Control.Monad.Identity
+import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Language.Clafer.Common
+import Language.Clafer.Front.Absclafer
+import Language.Clafer.Intermediate.Tracing
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.ClaferArgs
+
+{-
+ - Examples.
+ -
+ - If you need ClaferEnv:
+ -   runClafer args $
+ -     do
+ -       env <- getEnv
+ -       env' = ...
+ -       putEnv env'
+ -
+ - Remember to putEnv if you do any modification to the ClaferEnv or else your updates
+ - are lost!
+ -
+ -
+ - Throwing errors:
+ -
+ -   throwErr $ ParseErr (ErrFragPos fragId fragPos) "failed parsing"
+ -   throwErr $ ParseErr (ErrModelPos modelPos) "failed parsing"
+ -
+ - There is two ways of defining the position of the error. Either define the position
+ - relative to a fragment, or relative to the model. Pick the one that is convenient.
+ - Once thrown, the "partial" positions will be automatically updated to contain both
+ - the model and fragment positions.
+ - Use throwErrs to throw multiple errors.
+ - Use catchErrs to catch errors (usually not needed).
+ -
+ -}
+
+data ClaferEnv = ClaferEnv {
+                            args :: ClaferArgs,
+                            modelFrags :: [String], -- original text of the model fragments
+                            cAst :: Maybe Module,
+                            cIr :: Maybe (IModule, GEnv, Bool),
+                            frags :: [Pos],    -- line numbers of fragment markers
+                            irModuleTrace :: Map Span [Ir],
+                            astModuleTrace :: Map Span [Ast]
+                            } deriving Show
+
+getAst :: (Monad m) => ClaferT m Module
+getAst = do
+  env <- getEnv
+  case cAst env of
+    (Just a) -> return a
+    _ -> throwErr (ClaferErr "No AST. Did you forget to add fragments or parse?" :: CErr Span) -- Indicates a bug in the Clafer translator.
+
+getIr :: (Monad m) => ClaferT m (IModule, GEnv, Bool)
+getIr = do
+  env <- getEnv
+  case cIr env of
+    (Just i) -> return i
+    _ -> throwErr (ClaferErr "No IR. Did you forget to compile?" :: CErr Span) -- Indicates a bug in the Clafer translator.
+
+makeEnv :: ClaferArgs -> ClaferEnv                                                                            
+makeEnv args' = ClaferEnv { args = args'',
+                           modelFrags = [],
+                           cAst = Nothing,
+                           cIr = Nothing,
+                           frags = [],
+                           irModuleTrace = Map.empty,
+                           astModuleTrace = Map.empty}
+               where 
+                  args'' = if (CVLGraph `elem` (mode args') ||
+                               Html `elem` (mode args') ||
+                               Graph `elem` (mode args'))
+                            then args'{keep_unused=True}
+                            else args'
+
+-- | Monad for using Clafer.
+type ClaferM = ClaferT Identity
+
+-- | Monad Transformer for using Clafer.
+type ClaferT m = ErrorT ClaferErrs (StateT ClaferEnv m)
+
+type ClaferErr = CErr ErrPos
+type ClaferErrs = CErrs ErrPos
+
+type ClaferSErr = CErr Span
+type ClaferSErrs = CErrs Span
+
+-- | Possible errors that can occur when using Clafer
+-- | Generate errors using throwErr/throwErrs:
+data CErr p =
+  -- | Generic error
+  ClaferErr {  
+    msg :: String
+  } |
+  -- | Error generated by the parser
+  ParseErr {   
+    -- | Position of the error
+    pos :: p,  
+    msg :: String
+  } |
+  -- | Error generated by semantic analysis
+  SemanticErr { 
+    pos :: p,
+    msg :: String
+  }
+  deriving Show
+  
+-- | Clafer keeps track of multiple errors.
+data CErrs p =
+  ClaferErrs {errs :: [CErr p]}
+  deriving Show
+
+instance Error (CErr p) where
+  strMsg = ClaferErr
+  
+instance Error (CErrs p) where
+  strMsg m = ClaferErrs [strMsg m]
+  
+data ErrPos =
+  ErrPos {
+    -- | The fragment where the error occurred.
+    fragId :: Int,
+    -- | Error positions are relative to their fragments.
+    -- | For example an error at (Pos 2 3) means line 2 column 3 of the fragment, not the entire model.
+    fragPos :: Pos,
+    -- | The error position relative to the model.
+    modelPos :: Pos
+  }
+  deriving Show
+  
+
+-- | The full ErrPos requires lots of information that needs to be consistent. Every time we throw an error,
+-- | we need BOTH the (fragId, fragPos) AND modelPos. This makes it easier for developers using ClaferT so they
+-- | only need to provide part of the information and the rest is automatically calculated. The code using
+-- | ClaferT is more concise and less error-prone.
+-- |
+-- |   modelPos <- modelPosFromFragPos fragdId fragPos
+-- |   throwErr $ ParserErr (ErrPos fragId fragPos modelPos)
+-- |
+-- |     vs
+-- |
+-- |   throwErr $ ParseErr (ErrFragPos fragId fragPos)
+-- |
+-- | Hopefully making the error handling easier will make it more universal.
+data PartialErrPos =
+  -- | Position relative to the start of the fragment. Will calculate model position automatically.
+  -- | fragId starts at 0
+  -- | The position is relative to the start of the fragment.
+  ErrFragPos {
+    pFragId :: Int,
+    pFragPos :: Pos
+  } |
+  ErrFragSpan {
+    pFragId :: Int,
+    pFragSpan :: Span
+  } |
+  -- | Position relative to the start of the complete model. Will calculate fragId and fragPos automatically.
+  -- | The position is relative to the entire complete model.
+  ErrModelPos {
+    pModelPos :: Pos
+  }
+  |
+  ErrModelSpan {
+    pModelSpan :: Span
+  }
+  deriving Show
+  
+class ClaferErrPos p where
+  toErrPos :: Monad m => p -> ClaferT m ErrPos
+  
+instance ClaferErrPos Span where
+  toErrPos = toErrPos . ErrModelSpan
+  
+instance ClaferErrPos ErrPos where
+  toErrPos = return . id
+  
+instance ClaferErrPos PartialErrPos where
+  toErrPos (ErrFragPos frgId frgPos) =
+    do
+      f <- getsEnv frags
+      let pos' = ((Pos 1 1 : f) !! frgId) `addPos` frgPos
+      return $ ErrPos frgId frgPos pos'
+  toErrPos (ErrFragSpan frgId (Span frgPos _)) = toErrPos $ ErrFragPos frgId frgPos
+  toErrPos (ErrFragSpan frgId (PosSpan _ frgPos _)) = toErrPos $ ErrFragPos frgId frgPos -- Should never happen
+  toErrPos (ErrModelPos modelPos') =
+    do
+      f <- getsEnv frags
+      let fragSpans = zipWith Span (Pos 1 1 : f) f
+      case findFrag modelPos' fragSpans of
+        Just (frgId, Span fragStart _) -> return $ ErrPos frgId (modelPos' `minusPos` fragStart) modelPos'
+        Just (frgId, PosSpan _ fragStart _) -> return $ ErrPos frgId (modelPos' `minusPos` fragStart) modelPos'
+        Nothing -> error $ show modelPos' ++ " not within any frag spans: " ++ show fragSpans -- Indicates a bug in the Clafer translator
+    where
+    findFrag pos'' spans =
+      find (inSpan pos'' . snd) (zip [0..] spans)
+  toErrPos (ErrModelSpan (Span modelPos'' _)) = toErrPos $ ErrModelPos modelPos''
+  toErrPos (ErrModelSpan (PosSpan _ modelPos'' _)) = toErrPos $ ErrModelPos modelPos'' -- Should never happen
+
+
+class Throwable t where
+  toErr :: t -> Monad m => ClaferT m ClaferErr
+  
+instance ClaferErrPos p => Throwable (CErr p) where
+  toErr (ClaferErr mesg) = return $ ClaferErr mesg
+  toErr err =
+    do
+      pos' <- toErrPos $ pos err
+      return $ err{pos = pos'}
+  
+-- | Throw many errors.
+throwErrs :: (Monad m, Throwable t) => [t] -> ClaferT m a
+throwErrs throws =
+  do
+    errors <- mapM toErr throws
+    throwError $ ClaferErrs errors
+
+-- | Throw one error.
+throwErr :: (Monad m, Throwable t) => t -> ClaferT m a
+throwErr throw = throwErrs [throw]
+
+-- | Catch errors
+catchErrs :: Monad m => ClaferT m a -> ([ClaferErr] -> ClaferT m a) -> ClaferT m a
+catchErrs e h = e `catchError` (h . errs)
+
+addPos :: Pos -> Pos -> Pos
+addPos (Pos l c) (Pos 1 d) = Pos l (c + d - 1)    -- Same line
+addPos (Pos l _) (Pos m d) = Pos (l + m - 1) d    -- Different line
+addPos pos' (PosPos _ l c) = addPos pos' (Pos l c)
+addPos (PosPos _ l c) pos' = addPos (Pos l c) pos'
+minusPos :: Pos -> Pos -> Pos
+minusPos (Pos l c) (Pos 1 d) = Pos l (c - d + 1)  -- Same line
+minusPos (Pos l c) (Pos m _) = Pos (l - m + 1) c  -- Different line
+minusPos pos' (PosPos _ l c) = minusPos pos' (Pos l c)
+minusPos (PosPos _ l c) pos' = minusPos (Pos l c) pos'
+
+inSpan :: Pos -> Span -> Bool
+inSpan pos' (Span start end) = pos' >= start && pos' <= end
+inSpan pos' (PosSpan _ s e)  = inSpan pos' (Span s e)
+
+-- | Get the ClaferEnv
+getEnv :: Monad m => ClaferT m ClaferEnv
+getEnv = get
+
+getsEnv :: Monad m => (ClaferEnv -> a) -> ClaferT m a
+getsEnv = gets
+
+-- | Modify the ClaferEnv
+modifyEnv :: Monad m => (ClaferEnv -> ClaferEnv) -> ClaferT m ()
+modifyEnv = modify
+
+-- | Set the ClaferEnv. Remember to set the env after every change.
+putEnv :: Monad m => ClaferEnv -> ClaferT m ()
+putEnv = put
+
+-- | Uses the ErrorT convention:
+-- |   Left is for error (a string containing the error message)
+-- |   Right is for success (with the result)
+runClaferT :: Monad m => ClaferArgs -> ClaferT m a -> m (Either [ClaferErr] a)
+runClaferT args' exec =
+  mapLeft errs `liftM` evalStateT (runErrorT exec) (makeEnv args')
+  where
+  mapLeft :: (a -> c) -> Either a b -> Either c b
+  mapLeft f (Left l) = Left (f l)
+  mapLeft _ (Right r) = Right r
+
+-- | Convenience
+runClafer :: ClaferArgs -> ClaferM a -> Either [ClaferErr] a
+runClafer args' = runIdentity . runClaferT args'
+ src/clafer.hs view
@@ -0,0 +1,209 @@+{-
+ Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Michal Antkiewicz <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Main where
+
+import Prelude hiding (writeFile, readFile, print, putStrLn)
+import qualified Data.Map as Map
+import qualified Data.List as List
+import Data.List.Split
+import Data.Maybe
+import Control.Monad.State
+import System.IO
+import System.Cmd
+import System.Exit
+import System.Timeout
+import System.FilePath (dropExtension,takeBaseName)
+import System.Process (readProcessWithExitCode)
+
+import Paths_clafer
+import Language.Clafer
+import Language.ClaferT
+import Language.Clafer.Css
+import Language.Clafer.ClaferArgs
+import Language.Clafer.JSONMetaData
+import Language.Clafer.QNameUID
+import Language.Clafer.Intermediate.Intclafer
+import Language.Clafer.Generator.Html (highlightErrors)
+import Language.Clafer.Generator.Graph (genSimpleGraph)
+
+putStrV :: VerbosityL -> String -> IO ()
+putStrV v s = if v > 1 then putStrLn s else return ()
+
+run :: VerbosityL -> ClaferArgs -> InputModel -> IO ()
+run _ args' input =
+  do
+    result <- runClaferT args' $
+      do
+        addFragments $ fragments input
+        parse
+        compile
+        fs <- save args'
+        when (validate args') $ forM_ fs (liftIO . runValidate args' )
+    if Html `elem` (mode args')
+      then htmlCatch result args' input
+      else return ()
+    result `cth` handleErrs
+  where
+  cth (Left err) f = f err
+  cth (Right r)  _ = return r
+  addFragments []     = return ()
+  addFragments (x:xs) = addModuleFragment x >> addFragments xs
+  fragments model = map unlines $ fragments' $ lines model
+  fragments' []                  = []
+  fragments' ("//# FRAGMENT":xs) = fragments' xs
+  fragments' model               = takeWhile (/= "//# FRAGMENT") model : fragments' (dropWhile (/= "//# FRAGMENT") model)
+--  htmlCatch :: Either ClaferErr CompilerResult -> ClaferArgs -> String -> IO(CompilerResult)
+  htmlCatch (Right r) _ _ = return r
+  htmlCatch (Left err) args'' model =
+    do let f = (dropExtension $ file args'') ++ ".html"
+       let result = (if (self_contained args'') then header ++ "<style>" ++ css ++ "</style>" ++ "</head>\n<body>\n<pre>\n" else "") ++ highlightErrors model err ++
+                                                               (if (self_contained args'') then "\n</pre>\n</html>" else "")
+       liftIO $ if console_output args'' then putStrLn result else writeFile f result
+  
+  handleErrs = mapM_ handleErr
+  handleErr (ClaferErr mesg) =
+    do
+      putStrLn "\nError...\n"
+      putStrLn mesg
+      exitFailure
+  -- We only use one fragment. Fragment id and position is not useful to us. We
+  -- only care about the position relative to 
+  handleErr (ParseErr ErrPos{modelPos = Pos l c} mesg) =
+    do
+      putStrLn $ "\nParse failed at line " ++ show l ++ " column " ++ show c ++ "..."
+      putStrLn mesg
+      exitFailure
+  handleErr (SemanticErr ErrPos{modelPos = Pos l c} mesg) =
+    do
+      putStrLn $ "\nCompile error at line " ++ show l ++ " column " ++ show c ++ "..."
+      putStrLn mesg
+      exitFailure
+  handleErr _ = error "Function handleErr from Main file was given an invalid argument"
+
+save :: MonadIO m => ClaferArgs -> ClaferT m [ String ]
+save args'=
+  do
+    resultsMap <- generate
+    let results = snd $ List.unzip $ Map.toList resultsMap
+    -- print stats only once
+    when (not $ no_stats args') $ liftIO $ printStats results
+    -- save the outputs
+    (iModule, _, _) <- getIr
+    forM results $ \result -> do
+      result' <- if (add_graph args') && (Html `elem` (mode args') && ("dot" `List.isSuffixOf` (extension result))) 
+            then do
+                   ast' <- getAst
+                   (_, graph, _) <- liftIO $ readProcessWithExitCode "dot"  ["-Tsvg"] $ genSimpleGraph ast' iModule (takeBaseName $ file args') (show_references args')
+                   return $ summary graph result
+            else return result
+      let f = dropExtension $ file args'
+      let f' = f ++ "." ++ (extension result)
+      liftIO $ if console_output args' then putStrLn (outputCode result') else writeFile f' (outputCode result')
+      liftIO $ when (alloy_mapping args') $ writeFile (f ++ ".map") $ show (mappingToAlloy result')
+      let 
+        qNameMaps :: QNameMaps
+        qNameMaps = deriveQNameMaps iModule
+      liftIO $ when (meta_data args') $ writeFile (f ++ ".cfr-map") $ generateJSONnameUIDMap qNameMaps
+      liftIO $ when (meta_data args' && inScopeModes) $ writeFile (f ++ ".cfr-scope") $ generateJSONScopes qNameMaps $ getScopesList resultsMap
+      return f'  
+  where
+    printStats :: [CompilerResult] -> IO ()
+    printStats []         = putStrLn "No compiler output."
+    printStats (r:_) = putStrLn (statistics r)
+
+    inScopeModes :: Bool
+    inScopeModes = 
+      Alloy `elem` mode args' ||
+      Alloy42 `elem` mode args' ||
+      Choco `elem` mode args'
+
+    getScopesList :: (Map.Map ClaferMode CompilerResult) -> [(UID, Integer)]
+    getScopesList    resultsMap =
+        let
+           alloyResult = Map.lookup Alloy resultsMap
+           alloy42Result = Map.lookup Alloy42 resultsMap
+           chocoResult = Map.lookup Choco resultsMap
+        in 
+           if (isNothing alloyResult)
+           then if (isNothing alloy42Result)
+                then if (isNothing chocoResult)
+                     then []
+                     else scopesList $ fromJust chocoResult
+                else scopesList $ fromJust alloy42Result
+           else scopesList $ fromJust alloyResult
+
+summary :: String -> CompilerResult -> CompilerResult
+summary graph result = result{outputCode=unlines $ summary' graph ("<pre>" ++ statistics result ++ "</pre>") (lines $ outputCode result)}
+
+summary' :: String -> String -> [String] -> [String]
+summary' _ _ [] = []
+summary' graph stats ("<!-- # SUMMARY /-->":xs) = graph:stats:summary' graph stats xs
+summary' graph stats ("<!-- # STATS /-->":xs) = stats:summary' graph stats xs
+summary' graph stats ("<!-- # GRAPH /-->":xs) = graph:summary' graph stats xs
+summary' graph stats ("<!-- # CVLGRAPH /-->":xs) = graph:summary' graph stats xs
+summary' graph stats (x:xs) = x:summary' graph stats xs
+
+conPutStrLn :: ClaferArgs -> String -> IO ()
+conPutStrLn args' s = when (not $ console_output args') $ putStrLn s
+
+runValidate :: ClaferArgs -> String -> IO ()
+runValidate args' fo = do
+  let path = (tooldir args') ++ "/"
+  liftIO $ putStrLn ("Validating '" ++ fo ++"'")
+  let modes = mode args' 
+  when (Xml `elem` modes && "xml" `List.isSuffixOf` fo) $ do
+      writeFile "ClaferIR.xsd" claferIRXSD
+      voidf $ system $ "java -classpath " ++ path ++ " XsdCheck ClaferIR.xsd " ++ fo
+  when (Alloy `elem` modes && "als" `List.isSuffixOf` fo) $ do
+    voidf $ system $ validateAlloy path "4" ++ fo
+  when (Alloy42 `elem` modes && "als4" `List.isSuffixOf` fo) $ do
+    voidf $ system $ validateAlloy path "4.2" ++ fo
+  when (Clafer `elem` modes && "des.cfr" `List.isSuffixOf` fo) $ do  
+    voidf $ system $ "../dist/build/clafer/clafer -s -m=clafer " ++ fo
+
+validateAlloy :: String -> String -> String
+validateAlloy path version = "java -cp " ++ path ++ "alloy" ++ version ++ ".jar edu.mit.csail.sdg.alloy4whole.ExampleUsingTheCompiler "
+
+main :: IO ()
+main = do
+  (args', model) <- mainArgs
+  let timeInSec = (timeout_analysis args') * 10^(6::Integer)
+  if timeInSec > 0
+    then timeout timeInSec $ start 2 args' model
+    else Just `liftM` start 2 args' model
+  return ()
+
+start :: VerbosityL -> ClaferArgs -> InputModel-> IO ()
+start v args' model = if schema args'
+  then putStrLn claferIRXSD
+  else if ecore2clafer args'
+    then runEcore2Clafer (file args') $ (tooldir args')
+    else run v args' model
+
+runEcore2Clafer :: FilePath -> FilePath -> IO ()
+runEcore2Clafer    ecoreFile toolPath
+  | null ecoreFile = do
+      putStrLn "Error: Provide a file name of an ECore model."
+  | otherwise      = do
+      putStrLn $ "Converting " ++ ecoreFile ++ " into Clafer"
+      voidf $ system $ "java -jar " ++ toolPath ++ "/ecore2clafer.jar " ++ ecoreFile
+ test/Functions.hs view
@@ -0,0 +1,64 @@+{-
+ Copyright (C) 2013 Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Functions where
+
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Language.Clafer
+import System.Directory
+
+getClafers :: FilePath -> IO [(String, String)]
+getClafers dir = do
+					files <- getDirectoryContents dir
+					let claferFiles = List.filter checkClaferExt files
+					claferModels <- mapM (\x -> readFile (dir++"/"++x)) claferFiles
+					return $ zip claferFiles claferModels
+
+checkClaferExt :: String -> Bool
+checkClaferExt "des.cfr" = True
+checkClaferExt file' = if ((eman == "")) then False else (txe == "rfc") && (takeWhile (/='.') (tail eman) /= "esd")
+	where (txe, eman) = span (/='.') (reverse file')
+
+				
+compileOneFragment :: ClaferArgs -> InputModel -> Either [ClaferErr] (Map.Map ClaferMode CompilerResult)
+compileOneFragment args' model =
+ 	runClafer args' $  
+		do
+			addModuleFragment model
+			parse
+			compile
+			generate
+
+compiledCheck :: Either a b -> Bool
+compiledCheck (Left _) = False
+compiledCheck (Right _) = True
+
+fromLeft :: Either a b -> a
+fromLeft (Left a) = a
+fromLeft (Right _) = error "Function fromLeft expects argument of the form 'Left a'"
+
+fromRight :: Either a b -> b
+fromRight (Right b) = b
+fromRight (Left _) = error "Function fromLeft expects argument of the form 'Right b'"
+
+andMap :: (a -> Bool) -> [a] -> Bool
+andMap f lst = and $ map f lst
+ test/Suite/Example.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-
+ Copyright (C) 2013 Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Suite.Example (tg_Test_Suite_Example) where
+
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.Monoid
+import Control.Monad
+import Language.Clafer
+import Language.Clafer.Css
+import Test.Framework
+import Test.Framework.TH
+import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.HUnit
+import Test.QuickCheck
+import Language.Clafer.ClaferArgs
+import Control.Monad
+import System.Directory
+import System.IO
+import Functions
+
+tg_Test_Suite_Example = $(testGroupGenerator)
+
+case_1 :: Assertion
+case_1 = assertEqual "for luckynumber" "WIN!" (luckynumber 42)
+
+case_2 :: Assertion
+case_2 =
+	do 
+		let a = luckynumber 7
+		assertEqual "for luckynumber" "WIN!" a
+		let b = (luckynumber 2) == (luckynumber 4)
+		assertBool ("Falied! Lucky number must be either 2 or 4") b
+
+case_3 = assertString "This will always fail :("
+
+prop_4 :: [Int] -> Bool
+prop_4 xs = reverse (reverse xs) == xs
+
+prop_5 :: [Int] -> Property 
+prop_5 xs = (length xs) >= 5 ==> (length (take 5 xs)) == 5 
+	where types = (xs :: [Int])
+
+case_6 :: Assertion
+case_6 = List.sort [1,8,6,5,3,9,0,2,4,10] @?= [0..9]
+
+case_7 = 
+	do
+		False @? "Always fails =("
+		True @? "You will never see this msg =D"
+		[0..9] @=? List.sort [1,8,6,5,3,9,0,2,4,10]
+
+case_8 = assertString ""
+
+prop_9 x = 	x >= 5 ==>
+			x <= 10 ==>
+			luckynumber x == "LOSE!"
+	where types = (x :: Int)
+
+
+case_10 :: Assertion
+case_10 = do 
+	let e1 = fromRight $ fmap claferEnv $ compileOneFragment defaultClaferArgs "A"
+	let e2 = fromRight $ fmap claferEnv $ compileOneFragment defaultClaferArgs "B"
+	assertBool ("This shouldn't fail") (e1 == e1)
+	assertBool ("This should fail") (e1 == e2)
+
+case_11 :: Assertion
+case_11 = do
+			clafers <- positiveClafers
+			getAll (List.foldr (\x -> mappend (All $ x==x)) (All True) clafers) @? "Error in one of clafers"
+
+--Example of generator
+newtype ArbitraryClafer = ArbitraryClafer {getModel :: String} deriving Show
+
+instance Arbitrary ArbitraryClafer where
+	arbitrary = do 
+					clafers <- getClafers "positive"
+					clafer <- elements clafers
+					return $ ArbitraryClafer clafer
+
+
+prop_12 :: ArbitraryClafer -> Bool
+prop_12 model = (getModel model) == (getModel model)
+
+
+luckynumber :: Int -> Bool
+luckynumber 7 = True
+luckynumber _ = False
+ test/Suite/Negative.hs view
@@ -0,0 +1,55 @@+{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-
+ Copyright (C) 2013 Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Suite.Negative (tg_Test_Suite_Negative) where
+
+import Functions
+import Control.Monad
+import qualified Test.Framework as T
+import Test.Framework.TH
+import Test.Framework.Providers.HUnit
+import Test.HUnit
+import Language.Clafer.ClaferArgs
+
+tg_Test_Suite_Negative :: T.Test
+tg_Test_Suite_Negative = $(testGroupGenerator)
+
+negativeClaferModels :: IO [([Char], String)]
+negativeClaferModels = do
+	claferModels <- getClafers "test/negative"
+	return $ filter ((`notElem` crashModels) . fst ) claferModels
+	where
+		crashModels = ["i127-loop.cfr", "i141-constraints.cfr", "i199-afm-check.cfr"]
+{-Put models in the list above that completly crash 
+  the compiler, this will avoid crashing the test suite
+  Note: If the model is giving an unexpected error it 
+  should be located in failing/negative not here!-}
+
+case_failTest :: Assertion
+case_failTest = do 
+	claferModels <- negativeClaferModels
+	let compiledClafers = map (\(file', model) -> 
+		(file', compileOneFragment defaultClaferArgs model)) claferModels
+	forM_ compiledClafers (\(file', compiled) -> 
+		when (compiledCheck compiled) $ putStrLn (file' ++ " compiled when it should not have."))
+	(andMap (not . compiledCheck . snd) compiledClafers 
+		@? "test/negative fail: The above clafer models compiled.")
+ test/Suite/Positive.hs view
@@ -0,0 +1,87 @@+{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-
+ Copyright (C) 2013 Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+module Suite.Positive (tg_Test_Suite_Positive) where
+
+import Functions
+import Language.Clafer.Intermediate.Intclafer
+import Data.Foldable (foldMap)
+import Data.Maybe
+import Control.Monad
+import Language.Clafer
+import Language.ClaferT
+import qualified Test.Framework as T
+import Test.Framework.TH
+import Test.Framework.Providers.HUnit
+import Test.HUnit
+import qualified Data.Map as Map
+
+tg_Test_Suite_Positive :: T.Test
+tg_Test_Suite_Positive = $(testGroupGenerator)
+ 
+positiveClaferModels :: IO [(String, String)]
+positiveClaferModels = getClafers "test/positive"
+
+case_compileTest :: Assertion
+case_compileTest = do 
+	claferModels <- positiveClaferModels
+	let compiledClafers = map (\(file', model) -> 
+		(file', compileOneFragment defaultClaferArgs model)) claferModels
+	forM_ compiledClafers (\(file', compiled) -> 
+		when (not $ compiledCheck compiled) $ putStrLn (file' ++ " Error: " ++ (show $ fromLeft compiled)))
+	(andMap (compiledCheck . snd) compiledClafers 
+		@? "test/positive fail: The above claferModels did not compile.")
+
+case_reference_Unused_Abstract_Clafer :: Assertion
+case_reference_Unused_Abstract_Clafer = do
+	model <- readFile "test/positive/i235.cfr"
+	let compiledClafers = 
+		[("None", compileOneFragment defaultClaferArgs{scope_strategy = None} model), ("Simple", compileOneFragment defaultClaferArgs{scope_strategy = Simple} model)]
+	forM_ compiledClafers (\(ss, compiled) -> 
+		when (not $ compiledCheck compiled) $ putStrLn ("i235.cfr failed for scope_strategy = " ++ ss))
+	(andMap (compiledCheck . snd) compiledClafers 
+		@? "reference_Unused_Abstract_Clafer (i235) failed, error for referencing unused abstract clafer")
+
+case_nonempty_cards :: Assertion
+case_nonempty_cards = do
+	claferModels <- positiveClaferModels
+	let compiledClafeIrs = foldMap getIR $ map (\(file', model) -> (file', compileOneFragment defaultClaferArgs model)) claferModels
+	forM_ compiledClafeIrs (\(file', ir') ->
+		let emptys = foldMapIR isEmptyCard ir'
+		in when (emptys /= []) $ putStrLn (file' ++ " Error: Contains empty cardinalities after analysis at\n" ++ emptys))
+	(andMap ((==[]) . foldMapIR isEmptyCard . snd) compiledClafeIrs
+		@? "nonempty card test failed. Files contain empty cardinalities after fully compiling")
+	where
+		getIR (file', (Right (resultMap))) = 
+			let
+				CompilerResult{claferEnv = ClaferEnv{cIr = Just (iMod, _, _)}} = fromJust $ Map.lookup Alloy resultMap
+			in
+				[(file', iMod)]
+		getIR (_, _) = []
+		isEmptyCard (IRClafer (IClafer{cinPos=(Span (Pos l c) _), card = Nothing})) = "Line " ++ show l ++ " column " ++ show c ++ "\n"
+		isEmptyCard (IRClafer (IClafer{cinPos=(PosSpan _ (Pos l c) _), card = Nothing})) = "Line " ++ show l ++ " column " ++ show c ++ "\n"
+		isEmptyCard	_ = ""
+
+case_stringEqual :: Assertion
+case_stringEqual = do
+	let strMap = stringMap $ fromJust $ Map.lookup Alloy $ fromRight $ compileOneFragment defaultClaferArgs "A\n    text1 : string = \"some text\"\n    text2 : string = \"some text\""
+	(Map.size strMap) == 1 @? "Error: same string assigned to differnet numbers!"
+ test/test-suite.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-
+ Copyright (C) 2013 Luke Brown <http://gsd.uwaterloo.ca>
+
+ Permission is hereby granted, free of charge, to any person obtaining a copy of
+ this software and associated documentation files (the "Software"), to deal in
+ the Software without restriction, including without limitation the rights to
+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+ of the Software, and to permit persons to whom the Software is furnished to do
+ so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included in all
+ copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
+-}
+import Data.List
+import qualified Data.Map as Map
+import Data.Maybe
+import Language.Clafer
+import Language.Clafer.QNameUID
+
+import Suite.Positive
+import Suite.Negative
+import Functions
+import Test.HUnit
+import Test.Framework
+import Test.Framework.TH
+import Test.Framework.Providers.HUnit
+
+tg_Main_Test_Suite = $(testGroupGenerator)
+main = defaultMain[tg_Main_Test_Suite, tg_Test_Suite_Positive, tg_Test_Suite_Negative]
+
+{-
+a            // ::a -> c0_a
+    b        // ::a::b -> c0_b
+b            // ::b -> c1_b
+c            // ::c -> c0_c
+    d        // ::c::d -> c0_d
+         b   // ::c::d::b -> c2_b
+d            // ::d -> c1_d
+    b        // ::d::b -> c3_b
+
+"b" -> "c0_b", "c1_b", "c2_b", "c3_b"
+"d::b" -> "c2_b", "c3_b"
+"c::d" -> "c0_d"
+"d" -> "c0_d", "c1_d"
+"x" -> []
+
+a\n    b\nb\nc\n    d\n         b\nd\n    b
+-}
+case_FQMapLookup :: Assertion
+case_FQMapLookup = do
+	let
+		(Just (iModule, _, _)) = cIr $ claferEnv $ fromJust $ Map.lookup Alloy $ fromRight $ compileOneFragment defaultClaferArgs "a\n    b\nb\nc\n    d\n         b\nd\n    b"
+		qNameMaps = deriveQNameMaps iModule
+	[ "c0_a" ] == (getUIDs qNameMaps "::a" ) @? "UID for `::a` different from `c0_a`"
+	[ "c0_b" ] == (getUIDs qNameMaps "::a::b" ) @? "UID for `::a::b` different from `c0_b`"
+	[ "c1_b" ] == (getUIDs qNameMaps "::b" ) @? "UID for `::b` different from `c1_b`"
+	[ "c0_c" ] == (getUIDs qNameMaps "::c" ) @? "UID for `::c` different from `c0_c`"
+	[ "c0_d" ] == (getUIDs qNameMaps "::c::d" ) @? "UID for `::c::d` different from `c0_d`"
+	[ "c0_d" ] == (getUIDs qNameMaps "c::d" ) @? "UID for `c::d` different from `c0_d`"
+	[ "c2_b" ] == (getUIDs qNameMaps "::c::d::b" ) @? "UID for `::c::d::b` different from `c2_b`"
+	[ "c1_d" ] == (getUIDs qNameMaps "::d" ) @? "UID for `::d` different from `c1_d`"
+	[ "c3_b" ] == (getUIDs qNameMaps "::d::b" ) @? "UID for `::d::b` different from `c3_d`"
+	null ([ "c0_b", "c1_b", "c2_b", "c3_b" ] \\ (getUIDs qNameMaps "b" )) @? "UIDs for `b` different from `c0_b`, `c1_b`, `c2_b`, `c3_b` "
+	null ([ "c2_b", "c3_b" ] \\ (getUIDs qNameMaps "d::b" )) @? "UIDs for `d::b` different from `c2_b`, `c3_b` "
+	null ([ "c0_d", "c1_d" ] \\ (getUIDs qNameMaps "d" )) @? "UIDs for `d` different from `c0_d`, `c1_d` "	
+	null (getUIDs qNameMaps "x") @? "UID for `x` different from []"
+	null (getUIDs qNameMaps "::x") @? "UID for `::x` different from []"
+
+ tools/Makefile view
@@ -0,0 +1,32 @@+UNAME := $(shell uname | tr "A-Z" "a-z")
+
+ifeq ($(UNAME), darwin)
+    WGET_COMMAND := curl -O
+else
+	ifeq ($(UNAME), mingw32_nt-6.1)
+		ifeq ($(shell which wget), which: wget: unkown command)
+			mingw-get install msys-wget-bin
+		endif
+	endif
+	WGET_COMMAND := wget
+endif
+
+all:
+
+	@if [[ "$(UNAME)"=="mingw32_nt-6.1" && -z "$(shell which wget)" ]] ; then \
+		mingw-get install msys-wget-bin; \
+	fi
+
+	@if test ! -f "alloy4.jar"; then \
+		echo "[WARNING] Missing alloy4.jar. Downloading...";  \
+		$(WGET_COMMAND) http://alloy.mit.edu/alloy/downloads/alloy4.jar; \
+	fi
+
+	@if test ! -f "alloy4.2.jar"; then \
+		echo "[WARNING] Missing alloy4.2.jar. Downloading...";  \
+		$(WGET_COMMAND) http://alloy.mit.edu/alloy/downloads/alloy4.2.jar; \
+	fi
+
+	javac -source 1.6 -target 1.6 XsdCheck.java
+clean:
+	find . -type f -name '*.class' -print0 | xargs -0 rm -f
+ tools/XsdCheck.class view

binary file changed (absent → 1779 bytes)

+ tools/ecore2clafer.jar view

file too large to diff