[ create a new paste ] login | about

Link: http://codepad.org/78p5P2Kj    [ raw code | fork ]

Scheme, pasted on Apr 11:
;; (define i 0) 
;; (do-while (< i 4) (print "toto") (set! i (+ i 1)) ) 
;; toto
;; toto
;; toto
;; toto
(define-macro (do-while pred b1 . Larg)
  `(let loop ()
     (begin ,b1 ,@Larg)
     (when ,pred (loop))))


;; (do (print i) (if (< i 4) (print "inf") (print "sup")) (set! i (+ i 1)) while (< i 4))
;; 0
;; inf
;; 1
;; inf
;; 2
;; inf
;; 3
;; inf

(define-macro (do b1 . Larg)
   (let ((lst (gensym)) ;; list
	 (rev-lst (gensym)) ;; reversed list
	 (pred (gensym)) ;; predicate
	 (q-while (gensym)) ;; MUST be (quote while)
	 (lst-instr (gensym))) ;; instructions to execute list

      `(let ((,lst (cons
		    (quote ,b1)
		    (quote ,Larg))) ;; list
	     (,rev-lst '()) ;; reversed list
	     (,pred '()) ;; predicate
	     (,q-while '()) ;; MUST be (quote while)
	     (,lst-instr '())) ;; instructions to execute list
	  
	  (if (< (length ,lst) 2)
	      "ERROR: too few arguments: must not be less than 2"
	      (begin
		 (set! ,rev-lst (reverse ,lst))
		 (set! ,pred (car ,rev-lst))
		 (set! ,q-while (car (cdr ,rev-lst)))
		 (if (not 
		      (or (equal? ,q-while (quote while))
			  (equal? ,q-while (quote WHILE))))
		     "ERROR: WHILE key-word not found"
		     (begin
			(set! ,lst-instr (reverse
					  (cdr 
					   (cdr ,rev-lst))))
			(let loop ()
			   (map eval ,lst-instr)
			   (if (eval ,pred) (loop))))))))))
			


Create a new paste based on this one


Comments: