First-class functions/Use numbers analogously: Difference between revisions
Content deleted Content added
Pascal draft |
→{{header|TXR}}: New section. |
||
Line 1,682: | Line 1,682: | ||
4 * 0.25 * 0.5 = 0.5 |
4 * 0.25 * 0.5 = 0.5 |
||
6 * 0.166667 * 0.5 = 0.5</pre> |
6 * 0.166667 * 0.5 = 0.5</pre> |
||
=={{header|TXR}}== |
|||
This solution seeks a non-strawman interpretation of the exercise: to treat functions and literal numeric terms under the same operations. We develop a three-argument function called <code>binop</code> whose argument is an ordinary function which works on numbers, and two arithmetic arguments which are any combination of functions or numbers. The functions may have any arity from 0 to 2. The <code>binop</code> functions handles all the cases. |
|||
The basic rules are: |
|||
* When all required arguments are given to a function, it is expected that a number will be produced. |
|||
* Zero-argument functions are called to force a number out of them. |
|||
* When operands are numbers or zero-argument functions, a numeric result is calculated. |
|||
* Otherwise the operation is a functional combinator, returning a function. |
|||
<syntaxhighlight lang="txrlisp">(defun binop (numop x y) |
|||
(typecase x |
|||
(number (typecase y |
|||
(number [numop x y]) |
|||
(fun (caseql (fun-fixparam-count y) |
|||
(0 [numop x [y]]) |
|||
(1 (ret [numop x [y @1]])) |
|||
(2 (ret [numop x [y @1 @2]])) |
|||
(t (error "~s: right argument has too many params" |
|||
%fun% y)))) |
|||
(t (error "~s: right argument must be function or number" |
|||
%fun% y)))) |
|||
(fun (typecase y |
|||
(number (caseql (fun-fixparam-count x) |
|||
(0 [numop [x] y]) |
|||
(1 (ret [numop [x @1] y])) |
|||
(2 (ret [numop [x @1 @2] y])) |
|||
(t (error "~s: left argument has too many params" |
|||
%fun% x)))) |
|||
(fun (macrolet ((pc (x-param-count y-param-count) |
|||
^(+ (* 3 ,x-param-count) ,y-param-count))) |
|||
(caseql* (pc (fun-fixparam-count x) (fun-fixparam-count y)) |
|||
(((pc 0 0)) [numop [x] [y]]) |
|||
(((pc 0 1)) (ret [numop [x] [y @1]])) |
|||
(((pc 0 2)) (ret [numop [x] [y @1 @2]])) |
|||
(((pc 1 0)) (ret [numop [x @1] [y]])) |
|||
(((pc 1 1)) (ret [numop [x @1] [y @1]])) |
|||
(((pc 1 2)) (ret [numop [x @1] [y @1 @2]])) |
|||
(((pc 2 0)) (ret [numop [x @1 @2] [y]])) |
|||
(((pc 2 1)) (ret [numop [x @1 @2] [y @1]])) |
|||
(((pc 2 2)) (ret [numop [x @1 @2] [y @1 @2]])) |
|||
(t (error "~s: one or both arguments ~s and ~s\ \ |
|||
have excess arity" %fun% x y))))))) |
|||
(t (error "~s: left argument must be function or number" |
|||
%fun% y)))) |
|||
(defun f+ (x y) [binop + x y]) |
|||
(defun f- (x y) [binop - x y]) |
|||
(defun f* (x y) [binop * x y]) |
|||
(defun f/ (x y) [binop / x y])</syntaxhighlight> |
|||
With this, the following sort of thing is possible: |
|||
<pre>1> [f* 6 4] ;; ordinary arithmetic. |
|||
24 |
|||
2> [f* f+ f+] ;; product of additions |
|||
#<interpreted fun: lambda (#:arg-1-0062 #:arg-2-0063 . #:arg-rest-0061)> |
|||
3> [*2 10 20] ;; i.e. (* (+ 10 20) (+ 10 20)) -> (* 30 30) |
|||
900 |
|||
4> [f* 2 f+] ;; doubled addition |
|||
#<interpreted fun: lambda (#:arg-1-0017 #:arg-2-0018 . #:arg-rest-0016)> |
|||
5> [*4 11 19] ;; i.e. (* 2 (+ 11 19)) |
|||
60 |
|||
6> [f* (op f+ 2 @1) (op f+ 3 @1)] |
|||
#<interpreted fun: lambda (#:arg-1-0047 . #:arg-rest-0046)> |
|||
7> [*6 10 10] ;; i.e. (* (+ 2 10) (+ 3 10)) -> (* 12 13) |
|||
156 |
|||
</pre> |
|||
So with these definitions, we can solve the task like this, which demonstrates that numbers and functions are handled by the same operations: |
|||
<syntaxhighlight lang="txrlisp">(let* ((x 2.0) |
|||
(xi 0.5) |
|||
(y 4.0) |
|||
(yi 0.25) |
|||
(z (lambda () (f+ x y))) ;; z is obviously function |
|||
(zi (f/ 1 z))) ;; also a function |
|||
(flet ((multiplier (a b) (op f* @1 (f* a b)))) |
|||
(each ((n (list x y z)) |
|||
(v (list xi yi zi))) |
|||
(prinl [[multiplier n v] 42.0]))))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>42.0 |
|||
42.0 |
|||
42.0</pre> |
|||
=={{header|Ursala}}== |
=={{header|Ursala}}== |