apl - ; APL interpreter project apl.scm ; just so file will...

Info iconThis preview shows pages 1–3. Sign up to view the full content.

View Full Document Right Arrow Icon
;;; APL interpreter project apl.scm (define (----YOU-FILL-THIS-IN----) '()) ; just so file will load ;;; Step 1: convert scalar procedures to array procedures (define (single x) ; reduce order of single-element list (cond ((not (pair? x)) x) ((null? (cdr x)) (single (car x))) (else x))) (define (apl-dyadic op) ; turn dyadic scalar function into APL array fn (define (newop x y) (let ((xx (single x)) (yy (single y))) (cond ((and (number? xx) (number? yy)) (----YOU-FILL-THIS-IN----)) ((number? xx) (map (----YOU-FILL-THIS-IN----) yy)) ((number? yy) (map (----YOU-FILL-THIS-IN----) xx)) (else (map newop xx yy))))) newop) ;;; Step 2: APL primitive operations (define (iota n) ; monadic iota (define (iter x n) (if (> x n) '() (cons x (iter (1+ x) n)))) (iter 1 (single n))) (define (reshape shape l) ; dyadic rho (define (circular l) (define (c1 pair) (if (null? (cdr pair)) (set-cdr! pair l) (c1 (cdr pair)))) (c1 l) l) (define token (let ((source (circular (ravel l)))) (lambda () (let ((out (car source))) (set! source (cdr source)) out)))) (define (string n shape) (if (= n 0) '() (let ((top (re1 shape))) (cons top (string (-1+ n) shape))))) (define (re1 shape) (if (null? shape) (token) (string (car shape) (cdr shape)))) (re1 shape)) (define (cat a b) ; dyadic comma (define (depth l) (if (not (pair? l))
Background image of page 1

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
0 (1+ (depth (car l))))) (define (max x y) (if (> x y) x y)) (define (shapeup l dims) (if (= dims (depth l)) l (shapeup (cons l '()) dims)))
Background image of page 2
Image of page 3
This is the end of the preview. Sign up to access the rest of the document.

Page1 / 5

apl - ; APL interpreter project apl.scm ; just so file will...

This preview shows document pages 1 - 3. Sign up to view the full document.

View Full Document Right Arrow Icon
Ask a homework question - tutors are online