let rseed = ref 1234;;

let random () =
    let nrs = (!rseed) * 214013 + 2531011 in
    rseed := nrs;
    (nrs lsr 16) land 0x7FFFFFFF;;

let rec lcreate func lst = function
     0 -> lst
|    n -> lcreate func ((func n)::lst) (n-1);;

let applay_mods mods h n =
    let (x,y) = (n mod h, n / h) in
    let ffun el f = f el x y in
    List.fold_left ffun (0,0,0,0) mods;;

let create_modifier w h _ =
    let x1 = (random ()) mod w
    and y1 = (random ()) mod h
    and x2 = (random ()) mod w
    and y2 = (random ()) mod h
    and cr = (random ()) mod 255
    and cg = (random ()) mod 255
    and cb = (random ()) mod 255
    and ca = (random ()) mod 255 in
    let (nx1,nx2) = if (x1 > x2) then (x2, x1-x2+1) else (x1, x2-x1+1)
    and (ny1,ny2) = if (y1 > y2) then (y2, y1-y2+1) else (y1, y2-y1+1) in
    fun ((r,g,b,a) as point) x y ->
        if ((x < nx1) || (x > nx2) || (y < ny1) || (y > ny2)) then point else 
        let nr = ((((cr-r)*ca) lsr 8) + r) land 255
        and ng = ((((cg-g)*ca) lsr 8) + g) land 255
        and nb = ((((cb-b)*ca) lsr 8) + b) land 255
        and na = (ca*a-((ca*a) lsr 8)) land 255 in
        (nr, ng, nb, na);;

let test_alpha_blend w h n =
    let mods = lcreate (create_modifier w h) [] n in
    lcreate (applay_mods mods h) [] (w*h);;

let main () =
    let w = 1000
    and h = 1000
    and n = 1000 in
    test_alpha_blend w h n;;

main ();;

CreateNameValueDialog(150, this,
{
    | "Number of inputs" => udInputs : NumericUpDown ( Maximum = 8, Value = 1)
    | "Number of outputs" => udOutputs : NumericUpDown ( Minimum = 1, Maximum = 8, Value = 1)
})

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
          (if (same-variable? exp var) 1 0))
        ((sum? exp)
          (make-sum (deriv (addend exp) var) 
                    (deriv (augend exp) var)))
        ((product? exp)
          (make-sum
            (make-product (multiplier exp)
                          (deriv (multiplicand exp) var))
            (make-product (deriv (multiplier exp) var)
                          (multiplicand exp))))
        (else
          (error "unknown expression type -- DERIV" exp))))

(deriv '(* (* x y) (+ x 3)) 'x)
(+ (* (* x y) (+ 1 0))
   (* (+ (* x 0) (* 1 y))
      (+  x 3)))

-- строительные блоки для выражений
infixl 5 :+
infixl 6 :*
data Exp = Num Integer
         | Var Sym
         | Exp :+ Exp
         | Exp :* Exp deriving (Eq,Show)

data Sym = X | Y deriving (Eq,Show)

main = do let exp = (Num 4 :* Var X :* Var X)
          let deriv = d exp X
          putStrLn $ "Original expression : " ++ (show exp)
          putStrLn $ "Derivative : " ++ (show $ simplify deriv)
          putStrLn $ "Derivative evaluated at X=10 : "
                     ++ (show $ eval (d exp X) [(X,10)])

-- взять производную
d (Num n)  x = Num 0
d (Var y)  x | x==y      = Num 1
             | otherwise = Num 0 
d (f :+ g) x = (d f x) :+ (d g x)
d (f :* g) x = (d f x) :* g :+ f :* (d g x)

-- вычислить выражение типа Exp...
eval (Num x) env = x
eval (Var x) env = case (lookup x env) of 
                        (Just n)  -> n
                        (Nothing) -> error $ "no variable "++(show x)++" in env"
eval (x :+ y) env = eval x env + eval y env
eval (x :* y) env = eval x env * eval y env

