clafer 0.3.9 → 0.3.10

raw patch · 27 files changed

+516/−440 lines, 27 filesdep ~claferPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: clafer

API changes (from Hackage documentation)

- Language.Clafer.Intermediate.ResolverType: instance MonadTypeAnalysis m => MonadTypeAnalysis (ErrorT ClaferSErr m)

- Language.ClaferT: instance Error (CErr p)

- Language.ClaferT: instance Error (CErrs p)

+ Language.Clafer.ClaferArgs: JSON :: ClaferMode

+ Language.Clafer.Intermediate.Intclafer: instance Plated IModule

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IClafer

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IDecl

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IElement

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IExp

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IGCard

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IModule

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IQuant

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IReference

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON IType

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON PExp

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON Pos

+ Language.Clafer.Intermediate.Intclafer: instance ToJSON Span

+ Language.Clafer.Intermediate.ResolverInheritance: resolveHierarchy :: UIDIClaferMap -> IElement -> IElement

+ Language.Clafer.Intermediate.ResolverType: instance MonadTypeAnalysis m => MonadTypeAnalysis (ExceptT ClaferSErr m)

- Language.Clafer.Intermediate.ResolverInheritance: resolveN :: Span -> [IElement] -> String -> Resolve (Maybe (String, [IClafer]))

+ Language.Clafer.Intermediate.ResolverInheritance: resolveN :: Span -> [IClafer] -> String -> Resolve (Maybe (String, [IClafer]))

- Language.Clafer.Intermediate.ResolverInheritance: resolveNClafer :: [IElement] -> IClafer -> Resolve IClafer

+ Language.Clafer.Intermediate.ResolverInheritance: resolveNClafer :: [IClafer] -> IClafer -> Resolve IClafer

- Language.Clafer.Intermediate.ResolverInheritance: resolveNElement :: [IElement] -> IElement -> Resolve IElement

+ Language.Clafer.Intermediate.ResolverInheritance: resolveNElement :: [IClafer] -> IElement -> Resolve IElement

- Language.Clafer.Intermediate.ResolverInheritance: resolveNSuper :: [IElement] -> Maybe PExp -> Resolve (Maybe PExp, Maybe IClafer)

+ Language.Clafer.Intermediate.ResolverInheritance: resolveNSuper :: [IClafer] -> Maybe PExp -> Resolve (Maybe PExp, Maybe IClafer)

- Language.Clafer.Intermediate.ResolverName: liftError :: Monad m => Either e a -> ErrorT e m a

+ Language.Clafer.Intermediate.ResolverName: liftError :: Monad m => Either e a -> ExceptT e m a

- Language.ClaferT: type ClaferT m = ErrorT ClaferErrs (StateT ClaferEnv m)

+ Language.ClaferT: type ClaferT m = ExceptT ClaferErrs (StateT ClaferEnv m)

Files

CHANGES.md +4/−0
README.md +46/−44
clafer.cabal +9/−15
dist/build/Language/Clafer/Front/ParClafer.hs +2/−1
src-cmd/clafer.hs +0/−1
src/Language/Clafer.hs +110/−93
src/Language/Clafer/ClaferArgs.hs +2/−2
src/Language/Clafer/Common.hs +2/−1
src/Language/Clafer/Front/ErrM.hs +3/−2
src/Language/Clafer/Front/PrintClafer.hs +1/−0
src/Language/Clafer/Generator/Alloy.hs +4/−3
src/Language/Clafer/Generator/Choco.hs +1/−1
src/Language/Clafer/Generator/Graph.hs +1/−1
src/Language/Clafer/Generator/Html.hs +15/−9
src/Language/Clafer/Generator/Python.hs +7/−3
src/Language/Clafer/Intermediate/Intclafer.hs +33/−2
src/Language/Clafer/Intermediate/ResolverInheritance.hs +39/−23
src/Language/Clafer/Intermediate/ResolverName.hs +8/−7
src/Language/Clafer/Intermediate/ResolverType.hs +30/−29
src/Language/Clafer/Intermediate/SimpleScopeAnalyzer.hs +1/−1
src/Language/Clafer/Optimizer/Optimizer.hs +2/−1
src/Language/ClaferT.hs +51/−54
test/Functions.hs +12/−12
test/Suite/Negative.hs +10/−11
test/Suite/Positive.hs +31/−32
test/Suite/SimpleScopeAnalyser.hs +90/−90
tools/Makefile +2/−2

CHANGES.md view

