clafer-0.4.4: Compiles Clafer models to other formats: Alloy, JavaScript, JSON, HTML, Dot.

Safe HaskellNone
LanguageHaskell2010

Language.Clafer.Intermediate.Intclafer

Contents

Description

Intermediate representation (IR) of a Clafer model

Synopsis

Documentation

type UID = String Source #

unique identifier of a clafer

type CName = String Source #

clafer name as declared in the source model

type URL = String Source #

file:/ ftp: or http:/ prefixed URL

data Ir Source #

A "supertype" of all IR types

Instances

Eq Ir Source # 

Methods

(==) :: Ir -> Ir -> Bool #

(/=) :: Ir -> Ir -> Bool #

Show Ir Source # 

Methods

showsPrec :: Int -> Ir -> ShowS #

show :: Ir -> String #

showList :: [Ir] -> ShowS #

data IType Source #

Constructors

TBoolean 
TString 
TInteger 
TDouble 
TReal 
TClafer 

Fields

  • _hi :: [UID]
    UID
    represents an inheritance hierarchy obtained using @Common.findHierarchy
TMap 

Fields

TUnion 

Fields

  • _un :: [IType]
    IType
    is a list of basic types (not union types)

Instances

Eq IType Source # 

Methods

(==) :: IType -> IType -> Bool #

(/=) :: IType -> IType -> Bool #

Data IType Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IType -> c IType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IType #

toConstr :: IType -> Constr #

dataTypeOf :: IType -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IType) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IType) #

gmapT :: (forall b. Data b => b -> b) -> IType -> IType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IType -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IType -> r #

gmapQ :: (forall d. Data d => d -> u) -> IType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IType -> m IType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IType -> m IType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IType -> m IType #

Ord IType Source # 

Methods

compare :: IType -> IType -> Ordering #

(<) :: IType -> IType -> Bool #

(<=) :: IType -> IType -> Bool #

(>) :: IType -> IType -> Bool #

(>=) :: IType -> IType -> Bool #

max :: IType -> IType -> IType #

min :: IType -> IType -> IType #

Show IType Source # 

Methods

showsPrec :: Int -> IType -> ShowS #

show :: IType -> String #

showList :: [IType] -> ShowS #

ToJSON IType Source # 

data IModule Source #

each file contains exactly one mode. A module is a list of declarations

Constructors

IModule 

Fields

Instances

Eq IModule Source # 

Methods

(==) :: IModule -> IModule -> Bool #

(/=) :: IModule -> IModule -> Bool #

Data IModule Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IModule -> c IModule #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IModule #

toConstr :: IModule -> Constr #

dataTypeOf :: IModule -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IModule) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IModule) #

gmapT :: (forall b. Data b => b -> b) -> IModule -> IModule #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IModule -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IModule -> r #

gmapQ :: (forall d. Data d => d -> u) -> IModule -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IModule -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IModule -> m IModule #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IModule -> m IModule #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IModule -> m IModule #

Ord IModule Source # 
Show IModule Source # 
ToJSON IModule Source # 
Plated IModule Source # 

data IClafer Source #

Clafer has a list of fields that specify its properties. Some fields, marked as (o) are for generating optimized code

Constructors

IClafer 

Fields

Instances

Eq IClafer Source # 

Methods

(==) :: IClafer -> IClafer -> Bool #

(/=) :: IClafer -> IClafer -> Bool #

Data IClafer Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IClafer -> c IClafer #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IClafer #

toConstr :: IClafer -> Constr #

dataTypeOf :: IClafer -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IClafer) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IClafer) #

gmapT :: (forall b. Data b => b -> b) -> IClafer -> IClafer #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IClafer -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IClafer -> r #

gmapQ :: (forall d. Data d => d -> u) -> IClafer -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IClafer -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IClafer -> m IClafer #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IClafer -> m IClafer #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IClafer -> m IClafer #

Ord IClafer Source # 
Show IClafer Source # 
ToJSON IClafer Source # 
Plated IClafer Source # 

data IElement Source #

Clafer's subelement is either a clafer, a constraint, or a goal (objective) This is a wrapper type needed to have polymorphic lists of elements

Constructors

IEClafer 

Fields

IEConstraint 

Fields

IEGoal

Goal (optimization objective)

Fields

Instances

Eq IElement Source # 
Data IElement Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IElement -> c IElement #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IElement #

toConstr :: IElement -> Constr #

dataTypeOf :: IElement -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IElement) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IElement) #

