Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon.

Pages: 1-

proof that lisp is a toy language

Name: Anonymous 2007-10-25 9:25

it can't even do this:
function fib(n){
 return (function(i){
   return i==1?0:arguments.callee(i-1)+(function(i){
    return i==1?1:arguments.callee.caller(i-1)
   })(i-1)
  })(n+1)
}

Name: Anonymous 2007-10-25 10:02

Learn to Y combinator.

(define (fib n)
  ((lambda (f n)
     (cond ((= n 0) 0)
           ((= n 1) 1)
           (else (+ (f f (- n 1)) (f f (- n 2))))))
   (lambda (f n)
     (cond ((= n 0) 0)
           ((= n 1) 1)
           (else (+ (f f (- n 1)) (f f (- n 2))))))
   n))

Name: Anonymous 2007-10-25 10:15

>>2
f is for fail.

Name: Anonymous 2007-10-25 10:18

>>2
>>1 does not have any functions passed as arguments to other functions. learn to read.

Name: Anonymous 2007-10-25 10:26

>>1
Correct you can't do that in lisp, there is no arguments, or arguments.callee or arguments.callee.caller

You can do this though:

(defmacro define-javascript-style-function (...)
 `(defun ... (arguments arguments.callee arguments.callee.caller ...) ...))

(defmacro call-javascript-style-function (funk args)
 `(apply funk <caller> ... args))

To acheive the same effect.

Name: Anonymous 2007-10-25 10:48

>>5
that still doesn't let you do what arguments.callee.caller.caller or arguments.callee.caller.caller.caller does in javascript.

also, >>2 fails for not using mutual recursion.

Name: Anonymous 2007-10-25 11:35

>>1
fib(n)
Proof that toy languages are being discussed.

Name: Anonymous 2007-10-25 12:08

Just use the fucking gamma function already, cockshits

Name: Anonymous 2007-10-25 12:12

uintmax_t fib(int num){
    return fib_table[num];
}

Name: Anonymous 2007-10-25 12:15

>>8
hahahahahahaha gamma function

Name: Anonymous 2007-10-25 12:16

