Index: openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl,v
diff -u -N -r1.10.2.2 -r1.10.2.3
--- openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 24 Sep 2020 13:24:30 -0000 1.10.2.2
+++ openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 24 Sep 2020 13:34:19 -0000 1.10.2.3
@@ -17,7 +17,7 @@
f = a function
x = an element
xs = a list of elements
-
+
@author Mark Dettinger (mdettinger@arsdigita.com)
@creation-date March 29, 2000
@cvs-id $Id$
@@ -31,9 +31,9 @@
namespace eval ::f {
# This library was completely rewritten on July 18, 2000.
-# The design is now much cleaner. Constructed functions
+# The design is now much cleaner. Constructed functions
# are no longer represented by strings, but by real
-# (callable) function objects. The auxiliary functions
+# (callable) function objects. The auxiliary functions
# eval_unary and eval_binary are gone.
# Special thanks go to Sarah Arnold and Carsten Clasohm for extensive
@@ -48,7 +48,7 @@
ad_proc -public -deprecated lambda {args body} {
The lambda function - one of the foundations of functional programming -
defines an anonymous proc and returns it. This is useful if you quickly
- need an auxiliary function for a small task.
+ need an auxiliary function for a small task.
Examples
@@ -92,8 +92,8 @@
} {
set i 0
foreach arg $args {
- append code "set [lindex [info args $f] $i] {$arg}\n"
- incr i
+ append code "set [lindex [info args $f] $i] {$arg}\n"
+ incr i
}
append code [info body $f]
set proc_args [info args $f]
@@ -106,12 +106,12 @@
append code [info body $f]
set proc_args [info args $f]
set num_proc_args [llength $proc_args]
- lambda [cons [head $proc_args] [lrange $proc_args 2 $num_proc_args]] $code
+ lambda [cons [head $proc_args] [lrange $proc_args 2 $num_proc_args]] $code
}
# --------------------------------------------------------------------------------
# We now define several binary operators as procs, so we can pass them
-# as arguments to other functions.
+# as arguments to other functions.
# --------------------------------------------------------------------------------
proc + {a b} {expr {$a + $b}}
@@ -123,7 +123,7 @@
proc > {a b} {expr {$a > $b}}
proc < {a b} {expr {$a < $b}}
-# Example:
+# Example:
# + 5 6 = 11
# --------------------------------------------------------------------------------
@@ -165,15 +165,15 @@
-
- fold + 0 [list 1 2 3 4] = 10
+ fold + 0 [list 1 2 3 4] = 10
fold * 1 [list 1 2 3 4] = 24
} {
set result $e
foreach x $xs {
- set result [$f $result $x]
+ set result [$f $result $x]
}
return $result
}
@@ -195,9 +195,9 @@
} {
if { [null_p $xs] } {
- error "ERROR: fold1 is undefined for empty lists."
- } else {
- fold $f [head $xs] [tail $xs]
+ error "ERROR: fold1 is undefined for empty lists."
+ } else {
+ fold $f [head $xs] [tail $xs]
}
}
@@ -209,9 +209,9 @@
and returns {e (f e x1) (f (f e x1) x2) ...}" {
set current_element $e
set result [list $e]
- foreach x $xs {
- set current_element [$f $current_element $x]
- lappend result $current_element
+ foreach x $xs {
+ set current_element [$f $current_element $x]
+ lappend result $current_element
}
return $result
}
@@ -223,9 +223,9 @@
ad_proc -public scanl1 {f xs} "takes a binary function f and a list {x1 x2 x3 ...}
and returns {x1 (f x1 x2) (f (f x1 x2) x3) ...}" {
if { [null_p $xs] } {
- error "ERROR: scanl1 is undefined for empty lists."
- } else {
- scanl $f [head $xs] [tail $xs]
+ error "ERROR: scanl1 is undefined for empty lists."
+ } else {
+ scanl $f [head $xs] [tail $xs]
}
}
@@ -257,11 +257,11 @@
set big_elmts {}
set small_elmts {}
foreach x [tail $xs] {
- if { [$value $x] > [$value $pivot] } {
- lappend big_elmts $x
- } else {
- lappend small_elmts $x
- }
+ if { [$value $x] > [$value $pivot] } {
+ lappend big_elmts $x
+ } else {
+ lappend small_elmts $x
+ }
}
concat [qsort $small_elmts $value] [list $pivot] [qsort $big_elmts $value]
}
@@ -305,7 +305,7 @@
# ----------
# Using "map" and "uncurry", convert the tuple list
# {{3 1} {4 1} {5 9} {2 6}} into {1 1 5 2} (each tuple is replaced
-# by the minimum of its two components).
+# by the minimum of its two components).
ad_proc -public fst {xs} "returns the first element of a list" {
lindex $xs 0
@@ -314,7 +314,7 @@
ad_proc -public snd {xs} "returns the second element of a list" {
lindex $xs 1
}
-
+
ad_proc -public thd {xs} "returns the third element of a list" {
lindex $xs 2
}
@@ -364,7 +364,7 @@
}
ad_proc -public gcd {x y} "returns the greatest common divisor of x and y" {
- gcd' [abs $x] [abs $y]
+ gcd' [abs $x] [abs $y]
}
proc gcd' {x y} {
@@ -471,7 +471,7 @@
ad_proc -public head {xs} "first element of a list" {
lindex $xs 0
}
-
+
ad_proc -public last {xs} "last element of a list" {
lindex $xs [expr {[llength $xs]-1}]
}
@@ -502,9 +502,9 @@
} {
set result {}
foreach x $xs {
- if { [$pred $x] } {
- lappend result $x
- }
+ if { [$pred $x] } {
+ lappend result $x
+ }
}
return $result
}
@@ -532,7 +532,7 @@
# cycle 4 {1 2 3} = {1 2 3 1 2 3 1 2 3 1 2 3}
ad_proc -public cons {x xs} "inserts x at the front of the list xs" {
- concat [list $x] $xs
+ concat [list $x] $xs
}
ad_proc -public reverse {xs} "reverses the list xs" {
@@ -550,9 +550,9 @@
ad_proc -public nub {xs} "removes duplicates from xs" {
set result {}
foreach x $xs {
- if { [not_elem_p $x $result] } {
- lappend result $x
- }
+ if { [not_elem_p $x $result] } {
+ lappend result $x
+ }
}
return $result
}
@@ -564,7 +564,7 @@
ad_proc -public enum_from_to {lo hi} "generates {lo lo+1 ... hi-1 hi}" {
set result {}
for {set i $lo} {$i<=$hi} {incr i} {
- lappend result $i
+ lappend result $i
}
return $result
}
@@ -575,7 +575,7 @@
ad_proc -public zip {args} "takes two lists {x1 x2 x3 ...} and {y1 y2 y3 ...} and
returns a list of tuples {x1 y1} {x2 y2} {x3 y3} ...
- Works analogously with 3 or more lists." {
+ Works analogously with 3 or more lists." {
transpose $args
}
@@ -591,9 +591,9 @@
returns the list {(f x1 y1) (f x2 y2) (f x3 y3) ...}" {
set result {}
foreach x $xs y $ys {
- if { !([null_p $x] || [null_p $y]) } {
- lappend result [$f $x $y]
- }
+ if { !([null_p $x] || [null_p $y]) } {
+ lappend result [$f $x $y]
+ }
}
return $result
}
@@ -609,17 +609,17 @@
set num_lists [llength $lists]
if {!$num_lists} { return "" }
for {set i 0} {$i<$num_lists} {incr i} {
- set l($i) [lindex $lists $i]
+ set l($i) [lindex $lists $i]
}
set result {}
while {1} {
- set element {}
- for {set i 0} {$i<$num_lists} {incr i} {
- if {[null_p $l($i)]} { return $result }
- lappend element [head $l($i)]
- set l($i) [tail $l($i)]
- }
- lappend result $element
+ set element {}
+ for {set i 0} {$i<$num_lists} {incr i} {
+ if {[null_p $l($i)]} { return $result }
+ lappend element [head $l($i)]
+ set l($i) [tail $l($i)]
+ }
+ lappend result $element
}
# Note: This function takes about n*n seconds
@@ -643,8 +643,8 @@
} {
set result {}
for {set i 0} {$i<$n} {incr i} {
- lappend result $x
- set x [$f $x]
+ lappend result $x
+ set x [$f $x]
}
return $result
}
@@ -654,9 +654,9 @@
set left {}
set right {}
foreach x $xs {
- # assertion: x is a tuple
- lappend left [lindex $x 0]
- lappend right [lindex $x 1]
+ # assertion: x is a tuple
+ lappend left [lindex $x 0]
+ lappend right [lindex $x 1]
}
return [list $left $right]
}
@@ -687,19 +687,19 @@
ad_proc -public take_while {p xs} "returns the longest initial segment of xs whose
elements satisfy p" {
- set index 0
+ set index 0
foreach x $xs {
- if { ![$p $x] } { break }
- incr index
+ if { ![$p $x] } { break }
+ incr index
}
take $index $xs
}
ad_proc -public drop_while {p xs} "returns the remaining portion of the list" {
- set index 0
+ set index 0
foreach x $xs {
- if { ![$p $x] } { break }
- incr index
+ if { ![$p $x] } { break }
+ incr index
}
drop $index $xs
}
@@ -710,10 +710,10 @@
ad_proc -public take_until {p xs} "returns the list of elements up to and including the
first element of xs which satisfies p" {
- set index 0
+ set index 0
foreach x $xs {
- incr index
- if { [$p $x] } { break }
+ incr index
+ if { [$p $x] } { break }
}
take $index $xs
}
@@ -741,18 +741,18 @@
ad_proc -public pascal {size} "prints Pascal's triangle" {
for {set n 0} {$n<=$size} {incr n} {
- puts [map [bind choose $n] [enum_from_to 0 $n]]
+ puts [map [bind choose $n] [enum_from_to 0 $n]]
}
}
ad_proc -public prime_p {n} {
@return 1 if n is prime
-} {
+} {
if { $n<2 } { return 0 }
if { $n==2 } { return 1 }
if { [even_p $n] } { return 0 }
for {set i 3} {$i*$i<=$n} {incr i 2} {
- if { $n%$i==0 } { return 0 }
+ if { $n%$i==0 } { return 0 }
}
return 1
}
@@ -764,9 +764,9 @@
# This is an extreme example for test purposes only.
# This way of programming is not recommended. Kids: do not try this at home.
flip join \n [map [bind compose [bind flip join ""] [bind map [bind compose \
- [lambda {s} {format %4d $s}] product]]] \
- [map transpose [transpose [list [map [bind copy $x] [enum_from_to 1 $x]] \
- [copy $x [enum_from_to 1 $x]]]]]]
+ [lambda {s} {format %4d $s}] product]]] \
+ [map transpose [transpose [list [map [bind copy $x] [enum_from_to 1 $x]] \
+ [copy $x [enum_from_to 1 $x]]]]]]
}
# --------------------------------------------------------------------------------