clafer 0.3.6 → 0.3.6.1

raw patch · 10 files changed

+81/−47 lines, 10 filesdep ~HaXmldep ~claferdep ~lens

Dependency ranges changed: HaXml, clafer, lens

Files

CHANGES.md +4/−0
README.md +5/−5
clafer.cabal +18/−6
src/Language/Clafer.hs +2/−2
src/Language/Clafer/Generator/Choco.hs +18/−1
src/Language/Clafer/Intermediate/Desugarer.hs +11/−3
src/Language/Clafer/Intermediate/Intclafer.hs +9/−3
src/Language/Clafer/Intermediate/ResolverType.hs +4/−3
src/Language/Clafer/Intermediate/StringAnalyzer.hs +8/−22
src/Language/Clafer/Intermediate/Transformer.hs +2/−2

CHANGES.md view

@@ -1,3 +1,7 @@+**Clafer Version 0.3.6.1 released on Jul 08, 2014**
+
+[Release](https://github.com/gsdlab/clafer/pull/50)
+
 **Clafer Version 0.3.6 released on May 23, 2014**
 
 [Release](https://github.com/gsdlab/clafer/pull/48)

README.md view

@@ -1,7 +1,7 @@ Clafer
 ======
 
-v0.3.6
+v0.3.6.1
 
 [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 
@@ -94,7 +94,7 @@ 
 ### Installation from binaries
 
-Binary distributions of the release 0.3.6 of Clafer Tools for Windows, Mac, and Linux, 
+Binary distributions of the release 0.3.6.1 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). 
 
@@ -107,11 +107,11 @@ 
 * [The Haskell Platform](http://hackage.haskell.org/platform/) v2013.2.0.0
 
-Clafer is now available on [Hackage](http://hackage.haskell.org/package/clafer-0.3.6/) and it can be installed using
+Clafer is now available on [Hackage](http://hackage.haskell.org/package/clafer-0.3.6.1/) 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\i386-windows-ghc-7.6.3\clafer-0.3.6` on Windows or `.cabal/share/x86_64-linux-ghc-7.6.3/clafer-0.3.6/` on Linux)
+3. `cd <cabal's lib or share folder>`  (`C:\Users\<user>\AppData\Roaming\cabal\i386-windows-ghc-7.6.3\clafer-0.3.6.1` on Windows or `.cabal/share/x86_64-linux-ghc-7.6.3/clafer-0.3.6.1/` on Linux)
 4. to automatically download Alloy jars
   * execute `make` in `tools` 
 
@@ -185,7 +185,7 @@ (As printed by `clafer --help`)
 
 ```
-Clafer 0.3.6
+Clafer 0.3.6.1
 
 clafer [OPTIONS] [FILE]

clafer.cabal view

@@ -1,5 +1,5 @@ Name:               clafer
-Version:            0.3.6
+Version:            0.3.6.1
 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
@@ -53,7 +53,6 @@                     cmdargs >= 0.10.7, 
                     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.0.3, 
@@ -62,7 +61,12 @@                     test-framework-th >= 0.2.4,
                     text >= 0.11.3.1,
 
-                    clafer == 0.3.6
+                    clafer == 0.3.6.1
+    if os(windows)
+        build-depends: HaXml == 1.24
+    else
+        build-depends: HaXml >= 1.24
+
     hs-source-dirs: src
     other-modules: Paths_clafer
 
@@ -94,7 +98,6 @@                     cmdargs >= 0.10.7, 
                     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.0.3, 
@@ -103,6 +106,11 @@                     test-framework-th >= 0.2.4,
                     text >= 0.11.3.1
 
+    if os(windows)
+        build-depends: HaXml == 1.24
+    else
+        build-depends: HaXml >= 1.24
+
     hs-source-dirs:  src
     ghc-options:     -Wall -fno-warn-unused-do-bind -fno-warn-orphans
     exposed-modules: 
@@ -174,7 +182,6 @@                     cmdargs >= 0.10.7, 
                     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.0.3, 
@@ -183,7 +190,12 @@                     test-framework-th >= 0.2.4,
                     text >= 0.11.3.1,
 
-                    clafer == 0.3.6
+                    clafer == 0.3.6.1
+
+    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

src/Language/Clafer.hs view

@@ -479,7 +479,7 @@         -- result for Choco    
         ++ (if (Choco `elem` modes)
           then let 
-                  (imod,strMap) = astrModule iModule
+                  imod = iModule
                in
                   [ (Choco, 
                      CompilerResult { 
@@ -488,7 +488,7 @@                          statistics = stats,
                          claferEnv  = env,
                          mappingToAlloy = [],
-                         stringMap = strMap,
+                         stringMap = Map.empty,
                          scopesList = scopes
                       }) ]
           else []

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

@@ -5,7 +5,9 @@ module Language.Clafer.Generator.Choco (genCModule) where
 
 import Control.Applicative
+import Control.Lens.Plated
 import Control.Monad
+import Data.Data.Lens
 import Data.List
 import Data.Maybe
 import Data.Ord
@@ -17,7 +19,7 @@ 
 -- | Choco 3 code generation
 genCModule :: ClaferArgs -> (IModule, GEnv) -> [(UID, Integer)] -> Result
-genCModule _ (IModule{_mDecls}, _) scopes =
+genCModule _ (imodule@IModule{_mDecls}, _) scopes =
     genScopes
     ++ "\n"
     ++ (genAbstractClafer =<< abstractClafers)
@@ -115,8 +117,19 @@         (if null scopeMap then "" else "scope({" ++ intercalate ", " scopeMap ++ "});\n")
         ++ "defaultScope(1);\n"
         ++ "intRange(-" ++ show (2 ^ (bitwidth - 1)) ++ ", " ++ show (2 ^ (bitwidth - 1) - 1) ++ ");\n"
+        ++ "stringLength(" ++ show longestString ++ ");\n"
         where
             scopeMap = [uid' ++ ":" ++ show scope | (uid', scope) <- scopes, uid' /= "int"]
+
+    exps :: [IExp]
+    exps = universeOn biplate imodule
+
+    stringLength :: IExp -> Maybe Int
+    stringLength (IStr string) = Just $ length string
+    stringLength _ = Nothing
+
+    longestString :: Int
+    longestString = maximum $ 16 : mapMaybe stringLength exps
                 
     genConcreteClafer :: IClafer -> Result
     genConcreteClafer IClafer{_uid, _card = Just _card, _gcard = Just (IGCard _ _gcard)} =
@@ -243,6 +256,9 @@         | [arg] <- args', PExp{_exp = IFunExp{_exps = [a, PExp{_exp = IClaferId{_sident = "ref"}}]}} <- rewrite arg =
             "sum(" ++ genConstraintPExp a ++ ")"
         | otherwise = error "Unexpected sum argument."
+    genConstraintExp (IFunExp "+" args') =
+	(if _iType (head args') == Just TString then "concat" else "add") ++
+            "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
     genConstraintExp (IFunExp op' args') =
         mapFunc op' ++ "(" ++ intercalate ", " (map genConstraintPExp args') ++ ")"
     -- this is a keyword in Javascript so use "$this" instead
@@ -251,6 +267,7 @@         | _sident `elem` claferUids = "global(" ++ _sident ++ ")"
         | otherwise                = _sident
     genConstraintExp (IInt val) = "constant(" ++ show val ++ ")"
+    genConstraintExp (IStr val) = "constant(" ++ show val ++ ")"
     genConstraintExp e = error $ "Unknown expression: " ++ show e
                 
     mapQuant INo = "none"

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

@@ -104,9 +104,17 @@ 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
+desugarInit id' (PosInitSome s inithow exp') = [ IEConstraint (desugarInitHow inithow) (pExpDefPid s implIExp) ]
+  where 
+    cId :: PExp
+    cId = mkPLClaferId (snd $ getIdent id') False
+    -- <id> = <exp'>
+    assignIExp :: IExp
+    assignIExp = (IFunExp "=" [cId, desugarExp exp'])
+    -- some <id> => <assignIExp>
+    implIExp :: IExp
+    implIExp = (IFunExp "=>" [ pExpDefPid s $ IDeclPExp ISome [] cId, pExpDefPid s assignIExp ])
+    getIdent (PosIdent y) = y
 
 desugarInitHow :: InitHow -> Bool
 desugarInitHow InitHow_1  = desugarInitHow $ PosInitHow_1 noSpan

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

@@ -165,11 +165,17 @@       _exps :: [PExp]
     }
  -- | integer number
- | IInt Integer
+ | IInt {
+      _iint :: Integer
+    }
  -- | real number
- | IDouble Double
+ | IDouble {
+      _idouble :: Double
+    }
  -- | string
- | IStr String
+ | IStr {
+      _istr :: String
+    }
  -- | a reference to a clafer name
  | IClaferId {                   
       -- | module name - currently not used and empty since we have no module system

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

@@ -31,6 +31,7 @@ import qualified Language.Clafer.Intermediate.Intclafer as I
 
 import Control.Applicative
+import Control.Exception (assert)
 import Control.Monad.Error
 import Control.Monad.List
 import Control.Monad.Reader
@@ -203,7 +204,7 @@ resolveTElement _ (IEClafer iclafer) =
   do
     elements' <- mapM (resolveTElement $ I._uid iclafer) (_elements iclafer)
-    return $ IEClafer $ iclafer{_elements = elements'}
+    return $ IEClafer iclafer{_elements = elements'}
 resolveTElement parent' (IEConstraint _isHard _pexp) =
   IEConstraint _isHard <$> (testBoolean =<< resolveTConstraint parent' _pexp)
   where
@@ -228,7 +229,7 @@     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.
+      ([], [])  -> assert False $ 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]
@@ -292,7 +293,7 @@             | _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 ++ "'"
+            | otherwise = assert False $ error $ "Unknown op '" ++ _op ++ "'"
       result' <- result
       return (result', e{_exps = [arg']})

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

@@ -22,39 +22,37 @@ -}
 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, Map.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.Map String Int -> Map.Map Int String
     flipMap = Map.fromList . map swap . Map.toList
 
 
-astrClafer :: MonadState (Map String Int) m => IClafer -> m IClafer
+astrClafer :: MonadState (Map.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 :: MonadState (Map.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 :: MonadState (Map.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`
@@ -63,23 +61,11 @@                               (IDeclPExp quant' oDecls' `liftM` (astrPExp bpexp'))
 astrPExp x = return x
 
-astrIExp :: MonadState (Map String Int) m => IExp -> m IExp
+astrIExp :: MonadState (Map.Map String Int) m => IExp -> m IExp
 astrIExp x = case x of
-  IFunExp op' _ -> if op' == iUnion
-                     then astrIExp $ concatStrExp x else return x                    
+  IFunExp op' exps' -> IFunExp op' `liftM` mapM astrPExp exps'
   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+  _ -> return x

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

@@ -24,7 +24,7 @@ import Control.Lens
 import Data.Maybe
 import Language.Clafer.Common
-import qualified Language.Clafer.Intermediate.Intclafer as I (exp, elements, op)
+import qualified Language.Clafer.Intermediate.Intclafer as I (exp, elements)
 import Language.Clafer.Intermediate.Intclafer hiding (exp, elements, op)
 import Language.Clafer.Intermediate.Desugarer
 
@@ -44,7 +44,7 @@ transPExp False pexp'                     = pexp'
 
 transIExp :: IType -> IExp -> IExp
-transIExp iType' idpe@(IDeclPExp _ _ _) = bpexp            %~ transPExp False $ idpe
+transIExp _ idpe@(IDeclPExp _ _ _) = bpexp            %~ transPExp False $ idpe
 transIExp iType' ife@(IFunExp op' _)    = exps . traversed %~ transPExp cond  $ ife
   where
     cond = op' == iIfThenElse &&