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
0bc804f5
Commit
0bc804f5
authored
Oct 24, 2018
by
Kai-Oliver Prott
Browse files
Merge branch 'master' into libs_refactor
parents
38e0abe0
deafaa9e
Changes
4
Hide whitespace changes
Inline
Side-by-side
Findall.curry
View file @
0bc804f5
...
...
@@ -11,7 +11,7 @@
--- in order to support a more portable standard prelude.
---
--- @author Michael Hanus
--- @version
July
2018
--- @version
September
2018
--- @category general
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
...
...
@@ -19,7 +19,7 @@
module Findall
( getAllValues, getSomeValue
, allValues, someValue
, allValues, someValue
, oneValue
, allSolutions, someSolution
, isFail
#ifdef __PAKCS__
...
...
@@ -62,7 +62,7 @@ getSomeValue e = return (someValue e)
--- of the computed values depends on the ordering of the program rules.
allValues :: a -> [a]
#ifdef __PAKCS__
allValues e
= findall (\x -> x=:=e)
allValues e
xternal
#else
allValues e = ST.allValuesDFS (ST.someSearchTree e)
#endif
...
...
@@ -80,11 +80,31 @@ allValues e = ST.allValuesDFS (ST.someSearchTree e)
--- has a single value.
someValue :: a -> a
#ifdef __PAKCS__
someValue e
= findfirst (=:=e)
someValue e
xternal
#else
someValue = ST.someValueWith ST.dfsStrategy
#endif
--- Returns just one value for an expression (currently, via an incomplete
--- depth-first strategy). If the expression has no value, `Nothing`
--- is returned. Conceptually, the value is computed on a copy
--- of the expression, i.e., the evaluation of the expression does not share
--- any results. In PAKCS, the evaluation suspends as long as the expression
--- contains unbound variables.
---
--- Note that this operation is not purely declarative since
--- the computed value depends on the ordering of the program rules.
--- Thus, this operation should be used only if the expression
--- has a single value.
oneValue :: a -> Maybe a
#ifdef __PAKCS__
oneValue external
#else
oneValue x =
let vals = ST.allValuesWith ST.dfsStrategy (ST.someSearchTree x)
in (if null vals then Nothing else Just (head vals))
#endif
--- Returns all values satisfying a predicate, i.e., all arguments such that
--- the predicate applied to the argument can be evaluated to `True`
--- (currently, via an incomplete depth-first strategy).
...
...
@@ -208,13 +228,13 @@ best g cmp = bestHelp [] (try g) []
--- the values from the lambda-abstractions.
--- Similar to Prolog's findall.
findall :: (a -> Bool) -> [a]
findall
g = map unpack (solveAll g)
findall
external
--- Gets the first solution via a depth-first strategy
--- and unpack the values from the search goals.
findfirst :: (a -> Bool) -> a
findfirst
g = head (findall g)
findfirst
external
--- Shows the solution of a solved constraint.
browse :: Show a => (a -> Bool) -> IO ()
...
...
Findall.pakcs
View file @
0bc804f5
<?xml version="1.0" standalone="no"?>
<!DOCTYPE primitives SYSTEM "http://www.informatik.uni-kiel.de/~pakcs/primitives.dtd">
<primitives>
<primitive
name=
"allValues"
arity=
"1"
>
<library>
prim_standard
</library>
<entry>
prim_allValues[raw]
</entry>
</primitive>
<primitive
name=
"someValue"
arity=
"1"
>
<library>
prim_standard
</library>
<entry>
prim_someValue[raw]
</entry>
</primitive>
<primitive
name=
"oneValue"
arity=
"1"
>
<library>
prim_standard
</library>
<entry>
prim_oneValue[raw]
</entry>
</primitive>
<primitive
name=
"findall"
arity=
"1"
>
<library>
prim_standard
</library>
<entry>
prim_findall[raw]
</entry>
...
...
SetFunctions.curry
View file @
0bc804f5
...
...
@@ -46,10 +46,11 @@
--- the set functions itself will be evaluated.
---
--- @author Michael Hanus, Fabian Reck
--- @version
January
2018
--- @version
September
2018
--- @category general
------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
module SetFunctions
(set0, set1, set2, set3, set4, set5, set6, set7
...
...
@@ -77,31 +78,31 @@ import SearchTree
------------------------------------------------------------------------
--- Combinator to transform a 0-ary function into a corresponding set function.
set0 :: b -> Values b
set0 f = Values (
som
eValue f) (
findall (=:=
f)
)
set0 f = Values (
on
eValue f) (
allValues
f)
--- Combinator to transform a unary function into a corresponding set function.
set1 :: (a1 -> b) -> a1 -> Values b
set1 f x | x=:=x = Values (
som
eValue (f x)) (
findall (=:=
(f x))
)
set1 f x | x=:=x = Values (
on
eValue (f x)) (
allValues
(f x))
--- Combinator to transform a binary function into a corresponding set function.
set2 :: (a1 -> a2 -> b) -> a1 -> a2 -> Values b
set2 f x1 x2
| x1=:=x1 & x2=:=x2
= Values (
som
eValue (f x1 x2)) (
findall (=:=
(f x1 x2))
)
= Values (
on
eValue (f x1 x2)) (
allValues
(f x1 x2))
--- Combinator to transform a function of arity 3
--- into a corresponding set function.
set3 :: (a1 -> a2 -> a3 -> b) -> a1 -> a2 -> a3 -> Values b
set3 f x1 x2 x3
| x1=:=x1 & x2=:=x2 & x3=:=x3
= Values (
som
eValue (f x1 x2 x3)) (
findall (=:=
(f x1 x2 x3))
)
= Values (
on
eValue (f x1 x2 x3)) (
allValues
(f x1 x2 x3))
--- Combinator to transform a function of arity 4
--- into a corresponding set function.
set4 :: (a1 -> a2 -> a3 -> a4 -> b) -> a1 -> a2 -> a3 -> a4 -> Values b
set4 f x1 x2 x3 x4
| x1=:=x1 & x2=:=x2 & x3=:=x3 & x4=:=x4
= Values (
som
eValue (f x1 x2 x3 x4)) (
findall (=:=
(f x1 x2 x3 x4))
)
= Values (
on
eValue (f x1 x2 x3 x4)) (
allValues
(f x1 x2 x3 x4))
--- Combinator to transform a function of arity 5
--- into a corresponding set function.
...
...
@@ -109,7 +110,7 @@ set5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> b)
-> a1 -> a2 -> a3 -> a4 -> a5 -> Values b
set5 f x1 x2 x3 x4 x5
| x1=:=x1 & x2=:=x2 & x3=:=x3 & x4=:=x4 & x5=:=x5
= Values (
som
eValue (f x1 x2 x3 x4 x5)) (
findall (=:=
(f x1 x2 x3 x4 x5))
)
= Values (
on
eValue (f x1 x2 x3 x4 x5)) (
allValues
(f x1 x2 x3 x4 x5))
--- Combinator to transform a function of arity 6
--- into a corresponding set function.
...
...
@@ -117,8 +118,8 @@ set6 :: (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> b)
-> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> Values b
set6 f x1 x2 x3 x4 x5 x6
| x1=:=x1 & x2=:=x2 & x3=:=x3 & x4=:=x4 & x5=:=x5 & x6=:=x6
= Values (
som
eValue (f x1 x2 x3 x4 x5 x6))
(
findall (=:=
(f x1 x2 x3 x4 x5 x6))
)
= Values (
on
eValue (f x1 x2 x3 x4 x5 x6))
(
allValues
(f x1 x2 x3 x4 x5 x6))
--- Combinator to transform a function of arity 7
--- into a corresponding set function.
...
...
@@ -126,20 +127,8 @@ set7 :: (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> b)
-> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> Values b
set7 f x1 x2 x3 x4 x5 x6 x7
| x1=:=x1 & x2=:=x2 & x3=:=x3 & x4=:=x4 & x5=:=x5 & x6=:=x6 & x7=:=x7
= Values (someValue (f x1 x2 x3 x4 x5 x6 x7))
(findall (=:=(f x1 x2 x3 x4 x5 x6 x7)))
------------------------------------------------------------------------
-- Auxiliaries:
--- Computes some value of a given expression.
--- This implementation is specific to PAKCS in order to
--- to implement `notEmpty` and `selectValue` efficiently and
--- also for possibly infinite result sets.
someValue :: a -> Maybe a
someValue e =
let xs = findall (=:= (findfirst (=:=e)))
in if null xs then Nothing else Just (head xs)
= Values (oneValue (f x1 x2 x3 x4 x5 x6 x7))
(allValues (f x1 x2 x3 x4 x5 x6 x7))
------------------------------------------------------------------------
#else
...
...
Sort.curry
View file @
0bc804f5
...
...
@@ -62,7 +62,8 @@ permSort = permSortBy (<=)
--- of the input. This is not a usable way to sort a list but it can be used
--- as a specification of other sorting algorithms.
permSortBy :: Eq a => (a -> a -> Bool) -> [a] -> [a]
permSortBy leq xs | ys == perm xs && sortedBy leq ys = ys where ys free
permSortBy leq xs | sortedBy leq ys = ys
where ys = perm xs
--- Computes a permutation of a list.
perm :: [a] -> [a]
...
...
Write
Preview
Markdown
is supported
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