proc ::fptools::lpipe args {
    set shortcutSyntax 1
    set singleArg 1

    if {[llength $args] == 0} {
        wrongnargs {?-option ...? value {?lambdaArgs1 lambdaBody1 ...?}}
    } else {
        for {set i 0} {[string match -* [lindex $args $i]]} {incr i} {
            set option [lindex $args $i]
            switch -exact -- $option {
                -- {
                    break
                }
                -expanded {
                    set singleArg 0
                }
                -long {
                    set shortcutSyntax 0
                }
                default {
                    error "unknown option: \"$option\""
                }
            }
        }
        set value [lindex $args $i]
        if {$singleArg} {
            set lambdas [lindex $args $i+1]
            if {[llength $args] > $i + 2} {
                error "too many arguments: \"[lrange $args $i+2 end]\";\
                        did you forget to use the option -expanded?"
            }
        } else {
            set lambdas [lrange $args $i+1 end]
        }
    }

    # Get one lambda from the list.
    set getLambda {
        {} {
            upvar 1 shortcutSyntax shortcutSyntax
            upvar 1 lambdas lambdas
            upvar 1 i i
            set lambda [lindex $lambdas $i]
            if {$shortcutSyntax} {
                set lambda [list $lambda [lindex $lambdas $i+1]]
                incr i
            }
            return $lambda
        }
    }

    for {set i 0} {$i < [llength $lambdas]} {incr i} {
        if {[lindex $lambdas $i] in {map map* each each*}} {
            # Map N arguments (however many the lambda has) using the lambda to
            # one ("map" mode) or many ("map*" mode) items.
            set flatten [expr {[lindex $lambdas $i] in {map* each*}}]

            incr i
            set lambda [apply $getLambda]
            set lambdaArgCount [llength [lindex $lambda 0]]

            set newValue {}
            for {set j 0} {$j < [llength $value]} {incr j $lambdaArgCount} {
                set items {}
                for {set k $j} {$k < $j + $lambdaArgCount} {incr k} {
                    lappend items [lindex $value $k]
                }
                set itemsResult [uplevel 1 [list apply $lambda {*}$items]]
                if {$flatten} {
                    lappend newValue {*}$itemsResult
                } else {
                    lappend newValue $itemsResult
                }
            }
            set value $newValue
        } elseif {[lindex $lambdas $i] eq {filter}} {
            # Filter.
            incr i
            set lambda [apply $getLambda]
            set newValue {}
            foreach item $value {
                if {[uplevel 1 [list apply $lambda $item]]} {
                    lappend newValue $item
                }
            }
            set value $newValue
        } elseif {[lindex $lambdas $i] in {reduce foldl foldr}} {
            # Reduce the list to a single value with a two-argument lambda.
            if {[lindex $lambdas $i] eq {foldr}} {
                set value [lreverse $value]
            }
            incr i
            set lambda [apply $getLambda]
            set left [lindex $value 0]
            foreach right [lrange $value 1 end] {
                set left [uplevel 1 [list apply $lambda $left $right]]
            }
            set value $left
        } else {
            # Apply the lambda to the list.
            if {[lindex $lambdas $i] in {apply all}} {
                incr i
            }
            set lambda [apply $getLambda]
            set value [uplevel 1 [list apply $lambda $value]]
        }
    }

    return $value
}


### List tools

# Generate a list containing a range of integers.
proc ::fptools::range args {
    set start 0
    set end 0
    set step 1
    switch -exact -- [llength $args] {
        1 {lassign $args end}
        2 {lassign $args start end}
        3 {lassign $args start end step}
        default {
            wrongnargs {?start? end ?step?}
        }
    }
    if {$step == 0} {
        error "step can't be zero"
    }
    if {($end - $start) * $step < 0} {
        error "can't use step $step with a range from $start to $end"
    }

    set result {}
    for {set i $start} {$i < $end} {incr i $step} {
        lappend result $i
    }
    return $result
}

# Return the unique elements in a list.
proc ::fptools::luniq list {
    return [lsort -unique $list]
}

# Take $n elements randomly (uniformly) sampled from a list.
proc ::fptools::lsample {list {n 1}} {
    set result {}
    for {set i 0} {$i < $n} {incr i} {
        lappend result [lindex $list [expr {
            int(rand() * [llength $list])
        }]]
    }
    return $result
}

# Return 1 if the list is empty and 0 otherwise.
proc ::fptools::lempty {list} {
    expr {[llength $list] == 0}
}

# Return only those elements of $list for which $script evaluates to true.
proc ::fptools::lfilter {varName list script} {
    upvar 1 $varName var
    set result {}
    foreach var $list val $list {
        if {[uplevel 1 $script]} {
            lappend result $val
        }
    }
    return $result
}

