Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Fredrik Wieczerkowski
curry-libs
Commits
dad4d07d
Commit
dad4d07d
authored
Mar 27, 2015
by
Jan Rasmus Tikovsky
Browse files
Adapted Makefile for global installation of CLPFD2 library
parent
d25a3280
Changes
3
Hide whitespace changes
Inline
Side-by-side
External_CLPFD.hs
View file @
dad4d07d
{-# LANGUAGE MultiParamTypeClasses #-}
import
qualified
Curry_Prelude
as
CP
import
Curry_List
(
d_C_sum
)
import
Solver.Constraints
...
...
@@ -9,81 +8,84 @@ import Solver.Constraints
-- (curry list arguments have to be converted to haskell lists using toFDList)
-- yields Success or failed depending on whether given arguments satisfy the given predicate or not
cond
::
NonDet
a
=>
(
a
->
a
->
Cover
->
ConstStore
->
C
P
.
C_Bool
)
->
a
->
a
->
Cover
->
ConstStore
->
C_Success
cond
::
NonDet
a
=>
(
a
->
a
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Bool
)
->
a
->
a
->
Cover
->
ConstStore
->
C_Success
cond
p
x
y
cd
cs
|
fromCurry
(
p
x
y
cd
cs
)
=
C_Success
|
otherwise
=
C
P
.
d_C_failed
cd
cs
|
otherwise
=
C
urry_Prelude
.
d_C_failed
cd
cs
external_d_C_prim_domain
::
C
P
.
OP_List
CP
.
C_Int
->
CP
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_domain
::
C
urry_Prelude
.
OP_List
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_domain
vs
l
u
cd
cs
=
narrowIfFree2
l
u
cont
cont
cd
cs
where
cont
l'
u'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
FDDomain
(
toFDList
vs
)
(
toCsExpr
l'
)
(
toCsExpr
u'
))]
C_Success
external_d_C_prim_FD_plus
::
C
P
.
C_Int
->
CP
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Int
external_d_C_prim_FD_plus
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
P
.
d_OP_plus
cd
cs
external_d_C_prim_FD_plus
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Int
external_d_C_prim_FD_plus
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
urry_Prelude
.
d_OP_plus
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newArithConstr
Plus
x'
y'
result
)]
result
external_d_C_prim_FD_minus
::
C
P
.
C_Int
->
CP
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Int
external_d_C_prim_FD_minus
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
P
.
d_OP_minus
cd
cs
external_d_C_prim_FD_minus
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Int
external_d_C_prim_FD_minus
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
urry_Prelude
.
d_OP_minus
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newArithConstr
Minus
x'
y'
result
)]
result
external_d_C_prim_FD_times
::
C
P
.
C_Int
->
CP
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Int
external_d_C_prim_FD_times
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
P
.
d_OP_star
cd
cs
external_d_C_prim_FD_times
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Int
external_d_C_prim_FD_times
x
y
result
cd
cs
=
narrowIfFree2
x
y
contFree
C
urry_Prelude
.
d_OP_star
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newArithConstr
Mult
x'
y'
result
)]
result
external_d_C_prim_FD_equal
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_equal
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
C
P
.
d_OP_eq_eq
)
cd
cs
external_d_C_prim_FD_equal
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_equal
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
C
urry_Prelude
.
d_OP_eq_eq
)
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newRelConstr
Equal
x'
y'
)]
C_Success
external_d_C_prim_FD_notequal
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_notequal
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
(
\
x'
y'
cd'
cs'
->
C
P
.
d_C_not
(
CP
.
d_OP_eq_eq
x'
y'
cd'
cs'
)
cd'
cs'
))
cd
cs
external_d_C_prim_FD_notequal
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_notequal
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
(
\
x'
y'
cd'
cs'
->
C
urry_Prelude
.
d_C_not
(
Curry_Prelude
.
d_OP_eq_eq
x'
y'
cd'
cs'
)
cd'
cs'
))
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newRelConstr
Diff
x'
y'
)]
C_Success
external_d_C_prim_FD_le
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_le
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
(
\
x'
y'
cd'
cs'
->
C
P
.
d_OP_lt_eq
x'
(
C
P
.
d_OP_minus
y'
(
C
P
.
C_Int
1
#
)
cd'
cs'
)
cd'
cs'
))
cd
cs
external_d_C_prim_FD_le
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_le
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
(
\
x'
y'
cd'
cs'
->
C
urry_Prelude
.
d_OP_lt_eq
x'
(
C
urry_Prelude
.
d_OP_minus
y'
(
C
urry_Prelude
.
C_Int
1
#
)
cd'
cs'
)
cd'
cs'
))
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newRelConstr
Less
x'
y'
)]
C_Success
external_d_C_prim_FD_leq
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_leq
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
C
P
.
d_OP_lt_eq
)
cd
cs
external_d_C_prim_FD_leq
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_leq
x
y
cd
cs
=
narrowIfFree2
x
y
contFree
(
cond
C
urry_Prelude
.
d_OP_lt_eq
)
cd
cs
where
contFree
x'
y'
cd'
_
=
mkGuardExt
cd'
[
wrapCs
(
newRelConstr
LessEqual
x'
y'
)]
C_Success
external_d_C_prim_FD_ge
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_ge
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_ge
x
y
cd
cs
=
d_C_prim_FD_le
y
x
cd
cs
external_d_C_prim_FD_geq
::
C
P
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_FD_geq
::
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_FD_geq
x
y
cd
cs
=
d_C_prim_FD_leq
y
x
cd
cs
external_d_C_prim_allDifferent
::
C
P
.
OP_List
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_allDifferent
::
C
urry_Prelude
.
OP_List
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_allDifferent
vs
cd
cs
|
any
isFree
hvs
=
mkGuardExt
cd
[
wrapCs
(
FDAllDifferent
(
toFDList
vs
))]
C_Success
|
allDifferent
(
fromCurry
vs
::
[
Int
])
=
C_Success
|
otherwise
=
C
P
.
d_C_failed
cd
cs
|
otherwise
=
C
urry_Prelude
.
d_C_failed
cd
cs
where
hvs
=
toHaskellList
id
vs
external_d_C_prim_sum
::
CP
.
OP_List
CP
.
C_Int
->
CP
.
C_Int
->
Cover
->
ConstStore
->
CP
.
C_Int
external_d_C_prim_sum
vs
result
cd
cs
|
any
isFree
hvs
=
mkGuardExt
cd
[
wrapCs
(
FDSum
(
toFDList
vs
)
(
toCsExpr
result
))]
result
|
otherwise
=
d_C_sum
vs
cd
cs
where
hvs
=
toHaskellList
id
vs
external_d_C_prim_sum
::
Curry_Prelude
.
OP_List
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
Curry_Prelude
.
C_Int
external_d_C_prim_sum
vs
result
cd
cs
=
mkGuardExt
cd
[
wrapCs
(
FDSum
(
toFDList
vs
)
(
toCsExpr
result
))]
result
-- external_d_C_prim_sum :: Curry_Prelude.OP_List Curry_Prelude.C_Int -> Curry_Prelude.C_Int -> Cover -> ConstStore -> Curry_Prelude.C_Int
-- external_d_C_prim_sum vs result cd cs
-- | any isFree hvs = mkGuardExt cd [wrapCs (FDSum (toFDList vs) (toCsExpr result))] result
-- | otherwise = d_C_sum vs cd cs
-- where
-- hvs = toHaskellList id vs
external_d_C_prim_labelingWith
::
C_LabelingStrategy
->
C
P
.
OP_List
CP
.
C_Int
->
CP
.
OP_List
CP
.
C_Int
->
Cover
->
ConstStore
->
C
P
.
C_Success
external_d_C_prim_labelingWith
_
C
P
.
OP_List
_
cd
cs
=
C
P
.
d_C_failed
cd
cs
external_d_C_prim_labelingWith
strategy
vs
(
C
P
.
Choices_OP_List
_
j
@
(
FreeID
_
_
)
_
)
cd
cs
=
external_d_C_prim_labelingWith
::
C_LabelingStrategy
->
C
urry_Prelude
.
OP_List
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
OP_List
Curry_Prelude
.
C_Int
->
Cover
->
ConstStore
->
C
urry_Prelude
.
C_Success
external_d_C_prim_labelingWith
_
C
urry_Prelude
.
OP_List
_
cd
cs
=
C
urry_Prelude
.
d_C_failed
cd
cs
external_d_C_prim_labelingWith
strategy
vs
(
C
urry_Prelude
.
Choices_OP_List
_
j
@
(
FreeID
_
_
)
_
)
cd
cs
=
mkGuardExt
cd
[
wrapCs
(
FDLabeling
(
fromCurry
strategy
)
(
toFDList
vs
)
j
)]
C_Success
newArithConstr
::
ArithOp
->
C
P
.
C_Int
->
CP
.
C_Int
->
CP
.
C_Int
->
FDConstraint
newArithConstr
::
ArithOp
->
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
FDConstraint
newArithConstr
arithOp
x
y
result
=
FDArith
arithOp
(
toCsExpr
x
)
(
toCsExpr
y
)
(
toCsExpr
result
)
newRelConstr
::
RelOp
->
C
P
.
C_Int
->
CP
.
C_Int
->
FDConstraint
newRelConstr
::
RelOp
->
C
urry_Prelude
.
C_Int
->
Curry_Prelude
.
C_Int
->
FDConstraint
newRelConstr
relOp
x
y
=
FDRel
relOp
(
toCsExpr
x
)
(
toCsExpr
y
)
-- Conversion between Curry-LabelingStrategy and Haskell-LabelingStrategy
...
...
@@ -101,10 +103,10 @@ instance ConvertCurryHaskell C_LabelingStrategy LabelingStrategy where
fromCurry
_
=
error
"KiCS2 error: LabelingStrategy data with no ground term"
-- Convert to haskell list by converting list elements with given function
toHaskellList
::
(
a
->
b
)
->
C
P
.
OP_List
a
->
[
b
]
toHaskellList
_
C
P
.
OP_List
=
[]
toHaskellList
f
(
C
P
.
OP_Cons
x
xs
)
=
f
x
:
toHaskellList
f
xs
toHaskellList
::
(
a
->
b
)
->
C
urry_Prelude
.
OP_List
a
->
[
b
]
toHaskellList
_
C
urry_Prelude
.
OP_List
=
[]
toHaskellList
f
(
C
urry_Prelude
.
OP_Cons
x
xs
)
=
f
x
:
toHaskellList
f
xs
-- helper function to convert curry integer lists to lists of fd terms
toFDList
::
Constrainable
a
b
=>
C
P
.
OP_List
a
->
[
b
]
toFDList
::
Constrainable
a
b
=>
C
urry_Prelude
.
OP_List
a
->
[
b
]
toFDList
=
toHaskellList
toCsExpr
External_CLPFD2.hs
View file @
dad4d07d
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
...
...
@@ -7,7 +8,6 @@ import qualified Data.Map as Map
import
qualified
Data.Set
as
Set
import
Text.Show
(
showListWith
)
import
Curry_Prelude
import
Debug
(
internalError
)
import
qualified
Control.CP.ComposableTransformers
as
MCP
(
solve
)
...
...
@@ -155,23 +155,23 @@ instance Unifiable C_FDExpr where
lazyBind
=
internalError
"lazyBind for FDExpr is undefined"
fromDecision
_
_
_
=
error
"fromDecision for FDExpr is undefined"
instance
Curry
C_FDExpr
where
(
=?=
)
(
Choice_C_FDExpr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
=?=
z
)
d
)
cs
)
(((
y
=?=
z
)
d
)
cs
)
(
=?=
)
(
Choices_C_FDExpr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
=?=
y
)
d
)
cs
)
xs
(
=?=
)
(
Guard_C_FDExpr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
=?=
y
)
d
)
(
addCs
c
cs
))
instance
Curry
_Prelude
.
Curry
C_FDExpr
where
(
=?=
)
(
Choice_C_FDExpr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
Curry_Prelude
.
=?=
z
)
d
)
cs
)
(((
y
Curry_Prelude
.
=?=
z
)
d
)
cs
)
(
=?=
)
(
Choices_C_FDExpr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
Curry_Prelude
.
=?=
y
)
d
)
cs
)
xs
(
=?=
)
(
Guard_C_FDExpr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
Curry_Prelude
.
=?=
y
)
d
)
(
addCs
c
cs
))
(
=?=
)
(
Fail_C_FDExpr
cd
info
)
_
_
_
=
failCons
cd
info
(
=?=
)
z
(
Choice_C_FDExpr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
=?=
x
)
d
)
cs
)
(((
z
=?=
y
)
d
)
cs
)
(
=?=
)
y
(
Choices_C_FDExpr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
=?=
x
)
d
)
cs
)
xs
(
=?=
)
y
(
Guard_C_FDExpr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
=?=
e
)
d
)
(
addCs
c
cs
))
(
=?=
)
z
(
Choice_C_FDExpr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
Curry_Prelude
.
=?=
x
)
d
)
cs
)
(((
z
Curry_Prelude
.
=?=
y
)
d
)
cs
)
(
=?=
)
y
(
Choices_C_FDExpr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
Curry_Prelude
.
=?=
x
)
d
)
cs
)
xs
(
=?=
)
y
(
Guard_C_FDExpr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
Curry_Prelude
.
=?=
e
)
d
)
(
addCs
c
cs
))
(
=?=
)
_
(
Fail_C_FDExpr
cd
info
)
_
_
=
failCons
cd
info
(
=?=
)
x
y
_
_
=
toCurry
(
x
==
y
)
(
<?=
)
(
Choice_C_FDExpr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
<?=
z
)
d
)
cs
)
(((
y
<?=
z
)
d
)
cs
)
(
<?=
)
(
Choices_C_FDExpr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
<?=
y
)
d
)
cs
)
xs
(
<?=
)
(
Guard_C_FDExpr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
<?=
y
)
d
)
(
addCs
c
cs
))
(
<?=
)
(
Choice_C_FDExpr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
Curry_Prelude
.
<?=
z
)
d
)
cs
)
(((
y
Curry_Prelude
.
<?=
z
)
d
)
cs
)
(
<?=
)
(
Choices_C_FDExpr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
Curry_Prelude
.
<?=
y
)
d
)
cs
)
xs
(
<?=
)
(
Guard_C_FDExpr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
Curry_Prelude
.
<?=
y
)
d
)
(
addCs
c
cs
))
(
<?=
)
(
Fail_C_FDExpr
cd
info
)
_
_
_
=
failCons
cd
info
(
<?=
)
z
(
Choice_C_FDExpr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
<?=
x
)
d
)
cs
)
(((
z
<?=
y
)
d
)
cs
)
(
<?=
)
y
(
Choices_C_FDExpr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
<?=
x
)
d
)
cs
)
xs
(
<?=
)
y
(
Guard_C_FDExpr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
<?=
e
)
d
)
(
addCs
c
cs
))
(
<?=
)
z
(
Choice_C_FDExpr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
Curry_Prelude
.
<?=
x
)
d
)
cs
)
(((
z
Curry_Prelude
.
<?=
y
)
d
)
cs
)
(
<?=
)
y
(
Choices_C_FDExpr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
Curry_Prelude
.
<?=
x
)
d
)
cs
)
xs
(
<?=
)
y
(
Guard_C_FDExpr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
Curry_Prelude
.
<?=
e
)
d
)
(
addCs
c
cs
))
(
<?=
)
_
(
Fail_C_FDExpr
cd
info
)
_
_
=
failCons
cd
info
(
<?=
)
x
y
_
_
=
toCurry
(
x
<=
y
)
...
...
@@ -311,23 +311,23 @@ instance Unifiable C_FDConstr where
lazyBind
=
internalError
"lazyBind for FDConstr is undefined"
fromDecision
_
_
_
=
error
"fromDecision for FDConstr is undefined"
instance
Curry
C_FDConstr
where
(
=?=
)
(
Choice_C_FDConstr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
=?=
z
)
d
)
cs
)
(((
y
=?=
z
)
d
)
cs
)
(
=?=
)
(
Choices_C_FDConstr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
=?=
y
)
d
)
cs
)
xs
(
=?=
)
(
Guard_C_FDConstr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
=?=
y
)
d
)
(
addCs
c
cs
))
instance
Curry
_Prelude
.
Curry
C_FDConstr
where
(
=?=
)
(
Choice_C_FDConstr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
Curry_Prelude
.
=?=
z
)
d
)
cs
)
(((
y
Curry_Prelude
.
=?=
z
)
d
)
cs
)
(
=?=
)
(
Choices_C_FDConstr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
Curry_Prelude
.
=?=
y
)
d
)
cs
)
xs
(
=?=
)
(
Guard_C_FDConstr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
Curry_Prelude
.
=?=
y
)
d
)
(
addCs
c
cs
))
(
=?=
)
(
Fail_C_FDConstr
cd
info
)
_
_
_
=
failCons
cd
info
(
=?=
)
z
(
Choice_C_FDConstr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
=?=
x
)
d
)
cs
)
(((
z
=?=
y
)
d
)
cs
)
(
=?=
)
y
(
Choices_C_FDConstr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
=?=
x
)
d
)
cs
)
xs
(
=?=
)
y
(
Guard_C_FDConstr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
=?=
e
)
d
)
(
addCs
c
cs
))
(
=?=
)
z
(
Choice_C_FDConstr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
Curry_Prelude
.
=?=
x
)
d
)
cs
)
(((
z
Curry_Prelude
.
=?=
y
)
d
)
cs
)
(
=?=
)
y
(
Choices_C_FDConstr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
Curry_Prelude
.
=?=
x
)
d
)
cs
)
xs
(
=?=
)
y
(
Guard_C_FDConstr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
Curry_Prelude
.
=?=
e
)
d
)
(
addCs
c
cs
))
(
=?=
)
_
(
Fail_C_FDConstr
cd
info
)
_
_
=
failCons
cd
info
(
=?=
)
x
y
_
_
=
toCurry
(
x
==
y
)
(
<?=
)
(
Choice_C_FDConstr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
<?=
z
)
d
)
cs
)
(((
y
<?=
z
)
d
)
cs
)
(
<?=
)
(
Choices_C_FDConstr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
<?=
y
)
d
)
cs
)
xs
(
<?=
)
(
Guard_C_FDConstr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
<?=
y
)
d
)
(
addCs
c
cs
))
(
<?=
)
(
Choice_C_FDConstr
cd
i
x
y
)
z
d
cs
=
narrow
cd
i
(((
x
Curry_Prelude
.
<?=
z
)
d
)
cs
)
(((
y
Curry_Prelude
.
<?=
z
)
d
)
cs
)
(
<?=
)
(
Choices_C_FDConstr
cd
i
xs
)
y
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
x
Curry_Prelude
.
<?=
y
)
d
)
cs
)
xs
(
<?=
)
(
Guard_C_FDConstr
cd
c
e
)
y
d
cs
=
guardCons
cd
c
(((
e
Curry_Prelude
.
<?=
y
)
d
)
(
addCs
c
cs
))
(
<?=
)
(
Fail_C_FDConstr
cd
info
)
_
_
_
=
failCons
cd
info
(
<?=
)
z
(
Choice_C_FDConstr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
<?=
x
)
d
)
cs
)
(((
z
<?=
y
)
d
)
cs
)
(
<?=
)
y
(
Choices_C_FDConstr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
<?=
x
)
d
)
cs
)
xs
(
<?=
)
y
(
Guard_C_FDConstr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
<?=
e
)
d
)
(
addCs
c
cs
))
(
<?=
)
z
(
Choice_C_FDConstr
cd
i
x
y
)
d
cs
=
narrow
cd
i
(((
z
Curry_Prelude
.
<?=
x
)
d
)
cs
)
(((
z
Curry_Prelude
.
<?=
y
)
d
)
cs
)
(
<?=
)
y
(
Choices_C_FDConstr
cd
i
xs
)
d
cs
=
narrows
cs
cd
i
(
\
x
->
((
y
Curry_Prelude
.
<?=
x
)
d
)
cs
)
xs
(
<?=
)
y
(
Guard_C_FDConstr
cd
c
e
)
d
cs
=
guardCons
cd
c
(((
y
Curry_Prelude
.
<?=
e
)
d
)
(
addCs
c
cs
))
(
<?=
)
_
(
Fail_C_FDConstr
cd
info
)
_
_
=
failCons
cd
info
(
<?=
)
x
y
_
_
=
toCurry
(
x
<=
y
)
...
...
@@ -479,15 +479,15 @@ data Domain = Range Int Int
deriving
(
Eq
,
Ord
,
Show
)
external_d_C_prim_FD_domain
::
C_Int
->
C_Int
->
C_Int
->
Cover
->
ConstStore
->
OP_List
C_FDExpr
->
ConstStore
->
Curry_Prelude
.
OP_List
C_FDExpr
external_d_C_prim_FD_domain
l
u
(
Choices_C_Int
_
(
FreeID
_
s
)
_
)
_
_
=
if
l'
>
u'
then
OP_List
else
newFDVars
s
if
l'
>
u'
then
Curry_Prelude
.
OP_List
else
newFDVars
s
where
l'
=
fromCurry
l
u'
=
fromCurry
u
dom
=
Range
l'
u'
newFDVars
s'
=
let
i
=
getKey
$
thisID
$
leftSupply
s'
s1
=
rightSupply
s'
in
OP_Cons
(
FDVar
i
dom
)
(
newFDVars
s1
)
in
Curry_Prelude
.
OP_Cons
(
FDVar
i
dom
)
(
newFDVars
s1
)
-- -----------------------------------------------------------------------------
-- Arithmetic FD constraints
...
...
@@ -580,14 +580,14 @@ external_d_C_prim_FD_neg c _ _ = FDNeg c
-- Global FD constraints
-- -----------------------------------------------------------------------------
external_d_C_prim_FD_sum
::
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
C_FDExpr
external_d_C_prim_FD_sum
::
Curry_Prelude
.
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
C_FDExpr
external_d_C_prim_FD_sum
xs
_
_
=
FDSum
(
fromCurry
xs
)
external_d_C_prim_FD_allDifferent
::
OP_List
C_FDExpr
->
Cover
->
ConstStore
external_d_C_prim_FD_allDifferent
::
Curry_Prelude
.
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
C_FDConstr
external_d_C_prim_FD_allDifferent
xs
_
_
=
FDAllDifferent
(
fromCurry
xs
)
external_d_C_prim_FD_sorted
::
OP_List
C_FDExpr
->
Cover
->
ConstStore
external_d_C_prim_FD_sorted
::
Curry_Prelude
.
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
C_FDConstr
external_d_C_prim_FD_sorted
xs
_
_
=
FDSorted
(
fromCurry
xs
)
...
...
@@ -595,7 +595,7 @@ external_d_C_prim_FD_sorted xs _ _ = FDSorted (fromCurry xs)
-- Access FD expression list
-- -----------------------------------------------------------------------------
external_d_C_prim_FD_at
::
OP_List
C_FDExpr
->
C_FDExpr
->
Cover
->
ConstStore
external_d_C_prim_FD_at
::
Curry_Prelude
.
OP_List
C_FDExpr
->
C_FDExpr
->
Cover
->
ConstStore
->
C_FDExpr
external_d_C_prim_FD_at
xs
e
_
_
=
FDAt
(
fromCurry
xs
)
e
...
...
@@ -615,13 +615,13 @@ external_nd_C_prim_FD_loopall :: C_FDExpr -> C_FDExpr
external_nd_C_prim_FD_loopall
from
to
constr
s
cd
cs
=
FDLoopAll
from
to
(
\
e
->
nd_apply
constr
e
s
cd
cs
)
external_d_C_prim_FD_forall
::
OP_List
C_FDExpr
external_d_C_prim_FD_forall
::
Curry_Prelude
.
OP_List
C_FDExpr
->
(
C_FDExpr
->
Cover
->
ConstStore
->
C_FDConstr
)
->
Cover
->
ConstStore
->
C_FDConstr
external_d_C_prim_FD_forall
xs
constr
cd
cs
=
FDForAll
(
fromCurry
xs
)
(
\
e
->
constr
e
cd
cs
)
external_nd_C_prim_FD_forall
::
OP_List
C_FDExpr
external_nd_C_prim_FD_forall
::
Curry_Prelude
.
OP_List
C_FDExpr
->
(
Func
C_FDExpr
C_FDConstr
)
->
IDSupply
->
Cover
->
ConstStore
->
C_FDConstr
external_nd_C_prim_FD_forall
xs
constr
s
cd
cs
...
...
@@ -809,16 +809,16 @@ genDomConstr = do
let
dom
=
(
asExpr
l
,
asExpr
u
)
return
$
forall
col
(
\
v
->
v
@:
dom
)
external_d_C_prim_solveFD
::
OP_List
C_Option
->
C_FDConstr
->
Cover
->
ConstStore
->
OP_List
(
OP_List
C_Int
)
external_d_C_prim_solveFD
::
Curry_Prelude
.
OP_List
C_Option
->
C_FDConstr
->
Cover
->
ConstStore
->
Curry_Prelude
.
OP_List
(
Curry_Prelude
.
OP_List
C_Int
)
external_d_C_prim_solveFD
opts
constr
_
_
=
let
opts'
=
getOpts
$
fromCurry
opts
solutions
=
runSolver
opts'
constr
[]
in
toCurry
solutions
external_d_C_prim_solveFDVars
::
OP_List
C_Option
->
C_FDConstr
->
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
OP_List
(
OP_List
C_Int
)
external_d_C_prim_solveFDVars
::
Curry_Prelude
.
OP_List
C_Option
->
C_FDConstr
->
Curry_Prelude
.
OP_List
C_FDExpr
->
Cover
->
ConstStore
->
Curry_Prelude
.
OP_List
(
Curry_Prelude
.
OP_List
C_Int
)
external_d_C_prim_solveFDVars
opts
constr
lvars
_
_
=
let
opts'
=
getOpts
$
fromCurry
opts
solutions
=
runSolver
opts'
constr
(
fromCurry
lvars
)
...
...
@@ -989,4 +989,4 @@ labelWith labelOpt (ColList l) = label $ do
where
getLabelFunc
C_InOrder
=
inOrder
getLabelFunc
C_FirstFail
=
firstFail
getLabelFunc
C_MiddleOut
=
middleOut
getLabelFunc
C_EndsOut
=
endsOut
\ No newline at end of file
getLabelFunc
C_EndsOut
=
endsOut
Makefile.kics2
View file @
dad4d07d
...
...
@@ -49,10 +49,10 @@ CABAL_LIBDEPS = $(call comma_sep,$(LIBDEPS))
.PHONY
:
install
install
:
.curry/kics2/Curry_$(ALLLIBS).hs $(LIB_FCY) $(LIB_ACY) $(LIB_HS) $(LIB_HS_TRACE)
$(MAKE)
$(CABAL_FILE)
$(CABAL_INSTALL)
$(CABAL_PROFILE)
$(CABAL_INSTALL
_GECODE
)
$(CABAL_PROFILE)
rm
-f
$(CABAL_FILE)
$(MAKE)
$(CABAL_TRACE_FILE)
$(CABAL_INSTALL)
$(CABAL_PROFILE)
$(CABAL_INSTALL
_GECODE
)
$(CABAL_PROFILE)
rm
-f
$(CABAL_TRACE_FILE)
# create a program importing all libraries in order to re-compile them
...
...
@@ -97,6 +97,12 @@ $(CABAL_FILE): ../Makefile Makefile
echo
"Build-Type: Simple"
>>
$@
echo
"Cabal-Version: >= 1.9.2"
>>
$@
echo
""
>>
$@
echo
"Flag Gecode"
>>
$@
echo
" Description: Include Gecode Solver for finite"
>>
$@
echo
" domain constraints. Requires a"
>>
$@
echo
" working Gecode 3.1 installation"
>>
$@
echo
" Default: False"
>>
$@
echo
""
>>
$@
echo
"Library"
>>
$@
echo
" Build-Depends:"
>>
$@
echo
" kics2-runtime ==
$(VERSION)
"
>>
$@
...
...
@@ -107,6 +113,9 @@ $(CABAL_FILE): ../Makefile Makefile
echo
" Build-Depends: unix"
>>
$@
echo
" Exposed-modules:
$(HS_LIB_NAMES)
"
>>
$@
echo
" hs-source-dirs: ./.curry/kics2, ./meta/.curry/kics2"
>>
$@
echo
" if flag(gecode)"
>>
$@
echo
" Build-Depends: monadiccp-gecode"
>>
$@
echo
" CPP-Options: -DGECODE"
>>
$@
$(CABAL_TRACE_FILE)
:
../Makefile Makefile
echo
"Name:
$(PACKAGE_TRACE)
"
>
$@
...
...
@@ -118,6 +127,12 @@ $(CABAL_TRACE_FILE): ../Makefile Makefile
echo
"Build-Type: Simple"
>>
$@
echo
"Cabal-Version: >= 1.9.2"
>>
$@
echo
""
>>
$@
echo
"Flag Gecode"
>>
$@
echo
" Description: Include Gecode Solver for finite"
>>
$@
echo
" domain constraints. Requires a"
>>
$@
echo
" working Gecode 3.1 installation"
>>
$@
echo
" Default: False"
>>
$@
echo
""
>>
$@
echo
"Library"
>>
$@
echo
" Build-Depends:"
>>
$@
echo
" kics2-runtime ==
$(VERSION)
"
>>
$@
...
...
@@ -128,6 +143,9 @@ $(CABAL_TRACE_FILE): ../Makefile Makefile
echo
" Build-Depends: unix"
>>
$@
echo
" Exposed-modules:
$(HS_LIB_TRACE_NAMES)
"
>>
$@
echo
" hs-source-dirs: ./.curry/kics2, ./meta/.curry/kics2"
>>
$@
echo
" if flag(gecode)"
>>
$@
echo
" Build-Depends: monadiccp-gecode"
>>
$@
echo
" CPP-Options: -DGECODE"
>>
$@
# generate Haskell file in subdirectory .curry/kics2
.curry/kics2/Curry_Trace_%.hs
:
%.curry
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment