Commit 3a437f95 authored by Michael Hanus 's avatar Michael Hanus

Distribution, Findall, SetFunctions updated according to current lib-trunk version

parent 36bd2bb5
......@@ -4,12 +4,13 @@
--- compiler version, load paths, front end.
---
--- @author Bernd Brassel, Michael Hanus, Bjoern Peemoeller, Finn Teegen
--- @version July 2017
--- @version November 2018
--- @category general
--------------------------------------------------------------------------------
module Distribution (
curryCompiler, curryCompilerMajorVersion, curryCompilerMinorVersion,
curryCompilerRevisionVersion,
curryRuntime, curryRuntimeMajorVersion, curryRuntimeMinorVersion,
baseVersion, installDir, stripCurrySuffix, modNameToPath,
currySubdir, inCurrySubdir, addCurrySubdir,
......@@ -67,6 +68,10 @@ curryCompilerMajorVersion external
curryCompilerMinorVersion :: Int
curryCompilerMinorVersion external
--- The revision version number of the Curry compiler.
curryCompilerRevisionVersion :: Int
curryCompilerRevisionVersion external
--- The name of the run-time environment (e.g., "sicstus", "swi", or "ghc")
curryRuntime :: String
curryRuntime external
......@@ -274,7 +279,8 @@ lookupModuleSource loadpath mod = lookupSourceInPath loadpath
--- @cons HTML - colored HTML representation of source program
--- @cons CY - source representation employed by the frontend
--- @cons TOKS - token stream of source program
data FrontendTarget = FCY | TFCY | FINT | ACY | UACY | HTML | CY | TOKS
--- @cons TAFC - type-annotated Flat Curry file ending with .tafcy
data FrontendTarget = FCY | TFCY | FINT | ACY | UACY | HTML | CY | TOKS | TAFCY
deriving Eq
--- Abstract data type for representing parameters supported by the front end
......@@ -466,14 +472,15 @@ callFrontendWithParams target params modpath = do
quote s = '"' : s ++ "\""
showFrontendTarget FCY = "--flat"
showFrontendTarget TFCY = "--typed-flat"
showFrontendTarget FINT = "--flat"
showFrontendTarget ACY = "--acy"
showFrontendTarget UACY = "--uacy"
showFrontendTarget HTML = "--html"
showFrontendTarget CY = "--parse-only"
showFrontendTarget TOKS = "--tokens"
showFrontendTarget FCY = "--flat"
showFrontendTarget TFCY = "--typed-flat"
showFrontendTarget TAFCY = "--type-annotated-flat"
showFrontendTarget FINT = "--flat"
showFrontendTarget ACY = "--acy"
showFrontendTarget UACY = "--uacy"
showFrontendTarget HTML = "--html"
showFrontendTarget CY = "--parse-only"
showFrontendTarget TOKS = "--tokens"
showFrontendParams = unwords
[ if quiet params then runQuiet else ""
......
......@@ -9,6 +9,9 @@ external_d_C_curryCompilerMajorVersion _ _ = toCurry I.majorVersion
external_d_C_curryCompilerMinorVersion :: Cover -> ConstStore -> Curry_Prelude.C_Int
external_d_C_curryCompilerMinorVersion _ _ = toCurry I.minorVersion
external_d_C_curryCompilerRevisionVersion :: Cover -> ConstStore -> Curry_Prelude.C_Int
external_d_C_curryCompilerRevisionVersion _ _ = toCurry I.revisionVersion
external_d_C_curryRuntime :: Cover -> ConstStore -> Curry_Prelude.C_String
external_d_C_curryRuntime _ _ = toCurry I.runtime
......
......@@ -13,6 +13,10 @@
<library>prim_distribution</library>
<entry>prim_curryCompilerMinorVersion</entry>
</primitive>
<primitive name="curryCompilerRevisionVersion" arity="0">
<library>prim_distribution</library>
<entry>prim_curryCompilerRevisionVersion</entry>
</primitive>
<primitive name="curryRuntime" arity="0">
<library>prim_distribution</library>
<entry>prim_curryRuntime</entry>
......
......@@ -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 ()
......
<?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>
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment