diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 ` (`C:\Users\\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 ` (`C:\Users\\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] diff --git a/clafer.cabal b/clafer.cabal --- a/clafer.cabal +++ b/clafer.cabal @@ -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 diff --git a/src/Language/Clafer.hs b/src/Language/Clafer.hs --- a/src/Language/Clafer.hs +++ b/src/Language/Clafer.hs @@ -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 [] diff --git a/src/Language/Clafer/Generator/Choco.hs b/src/Language/Clafer/Generator/Choco.hs --- a/src/Language/Clafer/Generator/Choco.hs +++ b/src/Language/Clafer/Generator/Choco.hs @@ -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" diff --git a/src/Language/Clafer/Intermediate/Desugarer.hs b/src/Language/Clafer/Intermediate/Desugarer.hs --- a/src/Language/Clafer/Intermediate/Desugarer.hs +++ b/src/Language/Clafer/Intermediate/Desugarer.hs @@ -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 + -- = + assignIExp :: IExp + assignIExp = (IFunExp "=" [cId, desugarExp exp']) + -- some => + 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 diff --git a/src/Language/Clafer/Intermediate/Intclafer.hs b/src/Language/Clafer/Intermediate/Intclafer.hs --- a/src/Language/Clafer/Intermediate/Intclafer.hs +++ b/src/Language/Clafer/Intermediate/Intclafer.hs @@ -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 diff --git a/src/Language/Clafer/Intermediate/ResolverType.hs b/src/Language/Clafer/Intermediate/ResolverType.hs --- a/src/Language/Clafer/Intermediate/ResolverType.hs +++ b/src/Language/Clafer/Intermediate/ResolverType.hs @@ -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']}) diff --git a/src/Language/Clafer/Intermediate/StringAnalyzer.hs b/src/Language/Clafer/Intermediate/StringAnalyzer.hs --- a/src/Language/Clafer/Intermediate/StringAnalyzer.hs +++ b/src/Language/Clafer/Intermediate/StringAnalyzer.hs @@ -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 diff --git a/src/Language/Clafer/Intermediate/Transformer.hs b/src/Language/Clafer/Intermediate/Transformer.hs --- a/src/Language/Clafer/Intermediate/Transformer.hs +++ b/src/Language/Clafer/Intermediate/Transformer.hs @@ -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 &&