Commit 62e9fadf authored by Michael Hanus 's avatar Michael Hanus

Base libraries packaged

parents
*~
.cpm
.curry
Copyright (c) 2011-2017, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
base: Base libraries for Curry systems
======================================
This package contains the standard base libraries of the Curry systems
PAKCS and KiCS2. These libraries are directly distributed
with specific versions of the Curry systems.
In order to use some package with one of these Curry systems but a different
set of base libraries, one can put a dependency to a specific
version of base libraries in this package.
If a package has a dependency to this `base` package, this dependency
will ignored by CPM if the Curry system actually used has the
same set of base libraries, i.e., has the same version.
One can show the version of the base libraries of PAKCS or KiCS2
by the command
> pakcs --base-version
or
> kics2 --base-version
{
"name": "base",
"version": "1.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Base libraries for Curry systems",
"description": "This package contains the base libraries which are directly distributed with specific versions of the Curry systems PAKCS and KiCS2.",
"category": [ "Programming" ],
"compilerCompatibility": {
"kics2": ">= 2.0.0, < 3.0.0",
"pakcs": ">= 2.0.0, < 3.0.0"
},
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"dependencies": {
},
"testsuite": {
"src-dir": "src",
"options": "-m100 -dInt",
"modules": [ "Combinatorial", "Nat", "ShowS", "Sort" ]
}
}
------------------------------------------------------------------------------
--- This module contains a collection of functions for
--- obtaining lists of solutions to constraints.
--- These operations are useful to encapsulate
--- non-deterministic operations between I/O actions in
--- order to connect the worlds of logic and functional programming
--- and to avoid non-determinism failures on the I/O level.
---
--- In contrast the "old" concept of encapsulated search
--- (which could be applied to any subexpression in a computation),
--- the operations to encapsulate search in this module
--- are I/O actions in order to avoid some anomalities
--- in the old concept.
---
--- @category general
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module AllSolutions
( getAllValues, getAllSolutions, getOneValue, getOneSolution
, getAllFailures
#ifdef __PAKCS__
, getSearchTree, SearchTree(..)
#endif
) where
#ifdef __PAKCS__
import Findall
#else
import SearchTree
#endif
--- Gets all values of an expression (currently, via an incomplete
--- depth-first strategy). Conceptually, all values are computed
--- on a copy of the expression, i.e., the evaluation of the expression
--- does not share any results. Moreover, the evaluation suspends
--- as long as the expression contains unbound variables.
getAllValues :: a -> IO [a]
#ifdef __PAKCS__
getAllValues e = return (findall (=:=e))
#else
getAllValues e = getSearchTree e >>= return . allValuesDFS
#endif
--- Gets one value of an expression (currently, via an incomplete
--- left-to-right strategy). Returns Nothing if the search space
--- is finitely failed.
getOneValue :: a -> IO (Maybe a)
#ifdef __PAKCS__
getOneValue x = getOneSolution (x=:=)
#else
getOneValue x = do
st <- getSearchTree x
let vals = allValuesDFS st
return (if null vals then Nothing else Just (head vals))
#endif
--- Gets all solutions to a constraint (currently, via an incomplete
--- depth-first left-to-right strategy). Conceptually, all solutions
--- are computed on a copy of the constraint, i.e., the evaluation
--- of the constraint does not share any results. Moreover, this
--- evaluation suspends if the constraints contain unbound variables.
--- Similar to Prolog's findall.
getAllSolutions :: (a->Bool) -> IO [a]
#ifdef __PAKCS__
getAllSolutions c = return (findall c)
#else
getAllSolutions c = getAllValues (let x free in (x,c x)) >>= return . map fst
#endif
--- Gets one solution to a constraint (currently, via an incomplete
--- left-to-right strategy). Returns Nothing if the search space
--- is finitely failed.
getOneSolution :: (a->Bool) -> IO (Maybe a)
getOneSolution c = do
sols <- getAllSolutions c
return (if null sols then Nothing else Just (head sols))
--- Returns a list of values that do not satisfy a given constraint.
--- @param x - an expression (a generator evaluable to various values)
--- @param c - a constraint that should not be satisfied
--- @return A list of all values of e such that (c e) is not provable
getAllFailures :: a -> (a -> Bool) -> IO [a]
getAllFailures generator test = do
xs <- getAllValues generator
failures <- mapIO (naf test) xs
return $ concat failures
-- (naf c x) returns [x] if (c x) fails, and [] otherwise.
naf :: (a -> Bool) -> a -> IO [a]
#ifdef __PAKCS__
naf c x = do
mbl <- getOneSolution (\_->c x)
return (maybe [x] (const []) mbl)
#else
naf c x = getOneSolution (lambda c x) >>= returner x
lambda :: (a -> Bool) -> a -> () -> Bool
lambda c x _ = c x
returner :: a -> Maybe b -> IO [a]
returner x mbl = return (maybe [x] (const []) mbl)
#endif
#ifdef __PAKCS__
--- A search tree for representing search structures.
data SearchTree a b = SearchBranch [(b,SearchTree a b)] | Solutions [a]
deriving (Eq,Show)
--- Computes a tree of solutions where the first argument determines
--- the branching level of the tree.
--- For each element in the list of the first argument,
--- the search tree contains a branch node with a child tree
--- for each value of this element. Moreover, evaluations of
--- elements in the branch list are shared within corresponding subtrees.
getSearchTree :: [a] -> (b -> Bool) -> IO (SearchTree b a)
getSearchTree cs goal = return (getSearchTreeUnsafe cs goal)
getSearchTreeUnsafe :: [a] -> (b -> Bool) -> (SearchTree b a)
getSearchTreeUnsafe [] goal = Solutions (findall goal)
getSearchTreeUnsafe (c:cs) goal =
SearchBranch (findall (=:=(solve c cs goal)))
solve :: a -> [a] -> (b -> Bool) -> (a,SearchTree b a)
solve c cs goal | c=:=y = (y, getSearchTreeUnsafe cs goal) where y free
#endif
<?xml version="1.0" standalone="no"?>
<!DOCTYPE primitives SYSTEM "http://www.informatik.uni-kiel.de/~pakcs/primitives.dtd">
<primitives>
<primitive name="getOneSolution" arity="1">
<library>prim_standard</library>
<entry>prim_getOneSolution[raw]</entry>
</primitive>
</primitives>
------------------------------------------------------------------------------
--- Library for formatted output on terminals
---
--- Information on ANSI Codes can be found at
--- http://en.wikipedia.org/wiki/ANSI_escape_code
---
--- @author Sebastian Fischer, Bjoern Peemoeller
--- @version March 2015
--- @category general
------------------------------------------------------------------------------
module AnsiCodes
( -- cursor movement
cursorPos
, cursorHome
, cursorUp
, cursorDown
, cursorFwd
, cursorBack
, saveCursor
, restoreCursor
-- graphics control
, clear
, eraseLine
-- formatting output
, normal
, bold
, faint
, italic
, underline
, blinkSlow
, blinkRapid
, inverse
, concealed
, crossedout
-- foreground color
, black
, red
, green
, yellow
, blue
, cyan
, magenta
, white
, fgDefault
-- background color
, bgBlack
, bgRed
, bgGreen
, bgYellow
, bgBlue
, bgCyan
, bgMagenta
, bgWhite
, bgDefault
) where
import List (isSuffixOf)
-- -----------------------------------------------------------------------------
-- Cursor movement
-- -----------------------------------------------------------------------------
--- move cursor to position
cursorPos :: Int -> Int -> String
cursorPos r c = cmd (show r ++ ";" ++ show c ++ "H")
--- move cursor to home position
cursorHome :: String
cursorHome = cmd "H"
--- move cursor n lines up
cursorUp :: Int -> String
cursorUp = moveCursor "A"
--- move cursor n lines down
cursorDown :: Int -> String
cursorDown = moveCursor "B"
--- move cursor n columns forward
cursorFwd :: Int -> String
cursorFwd = moveCursor "C"
--- move cursor n columns backward
cursorBack :: Int -> String
cursorBack = moveCursor "D"
--- save cursor position
saveCursor :: String
saveCursor = cmd "s"
--- restore saved cursor position
restoreCursor :: String
restoreCursor = cmd "u"
-- -----------------------------------------------------------------------------
-- Graphics control
-- -----------------------------------------------------------------------------
--- clear screen
clear :: String
clear = cmd "2J"
--- erase line
eraseLine :: String
eraseLine = cmd "K"
-- -----------------------------------------------------------------------------
-- Text formatting
-- -----------------------------------------------------------------------------
--- Reset formatting to normal formatting
normal :: String -> String
normal = mode 0
--- Bold text
bold :: String -> String
bold = mode 1
--- Faint text
faint :: String -> String
faint = mode 2
--- Italic text
italic :: String -> String
italic = mode 3
--- Underlined text
underline :: String -> String
underline = mode 4
--- Slowly blinking text
blinkSlow :: String -> String
blinkSlow = mode 5
--- rapidly blinking text
blinkRapid :: String -> String
blinkRapid = mode 6
--- Inverse colors
inverse :: String -> String
inverse = mode 7
--- Concealed (invisible) text
concealed :: String -> String
concealed = mode 8
--- Crossed out text
crossedout :: String -> String
crossedout = mode 9
-- -----------------------------------------------------------------------------
-- Foreground color
-- -----------------------------------------------------------------------------
--- Black foreground color
black :: String -> String
black = mode 30
--- Red foreground color
red :: String -> String
red = mode 31
--- Green foreground color
green :: String -> String
green = mode 32
--- Yellow foreground color
yellow :: String -> String
yellow = mode 33
--- Blue foreground color
blue :: String -> String
blue = mode 34
--- Magenta foreground color
magenta :: String -> String
magenta = mode 35
--- Cyan foreground color
cyan :: String -> String
cyan = mode 36
--- White foreground color
white :: String -> String
white = mode 37
--- Default foreground color
fgDefault :: String -> String
fgDefault = mode 39
-- -----------------------------------------------------------------------------
-- Background color
-- -----------------------------------------------------------------------------
--- Black background color
bgBlack :: String -> String
bgBlack = mode 40
--- Red background color
bgRed :: String -> String
bgRed = mode 41
--- Green background color
bgGreen :: String -> String
bgGreen = mode 42
--- Yellow background color
bgYellow :: String -> String
bgYellow = mode 43
--- Blue background color
bgBlue :: String -> String
bgBlue = mode 44
--- Magenta background color
bgMagenta :: String -> String
bgMagenta = mode 45
--- Cyan background color
bgCyan :: String -> String
bgCyan = mode 46
--- White background color
bgWhite :: String -> String
bgWhite = mode 47
--- Default background color
bgDefault :: String -> String
bgDefault = mode 49
-- -----------------------------------------------------------------------------
-- Helper functions
-- -----------------------------------------------------------------------------
--- Cursor movements
moveCursor :: String -> Int -> String
moveCursor s n = cmd (show n ++ s)
--- Text mode
mode :: Int -> String -> String
mode n s = cmd (show n ++ "m") ++ s ++ if end `isSuffixOf` s then "" else end
where end = cmd "0m"
--- Create a command using the CSI (control sequence introducer) "\ESC["
cmd :: String -> String
cmd s = '\ESC' : '[' : s
--- Implementation of Arrays with Braun Trees. Conceptually, Braun trees
--- are always infinite. Consequently, there is no test on emptiness.
---
--- @authors {bbr, fhu}@informatik.uni-kiel.de
--- @category algorithm
module Array
(Array,
emptyErrorArray, emptyDefaultArray,
listToDefaultArray,listToErrorArray,
(//), update, applyAt,
(!),
combine, combineSimilar)
where
import Integer
infixl 9 !, //
data Array b = Array (Int -> b) (Entry b)
data Entry b = Entry b (Entry b) (Entry b) | Empty
--- Creates an empty array which generates errors for non-initialized
--- indexes.
emptyErrorArray :: Array b
emptyErrorArray = emptyDefaultArray errorArray
errorArray :: Int -> _
errorArray idx = error ("Array index "++show idx++" not initialized")
--- Creates an empty array, call given function for non-initialized
--- indexes.
--- @param default - function to call for each non-initialized index
emptyDefaultArray :: (Int -> b) -> Array b
emptyDefaultArray dflt = Array dflt Empty
--- Inserts a list of entries into an array.
--- @param array - array to modify
--- @param modifications - list of new (indexes,entries)
--- If an index in the list was already initialized, the old value
--- will be overwritten. Likewise the last entry with a given index
--- will be contained in the result array.
(//) :: Array b -> [(Int,b)] -> Array b
(//) (Array dflt array) modifications =
Array dflt
(foldr (\ (n,v) a -> at (dflt n) a n (const v)) array modifications)
--- Inserts a new entry into an array.
--- @param array - array to modify
--- @param idx - index of update
--- @param val - value to update at index idx
--- Entries already initialized will be overwritten.
update :: Array b -> Int -> b -> Array b
update (Array dflt a) i v =
Array dflt (at (dflt i) a i (const v))
--- Applies a function to an element.
--- @param array - array to modify
--- @param idx - index of update
--- @param fun - function to apply on element at index idx
applyAt :: Array b -> Int -> (b->b) -> Array b
applyAt (Array dflt a) n f = Array dflt (at (dflt n) a n f)
at :: b -> Entry b -> Int -> (b -> b) -> Entry b
at dflt Empty n f
| n==0 = Entry (f dflt) Empty Empty
| odd n = Entry dflt (at dflt Empty (n `div` 2) f) Empty
| otherwise = Entry dflt Empty (at dflt Empty (n `div` 2 - 1) f)
at dflt (Entry v al ar) n f
| n==0 = Entry (f v) al ar
| odd n = Entry v (at dflt al (n `div` 2) f) ar
| otherwise = Entry v al (at dflt ar (n `div` 2 - 1) f)
--- Yields the value at a given position.
--- @param a - array to look up in
--- @param n - index, where to look
(!) :: Array b -> Int -> b
(Array dflt array) ! i = from (dflt i) array i
from :: a -> Entry a -> Int -> a
from dflt Empty _ = dflt
from dflt (Entry v al ar) n
| n==0 = v
| odd n = from dflt al (n `div` 2)
| otherwise = from dflt ar (n `div` 2 - 1)
split :: [a] -> ([a],[a])
split [] = ([],[])
split [x] = ([x],[])
split (x:y:xys) = let (xs,ys) = split xys in
(x:xs,y:ys)
--- Creates a default array from a list of entries.
--- @param def - default funtion for non-initialized indexes
--- @param xs - list of entries
listToDefaultArray :: (Int -> b) -> [b] -> Array b
listToDefaultArray def = Array def . listToArray
--- Creates an error array from a list of entries.
--- @param xs - list of entries
listToErrorArray :: [b] -> Array b
listToErrorArray = listToDefaultArray errorArray
listToArray :: [b] -> Entry b
listToArray [] = Empty
listToArray (x:xs) = let (ys,zs) = split xs in
Entry x (listToArray ys)
(listToArray zs)
--- combine two arbitrary arrays
combine :: (a -> b -> c) -> Array a -> Array b -> Array c
combine f (Array def1 a1) (Array def2 a2) =
Array (\i -> f (def1 i) (def2 i)) (comb f def1 def2 a1 a2 0 1)
comb :: (a -> b -> c) -> (Int -> a) -> (Int -> b)
-> Entry a -> Entry b -> Int -> Int -> Entry c
comb _ _ _ Empty Empty _ _ = Empty
comb f def1 def2 (Entry x xl xr) Empty b o =
Entry (f x (def2 (b+o-1)))
(comb f def1 def2 xl Empty (2*b) o)
(comb f def1 def2 xr Empty (2*b) (o+b))
comb f def1 def2 Empty (Entry y yl yr) b o =
Entry (f (def1 (b+o-1)) y)
(comb f def1 def2 Empty yl (2*b) o)
(comb f def1 def2 Empty yr (2*b) (o+b))
comb f def1 def2 (Entry x xl xr) (Entry y yl yr) b o =
Entry (f x y)
(comb f def1 def2 xl yl (2*b) o)
(comb f def1 def2 xr yr (2*b) (o+b))
--- the combination of two arrays with identical default function
--- and a combinator which is neutral in the default
--- can be implemented much more efficient
combineSimilar :: (a -> a -> a) -> Array a -> Array a -> Array a
combineSimilar f (Array def a1) (Array _ a2) = Array def (combSim f a1 a2)
combSim :: (a -> a -> a) -> Entry a -> Entry a -> Entry a
combSim _ Empty a2 = a2
combSim _ (Entry x y z) Empty = Entry x y z
combSim f (Entry x xl xr) (Entry y yl yr) =
Entry (f x y) (combSim f xl yl) (combSim f xr yr)
This diff is collapsed.
------------------------------------------------------------------------------
--- Library with some useful functions on characters.
---
--- @author Michael Hanus, Bjoern Peemoeller
--- @version January 2015
--- @category general
------------------------------------------------------------------------------
module Char
( isAscii, isLatin1, isAsciiUpper, isAsciiLower, isControl
, isUpper, isLower, isAlpha, isDigit, isAlphaNum
, isBinDigit, isOctDigit, isHexDigit, isSpace
, toUpper, toLower, digitToInt, intToDigit
) where