daily pastebin goal
22%
SHARE
TWEET

Untitled

a guest May 16th, 2018 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (library (pt-class)
  2.  
  3.   (export make-pt is-pt pt::norm pt/n pt::normalize)
  4.  
  5.   (import (rnrs)
  6.       (dharmalab misc gen-id))
  7.  
  8.   (define-record-type pt
  9.     (fields (mutable x)
  10.         (mutable y)))
  11.  
  12.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14.   (define-syntax import-pt
  15.  
  16.     (lambda (stx)
  17.  
  18.       (syntax-case stx ()
  19.  
  20.     ((import-pt p)
  21.  
  22.      (with-syntax ( (x (gen-id #'p "x"))
  23.             (y (gen-id #'p "y"))
  24.  
  25.             (x! (gen-id #'p "x!"))
  26.             (y! (gen-id #'p "y!"))
  27.  
  28.             (neg       (gen-id #'p "neg"))
  29.             (norm      (gen-id #'p "norm"))
  30.             (normalize (gen-id #'p "normalize")) )
  31.  
  32.        #'(begin
  33.  
  34.            (define-syntax x
  35.          (identifier-syntax
  36.           (pt-x p)))
  37.  
  38.            (define-syntax y
  39.          (identifier-syntax
  40.           (pt-y p)))
  41.  
  42.            (define-syntax x!
  43.          (syntax-rules ()
  44.            ((x! val)
  45.             (pt-x-set! p val))))
  46.  
  47.            (define-syntax y!
  48.          (syntax-rules ()
  49.            ((y! val)
  50.             (pt-y-set! p val))))
  51.  
  52.            (define-syntax neg
  53.          (syntax-rules ()
  54.            ((neg)
  55.             (pt::neg p))))
  56.  
  57.            (define-syntax norm
  58.          (syntax-rules ()
  59.            ((norm)
  60.             (pt::norm p))))
  61.  
  62.            (define-syntax normalize
  63.          (syntax-rules ()
  64.            ((normalize)
  65.             (pt::normalize p))))))))))
  66.  
  67.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  68.  
  69.   (define-syntax is-pt
  70.  
  71.     (lambda (stx)
  72.  
  73.       (syntax-case stx ()
  74.  
  75.     ((is-pt p)
  76.  
  77.      (with-syntax ( (p.x (gen-id #'p #'p ".x"))
  78.             (p.y (gen-id #'p #'p ".y"))
  79.  
  80.             (p.x! (gen-id #'p #'p ".x!"))
  81.             (p.y! (gen-id #'p #'p ".y!"))
  82.  
  83.             (p.neg       (gen-id #'p #'p ".neg"))
  84.             (p.norm      (gen-id #'p #'p ".norm"))
  85.             (p.normalize (gen-id #'p #'p ".normalize")) )
  86.  
  87.        #'(begin
  88.  
  89.            (define-syntax p.x
  90.          (identifier-syntax
  91.           (pt-x p)))
  92.  
  93.            (define-syntax p.y
  94.          (identifier-syntax
  95.           (pt-y p)))
  96.  
  97.            (define-syntax p.x!
  98.          (syntax-rules ()
  99.            ((p.x! val)
  100.             (pt-x-set! p val))))
  101.  
  102.            (define-syntax p.y!
  103.          (syntax-rules ()
  104.            ((p.y! val)
  105.             (pt-y-set! p val))))
  106.  
  107.            (define-syntax p.neg
  108.          (syntax-rules ()
  109.            ((p.neg)
  110.             (pt::neg p))))
  111.  
  112.            (define-syntax p.norm
  113.          (syntax-rules ()
  114.            ((p.norm)
  115.             (pt::norm p))))
  116.  
  117.            (define-syntax p.normalize
  118.          (syntax-rules ()
  119.            ((p.normalize)
  120.             (pt::normalize p))))))))))
  121.  
  122.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  123.  
  124.   (define (sq x) (* x x))
  125.  
  126.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  127.  
  128.   (define (pt::norm p)
  129.  
  130.     (import-pt p)
  131.  
  132.     (sqrt (+ (sq x)
  133.          (sq y))))
  134.  
  135.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  136.  
  137.   (define (pt/n p n)
  138.  
  139.     (is-pt p)
  140.  
  141.     (make-pt (/ p.x n)
  142.          (/ p.y n)))
  143.  
  144.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  145.  
  146.   (define (pt::normalize p)
  147.  
  148.     (import-pt p)
  149.  
  150.     (pt/n p (norm)))
  151.  
  152.   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  153.  
  154.   )
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top