Merge branch 'master' into libs_refactor

Findall.curry

@@ -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 external
 #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 external
 #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

 <?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

@@ -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 (someValue f) (findall (=:=f))
+set0 f = Values (oneValue 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 (someValue (f x)) (findall (=:=(f x)))
+set1 f x | x=:=x = Values (oneValue (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 (someValue (f x1 x2)) (findall (=:=(f x1 x2)))
+  = Values (oneValue (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 (someValue (f x1 x2 x3)) (findall (=:=(f x1 x2 x3)))
+  = Values (oneValue (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 (someValue (f x1 x2 x3 x4)) (findall (=:=(f x1 x2 x3 x4)))
+  = Values (oneValue (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 (someValue (f x1 x2 x3 x4 x5)) (findall (=:=(f x1 x2 x3 x4 x5)))
+  = Values (oneValue (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 (someValue (f x1 x2 x3 x4 x5 x6))
-           (findall (=:=(f x1 x2 x3 x4 x5 x6)))
+  = Values (oneValue (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

@@ -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]