Examples
Factorial
A simple example that is often used to demonstrate thefactorial
) ''has type'' (::
) ''from integer to integer'' (Integer -> Integer
). That is, it takes an integer as an argument, and returns another integer. The type of a definition is product
function from the Prelude, a number of small functions analogous to C's ..n/nowiki>
denotes the arithmetic sequence in list form. Using the Prelude function enumFromTo
, the expression ..n/nowiki>
can be written as enumFromTo 1 n
, allowing the factorial function to be expressed as
where
or let
..in
. For example, to test the above examples and see the output 120
:
let
syntax without the in
part), and referenced later.
More complex examples
Calculator
In the Haskell source immediately below,::
can be read as "has type"; a -> b
can be read as "is a function from a to b". (Thus the Haskell calc :: String -> loat/code> can be read as "calc
has type of a function from Strings to lists of Floats".)
In the second line calc = ...
the equals sign can be read as "can be"; thus multiple lines with calc = ...
can be read as multiple possible values for calc
, depending on the circumstance detailed in each line.
A simple Reverse Polish notation
Reverse Polish notation (RPN), also known as reverse Łukasiewicz notation, Polish postfix notation or simply postfix notation, is a mathematical notation in which operators ''follow'' their operands, in contrast to prefix or Polish notation ...
calculator expressed with the higher-order function In mathematics and computer science, a higher-order function (HOF) is a function that does at least one of the following:
* takes one or more functions as arguments (i.e. a procedural parameter, which is a parameter of a procedure that is itself ...
foldl
whose argument ''f'' is defined in a ''where'' clause using pattern matching
In computer science, pattern matching is the act of checking a given sequence of tokens for the presence of the constituents of some pattern. In contrast to pattern recognition, the match usually must be exact: "either it will or will not be a ...
and the type class
In computer science, a type class is a type system construct that supports ad hoc polymorphism. This is achieved by adding constraints to type variables in parametrically polymorphic types. Such a constraint typically involves a type class T a ...
''Read'':
calc :: String -> loatcalc = foldl f [] . words
where
f (x:y:zs) "+" = (y + x):zs
f (x:y:zs) "-" = (y - x):zs
f (x:y:zs) "*" = (y * x):zs
f (x:y:zs) "/" = (y / x):zs
f (x:y:zs) "FLIP" = y:x:zs
f zs w = read w : zs
The empty list is the initial state, and ''f'' interprets one word at a time, either as a function name, taking two numbers from the head of the list and pushing the result back in, or parsing the word as a floating-point number
In computing, floating-point arithmetic (FP) is arithmetic on subsets of real numbers formed by a ''significand'' (a signed sequence of a fixed number of digits in some base) multiplied by an integer power of that base.
Numbers of this form ...
and prepending it to the list.
Fibonacci sequence
The following definition produces the list of Fibonacci numbers
In mathematics, the Fibonacci sequence is a sequence in which each element is the sum of the two elements that precede it. Numbers that are part of the Fibonacci sequence are known as Fibonacci numbers, commonly denoted . Many writers begin the s ...
in linear time:
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
The infinite list is produced by corecursion
In computer science, corecursion is a type of operation that is Dual (category theory), dual to recursion (computer science), recursion. Whereas recursion works analysis, analytically, starting on data further from a base case and breaking it dow ...
— the latter values of the list are computed on demand starting from the initial two items 0 and 1. This kind of a definition relies on lazy evaluation
In programming language theory, lazy evaluation, or call-by-need, is an evaluation strategy which delays the evaluation of an Expression (computer science), expression until its value is needed (non-strict evaluation) and which avoids repeated eva ...
, an important feature of Haskell programming. For an example of how the evaluation evolves, the following illustrates the values of ''fibs'' and ''tail fibs'' after the computation of six items and shows how ''zipWith (+)'' has produced four items and proceeds to produce the next item:
fibs = 0 : 1 : 1 : 2 : 3 : 5 : ...
+ + + + + +
tail fibs = 1 : 1 : 2 : 3 : 5 : ...
= = = = = =
zipWith ... = 1 : 2 : 3 : 5 : ''8'' : ...
fibs = 0 : 1 : 1 : 2 : 3 : 5 : ''8'' : ...
The same function, written using Glasgow Haskell Compiler
The Glasgow Haskell Compiler (GHC) is a native or machine code compiler for the functional programming language Haskell.
It provides a cross-platform software environment for writing and testing Haskell code and supports many extensions, libra ...
's parallel list comprehension syntax (GHC extensions must be enabled using a special command-line flag, here ''-XParallelListComp'', or by starting the source file with
):
fibs = 0 : 1 : a <- fibs , b <- tail fibs
or with regular list comprehension
A list comprehension is a syntactic construct available in some programming languages for creating a list based on existing lists. It follows the form of the mathematical '' set-builder notation'' (''set comprehension'') as distinct from the use o ...
s:
fibs = 0 : 1 : (a,b) <- zip fibs (tail fibs)
or directly self-referencing:
fibs = 0 : 1 : next fibs where next (a : t@(b:_)) = (a+b) : next t
With state
State most commonly refers to:
* State (polity), a centralized political organization that regulates law and society within a territory
**Sovereign state, a sovereign polity in international law, commonly referred to as a country
**Nation state, a ...
ful generating function:
fibs = next (0,1) where next (a,b) = a : next (b, a+b)
or with unfoldr
:
fibs = unfoldr (\(a,b) -> Just (a, (b, a+b))) (0, 1)
or scanl
:
fibs = 0 : scanl (+) 1 fibs
Using data recursion with Haskell's predefined fixpoint combinator:
fibs = fix (\xs -> 0 : 1 : zipWith (+) xs (tail xs)) -- zipWith version
= fix ((0:) . (1:) . (zipWith (+) <*> tail)) -- same as above, pointfree
= fix ((0:) . scanl (+) 1) -- scanl version
Factorial
The factorial we saw previously can be written as a sequence of functions:
factorial n = foldr ((.) . (*)) id ..n$ 1
-- factorial 5 ((1*) .) ( ((2*) .) ( ((3*) .) ( ((4*) .) ( ((5*) .) id )))) 1
-- (1*) . (2*) . (3*) . (4*) . (5*) . id $ 1
-- 1* ( 2* ( 3* ( 4* ( 5* ( id 1 )))))
factorial n = foldr ((.) . (*)) (const 1) ..n$ ()
-- factorial 5 ((1*) .) ( ((2*) .) ( ((3*) .) ( ((4*) .) ( ((5*) .) (const 1) )))) ()
-- (1*) . (2*) . (3*) . (4*) . (5*) . const 1 $ ()
-- 1* ( 2* ( 3* ( 4* ( 5* ( const 1 () )))))
factorial n = foldr (($) . (*)) 1 ..n= foldr ($) 1 $ map (*) ..n-- factorial 5 ((1*) $) ( ((2*) $) ( ((3*) $) ( ((4*) $) ( ((5*) $) 1 ))))
-- (1*) $ (2*) $ (3*) $ (4*) $ (5*) $ 1
-- 1* ( 2* ( 3* ( 4* ( 5* 1 ))))
More examples
Hamming numbers
A remarkably concise function that returns the list of Hamming numbers Hamming may refer to:
* Richard Hamming (1915–1998), American mathematician
* Hamming(7,4), in coding theory, a linear error-correcting code
* Overacting, or acting in an exaggerated way
See also
* Hamming code, error correction in telecommu ...
in order:
hamming = 1 : map (2*) hamming `union` map (3*) hamming
`union` map (5*) hamming
Like the various fibs
solutions displayed above, this uses corecursion to produce a list of numbers on demand, starting from the base case of 1 and building new items based on the preceding part of the list.
Here the function union
is used as an operator by enclosing it in back-quotes. Its case
clauses define how it merges two ascending lists into one ascending list without duplicate items, representing sets as ordered lists. Its companion function minus
implements set difference
In set theory, the complement of a set , often denoted by A^c (or ), is the set of elements not in .
When all elements in the universe, i.e. all elements under consideration, are considered to be members of a given set , the absolute complement ...
:
It is possible to generate only the unique multiples, for more efficient operation. Since there are no duplicates, there's no need to remove them:
smooth235 = 1 : foldr (\p s -> fix $ mergeBy (<) s . map (p*) . (1:)) [] [2,3,5]
where
fix f = x where x = f x -- fixpoint combinator, with sharing
This uses the more efficient function merge
which doesn't concern itself with the duplicates (also used in the following next function, mergesort
):
mergeBy less xs ys = merge xs ys where
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) , less y x = y : merge (x:xs) ys
, otherwise = x : merge xs (y:ys)
Each vertical bar ( ,
) starts a guard
Guard or guards may refer to:
Professional occupations
* Bodyguard, who protects an individual from personal assault
* Crossing guard, who stops traffic so pedestrians can cross the street
* Lifeguard, who rescues people from drowning
* Prison gu ...
clause with a ''guard expression'' before the =
sign and the corresponding definition after it, that is evaluated if the guard is true.
Mergesort
Here is a bottom-up merge sort
In computer science, merge sort (also commonly spelled as mergesort and as ) is an efficient, general-purpose, and comparison sort, comparison-based sorting algorithm. Most implementations of merge sort are Sorting algorithm#Stability, stable, wh ...
, defined using the higher-order function In mathematics and computer science, a higher-order function (HOF) is a function that does at least one of the following:
* takes one or more functions as arguments (i.e. a procedural parameter, which is a parameter of a procedure that is itself ...
until
:
mergesortBy less [] = []
mergesortBy less xs = head $
until (null . tail) (pairwise $ mergeBy less) [ , x <- xs]
pairwise f (a:b:t) = f a b : pairwise f t
pairwise f t = t
Prime numbers
The mathematical definition of primes can be translated pretty much word for word into Haskell:
-- "Integers above 1 that cannot be divided by a smaller integer above 1"
-- primes =
-- =
primes = n <- all (\d -> rem n d /= 0) .. all (\d -> rem n d /= 0) ">..(n-1)">.. all (\d -> rem n d /= 0) [2..(n-1)
This finds primes by ..(n-1)">..(n-1)">.. all (\d -> rem n d /= 0) [2..(n-1)
This finds primes by trial division. Note that it is not optimized for efficiency and has very poor performance. Slightly faster (but still very slow) is this code by David Turner:
primes = sieve David Turner (computer scientist)">David Turner:
primes = sieve [2.. where
sieve (p:xs) = p : sieve x <- xs, rem x p /= 0
Much faster is the optimal trial division algorithm
primes = 2 : n <- [3.. all ((> 0) . rem n) $
takeWhile ((<= n) . (^2)) primes">n "> n <- all ((> 0) . rem n) $
takeWhile ((<= n) . (^2)) primes
or an unbounded sieve of Eratosthenes">.. all ((> 0) . rem n) $
takeWhile ((<= n) . (^2)) primes
or an unbounded sieve of Eratosthenes with postponed sieving in stages,
primes = 2 : sieve primes [3..] where
sieve (p:ps) (span (< p*p) -> (h, t)) =
h ++ sieve ps (minus t [p*p, p*p+p..])
or the combined sieve implementation by Richard Bird (computer scientist), Richard Bird,O'Neill, Melissa E.
"The Genuine Sieve of Eratosthenes"
Journal of Functional Programming, Published online by Cambridge University Press 9 October 2008 , pp. 10, 11.
-- "Integers above 1 without any composite numbers which
-- are found by enumeration of each prime's multiples"
primes = 2 : minus .. (foldr (\(m:ms) r -> m : union ms r) []
p*p, p*p+p ..] , p <- primes])
or an even faster Fold (higher-order function)#Tree-like folds, tree-like folding variant with nearly optimal (for a list-based code) time complexity and very low space complexity achieved through telescoping multistage recursive production of primes:
primes = 2 : _Y ((3 :) . minus ,7... _U
. map (\p -> *p, p*p+2*p..)
where
-- non-sharing Y combinator:
_Y g = g (_Y g) -- (g (g (g (g (...)))))
-- big union ~= nub.sort.concat
_U ((x:xs):t) = x : (union xs . _U . pairwise union) t
Working on arrays by segments between consecutive squares of primes, it's
import Data.Array
import Data.List (tails, inits)
primes = 2 :
(r:q:_, px) <- zip (tails (2 : [p*p , p <- primes)
(inits primes),
(n, True) <- assocs ( accumArray (\_ _ -> False) True
(r+1,q-1)
[ (m,()) , p <- px
, s <- [ div (r+p) p * p]
, m <- [s,s+p..q-1] ] ) ]
The shortest possible code is probably nubBy (((>1) .) . gcd) [2..]
. It is quite slow.
Syntax
Layout
Haskell allows indentation
__FORCETOC__
In the written form of many languages, indentation describes empty space ( white space) used before or around text to signify an important aspect of the text such as:
* Beginning of a paragraph
* Hierarchy subordinate concept
* Qu ...
to be used to indicate the beginning of a new declaration. For example, in a ''where'' clause:
product xs = prod xs 1
where
prod [] a = a
prod (x:xs) a = prod xs (a*x)
The two equations for the nested function prod
are aligned vertically, which allows the semi-colon separator to be omitted. In Haskell, indentation can be used in several syntactic constructs, including do
, let
, case
, class
, and instance
.
The use of indentation to indicate program structure originates in Peter J. Landin's ISWIM
ISWIM (If You See What I Mean) is an abstract computer programming language (or a family of languages) devised by Peter Landin and first described in his article "The Next 700 Programming Languages", published in the ''Communications of the ACM ...
language, where it was called the off-side rule
The off-side rule describes syntax of a computer programming language that defines the bounds of a code block via indentation.
The term was coined by Peter Landin, possibly as a pun on the offside law in association football.
An off-side ...
. This was later adopted by Miranda, and Haskell adopted a similar (but rather more complex) version of Miranda's off-side rule, which is called "layout". Other languages to adopt whitespace character
A whitespace character is a character data element that represents white space when text is
rendered for display by a computer.
For example, a ''space'' character (, ASCII 32) represents blank space such as a word divider in a Western scrip ...
-sensitive syntax include Python
Python may refer to:
Snakes
* Pythonidae, a family of nonvenomous snakes found in Africa, Asia, and Australia
** ''Python'' (genus), a genus of Pythonidae found in Africa and Asia
* Python (mythology), a mythical serpent
Computing
* Python (prog ...
and F#.
The use of layout in Haskell is optional. For example, the function product
above can also be written:
product xs = prod xs 1
where
The explicit open brace after the where
keyword indicates that separate declarations will use explicit semi-colons, and the declaration-list will be terminated by an explicit closing brace. One reason for wanting support for explicit delimiters is that it makes automatic generation of Haskell source code
In computing, source code, or simply code or source, is a plain text computer program written in a programming language. A programmer writes the human readable source code to control the behavior of a computer.
Since a computer, at base, only ...
easier.
Haskell's layout rule has been criticised for its complexity. In particular, the definition states that if the parser encounters a parse error during processing of a layout section, then it should try inserting a close brace (the "parse error" rule). Implementing this rule in a traditional ''parsing
Parsing, syntax analysis, or syntactic analysis is a process of analyzing a String (computer science), string of Symbol (formal), symbols, either in natural language, computer languages or data structures, conforming to the rules of a formal gramm ...
'' and ''lexical analysis
Lexical tokenization is conversion of a text into (semantically or syntactically) meaningful ''lexical tokens'' belonging to categories defined by a "lexer" program. In case of a natural language, those categories include nouns, verbs, adjectives ...
'' combination requires two-way cooperation between the parser and lexical analyser, whereas in most languages, these two phases can be considered independently.
Function calls
Applying a function f
to a value x
is expressed as simply f x
.
Haskell distinguishes function calls from infix operators syntactically, but not semantically. Function names which are composed of punctuation characters can be used as operators, as can other function names if surrounded with backticks; and operators can be used in prefix notation if surrounded with parentheses.
This example shows the ways that functions can be called:
add a b = a + b
ten1 = 5 + 5
ten2 = (+) 5 5
ten3 = add 5 5
ten4 = 5 `add` 5
Functions which are defined as taking several parameters can always be partially applied. Binary operators can be partially applied using ''section'' notation:
ten5 = (+ 5) 5
ten6 = (5 +) 5
addfive = (5 +)
ten7 = addfive 5
List comprehensions
See List comprehension#Overview for the Haskell example.
Pattern matching
Pattern matching
In computer science, pattern matching is the act of checking a given sequence of tokens for the presence of the constituents of some pattern. In contrast to pattern recognition, the match usually must be exact: "either it will or will not be a ...
is used to match on the different constructors of algebraic data types. Here are some functions, each using pattern matching on each of the types below:
-- This type signature says that empty takes a list containing any type, and returns a Bool
empty :: -> Bool
empty (x:xs) = False
empty [] = True
-- Will return a value from a Maybe a, given a default value in case a Nothing is encountered
fromMaybe :: a -> Maybe a -> a
fromMaybe x (Just y) = y
fromMaybe x Nothing = x
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight (Left _) = False
getName :: Person -> String
getName (Person name _ _) = name
getSex :: Person -> Sex
getSex (Person _ sex _) = sex
getAge :: Person -> Int
getAge (Person _ _ age) = age
Using the above functions, along with the map
function, we can apply them to each element of a list, to see their results:
map empty 1,2,3[],[2],[1..
-- returns [False,True,False,False]
map (fromMaybe 0) [Just 2,Nothing,Just 109238, Nothing]
-- returns [2,0,109238,0]
map isRight [Left "hello", Right 6, Right 23, Left "world"]
-- returns alse, True, True, False
map getName erson "Sarah" Female 20, Person "Alex" Male 20, tom-- returns Sarah", "Alex", "Tom" using the definition for tom above
* Abstract Types
* Lists
Tuples
Tuples
In mathematics, a tuple is a finite sequence or ''ordered list'' of numbers or, more generally, mathematical objects, which are called the ''elements'' of the tuple. An -tuple is a tuple of elements, where is a non-negative integer. There is on ...
in haskell can be used to hold a fixed number of elements. They are used to group pieces of data of differing types:
account :: (String, Integer, Double) -- The type of a three-tuple, representing
-- a name, balance, and interest rate
account = ("John Smith",102894,5.25)
Tuples are commonly used in the zip* functions to place adjacent elements in separate lists together in tuples (zip4 to zip7 are provided in the Data.List module):
-- The definition of the zip function. Other zip* functions are defined similarly
zip :: -> -> x,y)zip (x:xs) (y:ys) = (x,y) : zip xs ys
zip _ _ = []
zip [1..5] "hello"
-- returns [(1,'h'),(2,'e'),(3,'l'),(4,'l'),(5,'o')]
-- and has type [(Integer, Char)]
zip3 [1..5] "hello" [False, True, False, False, True]
-- returns [(1,'h',False),(2,'e',True),(3,'l',False),(4,'l',False),(5,'o',True)]
-- and has type Integer,Char,Bool)
In the GHC compiler, tuples are defined with sizes from 2 elements up to 62 elements.
* Records
Namespaces
In the section above, calc
is used in two senses, showing that there is a Haskell type class namespace and also a namespace for values:
#a Haskell type class
In computer science, a type class is a type system construct that supports ad hoc polymorphism. This is achieved by adding constraints to type variables in parametrically polymorphic types. Such a constraint typically involves a type class T a ...
for calc
. The domain
A domain is a geographic area controlled by a single person or organization. Domain may also refer to:
Law and human geography
* Demesne, in English common law and other Medieval European contexts, lands directly managed by their holder rather ...
and range
Range may refer to:
Geography
* Range (geographic), a chain of hills or mountains; a somewhat linear, complex mountainous or hilly area (cordillera, sierra)
** Mountain range, a group of mountains bordered by lowlands
* Range, a term used to i ...
can be explicitly denoted in a Haskell type class.
#a Haskell value, formula, or expression for calc
.
Typeclasses and polymorphism
Algebraic data types
Algebraic data types
In computer programming, especially functional programming and type theory, an algebraic data type (ADT) is a kind of composite data type, i.e., a data type formed by combining other types.
Two common classes of algebraic types are product type ...
are used extensively in Haskell. Some examples of these are the built in list, Maybe
and Either
types:
-- A list of a's ( is either an a consed (:) onto another list of a's, or an empty list ([])
data = a : , []
-- Something of type Maybe a is either Just something, or Nothing
data Maybe a = Just a , Nothing
-- Something of type Either atype btype is either a Left atype, or a Right btype
data Either a b = Left a , Right b
Users of the language can also define their own abstract data type
In computer science, an abstract data type (ADT) is a mathematical model for data types, defined by its behavior (semantics) from the point of view of a '' user'' of the data, specifically in terms of possible values, possible operations on data ...
s. An example of an ADT used to represent a person's name, sex and age might look like:
data Sex = Male , Female
data Person = Person String Sex Int -- Notice that Person is both a constructor and a type
-- An example of creating something of type Person
tom :: Person
tom = Person "Tom" Male 27
Type system
* Type class
In computer science, a type class is a type system construct that supports ad hoc polymorphism. This is achieved by adding constraints to type variables in parametrically polymorphic types. Such a constraint typically involves a type class T a ...
es
* Type defaulting
* Overloaded literals
* Higher kinded polymorphism
* Multi-parameter type classes
* Functional dependencies
Monads and input/output
* Overview of the monad
Monad may refer to:
Philosophy
* Monad (philosophy), a term meaning "unit"
**Monism, the concept of "one essence" in the metaphysical and theological theory
** Monad (Gnosticism), the most primal aspect of God in Gnosticism
* ''Great Monad'', an ...
framework:
* Applications
** Monadic IO
** Do-notation
** References
** Exceptions
ST monad
The ST monad allows writing imperative programming
In computer science, imperative programming is a programming paradigm of software that uses Statement (computer science), statements that change a program's state (computer science), state. In much the same way that the imperative mood in natural ...
algorithms in Haskell, using mutable variables (STRefs) and mutable arrays (STArrays and STUArrays). The advantage of the ST monad is that it allows writing code that has internal side effects, such as destructively updating mutable variables and arrays, while containing these effects inside the monad. The result of this is that functions written using the ST monad appear pure to the rest of the program. This allows using imperative code where it may be impractical to write functional code, while still keeping all the safety that pure code provides.
Here is an example program (taken from the Haskell wiki page on th
ST monad
that takes a list of numbers, and sums them, using a mutable variable:
import Control.Monad.ST
import Data.STRef
import Control.Monad
sumST :: Num a => -> a
sumST xs = runST $ do -- runST takes stateful ST code and makes it pure.
summed <- newSTRef 0 -- Create an STRef (a mutable variable)
forM_ xs $ \x -> do -- For each element of the argument list xs ..
modifySTRef summed (+x) -- add it to what we have in n.
readSTRef summed -- read the value of n, which will be returned by the runST above.
STM monad
The STM monad is an implementation of Software Transactional Memory
In computer science, software transactional memory (STM) is a concurrency control mechanism analogous to database transactions for controlling access to shared memory in concurrent computing. It is an alternative to lock-based synchronization. ST ...
in Haskell. It is implemented in the GHC compiler, and allows for mutable variables to be modified in transactions.
Arrows
* Applicative Functors
* Arrows
As Haskell is a pure functional language, functions cannot have side effects. Being non-strict, it also does not have a well-defined evaluation order. This is a challenge for real programs, which among other things need to interact with an environment. Haskell solves this with '' monadic types'' that leverage the type system to ensure the proper sequencing of imperative constructs. The typical example is input/output
In computing, input/output (I/O, i/o, or informally io or IO) is the communication between an information processing system, such as a computer, and the outside world, such as another computer system, peripherals, or a human operator. Inputs a ...
(I/O), but monads are useful for many other purposes, including mutable state, concurrency and transactional memory, exception handling, and error propagation.
Haskell provides a special syntax for monadic expressions, so that side-effecting programs can be written in a style similar to current imperative programming languages; no knowledge of the mathematics behind monadic I/O is required for this. The following program reads a name from the command line and outputs a greeting message:
main = do putStrLn "What's your name?"
name <- getLine
putStr ("Hello, " ++ name ++ "!\n")
The do-notation eases working with monads. This do-expression is equivalent to, but (arguably) easier to write and understand than, the de-sugared version employing the monadic operators directly:
main = putStrLn "What's your name?" >> getLine >>= \ name -> putStr ("Hello, " ++ name ++ "!\n")
: ''See also wikibooks:Transwiki:List of hello world programs#Haskell for another example that prints text.''
Concurrency
The Haskell language definition includes neither concurrency nor parallelism, although GHC supports both.
Concurrent Haskell
Concurrent Haskell (also Control.Concurrent, or Concurrent and Parallel Haskell) is an extension to the functional programming language Haskell, which adds explicit primitive data types for concurrency. It was first added to Haskell 98, and ...
is an extension to Haskell that supports threads and synchronization
Synchronization is the coordination of events to operate a system in unison. For example, the Conductor (music), conductor of an orchestra keeps the orchestra synchronized or ''in time''. Systems that operate with all parts in synchrony are sa ...
.Simon Peyton Jones, Andrew Gordon, and Sigbjorn Finne
Concurrent Haskell
''ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages (PoPL).'' 1996. (Some sections are out of date with respect to the current implementation.) GHC's implementation of Concurrent Haskell is based on multiplexing lightweight Haskell threads onto a few heavyweight operating system
An operating system (OS) is system software that manages computer hardware and software resources, and provides common daemon (computing), services for computer programs.
Time-sharing operating systems scheduler (computing), schedule tasks for ...
(OS) threads,Runtime Support for Multicore Haskell
(Simon Marlow, Simon Peyton Jones, Satnam Singh) ICFP '09: Proceedings of the 14th ACM SIGPLAN international conference on Functional programming, Edinburgh, Scotland, August 2009 so that Concurrent Haskell programs run in parallel via symmetric multiprocessing
Symmetric multiprocessing or shared-memory multiprocessing (SMP) involves a multiprocessor computer hardware and software architecture where two or more identical processors are connected to a single, shared main memory, have full access to all ...
. The runtime can support millions of simultaneous threads.
The GHC implementation employs a dynamic pool of OS threads, allowing a Haskell thread to make a blocking system call without blocking other running Haskell threads.Extending the Haskell Foreign Function Interface with Concurrency
(Simon Marlow, Simon Peyton Jones, Wolfgang Thaller) Proceedings of the ACM SIGPLAN workshop on Haskell, pages 57--68, Snowbird, Utah, USA, September 2004 Hence the lightweight Haskell threads have the characteristics of heavyweight OS threads, and a programmer can be unaware of the implementation details.
Recently, Concurrent Haskell has been extended with support for ''software transactional memory
In computer science, software transactional memory (STM) is a concurrency control mechanism analogous to database transactions for controlling access to shared memory in concurrent computing. It is an alternative to lock-based synchronization. ST ...
'' (STM), which is a concurrency abstraction in which compound operations on shared data are performed atomically, as transactions. GHC's STM implementation is the only STM implementation to date to provide a static compile-time guarantee preventing non-transactional operations from being performed within a transaction. The Haskell STM library also provides two operations not found in other STMs: retry
and orElse
, which together allow blocking operations to be defined in a modular and composable fashion.
References
{{Haskell programming
Haskell programming language family
Articles with example Haskell code