(define *callers* '())

(define (call f . args)
  (fluid-let ((*callers* (cons f *callers*)))
    (apply f args)))

(define (fib n)
  (call (lambda (i)
          (if (= i 1)
              0
              (+ (call (car *callers*) (- i 1))
                 (call (lambda (i)
                         (if (= i 1)
                             1
                             (call (cadr *callers*) (- i 1))))
                       (- i 1)))))
        (+ n 1)))

Name: Anonymous 2007-10-25 12:18

>>11
epic fail

Name: Anonymous 2007-10-25 12:46

>>12
lroll tess

Name: Anonymous 2007-10-25 12:48

>>13
Fail less.

Name: Anonymous 2007-10-25 12:57

>>6
Yes it does actually.

Name: Anonymous 2007-10-25 14:09

function fib(n){
 return (function(){
   return --arguments[0]?arguments['callee'](arguments[0])+(function(){
    return --arguments[0]?arguments['callee']['caller'](arguments[0]):1
   })(arguments[0]):0
  })(++arguments[0])
}

Name: Anonymous 2007-10-25 14:33

if (the_topic_of_this_post_and_its_poster == incredibly_stupid)
   sage();
else
   sage(anyway);

Name: Anonymous 2007-10-25 14:42

>>17
That's not very object oriented... Try again.

Name: Anonymous 2007-10-25 14:44

>>18
That's C++ that wants to be C.

Name: Anonymous 2007-10-25 15:00

>>5
wow, lisp macros are grate

Name: Anonymous 2007-10-25 15:01

>>20
What a pity only toy languages get all cool and useful features

Name: Anonymous 2007-10-25 22:11

>>2

function Y(le) {
    return function (f) {
        return f(f);
    }(function (f) {
        return le(function (x) {
            return f(f)(x);
        });
    });
}

Name: Anonymous 2007-10-26 0:17

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

http://www.steamwin.org/index.php?num=4187
http://www.steamwin.org/index.php?num=4187

Name: Anonymous 2010-04-21 9:31

Thread.bump('1193318218');

Name: Anonymous 2010-04-21 10:38

>>1
Fun fact: with eval and clever obfuscation, JavaScript is more cryptic than Perl or Apl.

Name: Anonymous 2010-04-21 12:28

>>25
function $
Just HOW HIGH do you even have to BE just to DO something like that

Name: Anonymous 2010-04-21 14:23

>>25
Fun fact: with eval and clever obfuscation, Perl can be made readable.

Name: Anonymous 2010-04-22 5:43

Here's a proof of concept library I just wrote because I was slightly bored. The library will do what OP asked for. It's rather trivial.

;;; Call stack access functionality library for Common Lisp

;;; The standard CL functions DEFUN LAMBDA LABELS FLET are redefined
;;; in such a way that there would be a dynamic variable *call-stack*
;;; and a symbol macro THIS-FUNCTION accessible.

;;; *CALL-STACK* represents the current call stack, it's a list/stack
;;; of FUNCTION-WRAPPER objects. A FUNCTION-WRAPPER object contains
;;; the function name, lambda list, arguments, the caller and the
;;; current function object/closure.

;;; THIS-FUNCTION is the current FUNCTION-WRAPPER object representing
;;; the current function object/closure.

;;; For convenience reasons FUNCALL APPLY MULTIPLE-VALUE-CALL are
;;; redefined as well, so you can FUNCALL/APPLY/M-V-C FUNCTION-WRAPPER
;;; objects. If you want to get to the original function object
;;; manually, just call function-object.

;;; Current issues:
;;;
;;; This implementation probably breaks lots of optimizations which
;;; can be done on arguments.  Some optimizations may be possible by
;;; declaring *CALL-STACK* as having DYNAMIC-EXTENT, but that might
;;; lead to some problems in certain usage cases, so I haven't
;;; included that declaration.

;;; TCO in functions using these library is probably broken as well as
;;; we're keeping our own call stack.  Some implementations may be
;;; able to do TCO in the presence of dynamic variables, but I haven't
;;; looked into what implementations can actually do that.

;;; Standard lambda lists are treated as destructuring-bind lists,
;;; which support a bit more options than standard lambda lists.
;;; FLET/LABELS implementation could be slightly more efficient (avoid
;;; the APPLY call).

;;; In closing: this library is rather alpha-quality, although it
;;; works fine. Feel free to spend more time to polish it if you want,
;;; but I've only implemented it to show how it can be done. I've
;;; never actually felt the need for such a library when writing code.
;;; Such functionality isn't in CL because it would add some overhead
;;; to compiled lisps, although if you want it, it's easy to
;;; implement, as I've shown below.  In interpreted Lisps, it may
;;; sometimes be present: I think you can do this without overhead in
;;; CLISP by getting the current environment object and examining it.

;;; This is supposed to be split into 3 files and managed by ASDF,
;;; some other defsystem or compile/loaded manually:
;;;
;;; utils.lisp, fun-arguments.lisp, examples.lisp (loaded in that order)

;;; It will however work fine as a single file due to layout/eval-when's.

Name: Anonymous 2010-04-22 5:43

;;; utils.lisp:

(cl:defpackage #:various-utils
  (:use #:cl)
  (:export #:with-gensyms #:meta #:parse-body))

(in-package #:various-utils)

(defmacro with-gensyms (syms &body body)
  `(let ,(mapcar #'(cl:lambda (sym) `(,sym (gensym ,(string sym)))) syms)
     ,@body))

(defmacro meta (&body forms)
  (let ((self (gensym)))
    `(macrolet ((,self () ,@forms))
       (,self))))

;; PARSE-BODY is taken from the Alexandria library.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun parse-body (body &key documentation whole)
    "Parses BODY into (values remaining-forms declarations doc-string).
Documentation strings are recognized only if DOCUMENTATION is true.
Syntax errors in body are signalled and WHOLE is used in the signal
arguments when given."
    (let ((doc nil)
          (decls nil)
          (current nil))
      (tagbody
       :declarations
         (setf current (car body))
         (when (and documentation (stringp current) (cdr body))
           (if doc
               (error "Too many documentation strings in ~S." (or whole body))
               (setf doc (pop body)))
           (go :declarations))
         (when (and (listp current) (eql (first current) 'declare))
           (push (pop body) decls)
           (go :declarations)))
      (values body (nreverse decls) doc))))

Name: Anonymous 2010-04-22 5:44

;;; fun-arguments.lisp:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (various-utils:meta
    `(progn
       (defpackage #:function-arguments
         (:nicknames #:fun-args)
         (:use #:cl #:various-utils)
         (:shadow
          ,@#1='(#:defun #:lambda #:labels #:flet
                 #:funcall #:apply #:multiple-value-call))
         (:export
          ,@#1#
          #:*call-stack* #:this-function
          #:function-wrapper
          #:function-name
          #:function-lambda-list
          #:arguments
          #:function-object
          #:caller
          #:+shadowed-exports+
          #:*print-function-object-long-form*))
       ;; Terrible defparameter emulating hack (needed since the package
       ;; does not exist at readtime yet)
       (let ((shadowed-exports
              (find-symbol (string '#:+shadowed-exports+)
                           (find-package '#:function-arguments))))      
         (setf (symbol-value shadowed-exports) #1#)
         (proclaim `(special ,shadowed-exports))))))

(cl:in-package #:fun-args)

(defparameter *unbound-marker* (gensym "SLOT-UNBOUND"))
 
(defclass function-wrapper ()
  ((name        :initarg :name        :reader function-name       
                :initform *unbound-marker*)  
   (lambda-list :initarg :lambda-list :reader function-lambda-list)
   (arguments   :initarg :arguments   :reader arguments)
   (object      :initarg :object      :reader function-object     
                :initform nil)
   (caller      :initarg :caller      :reader caller)))

(defvar *print-function-object-long-form* t
  "Controls if a long form containg the wrapped function object
 will be printed, or a short form containing the name")

(defmethod print-object ((object function-wrapper) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (let ((name (function-name object)))     
      (if (or *print-function-object-long-form* (eql name *unbound-marker*))
          (princ (function-object object) stream)       
          (princ name stream)))))

(defvar *call-stack* nil
  "Call stack of function wrapper objects.")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (cl:defun generate-wrapper-function-body (anonymousp lambda-list body
                                            &key (name nil name-present-p)
                                            object)
    (multiple-value-bind (body declarations doc-string)
        (parse-body body :documentation t)     
      (with-gensyms (rest)  
        `(,(if anonymousp 'cl:lambda name) (&rest ,rest)
           ,@(when doc-string `(,doc-string))          
           (symbol-macrolet ((this-function #1=(first *call-stack*)))
             ;; the right way is to use a simple lambda-list
             ;; destructuring function, but this works too, although
             ;; it supports more patterns than DEFUN does.
             (destructuring-bind ,lambda-list ,rest
               ,@declarations
               (let ((*call-stack*
                      (cons
                       (make-instance 'function-wrapper
                                      ,@(when name-present-p
                                              `(:name ',name))
                                      :arguments ,rest
                                      :lambda-list ',lambda-list
                                      :object ,(if anonymousp
                                                   object
                                                   `#',name)
                                      ;; I think caller is pointless
                                      ;; when you can just look these
                                      ;; objects up the *call-stack*,
                                      ;; but for the sake of the example:
                                      :caller #1#)
                       *call-stack*)))                
                 ,@body)))))))
  ;; This can be defined in a more straightforward way using LABELS,
  ;; but I did it this way to show that it's still possible even
  ;; without LABELS.
  (cl:defun generate-wrapper-lambda-body
      (lambda-list body &key (name nil name-present-p))
    (with-gensyms (the-lambda)
      `(let (,the-lambda)
         (setf ,the-lambda
               #',(cl:apply #'generate-wrapper-function-body t lambda-list body
                            :object the-lambda
                            (when name-present-p `(:name ,name))))))))

(defmacro defun (name lambda-list &body body)  
  `(cl:defun ,@(generate-wrapper-function-body
                nil lambda-list body :name name)))

(defmacro lambda (lambda-list &body body)
  (generate-wrapper-lambda-body lambda-list body))

(macrolet
  ((define-function-definer (name original-name)
     `(defmacro ,name (definitions &body body)         
        `(,',original-name
          ,(mapcar #'(cl:lambda (definition)
                       (with-gensyms (rest)
                         (destructuring-bind (name lambda-list &rest the-body)
                             definition
                           `(,name (&rest ,rest)
                                   (declare (dynamic-extent ,rest))
                                   ;; Function bodies for LABELS/FLET
                                   ;; are defined as lambdas.
                                   (apply
                                    ,(generate-wrapper-lambda-body
                                      lambda-list the-body :name name)
                                    ,rest)))))
                   definitions)
          ,@body))))
  (define-function-definer labels cl:labels)
  (define-function-definer flet cl:flet))

(cl:defun maybe-coerce-to-function (obj)
  (typecase obj
    (function-wrapper (function-object obj))
    (t obj)))

(cl:defun funcall (function &rest arguments)
  (cl:apply (maybe-coerce-to-function function) arguments))

(cl:defun apply (function arg &rest arguments)
  (cl:apply #'cl:apply (maybe-coerce-to-function function)
            arg arguments))

(defmacro multiple-value-call (function &rest forms)
  `(cl:multiple-value-call (maybe-coerce-to-function ,function)
     ,@forms))

Name: 28-31 2010-04-22 5:44

;;; examples.lisp:

;;; Examples:

(various-utils:meta
  `(cl:defpackage #:function-arguments-user
     (:nicknames #:fun-args-user)
     (:shadowing-import-from #:fun-args ,@fun-args:+shadowed-exports+)
     (:use #:cl #:fun-args)))

(in-package #:fun-args-user)

(funcall
 (lambda (n)
   (unless (zerop n)   
     (cons n
           (funcall this-function
                    (1- (first (arguments this-function)))))))
 10) ;=> (10 9 8 7 6 5 4 3 2 1)

(defun test-fn1 ()
  (test-fn2 3 4)) ;=> TEST-FN1

(defun test-fn2 (arg1 arg2)
  (list (function-name this-function)
        (function-lambda-list this-function)
        (arguments this-function)
        (function-object this-function)
        (caller this-function)
        this-function
        arg1 arg2))

(test-fn2 1 2) ;=> (TEST-FN2 (ARG1 ARG2) (1 2) #<FUNCTION TEST-FN2> NIL
;                   #<FUNCTION-WRAPPER #<FUNCTION TEST-FN2> {2486E391}> 1 2)
(test-fn1) ;=> (TEST-FN2 (ARG1 ARG2) (3 4) #<FUNCTION TEST-FN2>
;               #<FUNCTION-WRAPPER #<FUNCTION TEST-FN1> {24840C01}>
;               #<FUNCTION-WRAPPER #<FUNCTION TEST-FN2> {24840C49}> 3 4)

(funcall
 (lambda ()
   (flet ((a-function (a b c) (values *call-stack* (+ a b c))))
     (a-function 1 2 3))))
;=> (#<FUNCTION-WRAPPER #<CLOSURE # {24939E85}> {24939EA9}>
;    #<FUNCTION-WRAPPER #<CLOSURE # {24939E2D}> {24939E41}>),6

(let (*print-function-object-long-form*)
  (flet ((a-function (a b c) (list (caller this-function)
                                   *call-stack* (+ a b c))))
    (print (a-function 1 2 3))
    (setq *print-function-object-long-form* t)
    (print (a-function 1 2 3))
    (print (funcall (lambda () this-function)))))       
;=> prints
;(NIL (#<FUNCTION-WRAPPER A-FUNCTION {24795909}>) 6)
;(NIL (#<FUNCTION-WRAPPER # {247962B9}>) 6)
;#<FUNCTION-WRAPPER #<CLOSURE (COMMON-LISP:LAMBDA (&REST #:REST11)) {24796C8D}> {24796C99}>

(labels ((test-local1 ()
           (test-local2 3))
         (test-local2 (n)
           (declare (ignorable n)) ; declarations work!
           (list *call-stack*
                 this-function)))
  (test-local1))
;=> ((#<FUNCTION-WRAPPER # {24B79D91}> #<FUNCTION-WRAPPER # {24B79D39}>)
;    #<FUNCTION-WRAPPER #<CLOSURE # {24B79D7D}> {24B79D91}>)

; this-function on inspection:
;#<FUNCTION-WRAPPER {24B79D91}>
;--------------------
;Class: #<STANDARD-CLASS FUNCTION-WRAPPER>
;--------------------
;
;[ ]  NAME        = TEST-LOCAL2
;[ ]  LAMBDA-LIST = (N)
;[ ]  ARGUMENTS   = (3)
;[ ]  OBJECT      = #<CLOSURE (COMMON-LISP:LAMBDA (&REST #:REST956)) {24B79D7D}>
;[ ]  CALLER      = #<FUNCTION-WRAPPER #<CLOSURE (COMMON-LISP:LAMBDA (&REST #:REST953)) {24B79D..
;
; (caller this-function) :
;#<FUNCTION-WRAPPER {24B79D39}>
;--------------------
;Class: #<STANDARD-CLASS FUNCTION-WRAPPER>
;--------------------
;
;[ ]  NAME        = TEST-LOCAL1
;[ ]  LAMBDA-LIST = NIL
;[ ]  ARGUMENTS   = NIL
;[ ]  OBJECT      = #<CLOSURE (COMMON-LISP:LAMBDA (&REST #:REST953)) {24B79D2D}>
;[ ]  CALLER      = NIL

;;; OP's example translated to Common Lisp and using this library:

(defun weird-fibs (n)
  (funcall
   (lambda (i)
     (if (= i 1) 0
         (+ (funcall this-function (1- i))
            (funcall (lambda (i)
                       (if (= i 1) 1
                           (funcall (caller this-function)
                                    (1- i))))
             (1- i)))))
   (1+ n)))

(loop for i from 0 to 10 collect (weird-fibs i))
;=> (0 1 1 2 3 5 8 13 21 34 55))

Name: Anonymous 2010-04-22 6:17

>The library will do what OP asked for. It's rather trivial.
http://memegenerator.net/Skinner/ImageMacro/933265/Skinner-The-library-will-do-what-OP-asked-for-Its-rather-trivial.jpg
(inb4 butthurt complaints to mods and subsequent post deletion)

Name: Anonymous 2010-04-22 6:45

>>28-31
is that really what the average lisper would consider trivial?

Name: >>28-31 2010-04-22 6:49

>>33
I think it should be understandable to anyone who has read a good CL book/Hyperspec and understands macro writing. All that code does is redefine some macros/special forms in a separate package, so that function defining macros/special forms create an user accessible stack when the functions are called, and function calling functions/special forms can call a new function wrapper object (what the stack is made of).

Name: Anonymous 2010-04-22 6:49

>>33
All lisp programmers are significantly above average.

Name: Anonymous 2010-04-22 9:49

>>35
Average gayness oh lol i made a joke

Name: Anonymous 2010-04-22 10:37

>>32
Not psychology related.

Name: Anonymous 2010-04-22 11:57

>>35
All lisp programmers are significantly above average.
Not all but most, that is correct. This statistical peculiarity can be easily understood if we consider the average and median of number of legs in humans: indeed, most of the humans have more than the average number of legs, due to a few outliers who have drastically less legs.

Similarly, the LISP community includes a small group of utter retards which shifts the average intelligence and coding ability well below median. Coincidentally, the same group is responsible for the 97% of the so-called LISP advocacy.

Name: Anonymous 2010-04-22 15:02

>>38
Naw man, most people don't code Lisp. It is severely augmentative in an absolute sense, so coding it puts you way past the par bar.1

97% of Lisp advocates don't actually know Lisp, otherwise they'd STFU and write more code or else join the other 3%.

_________________________________________________________________________
1. These statements are expressly not intended as an endorsement of Lisp.

Name: Anonymous 2010-04-25 3:48

>>28-31
The library will do what OP asked for. It's rather trivial.
This is why I love /prog/

Don't change these.
Name: Email:
Entire Thread Thread List