# Reduce (left fold) a list of values to a single value using $script. To get a
# right fold reverse the list first with [lreverse].
proc ::fptools::lreduce {varNameFirst varNameSecond initValue list script} {
    upvar 1 $varNameFirst first
    upvar 1 $varNameSecond second
    set first $initValue
    foreach second $list {
        set first [uplevel 1 $script]
    }
    return $first
}

# Compare the elements in two lists with the binary operation $op. Returns
# 1 or 0.
proc ::fptools::lcompare {list1 list2 {op eq}} {
    if {[info commands {::tcl::mathop::*}] eq {}} {
        # Jim Tcl.
        set compareLambda [format {
            {a b _} {
                expr {$a %s $b}
            }
        } $op]
    } else {
        set compareLambda {
            {a b op} {
                ::tcl::mathop::$op $a $b
            }
        }
    }
    foreach elem1 $list1 elem2 $list2 {
        if {![apply $compareLambda $elem1 $elem2 $op]} {
            return 0
        }
    }
    return 1
}

# Flatten a list of nested lists $n levels.
proc ::fptools::lflatten {list {n 1}} {
    set stack [list $list 0]
    set result {}
    while {[llength $stack] > 0} {
        lassign $stack elem depth
        set stack [lrange $stack 2 end]
        if {([llength $elem] > 1) && ($depth <= $n)} {
            foreach subelem $elem {
                set stack [linsert $stack 0 $subelem [expr {$depth + 1}]]
            }
        } else {
            set result [linsert $result 0 $elem]
        }
    }
    return $result
}

# Create a new list by applying multiple scripts to the values in a list.
proc ::fptools::lmultimap args {
    if {[llength $args] < 3} {
        wrongnargs {varList list script ?script...?}
    }

    lassign $args varList list
    set scripts [lrange $args 2 end]

    set varListLength [llength $varList]
    foreach varName $varList {
        upvar 1 $varName "loopVars$varName"
    }

    set result {}
    for {set i 0} {$i < [llength $list]} {incr i $varListLength} {
        foreach varName $varList value \
                [lrange $list $i [expr {$i + $varListLength - 1}]] {
            set "loopVars$varName" $value
        }
        foreach script $scripts {
            lappend result [uplevel 1 $script]
        }
    }
    return $result
}

# Take any arguments and return an empty string.
proc ::fptools::discard args {
    return {}
}

# Remove and return $n elements from the list stored in the variable $varName.
proc ::fptools::lshift! {varName {n 1}} {
    upvar 1 $varName list
    set result [lrange $list 0 $n-1]
    set list [lrange $list $n end]
    return $result
}

# Get multiple elements from $list using the [lindex] notation.
proc ::fptools::lmultiindex {list args} {
    set result {}
    foreach index $args {
         lappend result [lindex $list $index]
    }
    return $result
}

# Get multiple ranges of elements from $list.
proc ::fptools::lmultirange {list args} {
    set result {}
    foreach {from to} $args {
        lappend result [lrange $list $from $to]
    }
    return $result
}

### Pattern matching.

# Match a list against a list pattern. A list pattern consists of element
# patterns, one for each element in the list. An element pattern can be
# preceded by an option that says what kind of pattern it is. The pattern
# options are: "-exact", "-glob", "-lambda", "-command" and "-regexp".
#
# Matching has two modes: strict and nonstrict. In nonstrict mode, which is
# the default mode, if a list is longer than the list pattern only as many
# elements as there are in the list pattern are checked against it. In strict
# mode a list that is longer than the list pattern does not match the list
# pattern. In nonstrict mode an empty pattern matches everything; in strict
# mode it matches nothing.
#
# If you want to match a pattern that starts with a dash ("-") you need to use
# a match option or "--" before it.
proc ::fptools::match {listPattern list {debug 0}} {
    set matchModeDefault -glob
    set matchMode $matchModeDefault
    # Can the next $p be an option?
    set canBeAnOption 1
    # Options that affect all patterns.
    set specialOptions {-strict --}
    # All possible match modes.
    set matchModes {-exact -glob -lambda -command -regexp}
    set lengthMatch 0
    if {$debug} {
        puts "matching [list $list] against [list $listPattern]"
    }

    set i 0
    foreach p $listPattern {
        if {$debug} {
            puts "    $p"
        }
        if {$canBeAnOption && ([string index $p 0] eq "-")} {
            if {$p in $specialOptions} {
                if {$debug} {
                    puts {        special option}
                }

                switch -exact -- $p {
                    -nonstrict {
                        set lengthMatch 0
                    }
                    -strict {
                        set lengthMatch 1
                    }
                    -- {
                        set canBeAnOption 0
                    }
                }
            } else {
                if {$debug} {
                    puts {        match mode}
                }
                if {$p in $matchModes} {
                    set matchMode $p
                    set canBeAnOption 0
                } else {
                    return -code error "bad option \"$p\""
                }
            }
            continue
        } else {
            set canBeAnOption 1
        }

        set elem [lindex $list $i]
        incr i

        if {$debug} {
            puts "        element: $elem"
        }
        set gotMatch [switch -exact -- $matchMode {
            -exact {
                expr {$elem eq $p}
            }
            -glob {
                string match $p $elem
            }
            -lambda {
                uplevel 1 [list apply $p $elem]
            }
            -command {
                uplevel 1 [list {*}$p $elem]
            }
            -regexp {
                regexp $p $elem
            }
            default {
                error "unknown match mode $matchMode\
                        got through the initial check"
            }
        }]
        if {$debug} {
            puts "        matched: $gotMatch"
        }
        # Reset matchMode for the next match.
        set matchMode $matchModeDefault
        if {!$gotMatch} {
            return 0
        }
    }
    if {$lengthMatch && ($i < [llength $list])} {
        return 0
    }
    return 1
}