-- несколько алгебраических правил для упрощения
simp (x :+ y) | x == y = simp (Num 2):*x
simp ((Num 0) :+ x) = simp x
simp (x :+ (Num 0)) = simp x
simp ((Num x) :+ (Num y)) = Num (x+y)
simp (x :+ y) = simp x :+ simp y
simp ((Num 0) :* x) = Num 0
simp (x :* (Num 0)) = Num 0
simp ((Num 1) :* x) = simp x
simp (x :* (Num 1)) = simp x
simp ((Num x) :* (Num y)) = Num (x*y)
simp (x :* y) = simp x :* simp y
simp x = x

-- применять правила упрощения до тех пор, пока выражение не перестанет меняться
simplify x = let a = iterate simp x
                 fix = dropWhile (\(c,d)->c/=d) $ zip a (tail a)
             in (fst.head) fix

Original expression : (Num 4 :* Var X) :* Var X
Derivative : Num 2 :* (Num 4 :* Var X)
Derivative evaluated at X=10 : 80

PI>вот, я как-нибудь подобное реализую, а что такое 10 закон Гринспуна? что все сложное ломается?

Greenspun's Tenth Rule of Programming: "Any sufficiently complicated C or Fortran program contains an ad-hoc, informally-specified bug-ridden slow implementation of half of Common Lisp."

PI>он уже ближе к статике, не так ли?

> type Region = Point -> Bool

> circle :: Radius -> Region -- creates a region with given radius
> outside :: Region -> Region -- the logical negation of a region
> (/\) :: Region -> Region -> Region -- the intersection of two regions

> annulus :: Radius -> Radius -> Region
> annulus r1 r2 = outside (circle r1) /\ circle r2

-- Вариант 1

infixl 5 /\
infixl 5 \/

type Point = (Float, Float)

type Region = Point -> Bool

p `inRegion` r = r p

circle (x,y) r = \(x',y') -> (x-x')2 + (y-y')2 < r2
rectangle (x1,y1) (x2,y2) =
    \(x,y) -> x > min x1 x2 && x < max x1 x2 &&
              y > min y1 y2 && y < max y1 y2
outside r = \p -> not (p `inRegion` r)
x /\ y = \p -> (p `inRegion` x) && (p `inRegion` y)
x \/ y = \p -> (p `inRegion` x) || (p `inRegion` y)

-- Вариант 2

infixl 5 /\
infixl 5 \/

type Point = (Float, Float)

data Region = Circle Point Float         |
              Rectangle Point Point      |
              Outside Region             |
              Intersection Region Region |
              Union Region Region

-- функции-конструкторы для единообразия примитивных
-- и сложных регионов
circle = Circle
rectangle = Rectangle
outside = Outside
(/\) = Intersection
(\/) = Union

(x,y) `inRegion` (Circle (x',y') r) = (x-x')2 + (y-y')2 < r2
(x,y) `inRegion` (Rectangle (x1,y1) (x2,y2)) =
    x > min x1 x2 && x < max x1 x2 && y > min y1 y2 && y < max y1 y2
p `inRegion` (Outside r) = not (p `inRegion` r)
p `inRegion` (Intersection x y) = (p `inRegion` x) && (p `inRegion` y)
p `inRegion` (Union x y) = (p `inRegion` x) || (p `inRegion` y)

-- клиентский код
annulus center r1 r2 = outside (circle center r1) /\ (circle center r2)

M>>А вообще примеры в Scala By Example слизаны с SICP

def sumInts(a: int, b: int): int =
    if (a > b) 0 else a + sumInts(a + 1, b)

def square(x: int): int = x * x
def sumSquares(a: int, b: int): int =
    if (a > b) 0 else square(a) + sumSquares(a + 1, b)

def powerOfTwo(x: int): int = if (x == 0) 1 else x * powerOfTwo(x 1)
def sumPowersOfTwo(a: int, b: int): int =
    if (a > b) 0 else powerOfTwo(a) + sumPowersOfTwo(a + 1, b)

def sum(f: int => int, a: int, b: int): double =
    if (a > b) 0 else f(a) + sum(f, a + 1, b)

def sumInts(a: int, b: int): int = sum(id, a, b)
def sumSquares(a: int, b: int): int = sum(square, a, b)
def sumPowersOfTwo(a: int, b: int): int = sum(powerOfTwo, a, b)
    where
def id(x: int): int = x
def square(x: int): int = x * x
def powerOfTwo(x: int): int = if (x == 0) 1 else x * powerOfTwo(x 1)