gmapT :: (forall b. Data b => b -> b) -> IElement -> IElement #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IElement -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IElement -> r #

gmapQ :: (forall d. Data d => d -> u) -> IElement -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IElement -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IElement -> m IElement #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IElement -> m IElement #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IElement -> m IElement #

Ord IElement Source # 
Show IElement Source # 
ToJSON IElement Source # 

data IReference Source #

A type of reference. -> values unique (set) ->> values non-unique (bag)

Constructors

IReference 

Fields

  • _isSet :: Bool

    whether set or bag

  • _ref :: PExp

    the only allowed reference expressions are IClafer and set expr. (++, **, --s)

Instances

Eq IReference Source # 
Data IReference Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IReference -> c IReference #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IReference #

toConstr :: IReference -> Constr #

dataTypeOf :: IReference -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IReference) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IReference) #

gmapT :: (forall b. Data b => b -> b) -> IReference -> IReference #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IReference -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IReference -> r #

gmapQ :: (forall d. Data d => d -> u) -> IReference -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IReference -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IReference -> m IReference #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IReference -> m IReference #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IReference -> m IReference #

Ord IReference Source # 
Show IReference Source # 
ToJSON IReference Source # 

data IGCard Source #

Group cardinality is specified as an interval. It may also be given by a keyword. xor 1..1 isKeyword = True 1..1 1..1 isKeyword = False

Constructors

IGCard 

Fields

Instances

Eq IGCard Source # 

Methods

(==) :: IGCard -> IGCard -> Bool #

(/=) :: IGCard -> IGCard -> Bool #

Data IGCard Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IGCard -> c IGCard #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IGCard #

toConstr :: IGCard -> Constr #

dataTypeOf :: IGCard -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IGCard) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IGCard) #

gmapT :: (forall b. Data b => b -> b) -> IGCard -> IGCard #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IGCard -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IGCard -> r #

gmapQ :: (forall d. Data d => d -> u) -> IGCard -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IGCard -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IGCard -> m IGCard #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IGCard -> m IGCard #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IGCard -> m IGCard #

Ord IGCard Source # 
Show IGCard Source # 
ToJSON IGCard Source # 

type Interval = (Integer, Integer) Source #

(Min, Max) integer interval. -1 denotes *

data PExp Source #

This is expression container (parent). It has meta information about an actual expression exp

Constructors

PExp 

Fields

Instances

Eq PExp Source # 

Methods

(==) :: PExp -> PExp -> Bool #

(/=) :: PExp -> PExp -> Bool #

Data PExp Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PExp -> c PExp #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PExp #

toConstr :: PExp -> Constr #

dataTypeOf :: PExp -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c PExp) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PExp) #

gmapT :: (forall b. Data b => b -> b) -> PExp -> PExp #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PExp -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PExp -> r #

gmapQ :: (forall d. Data d => d -> u) -> PExp -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PExp -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PExp -> m PExp #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PExp -> m PExp #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PExp -> m PExp #

Ord PExp Source # 

Methods

compare :: PExp -> PExp -> Ordering #

(<) :: PExp -> PExp -> Bool #

(<=) :: PExp -> PExp -> Bool #

(>) :: PExp -> PExp -> Bool #

(>=) :: PExp -> PExp -> Bool #

max :: PExp -> PExp -> PExp #

min :: PExp -> PExp -> PExp #

Show PExp Source # 

Methods

showsPrec :: Int -> PExp -> ShowS #

show :: PExp -> String #

showList :: [PExp] -> ShowS #

ToJSON PExp Source # 
Plated PExp Source # 

type ClaferBinding = Maybe UID Source #

Embedes reference to a resolved Clafer

data IExp Source #

Constructors

IDeclPExp

quantified expression with declarations e.g., [ all x1; x2 : X | x1.ref != x2.ref ]

Fields

IFunExp

expression with a unary function, e.g., -1 binary function, e.g., 2 + 3 ternary function, e.g., if x then 4 else 5

Fields

IInt

integer number

Fields

IReal

real number

Fields

IDouble

double-precision floating point number

Fields

IStr

string

Fields

IClaferId

a reference to a clafer name

Fields

Instances

Eq IExp Source # 

Methods

(==) :: IExp -> IExp -> Bool #

(/=) :: IExp -> IExp -> Bool #

Data IExp Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IExp -> c IExp #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IExp #

toConstr :: IExp -> Constr #

dataTypeOf :: IExp -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IExp) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IExp) #

gmapT :: (forall b. Data b => b -> b) -> IExp -> IExp #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IExp -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IExp -> r #

