This commit is contained in:
Ingy döt Net 2013-10-27 22:24:23 +00:00
parent 6f050a029e
commit 776bba907c
3887 changed files with 59894 additions and 7280 deletions

View file

@ -1,9 +1,3 @@
(defun fib (number)
"Fibonacci sequence function."
(if (< number 0)
(error "Error. The number entered: ~A is negative" number)
(labels ((fib1 (n a b)
(if (= n 0)
a
(fib1 (- n 1) b (+ a b)))))
(fib1 number 0 1))))
(defmacro alambda (parms &body body)
`(labels ((self ,parms ,@body))
#'self))

View file

@ -1,8 +1,8 @@
(defun fib (number)
"Fibonacci sequence function."
(if (< number 0)
(error "Error. The number entered: ~A is negative" number)
(recursive ((n number) (a 0) (b 1))
(if (= n 0)
a
(recurse (- n 1) b (+ a b))))))
(defun fib (n)
(assert (>= n 0) nil "'~a' is a negative number" n)
(funcall
(alambda (n)
(if (>= 1 n)
n
(+ (self (- n 1)) (self (- n 2)))))
n))

View file

@ -1,5 +1,9 @@
(defmacro recursive ((&rest parm-init-pairs) &body body)
(let ((hidden-name (gensym "RECURSIVE-")))
`(macrolet ((recurse (&rest args) `(,',hidden-name ,@args)))
(labels ((,hidden-name (,@(mapcar #'first parm-init-pairs)) ,@body))
(,hidden-name ,@(mapcar #'second parm-init-pairs))))))
(defun fib (number)
"Fibonacci sequence function."
(if (< number 0)
(error "Error. The number entered: ~A is negative" number)
(labels ((fib1 (n a b)
(if (= n 0)
a
(fib1 (- n 1) b (+ a b)))))
(fib1 number 0 1))))

View file

@ -1,64 +1,8 @@
(setf (symbol-function '!) (symbol-function 'funcall)
(symbol-function '!!) (symbol-function 'apply))
(defmacro ? (args &body body)
`(lambda ,args ,@body))
(defstruct combinator
(name nil :type symbol)
(function nil :type function))
(defmethod print-object ((combinator combinator) stream)
(print-unreadable-object (combinator stream :type t)
(format stream "~A" (combinator-name combinator))))
(defconstant +y-combinator+
(make-combinator
:name 'y-combinator
:function (? (f) (! (? (g) (! g g))
(? (g) (! f (? (&rest a)
(!! (! g g) a))))))))
(defconstant +z-combinator+
(make-combinator
:name 'z-combinator
:function (? (f) (! (? (g) (! f (? (x) (! (! g g) x))))
(? (g) (! f (? (x) (! (! g g) x))))))))
(defparameter *default-combinator* +y-combinator+)
(defmacro with-y-combinator (&body body)
`(let ((*default-combinator* +y-combinator+))
,@body))
(defmacro with-z-combinator (&body body)
`(let ((*default-combinator* +z-combinator+))
,@body))
(defun x-call (x-function &rest args)
(apply (funcall (combinator-function *default-combinator*) x-function) args))
(defmacro x-function ((name &rest args) &body body)
`(lambda (,name)
(lambda ,args
(macrolet ((,name (&rest args)
`(funcall ,',name ,@args)))
,@body))))
(defmacro x-defun (name args &body body)
`(defun ,name ,args
(x-call (x-function (,name ,@args) ,@body) ,@args)))
;;;; examples
(x-defun factorial (n)
(if (zerop n)
1
(* n (factorial (1- n)))))
(x-defun fib (n)
(case n
(0 0)
(1 1)
(otherwise (+ (fib (- n 1))
(fib (- n 2))))))
(defun fib (number)
"Fibonacci sequence function."
(if (< number 0)
(error "Error. The number entered: ~A is negative" number)
(recursive ((n number) (a 0) (b 1))
(if (= n 0)
a
(recurse (- n 1) b (+ a b))))))

View file

@ -0,0 +1,5 @@
(defmacro recursive ((&rest parm-init-pairs) &body body)
(let ((hidden-name (gensym "RECURSIVE-")))
`(macrolet ((recurse (&rest args) `(,',hidden-name ,@args)))
(labels ((,hidden-name (,@(mapcar #'first parm-init-pairs)) ,@body))
(,hidden-name ,@(mapcar #'second parm-init-pairs))))))

View file

@ -0,0 +1,64 @@
(setf (symbol-function '!) (symbol-function 'funcall)
(symbol-function '!!) (symbol-function 'apply))
(defmacro ? (args &body body)
`(lambda ,args ,@body))
(defstruct combinator
(name nil :type symbol)
(function nil :type function))
(defmethod print-object ((combinator combinator) stream)
(print-unreadable-object (combinator stream :type t)
(format stream "~A" (combinator-name combinator))))
(defconstant +y-combinator+
(make-combinator
:name 'y-combinator
:function (? (f) (! (? (g) (! g g))
(? (g) (! f (? (&rest a)
(!! (! g g) a))))))))
(defconstant +z-combinator+
(make-combinator
:name 'z-combinator
:function (? (f) (! (? (g) (! f (? (x) (! (! g g) x))))
(? (g) (! f (? (x) (! (! g g) x))))))))
(defparameter *default-combinator* +y-combinator+)
(defmacro with-y-combinator (&body body)
`(let ((*default-combinator* +y-combinator+))
,@body))
(defmacro with-z-combinator (&body body)
`(let ((*default-combinator* +z-combinator+))
,@body))
(defun x-call (x-function &rest args)
(apply (funcall (combinator-function *default-combinator*) x-function) args))
(defmacro x-function ((name &rest args) &body body)
`(lambda (,name)
(lambda ,args
(macrolet ((,name (&rest args)
`(funcall ,',name ,@args)))
,@body))))
(defmacro x-defun (name args &body body)
`(defun ,name ,args
(x-call (x-function (,name ,@args) ,@body) ,@args)))
;;;; examples
(x-defun factorial (n)
(if (zerop n)
1
(* n (factorial (1- n)))))
(x-defun fib (n)
(case n
(0 0)
(1 1)
(otherwise (+ (fib (- n 1))
(fib (- n 2))))))

View file

@ -1,9 +1,14 @@
uint fib(in uint n) pure nothrow {
immutable self = &__traits(parent, {});
return (n < 2) ? n : self(n - 1) + self(n - 2);
import std.stdio, std.exception;
int fib(int arg) pure {
enforce(arg >= 0);
return function int (int n) pure nothrow {
auto self = __traits(parent, {});
return (n < 2) ? n : self(n - 1) + self(n - 2);
}(arg);
}
void main() {
import std.stdio;
writeln(fib(39));
39.fib.writeln;
}

View file

@ -1,21 +1,22 @@
#define std'dictionary'*.
#define std'patterns'*.
#define system.
#symbol fibo : i =
#symbol fibo = &&:n
[
Control ifNot:(i < 0).
n < 0
? [ #throw InvalidArgumentException new:"Must be non negative". ].
#if (i < 2)
? [ ^ i. ]
| [ ^ fibo::(i - 2) + fibo::(i - 1). ].
^ &&:n [ (n > 1) ? [ ($self:(n - 2)) + ($self:(n - 1)) ] ! [ n ] ] : n.
].
#symbol Program =
#symbol program =
[
loop &&from:-1 &to:10 run: i =
control from:-1 &to:10 &do: &&:i
[
'program'output << "%nfib(" << i << ")=".
console << "%fib(" << i << ")=".
'program'output << fibo::i | << "failed".
console writeLine:(fibo:i) | onInvalidArgumentError: &&:e
[
console writeLine:"invalid".
].
].
].