# If a list matches a list pattern (using [::fptools::match]) run a script that
# corresponds to it. One of the patterns given must match or else an error is
# generated. If the script is "-", fall through to the next script.
proc ::fptools::mswitch args {
    if {[llength $args] == 2} {
        lassign $args list statements
    } elseif {[llength $args] >= 3} {
        set list [lindex $args 0]
        set statements [lrange $args 1 end]
    } else {
        wrongnargs {list pattern script ?pattern script?}
    }
    if {[llength $statements] % 2 == 1} {
        return -code error {extra mswitch pattern with no script}
    }

    for {set i 0} {$i < [llength $statements]} {incr i 2} {
        set pattern [lindex $statements $i]
        set script [lindex $statements $i+1]
        if {($pattern eq {default}) || [match $pattern $list]} {
            # Fallthrough.
            while {$script eq {-}} {
                incr i 2
                set script [lindex $statements $i+1]
            }
            return [uplevel 1 $script]
        }
    }
    error {no matches}
}

### Tests.

namespace eval ::fptools::tests {
    variable verbose 0
}

proc ::fptools::tests::assert expr {
    variable verbose
    if {$verbose} {
        puts "asserting $expr"
    }
    if {![expr $expr]} {
        error "assertion failed: $expr"
    }
}

proc ::fptools::tests::run {} {
    # [::fptools::pipe] test.
    assert {
        [::fptools::pipe 2 {
            expr { $_ + 1}
        } {
            expr { $pipe(0) + $pipe(1) }
        }] == 5
    }

    # [::fptools::lpipe] tests.
    assert {
        [::fptools::lpipe -long {1 2 3 4} {
            each {{x} { expr { $x + 1 } }}
            all {{x} { concat 1 $x 6 }}
        }] == {1 2 3 4 5 6}
    }
    assert {
        [::fptools::lpipe -expanded {k1 v1 k2 v2} each* {x y} { list $y $x }]
        == {v1 k1 v2 k2}
    }
    assert {
        [::fptools::lpipe -expanded {a b c} each* {x y z} { list $y $z $x }]
        == {b c a}
    }

    # [::fptools::range] tests.
    assert {[::fptools::range 10] eq {0 1 2 3 4 5 6 7 8 9}}
    assert {[::fptools::range 1 10] eq {1 2 3 4 5 6 7 8 9}}
    assert {[::fptools::range -10 0 1] eq {-10 -9 -8 -7 -6 -5 -4 -3 -2 -1}}
    assert {[catch {::fptools::range 0 10 -1}]}
    assert {[catch {::fptools::range -10 -7 -1}]}
    assert {[catch {::fptools::range 10 0 1}]}
    assert {[catch {::fptools::range -7 -10 1}]}
    assert {[::fptools::range 0 0 1] eq {}}

    # [::fptools::lcompare] tests.
    assert {[::fptools::lcompare {1 2 3} {1 2 3}]}
    assert {[::fptools::lcompare {1 2 a} {1 2 a}]}
    assert {![::fptools::lcompare {1 2 3} {1 2}]}
    assert {![::fptools::lcompare {1 2} {1 2 3}]}
    assert {[::fptools::lcompare {0 1 2} {1 2 3} <]}
    assert {[::fptools::lcompare {1 2 3} {0 1 2} >]}
    assert {[::fptools::lcompare {1 2 3} {1 2 3} ==]}
    assert {[::fptools::lcompare {1 2 3} {-7 -9 -11} !=]}

    # [::fptools::lflatten] tests.
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}}] eq {1 2 3 4 5 {6 7}}}
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}} 0] eq {1 2 3 {4 5 {6 7}}}}
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}} 1] eq {1 2 3 4 5 {6 7}}}
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}} 2] eq {1 2 3 4 5 6 7}}
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}} 3] eq {1 2 3 4 5 6 7}}
    assert {[::fptools::lflatten {1 2 3 {4 5 {6 7}}} 99] eq {1 2 3 4 5 6 7}}

    # [::fptools::lmultimap] tests.
    assert {[::fptools::lmultimap {x y} {1 2 3} {
        lindex $x-$y}] eq {1-2 3-}}

    assert {[::fptools::lmultimap {x y} {1 2 3} {
        lindex $x-$y} {lindex $x} {lindex $y}]
        eq {1-2 1 2 3- 3 {}}
    }

    # [::fptools::lmultirange] tests.
    assert {[::fptools::lmultirange {0 1 2 3 4} 0 0 1 end]
        eq {0 {1 2 3 4}}}
    assert {[::fptools::lmultirange {0 1 2 3 4} end end 0 end-1]
        eq {4 {0 1 2 3}}
    }

    # [::fptools::match] and [::fptools::mswitch] tests.
    assert [::fptools::mswitch {a b c} \
        {* * c} {lindex 1} \
        default {lindex 0}
    ]
    assert [::fptools::mswitch {a b c} \
        {-glob * -glob * -exact c} {lindex 1} \
        default {lindex 0}
    ]
    assert [::fptools::mswitch {a b c} \
        {-glob * -glob * -regexp [a-z]} {lindex 1} \
        default {lindex 0}
    ]
    assert [::fptools::mswitch {a b x} \
        {-glob * -glob * -regexp [a-z]} {lindex 1} \
        default {lindex 0}
    ]
    assert {![::fptools::mswitch {a b x} \
        {-glob * -glob * c} {lindex 1} \
        default {lindex 0}]
    }
    # Use the next pattern's script.
    assert {[
        ::fptools::mswitch {a b c} {* * c} - \
            pattern1 {lindex 1} \
            default {lindex 0}
    ]}

    assert {[::fptools::mswitch {a b c} \
        pattern0 - \
        pattern1 - \
        pattern2 {lindex 0} \
        default - \
        {never reached} {lindex 1}
    ]}
    # Match the literal word "default", not the *default option*, with a
    # switch.
    assert [::fptools::mswitch default \
        {-exact default} {lindex 1} \
        default {lindex 0}
    ]
    assert [::fptools::mswitch default \
            { default } {lindex 1} \
            default {lindex 0}
    ]
    # Two-argument mswitch.
    assert [::fptools::mswitch {a b c} {
        {* * c} {lindex 1}
        default {lindex 0}
    }]

    assert [::fptools::match {} {a b c}]
    assert {
        ![::fptools::match {-strict} {a b c}]
    }
    assert [::fptools::match {a b c} {a b c d e f g h}]
    assert {
        ![::fptools::match {-strict a b c d e f g h} {a b c}]
    }
    assert [::fptools::match \
            {-strict -glob a -strict -exact b -strict c} {a b c}]
    assert [::fptools::match {-strict -- ------} ------]
    assert { [catch { ::fptools::match {------} {------} }] }
    assert [::fptools::match {-exact -exact} -exact]
    assert [::fptools::match {-- -exact} -exact]
    assert [::fptools::match {-glob -glob} -glob]
    assert [::fptools::match {-- -glob} -glob]
    assert [::fptools::match {-lambda {{x} {expr {$x == 5}}}} 5]
    assert [::fptools::match {-command {string is integer -strict}} 118]
    assert {
        ![::fptools::match {-command {string is integer -strict}} hello]
    }
}

# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    lassign $argv command
    if {$command in {report list}} {
        # Print all procedures.

        set runningJimTcl [catch { info tclversion }]
        if {$runningJimTcl} {
            proc argsWithDefaults {procName} {
                return [info args $procName]
            }
        } else {
            proc argsWithDefaults {procName} {
                set arguments {}
                foreach argument [info args $procName] {
                    if {[info default $procName $argument defaultValue]} {
                        lappend arguments [list $argument $defaultValue]
                    } else {
                        lappend arguments $argument
                    }
                }
                return $arguments
            }
        }

        foreach procName [lsort [info procs ::fptools::*]] {
            puts "$procName \{[argsWithDefaults $procName]\}"
        }
    } elseif {$command eq {test}} {
        if {[lindex $argv 1] eq {--verbose}} {
            set ::fptools::tests::verbose 1
        }
        ::fptools::tests::run
    } else {
        puts "unknown command line arguments: \"$argv\";\
            must be \"report\" or \"test\""
        exit 1
    }
}