@@ -1,3 +1,7 @@+**Clafer Version 0.3.10 released on April 24, 2015**
+
+[Release](https://github.com/gsdlab/clafer/pull/66)
+
 **Clafer Version 0.3.9 released on March 06, 2015**
 
 [Release](https://github.com/gsdlab/clafer/pull/63)

README.md view

@@ -1,41 +1,41 @@ Clafer
 ======
 
-v0.3.9
+v0.3.10
 
-[Clafer](http://clafer.org) is a general-purpose lightweight structural modeling language developed by 
-[GSD Lab](http://gsd.uwaterloo.ca/), [University of Waterloo](http://uwaterloo.ca), and 
+[Clafer](http://clafer.org) is a general-purpose lightweight structural modeling language developed by
+[GSD Lab](http://gsd.uwaterloo.ca/), [University of Waterloo](http://uwaterloo.ca), and
 [MODELS](http://www.itu.dk/research/models/) group at [IT University of Copenhagen](http://www.itu.dk/).
-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. 
+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. 
+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. 
+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. 
+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. 
+Clafer compiler provides a reference language implementation.
 It translates models in Clafer to other formats (e.g., Alloy, XML, Python, JS, HTML, DOT) to allow for reasoning and processing with existing tools (Alloy Analyzer, Choco3, and Z3 SMT solver).
 
-Currently, the compiler is used by 
+Currently, the compiler is used by
 
 * Backends
-  * Alloy-based Instance Generator ([ClaferIG](https://github.com/gsdlab/claferIG)), 
+  * Alloy-based Instance Generator ([ClaferIG](https://github.com/gsdlab/claferIG)),
   * Choco3-based Instance Generator and Multi-Objective Optimizer ([chocosolver](https://github.com/gsdlab/chocosolver), [ClaferChocoIG](https://github.com/gsdlab/ClaferChocoIG)), and
-  * Z3-based Instance Generator and Multi-Objective Optimizer ([ClaferSMT](https://github.com/gsdlab/claferSMT)), 
+  * Z3-based Instance Generator and Multi-Objective Optimizer ([ClaferSMT](https://github.com/gsdlab/claferSMT)),
 * Web Frontends
   * Clafer Integrated Development Environment ([ClaferIDE](https://github.com/gsdlab/claferIDE)),
-  * Clafer Configurator ([ClaferConfigurator](https://github.com/gsdlab/ClaferConfigurator)), 
-  * Multi-Objective [Visualizer and Explorer](https://github.com/gsdlab/ClaferMooVisualizer), and 
+  * Clafer Configurator ([ClaferConfigurator](https://github.com/gsdlab/ClaferConfigurator)),
+  * Multi-Objective [Visualizer and Explorer](https://github.com/gsdlab/ClaferMooVisualizer), and
   * Clafer Wiki ([ClaferWiki](https://github.com/gsdlab/claferwiki)).
 
 Contributors
@@ -56,7 +56,7 @@ 
 ### Dependencies for running
 
-Regardless of the installation method, the following are 
+Regardless of the installation method, the following are
 
 Optional:
 
@@ -69,9 +69,9 @@ 
 ### Installation from binaries
 
-Binary distributions of the release 0.3.9 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). 
+Binary distributions of the release 0.3.10 of Clafer Tools for Windows, Mac, and Linux,
+can be downloaded from
+[Clafer Tools - Binary Distributions](http://gsd.uwaterloo.ca/clafer-tools-binary-distributions).
 
 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
@@ -80,39 +80,39 @@ 
 Dependencies
 
-* [The Haskell Platform](http://hackage.haskell.org/platform/) v2014.2.0.0 
+* [The Haskell Platform](http://hackage.haskell.org/platform/) v2014.2.0.0
   * Alternatively GHC >= 7.8.3 and Cabal >= 1.18
 
-Clafer is now available on [Hackage](http://hackage.haskell.org/package/clafer-0.3.9/) and it can be installed using
+Clafer is now available on [Hackage](http://hackage.haskell.org/package/clafer-0.3.10/) and it can be installed using
 
 1. `cabal update`
 2. `cabal install clafer`
-3. `cd <cabal's lib or share folder>`  (`C:\Users\<user>\AppData\Roaming\cabal\x86_64-windows-ghc-7.8.3\clafer-0.3.9` on Windows or `.cabal/share/x86_64-linux-ghc-7.8.3/clafer-0.3.9/` on Linux)
+3. `cd <cabal's lib or share folder>`  (`C:\Users\<user>\AppData\Roaming\cabal\x86_64-windows-ghc-7.8.3\clafer-0.3.10` on Windows or `.cabal/share/x86_64-linux-ghc-7.8.3/clafer-0.3.10/` on Linux)
 4. to automatically download Alloy jars
-  * execute `make` in `tools` 
+  * execute `make` in `tools`
 
 ### Installation from the source code
 
 Dependencies
 
-* [The Haskell Platform](http://hackage.haskell.org/platform/) v2014.2.0.0 
+* [The Haskell Platform](http://hackage.haskell.org/platform/) v2014.2.0.0
   * Alternatively GHC >= 7.8.3 and Cabal >= 1.18
 * [Alloy4.1 and/or Alloy4.2](http://alloy.mit.edu/alloy/download.html)
   * downloaded automatically during the build
 * [Git](http://git-scm.com/)
 
-On Windows 
+On Windows
 
-* [MSYS2](http://msys2.sourceforge.net/) 
+* [MSYS2](http://msys2.sourceforge.net/)
   * download MSYS2 installer
   * in MSYS2 console, execute
-     * `pacman -Syu` 
+     * `pacman -Syu`
      * `pacman -S make wget unzip diffutils`
 
 #### 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. 
+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.
@@ -121,7 +121,7 @@ 
 1. install the dependencies
 2. open the command line terminal. On Windows, open MSYS2 terminal.
-3. in some `<source directory>` of your choice, execute 
+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`
@@ -130,10 +130,10 @@ 
 ### Installation
 
-1. Execute 
-  * `make install to=<target directory>` 
+1. Execute
+  * `make install to=<target directory>`
 
-#### Note: 
+#### Note:
 > On Windows, use `/` with the `make` command instead of `\`.
 
 Integration with Sublime Text 2/3
@@ -155,7 +155,7 @@ (As printed by `clafer --help`)
 
 ```
-Clafer 0.3.9
+Clafer 0.3.10
 
 clafer [OPTIONS] [FILE]
 
@@ -164,14 +164,16 @@                                           CLAFERMODEs are: 'alloy' (Alloy 4.1);
                                           'alloy42' (default, 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
+                                          Clafer model); 'json' (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'.
@@ -242,7 +244,7 @@ 
 The dependencies among the command line arguments are described on the [model wiki](http://t3-necsis.cs.uwaterloo.ca:8091/ClaferTools/CommandLineArguments).
 
-Multiple modes can be used at the same time. For example, 
+Multiple modes can be used at the same time. For example,
 
 `clafer model.cfr -m alloy -m xml -m html -m graph --self-contained --show-references --no-stats`
 
@@ -274,7 +276,7 @@ 
 * `//# 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`. 
+* `//# 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.

clafer.cabal view

@@ -1,5 +1,5 @@ Name:                   clafer
-Version:                0.3.9
+Version:                0.3.10
 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, and MODELS group at IT University of Copenhagen. 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
@@ -24,10 +24,7 @@     location:           git://github.com/gsdlab/clafer.git
 Executable clafer
     build-tools:        ghc >= 7.8.3
-    default-language:
-                        Haskell2010
-    default-extensions: DeriveDataTypeable
-                      , RankNTypes
+    default-language:   Haskell2010
     main-is:            clafer.hs
     hs-source-dirs:     src-cmd
     build-depends:      base >= 4.7.0.1 && < 5
@@ -35,12 +32,12 @@                       , filepath >= 1.3.0.2
                       , process >= 1.1.0.2
 
-                      , mtl >= 2.1.3.1
+                      , mtl >= 2.2.1
 
                       , cmdargs >= 0.10.7
                       , split >= 0.2.2
 
-                      , clafer == 0.3.9
+                      , clafer == 0.3.10
     if os(windows)
         build-depends:  HaXml == 1.24
     else
@@ -51,8 +48,6 @@ library
     build-tools:        ghc >= 7.8.3
     default-language:   Haskell2010
-    default-extensions: DeriveDataTypeable
-                      , RankNTypes
     build-depends:      array >= 0.4.0.1
                       , base >= 4.7.0.1 && < 5
                       , bytestring >= 0.10.4.0
@@ -63,12 +58,11 @@                       , transformers >= 0.3.0.0
 
                       , HTTP >= 4000.2.10
-                      , mtl >= 2.1.3.1
+                      , mtl >= 2.2.1
                       , network >= 2.6
                       , parsec >= 3.1.3
                       , text >= 1.1.0.0
 
-
                       , aeson >= 0.7.0.6
                       , cmdargs >= 0.10.7
                       , data-stringmap >= 1.0.1.1
@@ -86,7 +80,7 @@         build-depends:  HaXml >= 1.24
 
     hs-source-dirs:     src
-    ghc-options:        -Wall -fno-warn-unused-do-bind -fno-warn-orphans
+    ghc-options:        -Wall -fno-warn-orphans
     exposed-modules:    Language.Clafer
                       , Language.ClaferT
                       , Language.Clafer.ClaferArgs
@@ -138,7 +132,7 @@                       , filepath >= 1.3.0.2
 
                       , HUnit >= 1.2.5.2
-                      , mtl >= 2.1.3.1
+                      , mtl >= 2.2.1
                       , QuickCheck >= 2.6
 
                       , data-stringmap >= 1.0.1.1
@@ -148,14 +142,14 @@                       , tasty-hunit >= 0.9
                       , tasty-th >= 0.1.2
 
-                      , clafer == 0.3.9
+                      , clafer == 0.3.10
 
     if os(windows)
         build-depends:  HaXml == 1.24
     else
         build-depends:  HaXml >= 1.24
 
-    ghc-options:        -Wall -fno-warn-unused-do-bind -fno-warn-orphans
+    ghc-options:        -Wall
 
     other-modules:      Paths_clafer
                       , Functions

dist/build/Language/Clafer/Front/ParClafer.hs view

@@ -8,8 +8,9 @@ import qualified Data.Array as Happy_Data_Array
 import qualified GHC.Exts as Happy_GHC_Exts
 import Control.Applicative(Applicative(..))
+import Control.Monad (ap)
 
--- parser produced by Happy Version 1.19.4
+-- parser produced by Happy Version 1.19.5
 
 newtype HappyAbsSyn  = HappyAbsSyn HappyAny
 #if __GLASGOW_HASKELL__ >= 607

src-cmd/clafer.hs view

@@ -29,7 +29,6 @@ import System.Process (system)
 
 import Language.Clafer
-import Language.Clafer.ClaferArgs
 
 main :: IO ()
 main = do

src/Language/Clafer.hs view

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE NamedFieldPuns     #-}
 {-
  Copyright (C) 2012-2014 Kacper Bak, Jimmy Liang, Michal Antkiewicz <http://gsd.uwaterloo.ca>
 
@@ -31,7 +32,8 @@ >       addModuleFragment a
 >       addModuleFragment b
 >       parse
->       compile
+>       iModule <- desugar ""
+>       compile iModule
 >       generate
 
 Example of compiling a model consisting of one fragment:
@@ -42,7 +44,8 @@ >     do
 >       addModuleFragment model
 >       parse
->       compile
+>       iModule <- desugar "http://mydomain.org/mymodel.cfr"
+>       compile iModule
 >       generate
 
 > compileTwoFragments :: ClaferArgs -> InputModel -> InputModel -> Either ClaferErr [String]
@@ -52,7 +55,8 @@ >      addModuleFragment frag1
 >      addModuleFragment frag2
 >      parse
->      compile
+>      iModule <- desugar ""
+>      compile iModule
 >      generate
 
 Use "throwErr" to halt execution:
@@ -62,79 +66,82 @@ 
 Use "catchErrs" to catch the errors.
 -}
-module Language.Clafer (runCompiler,
-                        addModuleFragment,
-                        compile,
-                        parse,
-                        desugar,
-                        generate,
-                        generateHtml,
-                        runClaferT,
-                        runClafer,
-                        ClaferErr,
-                        getEnv,
-                        putEnv,
-                        CompilerResult(..),
-                        claferIRXSD,
-                        InputModel,
-                        Token,
-                        Module,
-                        GEnv,
-                        IModule,
-                        voidf,
-                        ClaferEnv(..),
-                        getIr,
-                        getAst,
-                        makeEnv,
-                        Pos(..),
-                        IrTrace(..),
-                        module Language.Clafer.ClaferArgs,
-                        module Language.Clafer.Front.ErrM)
-where
+module Language.Clafer
+  ( runCompiler
+  , addModuleFragment
+  , compile
+  , parse
+  , desugar
+  , generate
+  , generateHtml
+  , runClaferT
+  , runClafer
+  , ClaferErr
+  , getEnv
+  , putEnv
+  , CompilerResult(..)
+  , claferIRXSD
+  , InputModel
+  , Token
+  , Module
+  , GEnv
+  , IModule
+  , voidf
+  , ClaferEnv(..)
+  , getIr
+  , getAst
+  , makeEnv
+  , Pos(..)
+  , IrTrace(..)
+  , module Language.Clafer.ClaferArgs
+  , module Language.Clafer.Front.ErrM
+  ) where
 
-import Data.Data.Lens
-import Data.Either
-import Data.List
-import Data.Maybe
+import           Control.Lens.Plated
+import           Control.Monad
+import           Control.Monad.State
+import           Data.Aeson
+import           Data.Data.Lens
+import           Data.Either
+import           Data.List
 import qualified Data.Map as Map
-import Control.Monad
-import Control.Monad.State
-import Control.Lens.Plated
-import System.Exit
-import System.FilePath (dropExtension,takeBaseName)
-import System.Process (readProcessWithExitCode, system)
+import           Data.Maybe
+import           Data.String.Conversions
+import           System.Exit
+import           System.FilePath (dropExtension, takeBaseName)
+import           System.Process (readProcessWithExitCode, system)
 
-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           Language.Clafer.ClaferArgs hiding (Clafer)
+import qualified Language.Clafer.ClaferArgs  as Mode (ClaferMode (Clafer))
+import           Language.Clafer.Comments
+import           Language.Clafer.Common
 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.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.Concat
-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
-import Language.Clafer.JSONMetaData
-import Language.Clafer.QNameUID
+import           Language.Clafer.Front.AbsClafer
+import           Language.Clafer.Front.ErrM
+import           Language.Clafer.Front.LayoutResolver
+import           Language.Clafer.Front.LexClafer
+import           Language.Clafer.Front.ParClafer
+import           Language.Clafer.Front.PrintClafer
+import           Language.Clafer.Generator.Alloy
+import           Language.Clafer.Generator.Choco
+import           Language.Clafer.Generator.Concat
+import           Language.Clafer.Generator.Graph
+import           Language.Clafer.Generator.Html
+import           Language.Clafer.Generator.Python
+import           Language.Clafer.Generator.Schema
+import           Language.Clafer.Generator.Stats
+import           Language.Clafer.Generator.Xml
+import           Language.Clafer.Intermediate.Desugarer
+import           Language.Clafer.Intermediate.Intclafer
+import           Language.Clafer.Intermediate.Resolver
+import           Language.Clafer.Intermediate.ScopeAnalysis
+import           Language.Clafer.Intermediate.StringAnalyzer
+import           Language.Clafer.Intermediate.Tracing
+import           Language.Clafer.Intermediate.Transformer
+import           Language.Clafer.JSONMetaData
+import           Language.Clafer.Optimizer.Optimizer
+import           Language.Clafer.QNameUID
+import           Language.ClaferT
 
 type InputModel = String
 
@@ -450,7 +457,7 @@     afterDecl :: Declaration -> [(Span, String)] -> [(Span, String)]
     afterDecl decl comments = let (Span _ (Pos line' _)) = getSpan decl in dropWhile (\(x, _) -> let (Span _ (Pos line'' _)) = x in line'' <= line') comments
     printComments [] = []
-    printComments ((s, comment):cs) = (snd (printComment s [(s, comment)]) ++ "<br>\n"):printComments cs
+    printComments ((s, comment):cs') = (snd (printComment s [(s, comment)]) ++ "<br>\n"):printComments cs'
 
 iExpBasedChecks :: IModule -> (Bool, Bool)
 iExpBasedChecks iModule = (null realLiterals, null productOperators)
@@ -565,6 +572,20 @@                   }) ]
           else []
         )
+        -- result for JSON
+        ++ (if (JSON `elem` modes)
+          then [ (JSON,
+                  CompilerResult {
+                   extension = "json",
+                   outputCode = convertString $ encode $ toJSON iModule,
+                   statistics = stats,
+                   claferEnv  = env,
+                   mappingToAlloy = [],
+                   stringMap = Map.empty,
+                   scopesList = []
+                  }) ]
+          else []
+        )
         -- result for Clafer
         ++ (if (Mode.Clafer `elem` modes)
           then [ (Mode.Clafer,
@@ -649,31 +670,27 @@         ))
 
 -- | 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)]
-                            }
-                      | NoCompilerResult {
-                            reason :: String
-                      } deriving Show
+data CompilerResult
+  = CompilerResult
+    { extension      :: String                -- ^ output file extension
+    , outputCode     :: String                -- ^ output text
+    , 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)]
+    }
+  | NoCompilerResult
+    { reason :: String
+    }
+  deriving Show
 
 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' iModule = do
-  liftError $ findDupModule args' iModule
+  _ <-liftError $ findDupModule args' iModule
   let
     au = allUnique iModule
   let args'' = args'{skip_resolver = au && (skip_resolver args')}

src/Language/Clafer/ClaferArgs.hs view

@@ -38,7 +38,7 @@ import GetURL
 
 -- | Type of output to be generated at the end of compilation
-data ClaferMode = Alloy42 | Alloy | Xml | Clafer | Html | Graph | CVLGraph | Python | Choco
+data ClaferMode = Alloy42 | Alloy | Xml | JSON | Clafer | Html | Graph | CVLGraph | Python | Choco
   deriving (Eq, Show, Ord, Data, Typeable)
 instance Default ClaferMode where
   def = Alloy42
@@ -79,7 +79,7 @@ 
 clafer :: ClaferArgs
 clafer = ClaferArgs {
-  mode                = [] &= help "Generated output type. Available CLAFERMODEs are: 'alloy' (Alloy 4.1); 'alloy42' (default, 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",
+  mode                = [] &= help "Generated output type. Available CLAFERMODEs are: 'alloy' (Alloy 4.1); 'alloy42' (default, Alloy 4.2); 'xml' (intermediate representation of Clafer model); 'json' (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.",

src/Language/Clafer/Common.hs view

@@ -22,7 +22,7 @@ -}
 module Language.Clafer.Common where
 
-import           Control.Applicative ((<$>))
+import           Control.Applicative
 import           Control.Lens (universeOn)
 import           Data.Char
 import           Data.Data.Lens (biplate)
@@ -32,6 +32,7 @@ import           Data.StringMap (StringMap)
 import qualified Data.StringMap as SMap
 import           Data.Tree
+import           Prelude
 
 import Language.Clafer.Front.AbsClafer
 import Language.Clafer.Intermediate.Intclafer

src/Language/Clafer/Front/ErrM.hs view

@@ -6,8 +6,9 @@ 
 -- the Error monad: like Maybe type with error msgs
 
-import Control.Monad (MonadPlus(..), liftM)
-import Control.Applicative (Applicative(..), Alternative(..))
+import Control.Monad
+import Control.Applicative
+import Prelude
 
 import Language.Clafer.Front.AbsClafer

src/Language/Clafer/Front/PrintClafer.hs view

@@ -5,6 +5,7 @@ 
 import Language.Clafer.Front.AbsClafer
 import Data.Char
+import Prelude hiding (exp, init)
 
 
 -- the top-level printing method

src/Language/Clafer/Generator/Alloy.hs view

@@ -23,11 +23,11 @@ -- | Generates Alloy4.1 or 4.2 code for a Clafer model
 module Language.Clafer.Generator.Alloy (genModule) where
 
-import Control.Applicative ((<$>))
-import Control.Lens hiding (elements, mapping)
+import Control.Applicative
 import Control.Monad.State
 import Data.List
 import Data.Maybe
+import Prelude
 
 import Language.Clafer.Common
 import Language.Clafer.ClaferArgs
@@ -335,6 +335,7 @@   interval' = genInterval constraintName group' element' crd
   crd'  = flatten $ interval'
 
+{-
 -- generates expression for references that point to expressions (not single clafers)
 genPathConst :: GenEnv -> String -> [String] -> IClafer -> Concat
 genPathConst    genEnv    name      resPath     c
@@ -352,7 +353,7 @@ isSimplePath    (PExp _ _ _ (IClaferId _ _ _ _)) = True
 isSimplePath    (PExp _ _ _ (IFunExp op' _)) = op'  == iUnion
 isSimplePath    _ = False
-
+-}
 -- -----------------------------------------------------------------------------
 -- Not used?
 -- genGCard element gcard = genInterval element  $ interval $ fromJust gcard

src/Language/Clafer/Generator/Choco.hs view

@@ -191,7 +191,7 @@             "product(" ++ genConstraintPExp a ++ ")"
         | otherwise = error "Choco: Unexpected product argument."
     genConstraintExp (IFunExp "+" args') =
-	(if _iType (head args') == Just TString then "concat" else "add") ++
+        (if _iType (head args') == Just TString then "concat" else "add") ++
             "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
     genConstraintExp (IFunExp op' args') =
         mapFunc op' ++ "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"

src/Language/Clafer/Generator/Graph.hs view

@@ -27,7 +27,7 @@ import Language.Clafer.Intermediate.Tracing
 import Language.Clafer.Intermediate.Intclafer
 import Language.Clafer.Generator.Html(genTooltip)
-import Control.Applicative ((<$>))
+import Control.Applicative
 import qualified Data.Map as Map
 import Data.Maybe
 import Prelude hiding (exp)

src/Language/Clafer/Generator/Html.hs view

@@ -42,14 +42,13 @@ import Language.Clafer.Intermediate.Tracing
 import Language.Clafer.Intermediate.Intclafer
 
-import Control.Applicative ((<$>))
+import Control.Applicative
 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)
@@ -78,7 +77,14 @@   | otherwise = (c:cs, "")
   where trim' = let f = reverse. dropWhile isSpace in f . f
 printStandaloneComment :: String -> String
-printStandaloneComment comment = "<div class=\"standalonecomment\">" ++ comment ++ "</div>"
+printStandaloneComment comment = "<div class=\"standalonecomment\">" ++ replaceNLwithBR comment ++ "</div>"
+  where
+    replaceNLwithBR :: String   -> String
+    replaceNLwithBR    ""        = ""
+    replaceNLwithBR    ('\n':cs) = "<br>\n" ++ replaceNLwithBR cs
+    replaceNLwithBR    (c:cs)    = c : replaceNLwithBR cs
+
+
 printInlineComment :: String -> String
 printInlineComment comment = "<span class=\"inlinecomment\">" ++ comment ++ "</span>"
 
@@ -426,10 +432,10 @@ 
 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' (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'
@@ -437,10 +443,10 @@ 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>"
+           "...\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>"
+           "...\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

src/Language/Clafer/Generator/Python.hs view

@@ -188,8 +188,12 @@         | [arg] <- args', PExp{_exp = IFunExp{_exps = [a, PExp{_exp = IClaferId{_sident = "ref"}}]}} <- rewrite arg =
             "sum(" ++ genConstraintPExp a ++ ")"
         | otherwise = error "Python: Unexpected sum argument."
+    genConstraintExp (IFunExp "product" args')
+        | [arg] <- args', PExp{_exp = IFunExp{_exps = [a, PExp{_exp = IClaferId{_sident = "ref"}}]}} <- rewrite arg =
+            "product(" ++ genConstraintPExp a ++ ")"
+        | otherwise = error "Python: Unexpected product argument."
     genConstraintExp (IFunExp "+" args') =
-	(if _iType (head args') == Just TString then "concat" else "add") ++
+        (if _iType (head args') == Just TString then "concat" else "add") ++
             "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
     genConstraintExp (IFunExp op' args') =
         mapFunc op' ++ "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
@@ -236,8 +240,8 @@ {-    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
+    scopeOf i = fromMaybe 1 $ lookup i scopes
+    bitwidth = fromMaybe 4 $ lookup "int" scopes :: Integer  -}
 
 -- isQuant PExp{_exp = IDeclPExp{}} = True
 -- isQuant _ = False

src/Language/Clafer/Intermediate/Intclafer.hs view

@@ -26,9 +26,12 @@ import Language.Clafer.Front.AbsClafer
 
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
 import Data.Data
 import Data.Monoid
-import Data.Foldable (foldMap)
+import Data.Foldable
+import Prelude
 
 -- | unique identifier of a clafer
 type UID = String
@@ -347,11 +350,13 @@ unWrapIGCard (IRIGCard x) = x
 unWrapIGCard x = error $ "Can't call unWarpIGcard on " ++ show x
 
-
+instance Plated IModule
 instance Plated IClafer
 instance Plated PExp
 instance Plated IExp
 
+makeLenses ''IType
+
 makeLenses ''IModule
 
 makeLenses ''IClafer
@@ -367,3 +372,29 @@ makeLenses ''IExp
 
 makeLenses ''IDecl
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IType)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IModule)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IClafer)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IElement)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IReference)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IGCard)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''PExp)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IExp)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IDecl)
+
+$(deriveToJSON defaultOptions{fieldLabelModifier = tail, omitNothingFields=True} ''IQuant)
+
+instance ToJSON Span where
+  toJSON _ = Null
+
+instance ToJSON Pos where
+  toJSON _ = Null

src/Language/Clafer/Intermediate/ResolverInheritance.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-}
 {-
- Copyright (C) 2012 Kacper Bak <http://gsd.uwaterloo.ca>
+ Copyright (C) 2012-2015 Kacper Bak, 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
@@ -23,14 +23,16 @@ module Language.Clafer.Intermediate.ResolverInheritance where
 
 import Control.Applicative
+import Control.Lens  ((%~), mapped)
 import Control.Monad
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.State
 import Data.Maybe
 import Data.Graph
 import Data.Tree
 import Data.List
 import qualified Data.Map as Map
+import Prelude
 
 import Language.ClaferT
 import Language.Clafer.Common
@@ -43,31 +45,36 @@ resolveNModule :: (IModule, GEnv) -> Resolve (IModule, GEnv)
 resolveNModule (imodule, genv') =
   do
-    let decls' = _mDecls imodule
-    decls'' <- mapM (resolveNElement decls') decls'
-    let imodule' = imodule{_mDecls = decls''}
+    let
+      unresolvedDecls = _mDecls imodule
+      abstractClafers = filter _isAbstract $ bfsClafers $ toClafers unresolvedDecls
+    resolvedDecls <- mapM (resolveNElement abstractClafers) unresolvedDecls
+    let
+      uidClaferMap' = createUidIClaferMap imodule{_mDecls = resolvedDecls}
+      resolvedHierarchyDecls = map (resolveHierarchy uidClaferMap') resolvedDecls
+      resolvedHierarchiesIModule = imodule{_mDecls = resolvedHierarchyDecls}
     return
-      ( imodule'
-      , genv'{sClafers = bfs toNodeShallow $ toClafers decls'', uidClaferMap = createUidIClaferMap imodule'})
-
-
+      ( resolvedHierarchiesIModule
+      , genv'{ sClafers = bfs toNodeShallow $ toClafers resolvedHierarchyDecls
+             , uidClaferMap = createUidIClaferMap resolvedHierarchiesIModule}
+      )
 
-resolveNClafer :: [IElement] -> IClafer -> Resolve IClafer
-resolveNClafer declarations clafer =
+resolveNClafer :: [IClafer] -> IClafer -> Resolve IClafer
+resolveNClafer abstractClafers clafer =
   do
-    (super', superIClafer')    <- resolveNSuper declarations $ _super clafer
-    elements' <- mapM (resolveNElement declarations) $ _elements clafer
+    (super', superIClafer')    <- resolveNSuper abstractClafers $ _super clafer
+    elements' <- mapM (resolveNElement abstractClafers) $ _elements clafer
     return $ clafer {_super = super',
             _elements = elements'}
 
 
-resolveNSuper :: [IElement] -> Maybe PExp -> Resolve (Maybe PExp, Maybe IClafer)
+resolveNSuper :: [IClafer] -> Maybe PExp -> Resolve (Maybe PExp, Maybe IClafer)
 resolveNSuper _ Nothing = return (Nothing, Nothing)
-resolveNSuper declarations (Just (PExp _ pid' pos' (IClaferId _ id' _ _))) =
+resolveNSuper abstractClafers (Just (PExp _ pid' pos' (IClaferId _ id' _ _))) =
     if isPrimitive id'
       then throwError $ SemanticErr pos' $ "Primitive types are not allowed as super types: " ++ id'
       else do
-        r <- resolveN pos' declarations id'
+        r <- resolveN pos' abstractClafers id'
         (id'', [superClafer']) <- case r of
           Nothing -> throwError $ SemanticErr pos' $ "No superclafer found: " ++ id'
           Just m  -> return m
@@ -76,16 +83,25 @@ resolveNSuper _ x = return (x, Nothing)
 
 
-resolveNElement :: [IElement] -> IElement -> Resolve IElement
-resolveNElement declarations x = case x of
-  IEClafer clafer  -> IEClafer <$> resolveNClafer declarations clafer
+resolveNElement :: [IClafer] -> IElement -> Resolve IElement
+resolveNElement abstractClafers x = case x of
+  IEClafer clafer  -> IEClafer <$> resolveNClafer abstractClafers 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
+resolveN :: Span -> [IClafer] -> String -> Resolve (Maybe (String, [IClafer]))
+resolveN pos' abstractClafers id' =
+  findUnique pos' id' $ map (\x -> (x, [x])) abstractClafers
+
+
+resolveHierarchy :: UIDIClaferMap -> IElement           -> IElement
+resolveHierarchy    uidClaferMap'    (IEClafer iClafer') = IEClafer $ super.mapped.iType.mapped %~ addHierarchy $ iClafer'
+  where
+    addHierarchy :: IType      -> IType
+    addHierarchy    (TClafer _) = TClafer $ tail $ mapHierarchy _uid getSuper uidClaferMap' iClafer'
+    addHierarchy    x           = x
+resolveHierarchy    _                x                   = x
+
 
 -- | Resolve overlapping inheritance
 resolveOModule :: (IModule, GEnv) -> Resolve (IModule, GEnv)

src/Language/Clafer/Intermediate/ResolverName.hs view

@@ -25,12 +25,13 @@ 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.Trans.Maybe
 import Control.Monad.State
 import Data.Maybe
 import Data.Function
 import Data.List
+import Prelude
 
 import Language.ClaferT
 import Language.Clafer.Common
@@ -149,7 +150,7 @@ 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
+    let (decls'', env') = runState (runExceptT $ (mapM (ExceptT . processDecl) decls')) env
     IDeclPExp quant' <$> decls'' <*> resolvePExp env' pexp
 
   IFunExp op' exps' -> if op' == iJoin then resNav else IFunExp op' <$> mapM (resolvePExp env) exps'
@@ -160,11 +161,11 @@   where
   resNav = fst <$> resolveNav pos' env x True
 
-liftError :: Monad m => Either e a -> ErrorT e m a
-liftError = ErrorT . return
+liftError :: Monad m => Either e a -> ExceptT e m a
+liftError = ExceptT . return
 
 processDecl :: MonadState SEnv m => IDecl -> m (Resolve IDecl)
-processDecl decl = runErrorT $ do
+processDecl decl = runExceptT $ do
   env <- lift $ get
   (body', path) <- liftError $ resolveNav (_inPos $ _body decl) env (I._exp $ _body decl) True
   lift $ modify (\e -> e { bindings = (_decls decl, path) : bindings e })
@@ -290,7 +291,7 @@ resolveChildren' :: Span -> SEnv -> String -> (SEnv -> [IClafer]) -> HowResolved -> Either ClaferSErr (Maybe (HowResolved, String, [IClafer]))
 resolveChildren' pos' env id' getChildrenF label =
   runMaybeT $ do
-    liftMaybe $ context env
+    _ <- liftMaybe $ context env
     u <- MaybeT $ findUnique pos' id' $ map (\x -> (x, [x,fromJust $ context env])) $ getChildrenF env
     liftMaybe $ toMTriple label u
 
@@ -300,7 +301,7 @@ resolveAncestor :: Span -> SEnv -> String -> Resolve (Maybe (HowResolved, String, [IClafer]))
 resolveAncestor pos' env id' =
   runMaybeT $ do
-    liftMaybe $ context env
+    _ <- liftMaybe $ context env
     u <- MaybeT $ findUnique pos' id' $ ancClafers env
     liftMaybe $ toMTriple Ancestor u

src/Language/Clafer/Intermediate/ResolverType.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE NamedFieldPuns, FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns, FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving #-}
 {-
  Copyright (C) 2012-2015 Jimmy Liang, Kacper Bak, Michal Antkiewicz <http://gsd.uwaterloo.ca>
 
@@ -22,7 +22,6 @@ -}
 module Language.Clafer.Intermediate.ResolverType (resolveTModule)  where
 
-import Prelude hiding (exp)
 import Language.ClaferT
 import Language.Clafer.Common
 import Language.Clafer.Intermediate.Intclafer hiding (uid)
@@ -31,12 +30,13 @@ 
 import Control.Applicative
 import Control.Exception (assert)
-import Control.Monad.Error
+import Control.Monad.Except
 import Control.Monad.List
 import Control.Monad.Reader
 import Data.Either
 import Data.List
 import Data.Maybe
+import Prelude hiding (exp)
 
 type TypeDecls = [(String, IType)]
 data TypeInfo = TypeInfo {iTypeDecls::TypeDecls, iUIDIClaferMap::UIDIClaferMap, iCurThis::IClafer, iCurPath::Maybe IType}
@@ -87,13 +87,13 @@   typeDecls = lift typeDecls
   localDecls = mapListT . localDecls
 
-instance MonadTypeAnalysis m => MonadTypeAnalysis (ErrorT ClaferSErr m) where
+instance MonadTypeAnalysis m => MonadTypeAnalysis (ExceptT ClaferSErr m) where
   curThis = lift $ curThis
-  localCurThis = mapErrorT . localCurThis
+  localCurThis = mapExceptT . localCurThis
   curPath = lift $ curPath
-  localCurPath = mapErrorT . localCurPath
+  localCurPath = mapExceptT . localCurPath
   typeDecls = lift typeDecls
-  localDecls = mapErrorT . localDecls
+  localDecls = mapExceptT . localDecls
 
 -- | Type inference and checking
 runTypeAnalysis :: TypeAnalysis a -> IModule -> Either ClaferSErr a
@@ -265,13 +265,13 @@     x <- resolveTPExp' p
     case partitionEithers x of
       (f:_, []) -> throwError f                       -- Case 1: Only fails. Complain about the first one.
-      ([], [])  -> assert False $ error "No results but no errors."  -- Case 2: No success and no error message. Bug.
+      ([], [])  -> throwError $ SemanticErr (_inPos p) ("No results but no errors for " ++ show p) -- 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"}} = do
   uidIClaferMap' <- asks iUIDIClaferMap
-  runListT $ runErrorT $ do
+  runListT $ runExceptT $ do
     curPath' <- curPath
     case curPath' of
       Just curPath'' -> do
@@ -283,7 +283,7 @@       Nothing -> throwError $ SemanticErr _inPos ("Cannot ref at the start of a path")
 resolveTPExp' p@PExp{_inPos, _exp = IClaferId{_sident = "parent"}} = do
   uidIClaferMap' <- asks iUIDIClaferMap
-  runListT $ runErrorT $ do
+  runListT $ runExceptT $ do
     curPath' <- curPath
     case curPath' of
       Just curPath'' -> do
@@ -295,10 +295,10 @@           <++>
           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{_exp = IClaferId{_sident = "integer"}} = runListT $ runExceptT $ return $ p `withType` TInteger
 resolveTPExp' p@PExp{_inPos, _exp = IClaferId{_sident}} = do
   uidIClaferMap' <- asks iUIDIClaferMap
-  runListT $ runErrorT $ do
+  runListT $ runExceptT $ do
     curPath' <- curPath
     sident' <- if _sident == "this" then _uid <$> curThis else return _sident
     when (isJust curPath') $ do
@@ -311,20 +311,21 @@ 
 
 resolveTPExp' p@PExp{_inPos, _exp} =
-  runListT $ runErrorT $ do
-    (iType', exp') <- ErrorT $ ListT $ resolveTExp _exp
+  runListT $ runExceptT $ do
+    (iType', exp') <- ExceptT $ 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@(IInt _)    = runListT $ runExceptT $ return (TInteger, e)
+  resolveTExp e@(IDouble _) = runListT $ runExceptT $ return (TReal, e)
+  resolveTExp e@(IStr _)    = runListT $ runExceptT $ return (TString, e)
 
   resolveTExp e@IFunExp {_op, _exps = [arg]} =
-    runListT $ runErrorT $ do
+    runListT $ runExceptT $ do
       arg' <- lift $ ListT $ resolveTPExp arg
       let t = typeOf arg'
-      let test c =
+      let
+          test c =
             unless c $
               throwError $ SemanticErr _inPos ("Function '" ++ _op ++ "' cannot be performed on " ++ _op ++ " '" ++ str t ++ "'")
       let result
@@ -339,7 +340,7 @@ 
   resolveTExp e@IFunExp {_op = ".", _exps = [arg1, arg2]} =
     do
-      runListT $ runErrorT $ do
+      runListT $ runExceptT $ do
         arg1' <- lift $ ListT $ resolveTPExp arg1
         localCurPath (typeOf arg1') $ do
             arg2' <- liftError $ lift $ ListT $ resolveTPExp arg2
@@ -353,7 +354,7 @@       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]} = do
     uidIClaferMap' <- asks iUIDIClaferMap
-    runListT $ runErrorT $ do
+    runListT $ runExceptT $ do
       arg1' <- lift $ ListT $ resolveTPExp arg1
       arg2' <- lift $ ListT $ resolveTPExp arg2
       let t1 = typeOf arg1'
@@ -389,7 +390,7 @@ 
   resolveTExp e@(IFunExp "ifthenelse" [arg1, arg2, arg3]) = do
     uidIClaferMap' <- asks iUIDIClaferMap
-    runListT $ runErrorT $ do
+    runListT $ runExceptT $ do
       arg1' <- lift $ ListT $ resolveTPExp arg1
       arg2' <- lift $ ListT $ resolveTPExp arg2
       arg3' <- lift $ ListT $ resolveTPExp arg3
@@ -410,7 +411,7 @@       return (t, e{_exps = [arg1', arg2', arg3']})
 
   resolveTExp e@IDeclPExp{_oDecls, _bpexp} =
-    runListT $ runErrorT $ do
+    runListT $ runExceptT $ do
       oDecls' <- mapM resolveTDecl _oDecls
       let extraDecls = [(decl, typeOf $ _body oDecl) | oDecl <- oDecls', decl <- _decls oDecl]
       localDecls extraDecls $ do
@@ -425,11 +426,11 @@   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 -> ExceptT ClaferSErr (ListT TypeAnalysis) PExp
 addRef pexp =
   do
     localCurPath (typeOf pexp) $ do
-      deref <- (ErrorT $ ListT $ resolveTPExp' $ newPExp $ IClaferId "" "ref" False Nothing) `catchError` const (lift mzero)
+      deref <- (ExceptT $ ListT $ resolveTPExp' $ newPExp $ IClaferId "" "ref" False Nothing) `catchError` const (lift mzero)
       let result = (newPExp $ IFunExp "." [pexp, deref]) `withType` typeOf deref
       return result <++> addRef result
   where
@@ -441,14 +442,14 @@ 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
+(<++>) :: MonadPlus m => ExceptT e m a -> ExceptT e m a -> ExceptT e m a
+(ExceptT a) <++> (ExceptT b) = ExceptT $ a `mplus` b
 
-liftError :: (MonadError e m, Error e) => ErrorT e m a -> ErrorT e m a
+liftError :: MonadError e m => ExceptT e m a -> ExceptT e m a
 liftError e =
   liftCatch catchError e throwError
   where
-  liftCatch catchError' m h = ErrorT $ runErrorT m `catchError'` (runErrorT . h)
+  liftCatch catchError' m h = ExceptT $ runExceptT m `catchError'` (runExceptT . h)
 
 {-
  -

src/Language/Clafer/Intermediate/SimpleScopeAnalyzer.hs view

@@ -21,7 +21,7 @@ -}
 module Language.Clafer.Intermediate.SimpleScopeAnalyzer (simpleScopeAnalysis) where
 
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Control.Lens hiding (elements, assign)
 import Data.Graph
 import Data.List

src/Language/Clafer/Optimizer/Optimizer.hs view

@@ -24,11 +24,12 @@ 
 import Data.Maybe
 import Data.List
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Control.Lens hiding (elements, children, un)
 import Control.Monad.State
 import Data.Data.Lens (biplate)
 import qualified Data.Map as Map
+import Prelude
 
 import Language.Clafer.Common
 import Language.Clafer.ClaferArgs

src/Language/ClaferT.hs view

@@ -56,17 +56,17 @@   , Pos(..)
   ) where
 
-import Control.Monad.Error
-import Control.Monad.State
-import Control.Monad.Identity
-import Data.List
+import           Control.Monad.Except
+import           Control.Monad.Identity
+import           Control.Monad.State
+import           Data.List
 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
+import           Language.Clafer.ClaferArgs
+import           Language.Clafer.Common
+import           Language.Clafer.Front.AbsClafer
+import           Language.Clafer.Intermediate.Intclafer
+import           Language.Clafer.Intermediate.Tracing
 
 {-
  - Examples.
@@ -96,14 +96,15 @@  -
  -}
 
-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
-                            astModuleTrace :: Map.Map Span [Ast]  -- can keep the Ast map since it never changes
-                            } deriving Show
+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
+    , astModuleTrace :: Map.Map Span [Ast]  -- can keep the Ast map since it never changes
+    } deriving Show
 
 -- | This simulates a field in the ClaferEnv that will always recompute the map,
 --   since the IR always changes and the map becomes obsolete
@@ -137,24 +138,27 @@     _ -> 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 = [],
-                           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'
+makeEnv args' =
+  ClaferEnv
+    { args = args''
+    , modelFrags = []
+    , cAst = Nothing
+    , cIr = Nothing
+    , frags = []
+    , 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 ClaferT m = ExceptT ClaferErrs (StateT ClaferEnv m)
 
 type ClaferErr = CErr ErrPos
 type ClaferErrs = CErrs ErrPos
@@ -164,22 +168,21 @@ 
 -- | Possible errors that can occur when using Clafer
 -- | Generate errors using throwErr/throwErrs:
-data CErr p =
+data CErr p
   -- | Generic error
-  ClaferErr {
-    msg :: String
-  } |
+  = ClaferErr
+    { msg :: String
+    }
   -- | Error generated by the parser
-  ParseErr {
-    -- | Position of the error
-    pos :: p,
-    msg :: String
-  } |
+  | ParseErr
+    { pos :: p -- ^ Position of the error
+    , msg :: String
+    }
   -- | Error generated by semantic analysis
-  SemanticErr {
-    pos :: p,
-    msg :: String
-  }
+  | SemanticErr
+    { pos :: p
+    , msg :: String
+    }
   deriving Show
 
 -- | Clafer keeps track of multiple errors.
@@ -187,19 +190,13 @@   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,
+    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,
+    fragPos  :: Pos,
     -- | The error position relative to the model.
     modelPos :: Pos
   }
@@ -224,11 +221,11 @@   -- | fragId starts at 0
   -- | The position is relative to the start of the fragment.
   ErrFragPos {
-    pFragId :: Int,
+    pFragId  :: Int,
     pFragPos :: Pos
   } |
   ErrFragSpan {
-    pFragId :: Int,
+    pFragId   :: Int,
     pFragSpan :: Span
   } |
   -- | Position relative to the start of the complete model. Will calculate fragId and fragPos automatically.
@@ -325,7 +322,7 @@ -- |   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')
+  mapLeft errs `liftM` evalStateT (runExceptT exec) (makeEnv args')
   where
   mapLeft :: (a -> c) -> Either a b -> Either c b
   mapLeft f (Left l) = Left (f l)

test/Functions.hs view

@@ -28,26 +28,26 @@ 
 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
+                    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')
+    where (txe, eman) = span (/='.') (reverse file')
 
 
 compileOneFragment :: ClaferArgs -> InputModel -> Either [ClaferErr] (Map.Map ClaferMode CompilerResult)
 compileOneFragment args' model =
- 	runClafer (argsWithOPTIONS args' model) $
-		do
-			addModuleFragment model
-			parse
-			iModule <- desugar Nothing
-			compile iModule
-			generate
+    runClafer (argsWithOPTIONS args' model) $
+        do
+            addModuleFragment model
+            parse
+            iModule <- desugar Nothing
+            compile iModule
+            generate
 
 compiledCheck :: Either a b -> Bool
 compiledCheck (Left _) = False

test/Suite/Negative.hs view

@@ -34,10 +34,10 @@ 
 negativeClaferModels :: IO [([Char], String)]
 negativeClaferModels = do
-	claferModels <- getClafers "test/negative"
-	return $ filter ((`notElem` crashModels) . fst ) claferModels
-	where
-		crashModels = ["i127-loop.cfr", "i141-constraints.cfr"]
+    claferModels <- getClafers "test/negative"
+    return $ filter ((`notElem` crashModels) . fst ) claferModels
+    where
+        crashModels = ["i127-loop.cfr", "i141-constraints.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
@@ -45,10 +45,9 @@ 
 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.")
+    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

@@ -24,7 +24,7 @@ 
 import Functions
 import Language.Clafer.Intermediate.Intclafer
-import Data.Foldable (foldMap)
+import Data.Foldable hiding (forM_)
 import Data.Maybe
 import Control.Monad
 import Language.Clafer
@@ -33,6 +33,7 @@ import Test.Tasty.HUnit
 import Test.Tasty.TH
 import qualified Data.Map as Map
+import Prelude
 
 tg_Test_Suite_Positive :: TestTree
 tg_Test_Suite_Positive = $(testGroupGenerator)
@@ -42,43 +43,41 @@ 
 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.")
+    claferModels <- positiveClaferModels
+    let compiledClafers = map (\(file', model) -> (file', compileOneFragment defaultClaferArgs{keep_unused = True} 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")
+    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))) =
-			case Map.lookup Alloy42 resultMap of
-				Just CompilerResult{claferEnv = ClaferEnv{cIr = Just (iMod, _, _)}} -> [(file', iMod)]
-				_ -> []
-		getIR (_, _) = []
-		isEmptyCard (IRClafer (IClafer{_cinPos=(Span (Pos l c) _), _card = Nothing})) = "Line " ++ show l ++ " column " ++ show c ++ "\n"
-		isEmptyCard	_ = ""
+    claferModels <- positiveClaferModels
+    let compiledClafeIrs = foldMap getIR $ map (\(file', model) -> (file', compileOneFragment defaultClaferArgs{keep_unused = True} 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))) =
+            case Map.lookup Alloy42 resultMap of
+                Just CompilerResult{claferEnv = ClaferEnv{cIr = Just (iMod, _, _)}} -> [(file', iMod)]
+                _ -> []
+        getIR (_, _) = []
+        isEmptyCard (IRClafer (IClafer{_cinPos=(Span (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 Alloy42 $ 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!"
+    let strMap = stringMap $ fromJust $ Map.lookup Alloy42 $ 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/Suite/SimpleScopeAnalyser.hs view

@@ -40,82 +40,82 @@ 
 model :: String
 model = unlines
-			[ "a 0..0"
-			, "b ?"
-			, "c"
-			, "d *"
-			, "e +"
-			, "f 2..4"
-			, "g 3..*"
-			, "gs -> g 2"
-			, "abstract H"
-			, "    i ?"
-			, "    j *"
-			, "    k 2"
-			, "Hs -> H 3..*"
-			, "H1 : H 2"
-			, "    H12 : H 2"
-			, "H2 : H 4..4"
-			, "H3 : H 1..2"
-			, "H4 : H 5..*"
-			, "Hs2 -> H 0..*"
-			, "Hs3 -> H 5..8"
-			, "    l ?"
-			, "abstract FF : H"
-			, "f1 : FF 2..5"
-			, "    m 0"
-			, "i1 -> integer 2..4"
-			, "i2 ->> integer ?"
-			, "i3 -> integer *"
-			, "i4 ->> integer *"
-			, "s1 -> string 2..*"
-			, "s2 ->> string"
-			, "s3 -> string +"
-			, "s4 ->> string +"
-			]
+            [ "a 0..0"
+            , "b ?"
+            , "c"
+            , "d *"
+            , "e +"
+            , "f 2..4"
+            , "g 3..*"
+            , "gs -> g 2"
+            , "abstract H"
+            , "    i ?"
+            , "    j *"
+            , "    k 2"
+            , "Hs -> H 3..*"
+            , "H1 : H 2"
+            , "    H12 : H 2"
+            , "H2 : H 4..4"
+            , "H3 : H 1..2"
+            , "H4 : H 5..*"
+            , "Hs2 -> H 0..*"
+            , "Hs3 -> H 5..8"
+            , "    l ?"
+            , "abstract FF : H"
+            , "f1 : FF 2..5"
+            , "    m 0"
+            , "i1 -> integer 2..4"
+            , "i2 ->> integer ?"
+            , "i3 -> integer *"
+            , "i4 ->> integer *"
+            , "s1 -> string 2..*"
+            , "s2 ->> string"
+            , "s3 -> string +"
+            , "s4 ->> string +"
+            ]
 
 expectedScopesSet :: M.Map UID Integer
 expectedScopesSet = M.fromList $ [ ("c0_a", 0)
-							--	 , ("c0_b", 1)	-- uses global scope
-							--	 , ("c0_c", 1)	-- uses global scope
-							--	 , ("c0_d", 1) 	-- uses global scope
-							--	 , ("c0_e", 1)	-- uses global scope
-								 , ("c0_f", 4)
-								 , ("c0_g", 3)
-								 , ("c0_gs", 2)
-								 , ("c0_H", 22)
-								 , ("c0_i", 22)
-								 , ("c0_j", 22)
-								 , ("c0_k", 44)
-								 , ("c0_Hs", 16)
-								 , ("c0_H1", 2)
-								 , ("c0_H12", 4)
-								 , ("c0_H2", 4)
-								 , ("c0_H3", 2)
-								 , ("c0_H4", 5)
-								 , ("c0_Hs2", 16)
-								 , ("c0_Hs3", 8)
-								 , ("c0_l", 8)
-								 , ("c0_FF", 5)
-								 , ("c0_f1", 5)
-								 , ("c0_m", 0)
-								 , ("c0_i1", 4)
-							--	 , ("c0_i2", 1)	-- uses global scope
-							--	 , ("c0_i3", 1)	-- uses global scope
-							--	 , ("c0_i4", 1)	-- uses global scope
-								 , ("c0_s1", 2)
-							--	 , ("c0_s2", 1)	-- uses global scope
-							--	 , ("c0_s3", 1)	-- uses global scope
-							--	 , ("c0_s4", 1)	-- uses global scope
-								 ]
+                            --   , ("c0_b", 1)  -- uses global scope
+                            --   , ("c0_c", 1)  -- uses global scope
+                            --   , ("c0_d", 1)  -- uses global scope
+                            --   , ("c0_e", 1)  -- uses global scope
+                                 , ("c0_f", 4)
+                                 , ("c0_g", 3)
+                                 , ("c0_gs", 2)
+                                 , ("c0_H", 22)
+                                 , ("c0_i", 22)
+                                 , ("c0_j", 22)
+                                 , ("c0_k", 44)
+                                 , ("c0_Hs", 16)
+                                 , ("c0_H1", 2)
+                                 , ("c0_H12", 4)
+                                 , ("c0_H2", 4)
+                                 , ("c0_H3", 2)
+                                 , ("c0_H4", 5)
+                                 , ("c0_Hs2", 16)
+                                 , ("c0_Hs3", 8)
+                                 , ("c0_l", 8)
+                                 , ("c0_FF", 5)
+                                 , ("c0_f1", 5)
+                                 , ("c0_m", 0)
+                                 , ("c0_i1", 4)
+                            --   , ("c0_i2", 1) -- uses global scope
+                            --   , ("c0_i3", 1) -- uses global scope
+                            --   , ("c0_i4", 1) -- uses global scope
+                                 , ("c0_s1", 2)
+                            --   , ("c0_s2", 1) -- uses global scope
+                            --   , ("c0_s3", 1) -- uses global scope
+                            --   , ("c0_s4", 1) -- uses global scope
+                                 ]
 
 
 -- aggregates a difference
 aggregateDifference :: UID -> Integer -> Integer -> Maybe String
 aggregateDifference k computedV expectedV =
-	if computedV == expectedV
-	then Nothing
-	else Just $ k ++ " | computed: " ++ show computedV ++ " | expected: " ++ show expectedV ++ " |"
+    if computedV == expectedV
+    then Nothing
+    else Just $ k ++ " | computed: " ++ show computedV ++ " | expected: " ++ show expectedV ++ " |"
 
 -- prints only computed scopes missing in expected
 onlyComputed :: M.Map UID Integer -> M.Map UID String
@@ -128,36 +128,36 @@ 
 case_ScopeTest :: Assertion
 case_ScopeTest = do
-	let
-		-- use simple scope inference
-		(Right compilerResultMap) = compileOneFragment defaultClaferArgs model
-		(Just compilerResult) = M.lookup Alloy42 compilerResultMap
-		computedScopesSet :: M.Map UID Integer
-		computedScopesSet = M.fromList $ scopesList compilerResult
+    let
+        -- use simple scope inference
+        (Right compilerResultMap) = compileOneFragment defaultClaferArgs model
+        (Just compilerResult) = M.lookup Alloy42 compilerResultMap
+        computedScopesSet :: M.Map UID Integer
+        computedScopesSet = M.fromList $ scopesList compilerResult
 
-		differences = M.mergeWithKey aggregateDifference onlyComputed onlyExpected computedScopesSet expectedScopesSet
+        differences = M.mergeWithKey aggregateDifference onlyComputed onlyExpected computedScopesSet expectedScopesSet
 
-	(M.size differences) == 0 @?
-		"Computed scopes different from expected:\n" ++ (unlines $ M.foldl (\acc v -> v:acc) [] differences)
+    (M.size differences) == 0 @?
+        "Computed scopes different from expected:\n" ++ (unlines $ M.foldl (\acc v -> v:acc) [] differences)
 
 
 case_ReadScopesJSON :: Assertion
 case_ReadScopesJSON = do
-	let
-		-- use simple scope inference
-		(Right compilerResultMap) = compileOneFragment defaultClaferArgs model
-		(Just compilerResult) = M.lookup Alloy42 compilerResultMap
-		Just (iModule, _, _) = cIr $ claferEnv compilerResult
+    let
+        -- use simple scope inference
+        (Right compilerResultMap) = compileOneFragment defaultClaferArgs model
+        (Just compilerResult) = M.lookup Alloy42 compilerResultMap
+        Just (iModule, _, _) = cIr $ claferEnv compilerResult
 
-		qNameMaps = deriveQNameMaps iModule
+        qNameMaps = deriveQNameMaps iModule
 
-		computedScopes :: [ (UID, Integer) ]
-		computedScopes = scopesList compilerResult
+        computedScopes :: [ (UID, Integer) ]
+        computedScopes = scopesList compilerResult
 
-		scopesInJSON = generateJSONScopes qNameMaps computedScopes
-		decodedScopes = parseJSONScopes qNameMaps scopesInJSON
+        scopesInJSON = generateJSONScopes qNameMaps computedScopes
+        decodedScopes = parseJSONScopes qNameMaps scopesInJSON
 
-		differences = M.mergeWithKey aggregateDifference onlyComputed onlyExpected (M.fromList computedScopes) (M.fromList decodedScopes)
+        differences = M.mergeWithKey aggregateDifference onlyComputed onlyExpected (M.fromList computedScopes) (M.fromList decodedScopes)
 
-	(M.size differences) == 0 @?
-		"Parsed scopes different from original:\n" ++ (unlines $ M.foldl (\acc v -> v:acc) [] differences)
+    (M.size differences) == 0 @?
+        "Parsed scopes different from original:\n" ++ (unlines $ M.foldl (\acc v -> v:acc) [] differences)

tools/Makefile view

@@ -13,8 +13,8 @@ all:
 	@if test ! -f "alloy4.2.jar"; then \
 		echo "[WARNING] Missing alloy4.2.jar. Downloading...";  \
-		$(WGET_COMMAND) http://alloy.mit.edu/alloy/downloads/alloy4.2_2014-05-16.jar; \
-		mv alloy4.2_2014-05-16.jar alloy4.2.jar; \
+		$(WGET_COMMAND) http://alloy.mit.edu/alloy/downloads/alloy4.2_2015-02-22.jar; \
+		mv alloy4.2_2015-02-22.jar alloy4.2.jar; \
 	fi
 
 	javac  XsdCheck.java