summary refs log tree commit diff stats
path: root/ranger.py
diff options
context:
space:
mode:
authornfnty <git@nfnty.se>2017-02-03 01:39:24 +0100
committernfnty <git@nfnty.se>2017-02-03 01:39:24 +0100
commitbc1bea000aa785f6b2432589a698f73ea739faa5 (patch)
tree5dd7745721b48727833b05b4742b8d3f0f35a22d /ranger.py
parent71a5fa56a40fe447a5670aef9800711b93553e25 (diff)
downloadranger-bc1bea000aa785f6b2432589a698f73ea739faa5.tar.gz
core.actions.Actions.move: Fix visual selection
Diffstat (limited to 'ranger.py')
0 files changed, 0 insertions, 0 deletions
n45' href='#n45'>45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199






































































































































































































                                                                               
;;; Demonstration program for substitution-model evaluation
;;;   complete with normal-order and applicative-order versions.
;;; For use with Section 1.1 of SICP.
;;;
;;; This file defines three special forms: DEF, APPLIC, and NORMAL.
;;;
;;; Example of use:
;;;
;;; (def (f a b) (+ (g a) b))     ; define a function
;;; (def (g x) (* 3 x))           ; another one
;;; (applic (f (+ 2 3) (- 15 6))) ; show applicative-order evaluation
;;; (normal (f (+ 2 3) (- 15 6))) ; show normal-order evaluation

;;; In the printed results, something like
;;;     (* 2 3) ==> 6
;;; indicates the ultimate invocation of a primitive function.  But
;;;     (f 5 9) ---->
;;;     (+ (g 5) 9)
;;; indicates the substitution of actual arguments into the body of
;;; a function defined with DEF.  (Of course, whether actual argument
;;; values or actual argument expressions are substituted depends on
;;; whether you used APPLIC or NORMAL, respectively.)

;;; Restrictions:
;;;   * The operands of a combination must be numbers or combinations.
;;;          (I.e., no variables, no non-numeric data.)
;;;   * The operator of a combination must be a symbol that names a function.
;;;          If the function was not defined by DEF, it is taken as primitive
;;;          for purposes of the substitution model.
;;;   * DEF only understands the short-form function definition syntax.
;;;          (I.e., no lambda, no defining anything but functions.)
;;;   * The body of a function defined with DEF must be exactly one expression.

;;; A neat example:
;;; (def (zero x) (- x x))
;;; (applic (zero (random 10)))
;;; (normal (zero (random 10)))


;; The DEF special form.
;; Binds the symbol to a quoted lambda expression, not a closure, since we're
;;  using the substitution model.

;(define def (procedure->macro
;	     (lambda (exp env)
;	       `(begin (define ,(caadr exp)
;			 '(lambda ,(cdadr exp) ,(caddr exp)))
;		       (set! def-names (cons ',(caadr exp) def-names))
;		       ',(caadr exp)))))

(define-macro (def form . body) 
  `(begin
    (define ,(car form) '(lambda ,(cdr form) ,@body))
    (set! def-names (cons ',(car form) def-names))
    ',(car form)))

;;;; (extend-syntax (def)
;;;;   [(def (name . args) body)
;;;;    (begin (define name '(lambda args body))
;;;; 	  (set! def-names (cons 'name def-names))
;;;; 	  'name)])

;; A list of the functions defined using DEF.
;; We look in here to distinguish defined functions from primitives.

(define def-names '())

;; The APPLIC special form.  Expands an expression in applicative order.
;; Calls procedure applic1 to do the real work, except for some extra
;; top-level stuff to keep the return value separate from printed text.

;(define applic (procedure->macro
;		(lambda (exp env)
;		  `(let ((result (applic1 ',(cadr exp) "")))
;		     (newline)
;		     result))))

(define-macro (applic . exp)
   `(let ((result (applic1 ',(car exp) "")))
      (newline)
      result))

;;;; (extend-syntax (applic)
;;;;   [(applic thingo)
;;;;    (let ((result (applic1 'thingo '||)))
;;;;      (newline)
;;;;      result)])

;; The second argument to applic1 is a word of (initially zero) spaces
;; used to indent the printing of the expansion of subexpressions.

(define (applic1 form spaces)
  (if (not (pair? form))
      form
      (begin
       (newline)
       (display spaces)
       (display form)
       (cond ((and (not (memq (car form) def-names))
		   (all-numbers? (cdr form)))
	      (display " ==> ")
	      (let ((ans (eval form)))
		(display ans)
		ans))
 	     (else
	      (let ((new-form (subapplic (list (car form))
					 (cdr form)
					 (word spaces "   ") )))
		(if (and (memq (car form) def-names)
			 (not (all-numbers? (cdr form))) )
		    (begin (newline) (display spaces) (display new-form)) )
		(cond ((memq (car form) def-names)
		       (display " ----> ")
		       (applic1 (subst (eval (car form)) (cdr new-form))
				spaces))
		      ((equal? (car form) 'quote) (cadr form))
		      (else (applic1 new-form spaces)) )))))))

(define (all-numbers? l)
  (cond ((null? l) #t)
	((not (or (number? (car l)) (boolean? (car l)))) #f)
	(else (all-numbers? (cdr l))) ))

;; subapplic maps applic1 over the operands, left-to-right.

(define (subapplic done todo spaces)
  (if (null? todo)
      (reverse done)
      (let ((result (applic1 (car todo) spaces)))
	(subapplic (cons result done) (cdr todo) spaces) )))

;; subst takes a lambda expression and an actual argument list, and
;; returns the body with substitutions of args for formal parameters.

(define (subst proc args)
  (subst-in-body (caddr proc) (cadr proc) args))

(define (subst-in-body form params args)
  (cond ((null? form) '())
	((not (pair? form)) (lookup form params args))
	(else (cons (subst-in-body (car form) params args)
		    (subst-in-body (cdr form) params args) ))))

(define (lookup form params args)
  (cond ((null? params) form)
	((eq? form (car params)) (car args))
	(else (lookup form (cdr params) (cdr args))) ))

;; The NORMAL special form.  Everything below here is analogous to the
;; corresponding piece of APPLIC, but the logic of normal1 is different.

;(define normal (procedure->macro
;		(lambda (exp env)
;		  `(let ((result (normal1 ',(cadr exp) "")))
;		     (newline)
;		     result))))

(define-macro (normal . exp)
	`(let ((result (normal1 ',(car exp) "")))
	    (newline)
	    result))

;;;; (extend-syntax (normal)
;;;;   [(normal thingo)
;;;;    (let ((result (normal1 'thingo "")))
;;;;      (newline)
;;;;      result)])

(define (normal1 form spaces)
  (if (not (pair? form))
      form
      (begin
       (newline)
       (display spaces)
       (display form)
       (cond ((and (not (memq (car form) def-names))
		   (all-numbers? (cdr form)))
	      (display " ==> ")
	      (let ((ans (eval form)))
		(display ans)
		ans))
 	     ((memq (car form) def-names)
		       (display " ----> ")
		       (normal1 (subst (eval (car form)) (cdr form))
				spaces))
	     ((equal? (car form) 'quote) (cadr form))
	     (else
	      (let ((new-form (subnormal (list (car form))
					 (cdr form)
					 (word spaces "   ") )))
		(normal1 new-form spaces) ))))))

(define (subnormal done todo spaces)
  (if (null? todo)
      (reverse done)
      (let ((result (normal1 (car todo) spaces)))
	(subnormal (cons result done) (cdr todo) spaces) )))