LCR>>Владу скорее всего пример не понравится, потому что слишком заумный и оторванный от жизни.

I can't really imagine needing anything else in a language that isn't catered for in c# or vb.net for example.
...
I write in .net. I can't think of why I'd need another language.

PA>outside r = \p -> not (p `inRegion` r)
PA>x /\ y = \p -> (p `inRegion` x) && (p `inRegion` y)
PA>x \/ y = \p -> (p `inRegion` x) || (p `inRegion` y)
PA>

outside  = not
(/\) = (&&)
(\/) = (||)

M>>А как насчет реализации модного GoF паттерна Interpreter ?

Pattern matching is one of the most powerful features of Haskell (and most functional
programming languages). It is most commonly used in conjunction with case expressions,
which we have already seen in Section 3.5. Let's return to our Color example
from Section 4.5. I'll repeat the definition we already had for the datatype:

data Color
    = Red
    | Orange
    | Yellow
    | Green
    | Blue
    | Purple
    | White
    | Black
    | Custom Int Int Int -- R G B components
deriving (Show,Eq)

We then want to write a function that will convert between something of type Color
and a triple of Ints, which correspond to the RGB values, respectively. Specifically, if
we see a Color which is Red, we want to return (255,0,0), since this is the RGB
value for red. So we write that (remember that piecewise function definitions are just
case statements):

colorToRGB Red = (255,0,0)

If we see a Color which is Orange, we want to return (255,128,0); and if we
see Yellow, we want to return (255,255,0), and so on. Finally, if we see a custom
color, which is comprised of three components, we want to make a triple out of these,
so we write:

colorToRGB Orange = (255,128,0)
colorToRGB Yellow = (255,255,0)
colorToRGB Green = (0,255,0)
colorToRGB Blue = (0,0,255)
colorToRGB Purple = (255,0,255)
colorToRGB White = (255,255,255)
colorToRGB Black = (0,0,0)
colorToRGB (Custom r g b) = (r,g,b)

Then, in our interpreter, if we type:
Color> colorToRGB Yellow
(255,255,0)

What is happening is this: we create a value, call it x, which has value Red. We
then apply this to colorToRGB. We check to see if we can ?match? x against Red.
This match fails because according to the definition of Eq Color, Red is not equal
to Yellow. We continue down the definitions of colorToRGB and try to match
Yellow against Orange. This fails, too. We the try to match Yellow against
Yellow, which succeeds, so we use this function definition, which simply returns
the value (255,255,0), as expected.
Suppose instead, we used a custom color:
Color> colorToRGB (Custom 50 200 100)
(50,200,100)
We apply the same matching process, failing on all values from Red to Black.
We then get to try to match Custom 50 200 100 against Custom r g b. We
can see that the Custom part matches, so then we go see if the subelements match. In
the matching, the variables r, g and b are essentially wild cards, so there is no trouble
matching r with 50, g with 200 and b with 100. As a ?side-effect? of this matching, r
gets the value 50, g gets the value 200 and b gets the value 100. So the entire match
succeeded and we look at the definition of this part of the function and bundle up the
triple using the matched values of r, g and b.
We can also write a function to check to see if a Color is a custom color or not:

isCustomColor (Custom _ _ _) = True
isCustomColor _ = False