gmapQ :: (forall d. Data d => d -> u) -> IExp -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IExp -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IExp -> m IExp #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IExp -> m IExp #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IExp -> m IExp #

Ord IExp Source # 

Methods

compare :: IExp -> IExp -> Ordering #

(<) :: IExp -> IExp -> Bool #

(<=) :: IExp -> IExp -> Bool #

(>) :: IExp -> IExp -> Bool #

(>=) :: IExp -> IExp -> Bool #

max :: IExp -> IExp -> IExp #

min :: IExp -> IExp -> IExp #

Show IExp Source # 

Methods

showsPrec :: Int -> IExp -> ShowS #

show :: IExp -> String #

showList :: [IExp] -> ShowS #

ToJSON IExp Source # 
Plated IExp Source # 

data IDecl Source #

For IFunExp standard set of operators includes: 1. Unary operators: ! - not (logical) # - set counting operator - - negation (arithmetic) max - maximum (created for goals and maximum of a set) min - minimum (created for goals and minimum of a set) 2. Binary operators: <=> - equivalence => - implication || - disjunction xor - exclusive or && - conjunction < - less than > - greater than = - equality <= - less than or equal >= - greater than or equal != - inequality in - belonging to a set/being a subset nin - not belonging to a set/not being a subset + - addition/string concatenation - - substraction * - multiplication / - division ++ - set union -- - set difference ** - set intersection <: - domain restriction :> - range restriction . - relational join 3. Ternary operators ifthenelse -- if then else

Local declaration disj x1; x2 : X ++ Y y1 : Y

Constructors

IDecl 

Fields

Instances

Eq IDecl Source # 

Methods

(==) :: IDecl -> IDecl -> Bool #

(/=) :: IDecl -> IDecl -> Bool #

Data IDecl Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IDecl -> c IDecl #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IDecl #

toConstr :: IDecl -> Constr #

dataTypeOf :: IDecl -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IDecl) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IDecl) #

gmapT :: (forall b. Data b => b -> b) -> IDecl -> IDecl #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IDecl -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IDecl -> r #

gmapQ :: (forall d. Data d => d -> u) -> IDecl -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IDecl -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IDecl -> m IDecl #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IDecl -> m IDecl #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IDecl -> m IDecl #

Ord IDecl Source # 

Methods

compare :: IDecl -> IDecl -> Ordering #

(<) :: IDecl -> IDecl -> Bool #

(<=) :: IDecl -> IDecl -> Bool #

(>) :: IDecl -> IDecl -> Bool #

(>=) :: IDecl -> IDecl -> Bool #

max :: IDecl -> IDecl -> IDecl #

min :: IDecl -> IDecl -> IDecl #

Show IDecl Source # 

Methods

showsPrec :: Int -> IDecl -> ShowS #

show :: IDecl -> String #

showList :: [IDecl] -> ShowS #

ToJSON IDecl Source # 

data IQuant Source #

quantifier

Constructors

INo

does not exist

ILone

less than one

IOne

exactly one

ISome

at least one (i.e., exists)

IAll

for all

Instances

Eq IQuant Source # 

Methods

(==) :: IQuant -> IQuant -> Bool #

(/=) :: IQuant -> IQuant -> Bool #

Data IQuant Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> IQuant -> c IQuant #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c IQuant #

toConstr :: IQuant -> Constr #

dataTypeOf :: IQuant -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c IQuant) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IQuant) #

gmapT :: (forall b. Data b => b -> b) -> IQuant -> IQuant #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IQuant -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IQuant -> r #

gmapQ :: (forall d. Data d => d -> u) -> IQuant -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> IQuant -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> IQuant -> m IQuant #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> IQuant -> m IQuant #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> IQuant -> m IQuant #

Ord IQuant Source # 
Show IQuant Source # 
ToJSON IQuant Source # 

mapIR :: (Ir -> Ir) -> IModule -> IModule Source #

map over IR

foldMapIR :: Monoid m => (Ir -> m) -> IModule -> m Source #

foldMap over IR

foldIR :: (Ir -> a -> a) -> a -> IModule -> a Source #

fold the IR

iMap :: (Ir -> Ir) -> Ir -> Ir Source #

iFoldMap :: Monoid m => (Ir -> m) -> Ir -> m Source #

iFold :: (Ir -> a -> a) -> a -> Ir -> a Source #

data ObjectivesAndAttributes Source #

Datatype used for JSON output. See Language.Clafer.gatherObjectivesAndAttributes

Orphan instances