When we apply a value to isCustomColor it tries to match that value against
Custom . This match will succeed if the value is Custom x y z for any x,
y and z. The (underscore) character is a ?wildcard? and will match anything, but will
not do the binding that would happen if you put a variable name there. If this match
succeeds, the function returns True; however, if this match fails, it goes on to the next
line, which will match anything and then return False.
For some reason we might want to define a function which tells us whether a given
color is ?bright? or not, where my definition of ?bright? is that one of its RGB components
is equal to 255 (admittedly and arbitrary definition, but it's simply an example).
We could define this function as:

isBright = isBright' . colorToRGB
    where     isBright' (255,_,_) = True
            isBright' (_,255,_) = True
            isBright' (_,_,255) = True
            isBright' _ = False

Let's dwell on this definition for a second. The isBright function is the composition
of our previously defined function colorToRGB and a helper function isBright',
which tells us if a given RGB value is bright or not. We could replace the first line here

with isBright c = isBright' (colorToRGB c) but there is no need to explicitly
write the parameter here, so we don't. Again, this function composition style
of programming takes some getting used to, so I will try to use it frequently in this
tutorial.
The isBright' helper function takes the RGB triple produced by colorToRGB.
It first tries to match it against (255, , ) which succeeds if the value has 255 in
its first position. If this match succeeds, isBright' returns True and so does
isBright. The second and third line of definition check for 255 in the second and
third position in the triple, respectively. The fourth line, the fallthrough, matches everything
else and reports it as not bright.
We might want to also write a function to convert between RGB triples and Colors.
We could simple stick everything in a Custom constructor, but this would defeat the
purpose; we want to use the Custom slot only for values which don't match the prede
fined colors. However, we don't want to allow the user to construct custom colors
like (600,-40,99) since these are invalid RGB values. We could throw an error if such
a value is given, but this can be difficult to deal with. Instead, we use the Maybe
datatype. This is defined (in the Prelude) as:

data Maybe a = Nothing
| Just a

The way we use this is as follows: our rgbToColor function returns a value of
type Maybe Color. If the RGB value passed to our function is invalid, we return
Nothing, which corresponds to a failure. If, on the other hand, the RGB value is
valid, we create the appropriate Color value and return Just that. The code to do this
is:

rgbToColor 255 0 0 = Just Red
rgbToColor 255 128 0 = Just Orange
rgbToColor 255 255 0 = Just Yellow
rgbToColor 0 255 0 = Just Green
rgbToColor 0 0 255 = Just Blue
rgbToColor 255 0 255 = Just Purple
rgbToColor 255 255 255 = Just White
rgbToColor 0 0 0 = Just Black
rgbToColor r g b =
    if     0 <= r && r <= 255 &&
        0 <= g && g <= 255 &&
        0 <= b && b <= 255
    then Just (Custom r g b)
    else Nothing -- invalid RGB value

The first eight lines match the RGB arguments against the predefined values and,
if they match, rgbToColor returns Just the appropriate color. If none of these
matches, the last definition of rgbToColor matches the first argument against r, the

second against g and the third against b (which causes the side-effect of binding these
values). It then checks to see if these values are valid (each is greater than or equal to
zero and less than or equal to 255). If so, it returns Just (Custom r g b); if not,
it returns Nothing corresponding to an invalid color.
Using this, we can write a function that checks to see if a right RGB value is valid:

rgbIsValid r g b = rgbIsValid' (rgbToColor r g b)
where rgbIsValid' (Just _) = True
    rgbIsValid' _ = False

Here, we compose the helper function rgbIsValid' with our function rgbToColor.
The helper function checks to see if the value returned by rgbToColor is Just anything
(the wildcard). If so, it returns True. If not, it matches anything and returns
False.
Pattern matching isn't magic, though. You can only match against datatypes; you
cannot match against functions. For instance, the following is invalid:

f x = x + 1
g (f x) = x

Even though the intended meaning of g is clear (i.e., g x = x — 1), the compiler
doesn't know in general that f has an inverse function, so it can't perform matches
like this.

M>def sumInts(a: int, b: int): int = sum(id, a, b)
M>def sumSquares(a: int, b: int): int = sum(square, a, b)
M>def sumPowersOfTwo(a: int, b: int): int = sum(powerOfTwo, a, b)
M>    where
M>def id(x: int): int = x
M>def square(x: int): int = x * x
M>def powerOfTwo(x: int): int = if (x == 0) 1 else x * powerOfTwo(x 1)
M>

[оффтоп]
Затеял утреннюю разминку мозгов - втыкание в мир J :))
За базу взял приведенные примеры.

Определил 7 глаголов:

genArr =. ((0{q)+i.@>:@-@-/@q=.2&{.) .NB Генерируем массив по заданным границам [genArr 2 6 -> 2 3 4 5 6]

.NB следующие 3 можно было бы и не вводить, но для наглядности пущай будут
square =. *:    .NB Другие варианты: square =. 3 : 'y^2' или square =. 3 : 'y*y'
powerOfTwo =. ! .NB Если я все правильно понял, в примере на Scala потерялся минус и powerOfTwo не что иное, как факториал.
                .NB Можно выразить через другие примитивы: powerOfTwo =. */@(1&}.)@i.@>:
sum =. +/

sumInts =. sum@genArr
sumSquares =. sum@square@genArr
sumPowerOfTwo =. sum@powerOfTwo@genArr

.NB собственно использование:

sumInts 2 6        .NB выводит: 20
sumSquares 2 6     .NB выводит: 90
sumPowerOfTwo 2 6  .NB тут мои мозги закипели, выводит: 2 6 24 120 720... Почему?!!  :xz: 
.NB причем: "sum powerOfTwo@genArr 2 6" в отличае от "sum@powerOfTwo@genArr 2 6" выводит все правильно.
.NB аналогичная ситуация для случая с использованием стандартного square, т.е. "square =. *:", а для переопределенных вариантов все ок
[/оффтоп]

ie>Затеял утреннюю разминку мозгов — втыкание в мир J

ie>sumPowerOfTwo 2 6  .NB тут мои мозги закипели, выводит: 2 6 24 120 720... Почему?!!  :xz:

sumInts =. sum@:genArr
sumSquares =. sum@:square@genArr
sumPowerOfTwo =. sum@:powerOfTwo@genArr

   2&^ i. 10
1 2 4 8 16 32 64 128 256 512
   ! i.10
1 1 2 6 24 120 720 5040 40320 362880

ie>genArr =. ((0{q)+i.@>:@-@-/@q=.2&{.) .NB Генерируем массив по заданным границам [genArr 2 6 -> 2 3 4 5 6]

   genArr =. {. + i. @: ([: >: }.-{.)
   genArr 2 6
2 3 4 5 6

> PA>outside r = \p -> not (p `inRegion` r)
> PA>x /\ y = \p -> (p `inRegion` x) && (p `inRegion` y)
> PA>x \/ y = \p -> (p `inRegion` x) || (p `inRegion` y)
> PA>

> outside  = not
> (/\) = (&&)
> (\/) = (||)
>

This function was strictly unnecessary, and resulted in more lines of
code, but was considered to be an elegant form of self-documentation.

ie>>sumPowerOfTwo 2 6  .NB тут мои мозги закипели, выводит: 2 6 24 120 720... Почему?!!  :xz: 
LCR>

LCR>sumInts =. sum@:genArr
LCR>sumSquares =. sum@:square@genArr
LCR>sumPowerOfTwo =. sum@:powerOfTwo@genArr
LCR>

LCR>Ещё я не понял, почему функция называется sumPowerOfTwo, когда ты рисуешь факториал

LCR>   2&^ i. 10
LCR>1 2 4 8 16 32 64 128 256 512
LCR>   ! i.10
LCR>1 1 2 6 24 120 720 5040 40320 362880
LCR>

def powerOfTwo(x: int): int = if (x == 0) 1 else x * powerOfTwo(x - 1)

LCR>Это всего-лишь рекурсивный поиск с откатом Мне с моим чахлым воображением трудно представить, что в разных языках решения могут быть существенно разными. Единственный момент — это реализация с хвостовой рекурсией и без.

char[][] split(char[] s)
{
    size_t i;
    size_t istart = 0;
    bool inword = false;
    char[][] words;

    for (i = 0; i < s.length; i++)
    {
    switch (s[i])
    {
        case ' ':
        case '\t':
        case '\f':
        case '\r':
        case '\n':
        case '\v':
        if (inword)
        {
            words ~= s[istart .. i];
            inword = false;
        }
        break;

        default:
        if (!inword)
        {   istart = i;
            inword = true;
        }
        break;
    }
    }
    if (inword)
    words ~= s[istart .. i];
    return words;
}

alias char[] string;

string[] split(string s)
{
    bool is_delimiter(char c, string m)
    {
    if(m == "") return false;
    if(c == m[0]) return true;
    return is_delimiter(c, m[1 .. m.length]);
    }

    string[] r_split(string s, string word)
    {
    if(s == "") return [word];
    
    if(is_delimiter(s[0], " \n\t\f\r\n\v")) 
        return [word] ~ r_split(s[1 .. s.length], "");
    
    return r_split(s[1 .. s.length], word ~ s[0]);
    }
 
return  r_split(s, "");
}

M>Здесь мой мозг окончательно взорвался (такое происходит каждый раз, как я вижу J )

\frac{1}{2}mn(m+n)

LCR>>Это всего-лишь рекурсивный поиск с откатом Мне с моим чахлым воображением трудно представить, что в разных языках решения могут быть существенно разными. Единственный момент — это реализация с хвостовой рекурсией и без.

M>Всего лишь рекурсивный поиск с откатом, говоришь ? Трудно представить существенно разные решения говоришь ?

Public Function TryGuess() As Boolean
...
    ' Fill in with the next guess; work through all possibles
    For TrialIndex = 1 To nMaxGuesses
        nValue = TheNthPossible(GuessIndex, TrialIndex)
        If nValue <= 0 Then
            MsgBox "Run out of guesses!"
            Exit Function
        End If
        
        Call SetSquare(nValue, GuessIndex)
        
        If TrySolve() Then
            ' We are done
            Exit For
        Else
            Call UndoGuess(mnGuessLevel)
        End If
    Next
    
    ' If we're not there yet, we try another (recursive) guess at the next level
    If MissingValues() > 0 Then
        Call TryGuess
    End If
End Function

import List

type T = (Int,Int) -> [Int]

main = do
  s <- getContents
  putStr $ unlines $ map disp $ solve [input s]

solve :: [T] -> [T]
solve s = foldr search s idx where
    search p l = [mark (p,n) s | s <- l, n <- s p]

mark :: ((Int,Int),Int) -> T -> T
mark (p@(i,j),n) s q@(x,y) =
  if p==q then [n] else
  if x==i || y==j || e x i && e y j then delete n $ s q else s q
  where e a b = div (a-1) 3==div (b-1) 3

disp :: T -> String
disp s  = unlines [unwords [show $ head $ s (i,j) | j <- [1..9]] | i <- [1..9]]

input :: String -> T
input s = foldr mark (const [1..9]) $
  [(p,n) | (p,n) <- zip idx $ map read $ lines s >>= words, n>0]

idx :: [(Int,Int)]
idx = [(i,j) | i <- [1..9], j <- [1..9]]

FR>alias char[] string;

FR>string[] split(string s)
FR>{
FR>    bool is_delimiter(char c, string m)
FR>    {
FR>    if(m == "") return false;
FR>    if(c == m[0]) return true;
FR>    return is_delimiter(c, m[1 .. m.length]);
FR>    }

FR>    string[] r_split(string s, string word)
FR>    {
FR>    if(s == "") return [word];
    
FR>    if(is_delimiter(s[0], " \n\t\f\r\n\v")) 
FR>        return [word] ~ r_split(s[1 .. s.length], "");
    
FR>    return r_split(s[1 .. s.length], word ~ s[0]);
FR>    }
 
FR>return  r_split(s, "");
FR>}
FR>

object main extends Application {
  def split(s: String) = {
    def isCharInList(delims: List[Char])(c: Char): Boolean = delims match {
      case Nil  => false
      case head :: tail => if(head == c) true else isCharInList(tail)(c)
    }
    def isDelimiter = &isCharInList("\n\t\r ".toList)
    def resList(l: List[Char], word: String): List[String] = l match {
      case Nil  => List(word)
      case x :: xs if isDelimiter(x) => word :: resList(xs, "")
      case x :: xs => resList(xs, word + x)
    }
    resList(testStr.toList, "").filter(x => x != "")
  }
  val testStr = " word1   word2\t\t\t\t\n\nword3"
  Console.println(split(testStr))
}

PA>>outside r = \p -> not (p `inRegion` r)
PA>>x /\ y = \p -> (p `inRegion` x) && (p `inRegion` y)
PA>>x \/ y = \p -> (p `inRegion` x) || (p `inRegion` y)

Т>outside  = not
Т>(/\) = (&&)
Т>(\/) = (||)

inRegion {- x  p -} = ($) -- x $ p = p x
-- поэтому ниже мы его выплавим

outside {- x   p -} = f_gx    (not) {- x   p -}
(/\)    {- x y p -} = f_gx_hx (&&)  {- x y p -}
(\/)    {- x y p -} = f_gx_hx (||)  {- x y p -}

-- где комбинаторы
f_gx    f g x   = f (g x)       -- хорошо известный (.)
f_gx_hx f g h x = f (g x) (h x) -- лень выводить (в базисе Прелюдии будет выглядеть страшно)

К>inRegion {- x  p -} = ($) -- x $ p = p x
К>-- поэтому ниже мы его выплавим

К>outside {- x   p -} = f_gx    (not) {- x   p -}
К>(/\)    {- x y p -} = f_gx_hx (&&)  {- x y p -}
К>(\/)    {- x y p -} = f_gx_hx (||)  {- x y p -}

К>-- где комбинаторы
К>f_gx    f g x   = f (g x)       -- хорошо известный (.)
К>f_gx_hx f g h x = f (g x) (h x) -- лень выводить (в базисе Прелюдии будет выглядеть страшно)
К>

instance Monad ((->) a) where
    return  a = \x-> a
    (>>=) f g  = \x-> g (f x) x

lift2 :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c 
lift2 = liftM2 

lift1 = (.)

outside = lift1 not
(/\) =  lift2 (&&)
(\/) =  lift2 (||)

public FindUsages(line: string, testCase : int, declaration : Location, starter : string) : bool
{
    в тестовом сорце встречаются строки вида 
        mutable acquired = false; // definition {2} acquired     (явное указание объявлений в комментах)
    и строки вида
        acquired = true;  // usage {2}


    выявляем, что ищем
    def name = starter.Substring(starter.IndexOf('}') + 1).Trim();
    def position = line.IndexOf(name);
    def location = Location(declaration.File, declaration.Line, position, declaration.Line, position + name.Length);
    WriteLine($"\nSearching for usages of '$name' (test case: $testCase, location: $location)... ");
    выявили эн вхождений, для которых будем тестировать find references пакета интеграции
    def shouldFindRing = MakeUsage(line, declaration, name, starter) ::
        ScanSources(checkPhrase, testCase).Map((line, _, location, _) => MakeUsage(line, location, name, checkPhrase));
    Write($"\n Should find $(shouldFindRing.Length) usages... ");
    
    для каждого вхождения имитируем клик на нём юзером, и выбор команды find references
    получается список из эн списков, каждый из которых должен быть равен другому
    (действие команды не зависит от того, на каком вхождении кликнул юзер)
    def foundMultiple =
        shouldFindRing.Map(goto =>
        {
            def location = goto.Location;
            def shift = if (name.Length > 1) 1 else 0;
            TheEngine.Project.GetUsages(location.File, location.Line, location.Column + shift).ToList()
        });
    Assert.IsFalse(foundMultiple.IsEmpty); что-то найти мы должны
    здесь собственно, применяем функциональный стиль для проверки равенства этих списков
    def found = foundMultiple.FoldLeft(foundMultiple.Head, (ring, ring') =>
    {
        mutable coincide = false;
        def warning = "Find Usages should produce the same results, disregarding on which usage a user places a cursor";
        try
        {
            coincide = FoldLeft2(ring, ring', true, (a, b, coincideToTheLeft) =>
                if (coincideToTheLeft) a.Location.CompareLines(b.Location) == 0 else false);
        }
        catch
        {
            | _ => coincide = false;
        }
        when (stopAfterFirstFailedTest)
            Assert.IsTrue(coincide, warning);
        ring
    });
    Write($"found $(found.Length) usages, checking for correspondance... ");
    
    а дальше нужно проверить, что найдено действительно то, что должно быть найденно, но это уже другая история...
    def success = FoundUsagesAreRight(testCase, shouldFindRing, found);
    def message = if (success) "ok" else "incorrect!.. saving changes...";
    WriteLine(message);
    success
}

>> inRegion {- x  p -} = ($) -- x $ p = p x
>> -- поэтому ниже мы его выплавим
PA>-- на самом деле inRegion = flip ($)

flip ($) x y = ($) y x = y $ x = x y
flip ($) = id

point `inRegion` region = region point = point $ region
inRegion = ($)

> point `inRegion` region = region point = point $ region
> inRegion = ($)
>

region point = point $ region

Prelude>:t ($)
($) :: (a -> b) -> a -> b

> flip ($) = id
>

key_value_pairs |>
sort (fun (_, x) (_, y) -> compare y x) |>
first 10 |> map fst |> String.concat ";" |> print_endline

    search p l = [mark (p,n) s | s <- l, n <- s p]
                                        -- ^^^^^^^^ здесь s p вернет
                                        -- пустой список, если позиция
                                        -- на доске бесперспективная

G>Вот то же, но со списками, паттерн матчингом и каррингом

def split(s, delim = lambda c : c in " \n\t\f\r\n\v", word = ""):
    if not s: return [word]
    
    if delim(s[0]): return [word] + split(s[1:], delim, "")
        
    return split(s[1:], delim, word + s[0])

Split2(str : string) : array[string]
{
    mutable i = 0; 
    def next () { if (i < str.Length) { def ch = str[i]; i++; ch } else '\0' } 
    def word = Text.StringBuilder();
    def words = Generic.List();
    def addWord() { when (word.Length != 0) { words.Add(word.ToString()); word.Length = 0; } }
    def split(_)
    {
        | '\t' | '\n' | '\'' | ' ' => addWord();          split(next())
        | '\0'                     => addWord();
        | x                        => _ = word.Append(x); split(next())
    }
    
    split(next());
    words.ToArray();
}

FR>def split(s, delim = lambda c : c in " \n\t\f\r\n\v", word = ""):
FR>    if not s: return [word]
    
FR>    if delim(s[0]): return [word] + split(s[1:], delim, "")
        
FR>    return split(s[1:], delim, word + s[0])
FR>

def split2(s, delim = lambda c : c in " \n\t\f\r\n\v"):
    def _(sum, c):
        if delim(c): return sum + [""]
        return sum[:-1] + [sum[-1] + c]
        
    return reduce(_, s, [""])

widget.on_mouse_down {|button, x, y| ...} #функция-обработчик всех сообщений mouse_down
widget.on_mouse_down(LEFT_BUTTON) {|x, y| ...} #сюда паттерн-матчатся только left_mouse_down

#и т.п.
widget.on_key_press{|key, shifts| ...}
widget.on_key_press(Key::A){|shifts| ...}
widget.on_key_press(Key::A, Key::SHIFT){ ...}
widget.on_key_press(nil, Key::SHIFT){|key| ...}

#это мы определили переменную-лямбду
l = lambda{|param1, param2, param3| code}

#а это мы определяем блок переданный в функцию myfoo
myfoo(param1, param2){|block_param1, block_param2| code}

#другой вариант того же синтаксиса:
myfoo(param1, param2) do |block_param1, block_param2| code end
#или даже так:
myfoo param1, param2 do |block_param1, block_param2| code end

#пример использования на реальной библиотечной функции:
arr = [1,2,3,4]
print arr.sort{|left, right| right <=> left} #задаем лямбду сравнивающую значения
#этот код выведет [4, 3, 2, 1]

#функция, одним из параметров которой является лямбда, может выглядеть так:

def sort  #неявный параметр-блок не указывается...
   ...
   result = yield(left, right) #...и вызывается yield'ом
   ...
end

#а может выглядеть так:
#параметр-блок указывается явно, на то, что он должен быть блоком, указывает &
def sort(&block)  
   ...
   some_variable = block  #блок теперь обычная переменная, его можно хранить, передавать, возвращать...
   block.call(a,b,c) #ну и вызывать, конечно.
   ...
end

#есть объект widget
#его функция on_key_press вызывается с параметром-блоком; у блока есть параметры key, shifts
widget.on_key_press{|key, shifts| ...}

#сама функция on_key_press может выглядеть так:
class Widget
  def on_key_press(*arg, &handler)
    #* перед arg - оператор свертки, функция может принять любое количество аргументов 
    #и все они окажутся в массиве arg
    #в данной функции arg представляют собой паттерн, которому должно соответствовать событие
    #чтобы оно было отдиспатчено в handler
    
    #сохраняем обработчик в хеш:
    @handlers_hash[arg] = handler
  end

  #а вот что происходит где-то внутри window_proc:
  def window_proc(message_params)
    @handlers_hash.each do |key, value|
       message_params.match(key){|*match_res| value.call(*match_res)  }
    end
  end
end

#например, если мы установили такой обработчик:
widget.on_key_press(Key::A){|shifts| ...}

#то где-то в window_proc он будет вызыван, только в случае если нажата клавиша A 
#и любое сочетание Alt, Ctrl, Shift; при этом сочетание "шифтов" будет передано в блок.