├── .gitignore ├── aliens ├── dk-2013.pdf └── tr87.pdf ├── notes ├── composition.txt └── idiom_list.txt ├── remora ├── Readme.md ├── dynamic.rkt ├── dynamic │ ├── lang │ │ ├── basis-lib.rkt │ │ ├── language.rkt │ │ ├── reader.rkt │ │ ├── records.rkt │ │ ├── semantics.rkt │ │ └── syntax.rkt │ └── main.rkt ├── examples │ ├── 99-bottles.rkt │ ├── dsp.rkt │ ├── dtmf.rkt │ ├── idioms.rkt │ ├── image-loading.rkt │ ├── image.rkt │ ├── kernels.rkt │ ├── lerp.rkt │ ├── naive-bayes.rkt │ ├── spambase.data │ └── using-structs.rkt ├── info.rkt └── scribblings │ ├── application.scrbl │ ├── arrays.scrbl │ ├── basis-lib.scrbl │ ├── boxes.scrbl │ ├── functions.scrbl │ ├── integration.scrbl │ ├── records.scrbl │ ├── remora.scrbl │ └── tutorial.scrbl └── semantics ├── Readme.md ├── dependent-lang.rkt ├── language.rkt ├── redex-utils.rkt └── typed-reduction.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | **/compiled 2 | remora/doc/ 3 | remora/scribblings/*css 4 | remora/scribblings/*html 5 | remora/scribblings/*js 6 | remora/scribblings/*pdf 7 | -------------------------------------------------------------------------------- /aliens/dk-2013.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jrslepak/Remora/1a831dec554df9a7ef3eeb10f0d22036f1f86dbd/aliens/dk-2013.pdf -------------------------------------------------------------------------------- /aliens/tr87.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jrslepak/Remora/1a831dec554df9a7ef3eeb10f0d22036f1f86dbd/aliens/tr87.pdf -------------------------------------------------------------------------------- /notes/composition.txt: -------------------------------------------------------------------------------- 1 | These need to be syntax rather than actual operators because of variable arity. 2 | 3 | 4 | 5 | Fork: 6 | ((-< ⊕ f g h) x y) 7 | 8 | ⊕ 9 | / | \ 10 | / | \ 11 | f g h 12 | 13 | (⊕ (f x y) (g x y) (h x y)) 14 | 15 | Tines can have any arity, as long as all tines have the same arity. 16 | Resulting function has that arity. 17 | 18 | In typed Remora, all tines must have same input type. 19 | Joining function must take arguments of same type as tines' output. 20 | 21 | (f : t1 ... -> t2) ... 22 | ⊕ : t2 ... -> t3 23 | ---------------- 24 | (-< ⊕ f ...+) : t1 ... -> t3 25 | 26 | (using t1 ... t2 -> t3 as shorthand for t1 ... -> t2 -> t3 -- expand recursively) 27 | 28 | This carries the expected ranks of the tines through to become the expected ranks of the resulting function, so we should probably do the same in dynamic Remora. 29 | 30 | 31 | 32 | 33 | Fanout compose: 34 | ((&< ⊕ f g h) x y z) 35 | 36 | ⊕ 37 | / | \ 38 | / | \ 39 | f g h 40 | | | | 41 | | | | 42 | x y z 43 | 44 | (⊕ (f x) (g y) (h z)) 45 | 46 | Tines must be unary. 47 | Resulting function's arity is joining function's arity. 48 | 49 | (f : t1 -> t2) ... 50 | ⊕ : (t2 ... -> t3) 51 | ---------------- 52 | (&< ⊕ f ...+) : t1 ... -> t3 53 | 54 | 55 | 56 | 57 | Compose: 58 | ((& ⊕ f g) x y) 59 | 60 | ⊕ 61 | / \ 62 | f f 63 | | | 64 | g g 65 | | | 66 | x y 67 | 68 | (⊕ (f (g x)) (f (g y))) 69 | 70 | Each chain link must be unary. 71 | Resulting function's arity is joining function's arity. 72 | In typed Remora, n-ary chained compose is probably too tricky to type (even Typed Racket doesn't allow it). 73 | 74 | f : t1 -> t2 75 | ⊕ : t2 ... -> t3 76 | ---------------- 77 | (& ⊕ f) : t1 ... -> t3 78 | 79 | Alternatively, & could be a family of operators with types 80 | &_1 : ∀t1,t2,t3 . (t2 -> t3) -> (t1 -> t2) -> (t1 -> t3) 81 | &_2 : ∀t1,t2,t3 . (t2 -> t2 -> t3) -> (t1 -> t2) -> (t1 -> t1 -> t3) 82 | &_3 : ∀t1,t2,t3 . (t2 -> t2 -> t2 -> t3) -> (t1 -> t2) -> (t1 -> t1 -> t1 -> t3) 83 | etc. 84 | 85 | 86 | 87 | At: (or "chain"?) 88 | ((@ f g ⊕) x y z) 89 | 90 | f 91 | | 92 | g 93 | | 94 | ⊕ 95 | /|\ 96 | / | \ 97 | x y z 98 | 99 | (f (g (⊕ x y z))) 100 | Bottom of chain (joining function) can have any arity. Other links are unary. 101 | Again, n-ary chained compose is hard to type. 102 | 103 | ⊕ : t1 ... -> t2 104 | f : t2 -> t3 105 | ---------------- 106 | (@ f ⊕) : t1 ... -> t3 107 | 108 | @ could also be a family of operators like &, typed as 109 | @_1 : ∀t1,t2,t3 . (t2 -> t3) -> (t1 -> t2) -> (t1 -> t3) 110 | @_2 : ∀t1,t2,t3 . (t2 -> t3) -> (t1 -> t1 -> t2) -> (t1 -> t1 -> t3) 111 | @_3 : ∀t1,t2,t3 . (t2 -> t3) -> (t1 -> t1 -> t1 -> t2) -> (t1 -> t1 -> t1 -> t3) 112 | 113 | 114 | 115 | & and @ might be workable as sugar that expands to a chain of binary composition calls: 116 | (@ sqrt add1 +) -> (@_1 sqrt (@_2 add1 +)) 117 | 118 | 119 | All of these should be able to lift using prefix agreement like an actual function application. 120 | 121 | 122 | Supporting these composition forms is going to require changing how procedures imported from Racket are handled: instead of late-binding their arity, make the programmer specify their arity at import (maybe allow the smallest legal arity for the imported procedure as a default). I don't currently know the best way to do this is a new require-spec or a form like 123 | (import/lift (name arity) ...) 124 | 125 | 126 | Combining currying and a focus on pointfree programming makes it hard to talk about the arity of a function. Is filter a binary function that keeps list elements that match a predicate, or is it a unary function that produces a list processor? So we don't really know what arity the programmer intends a curried function to have. 127 | 128 | We have to make a decision based on (unknown) arity at the bottom of a -< or @ form -- we need to know whether the tines are meant to produce functions or first order data. We might be able to narrow this down by looking up one level. 129 | 130 | In (-< ⊕ f ...), find the argument types of ⊕. In (@ f ⊕), find the argument type of f. Take as much of (the right side of) each tine's type as it takes to unify with the argument type(s). 131 | 132 | We also have to know the arity of ⊕ in (& ⊕ f). 133 | 134 | (& ⊕ f ...) fixes some arity for ⊕ and requires all f ... to be unary. 135 | -------------------------------------------------------------------------------- /notes/idiom_list.txt: -------------------------------------------------------------------------------- 1 | 1. REMDUP W←((V⍳V)=⍳⍴V)/V 2 | Uses an index-of operator, which we don't currently have, to implement nub-sieve (use iota to generate list of indices, compare each index with corresponding element's first index). Then uses nub-sieve to implement nub. 3 | This operator is already provided as a primitive in J and Dynamic Remora. 4 | Translating would require adding an index-of operator. 5 | 6 | 7 | 2. EXPAND D←(1↓⍴A)⌈⍴B 8 | A←(((1↑⍴A),D)↑A),[1]D↑B 9 | Adds a new item B to an array A, padding the existing items or the new item as needed. 10 | First, the item shape of A and the shape of B are combined with max to get the new item shape. APL's take function allows the programmer to ask for more elements than are present -- the "extra" spaces are filled with 0 or ' ' depending on whether the original array contained numbers or characters (another use of filling, which does not generalize nicely to other types). It also requires the shape of the "how many" argument to be the same as the rank of the "source" argument (J's take allows a shorter input vector). 11 | Remora's take does not behave this way. Maybe it should? As it stands now, getting 2x3 from the corner of a matrix is 12 | (take 2 (#r(0 1)take 3 matrix)) 13 | instead of 14 | (take [2 3] matrix) 15 | We would have to add a length operator to the index language. Either way, the filling behavior won't really work, so we can't get the padding. 16 | 17 | 18 | 3. Bar Graph W←V∘.≥⍳⌈/V 19 | The maximum bar size is found by reducing V with max. Passing the max size to iota gets a vector of the right length. The outer product of the original vector and that counting-up vector puts a 1 in cells where the original (row #) is greater than or equal to the "count" (col #). 20 | In the Racket embedding, the issue I hit is what to use as the base case when folding with max. There is no "exact infinity," and max produces inexact results given any inexact input. For now, I have an explicit conversion back to exact numbers, but maybe iota should coerce inexact to exact on its own. 21 | We also have to take into account that the J/Remora starts at 0 whereas the APL iota starts at 1. 22 | (fn ((vec 1)) 23 | (unbox count (iota [(inexact->exact (foldr max -inf.0 vec))]) 24 | (box (bool->int (#r(0 1)>= vec (add1 count)))))) 25 | 26 | 27 | 4. TO V←A,A+(×B-A)×⍳|B-A 28 | The signum of the endpoints' difference is which direction we count (up or down). The absolute value of the difference is how many extra elements we need to generate. Multiplying these gets a vector of offsets from the left endpoint. Adding them to the left endpoint and then prepending the left endpoint itself produces the final result. 29 | (fn ((left 0) (right 0)) 30 | (unbox count (iota [(abs (- right left))]) 31 | (append [left] 32 | (+ left (* (signum (- right left)) 33 | (add1 count)))))) 34 | 35 | 36 | 5. Blank removal: 37 | a. Eliminate leading blanks: W←(∨\S≠' ')/S 38 | Comparing the string with the space character gives a boolean vector indicating which characters in the string are spaces. Scanning that vector with or identifies which characters appear at or after the first non-space. The result is them used to filter the string. 39 | Remora's scan function includes the "initial" result, which must be dropped here. Remora's filter produces a box because the result's length is indeterminate. There is also some marshalling that must be done to turn Racket strings into character arrays (not shown here). 40 | (fn ((str 1)) 41 | (filter (behead (scan or #f (not (equal? #\space str)))) 42 | str)) 43 | 44 | b. Eliminate trailing blanks: W←(⌽∨\⌽S≠' ')/S 45 | Similar to eliminating leading blanks, but we reverse the string to construct the filter and then reverse the filter to apply it to the non-reversed string. 46 | (fn ((str 1)) 47 | (filter (reverse (behead (scan or #f (not (equal? #\space (reverse str)))))) 48 | str)) 49 | 50 | c. Multiple blanks reduced to a single blank: 51 | After constructing a boolean vector which identifies which character positions contain spaces, we or that vector with a shifted version of itself to identify positions of digrams that are not two spaces. The characters at those positions are kept; the characters at other positions are the beginning of a ' ' digram and so are dropped. 52 | (fn ((str 1)) 53 | (filter (or (not (equal? #\space str)) 54 | (behead (rotate (append [#t] (not (equal? #\space str))) 1))) 55 | str)) 56 | 57 | 58 | 59 | 6. Character-number conversions: 60 | a. Number of digits needed: D←⌊1+10⍟N 61 | The number of digits in a positive number is one more than its (common) log, rounded down. 62 | (fn ((num 0)) 63 | (floor (add1 (log num)))) 64 | 65 | a(i). For possibly non-positive number: D←⌊1+10⍟N|N+N=0 66 | This alternate version does not seem to work. 67 | -------------------------------------------------------------------------------- /remora/Readme.md: -------------------------------------------------------------------------------- 1 | # Racket prototype 2 | This is the untyped array calculus from the ESOP'14 [paper](http://www.ccs.neu.edu/home/jrslepak/typed-j.pdf), extended with an application form that permits an explicit shape annotation. Our goal for this phase is to come up with enough practical sample code to properly form design goals for a type inference pass. 3 | 4 | ## Installation 5 | From a standard Racket install, run 6 | `raco pkg install git://github.com/jrslepak/Remora.git/?path=remora` 7 | 8 | **Or** using DrRacket's package manager window, install `git://github.com/jrslepak/Remora.git/?path=remora` 9 | 10 | ## Starting out 11 | The package documentation includes a tutorial and reference describing syntax and built-in operators. 12 | -------------------------------------------------------------------------------- /remora/dynamic.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "dynamic/main.rkt") 3 | (provide (all-from-out "dynamic/main.rkt")) -------------------------------------------------------------------------------- /remora/dynamic/lang/language.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/provide 4 | racket/require 5 | (except-in "syntax.rkt" 6 | Rλ) 7 | (only-in "semantics.rkt" 8 | debug-mode 9 | build-vec 10 | rem-box 11 | remora-apply 12 | racket->remora) 13 | (only-in "records.rkt" 14 | over view set) 15 | #; 16 | (except-in "semantics.rkt" 17 | apply-rem-array 18 | rem-array 19 | rem-array? 20 | rem-array-shape 21 | rem-array-data 22 | rem-array-rank 23 | rem-array->vector 24 | rem-proc 25 | rem-proc? 26 | rem-proc-body 27 | rem-proc-ranks 28 | rem-box 29 | rem-box? 30 | rem-box-contents 31 | subvector 32 | rem-scalar-proc 33 | scalar->atom 34 | list->array 35 | array->nest) 36 | ;"basis-lib.rkt" 37 | (for-syntax racket/base 38 | syntax/parse) 39 | (rename-in (only-in racket/base #%module-begin) 40 | [#%module-begin #%racket-module-begin])) 41 | 42 | ;;; Take all Remora primitive operations from the basis library, stripping the 43 | ;;; "R_" prefix 44 | (require (filtered-in (λ (name) 45 | (define new-name 46 | (if (regexp-match #rx"^R_" name) 47 | (regexp-replace #rx"^R_" name "") 48 | name)) 49 | #;(printf "got ~v from basis lib, providing ~v\n" 50 | name new-name) 51 | new-name) 52 | "basis-lib.rkt")) 53 | 54 | ;;; Take everything from racket/base that doesn't have the same name as a 55 | ;;; (prefix stripped) Remora primop or anything else from Remora's internals 56 | (require (subtract-in racket/base 57 | (filtered-in 58 | (λ (name) 59 | (define new-name 60 | (if (regexp-match #rx"^R_" name) 61 | (regexp-replace #rx"^R_" name "") 62 | name)) 63 | #;(printf "got ~v from basis lib, providing ~v\n" 64 | name new-name) 65 | new-name) 66 | "basis-lib.rkt") 67 | "syntax.rkt" 68 | "semantics.rkt")) 69 | ;;; Prefix the reader's exports so they don't conflict with things from 70 | ;;; racket/base or the Remora basis library 71 | (require (filtered-in 72 | (λ (name) (string-append "READER_" name)) 73 | "reader.rkt")) 74 | 75 | (provide (all-from-out "syntax.rkt" 76 | "semantics.rkt" 77 | "basis-lib.rkt" 78 | "records.rkt") 79 | (rename-out [remora-module-begin #%module-begin] 80 | [remora-top-interaction #%top-interaction]) 81 | #%racket-module-begin 82 | ;; Provide everything from racket/base that doesn't have the same name 83 | ;; as anything from Remora (must combine racket/base with the Remora 84 | ;; primops in order to subtract out Remora primops that don't shadow 85 | ;; anything in racket/base) 86 | (except-out (combine-out (all-from-out racket/base) 87 | (filtered-out 88 | (λ (name) 89 | (if (regexp-match #rx"^R_" name) 90 | (regexp-replace #rx"^R_" name "") 91 | name)) 92 | (all-from-out "basis-lib.rkt"))) 93 | (filtered-out 94 | (λ (name) 95 | (if (regexp-match #rx"^R_" name) 96 | (regexp-replace #rx"^R_" name "") 97 | name)) 98 | (all-from-out "basis-lib.rkt")) 99 | define λ struct 100 | #%module-begin 101 | #%top-interaction) 102 | (rename-out [defstruct struct] 103 | [def define] 104 | [fn λ])) 105 | 106 | (current-read-interaction READER_remora-read-syntax) 107 | 108 | (define-syntax (remora-module-begin stx) 109 | (syntax-parse stx 110 | [(_ body ...) 111 | #'(#%racket-module-begin (remora body) ...)])) 112 | 113 | (define-syntax (remora-top-interaction stx) 114 | (syntax-parse stx 115 | [(_ body ...) 116 | #'(remora (body ...))] 117 | [(_ . body) 118 | #'(remora body)])) 119 | -------------------------------------------------------------------------------- /remora/dynamic/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp syntax/module-reader 2 | remora/dynamic/lang/language 3 | #:read remora-read 4 | #:read-syntax remora-read-syntax 5 | (require "semantics.rkt" 6 | "syntax.rkt" 7 | racket/list) 8 | 9 | (provide remora-readtable 10 | remora-read 11 | remora-read-syntax) 12 | (define original-readtable (current-readtable)) 13 | 14 | ;;; #A(NAT ...)(ATOM ...) 15 | ;;; reads as 16 | ;;; (alit (NAT ...) ATOM ...) 17 | (define (read-alit trigger-char 18 | port 19 | source-name 20 | line-num 21 | col-num 22 | position) 23 | ;; take text from the port, looking for (NAT ...)(ATOM ...) 24 | (define shape (read port)) 25 | (define atoms (read port)) 26 | (cons 'alit 27 | (cons shape atoms))) 28 | 29 | ;;; [ALITERAL ...] 30 | ;;; reads as 31 | ;;; (array ALITERAL ...) 32 | (define (read-array trigger-char 33 | port 34 | source-name 35 | line-num 36 | col-num 37 | position) 38 | (define-struct end-of-form () #:transparent) 39 | (define pieces '()) 40 | (parameterize ([current-readtable 41 | (make-readtable (current-readtable) 42 | #\] 43 | 'terminating-macro 44 | (λ args (end-of-form)))]) 45 | (do ([next (begin #;(displayln " start loop") (read port)) 46 | (begin #;(displayln " step") (read port))]) 47 | ((equal? next (end-of-form)) (set! pieces (cons 'array (reverse pieces))) 48 | #;(printf "finishing with \'~v\'" next)) 49 | #;(printf "got element ~v\n" next) 50 | (set! pieces (cons next pieces))) 51 | pieces)) 52 | 53 | ;;; {FIELD ...} 54 | ;;; reads as 55 | ;;; (record-lit FIELD ...) 56 | (define (read-record trigger-char 57 | port 58 | source-name 59 | line-num 60 | col-num 61 | position) 62 | (define-struct end-of-form () #:transparent) 63 | (define pieces '()) 64 | (parameterize ([current-readtable 65 | (make-readtable (current-readtable) 66 | #\} 67 | 'terminating-macro 68 | (λ args (end-of-form)))]) 69 | (do ([next (begin #;(displayln " start loop") (read port)) 70 | (begin #;(displayln " step") (read port))]) 71 | ((equal? next (end-of-form)) 72 | (set! pieces (cons 'record-literal (reverse pieces))) 73 | #;(printf "finishing with \'~v\'" next)) 74 | #;(printf "got element ~v\n" next) 75 | (set! pieces (cons next pieces))) 76 | pieces)) 77 | 78 | ;;; #r(RANK ...)EXP 79 | ;;; reads as 80 | ;;; (rerank (RANK ...) EXP) 81 | (define (read-rerank trigger-char 82 | port 83 | source-name 84 | line-num 85 | col-num 86 | position) 87 | (define new-ranks (parameterize ([current-readtable original-readtable]) 88 | (read port))) 89 | (define base-exp (read port)) 90 | (list 'rerank new-ranks base-exp)) 91 | 92 | ;;; #_(FIELD ...) 93 | ;;; reads as 94 | ;;; (view (lens FIELD ...)) 95 | (define (read-view trigger-char 96 | port 97 | source-name 98 | line-num 99 | col-num 100 | position) 101 | (define field-names (parameterize ([current-readtable original-readtable]) 102 | (read port))) 103 | (list 'view (cons 'lens field-names))) 104 | 105 | ;;; #=(FIELD ...) 106 | ;;; reads as 107 | ;;; (set (lens FIELD ...)) 108 | (define (read-set trigger-char 109 | port 110 | source-name 111 | line-num 112 | col-num 113 | position) 114 | (define field-names (parameterize ([current-readtable original-readtable]) 115 | (read port))) 116 | (list 'set (cons 'lens field-names))) 117 | 118 | ;;; #^(FIELD ...) 119 | ;;; reads as 120 | ;;; (over (lens FIELD ...)) 121 | (define (read-over trigger-char 122 | port 123 | source-name 124 | line-num 125 | col-num 126 | position) 127 | (define field-names (parameterize ([current-readtable original-readtable]) 128 | (read port))) 129 | (list 'over (cons 'lens field-names))) 130 | 131 | (define (extend-readtable base-readtable . new-entries) 132 | (cond [(empty? new-entries) base-readtable] 133 | [else 134 | (apply extend-readtable 135 | (cons (apply make-readtable 136 | (cons base-readtable (first new-entries))) 137 | (rest new-entries)))])) 138 | 139 | (define remora-readtable 140 | (extend-readtable 141 | (current-readtable) 142 | (list #\A 'dispatch-macro read-alit) 143 | (list #\[ 'terminating-macro read-array) 144 | (list #\{ 'terminating-macro read-record) 145 | (list #\r 'dispatch-macro read-rerank) 146 | (list #\~ 'non-terminating-macro read-rerank) 147 | (list #\_ 'dispatch-macro read-view) 148 | (list #\= 'dispatch-macro read-set) 149 | (list #\^ 'dispatch-macro read-over))) 150 | 151 | (define (remora-read . args) 152 | (parameterize ([current-readtable remora-readtable]) 153 | (apply read args))) 154 | (define (remora-read-syntax . args) 155 | (parameterize ([current-readtable remora-readtable]) 156 | (apply read-syntax args))) 157 | -------------------------------------------------------------------------------- /remora/dynamic/lang/records.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require (for-syntax syntax/parse)) 4 | 5 | (provide (struct-out lrec) 6 | make-record 7 | make-lens 8 | over view set) 9 | 10 | (module+ test 11 | (require rackunit)) 12 | 13 | ;;; An ordered record structure, mapping symbols to values 14 | (define (lrec-print lr port mode) 15 | (display (lrec->string lr mode) port)) 16 | (define (lrec->string lr mode) 17 | (cond [(number? mode) ; print 18 | (string-join 19 | (for/list ([e (lrec-data lr)]) 20 | (format "(~s ~v)" (car e) (cdr e))) 21 | " " 22 | #:before-first "{" 23 | #:after-last "}")] 24 | [mode ; write 25 | (string-join 26 | (for/list ([e (lrec-data lr)]) 27 | (format "(~s ~s)" (car e) (cdr e))) 28 | " " 29 | #:before-first "{" 30 | #:after-last "}")] 31 | [else ; display 32 | (string-join 33 | (for/list ([e (lrec-data lr)]) 34 | (format "(~s ~a)" (car e) (cdr e))) 35 | " " 36 | #:before-first "{" 37 | #:after-last "}")])) 38 | (struct lrec (data) 39 | #:transparent 40 | #:methods gen:custom-write [(define write-proc lrec-print)]) 41 | 42 | 43 | 44 | ;;; Build a procedure which constructs an lrec 45 | (define (make-record . fnames) 46 | (λ fvals (lrec (map cons fnames fvals)))) 47 | ;;; A couple examples 48 | (define FLAT 49 | ((make-record 'foo 'bar 'baz 'quux) 10 1-3i #t "wut")) 50 | (define NESTED 51 | ((make-record 'foo 'bar 'baz 'quux) 52 | 10 1-3i 53 | ((make-record 'a 'b) "α" "β") 54 | "wut")) 55 | 56 | ;;; Special syntax for constructing an lrec 57 | (define-syntax (record stx) 58 | (syntax-parse stx 59 | [(_ (field:id value:expr) ...) 60 | #'((make-record 'field ...) value ...)])) 61 | 62 | ;;; Grab one field from a record 63 | (define (record-ref rec fname) 64 | (for/first ([field (lrec-data rec)] 65 | #:when (symbol=? fname (car field))) 66 | (cdr field))) 67 | 68 | ;;; Change one field in a record 69 | (define (replace-field rec fname new-val) 70 | (lrec (for/list ([field (lrec-data rec)]) 71 | (if (symbol=? fname (car field)) 72 | (cons fname new-val) 73 | field)))) 74 | 75 | 76 | ;;; Make something like Functor's fmap available by making the "dictionary 77 | ;;; passing" explicit. A value meant to be treated as having an associated 78 | ;;; Functor instance must be packaged up along with how it implements fmap. 79 | ;;; val : [F s] (for some imagined type constructor F) 80 | ;;; fn : [s -> t] [F s] -> [F t] 81 | (struct functor (val fn) #:transparent) 82 | (define (fmap a b) 83 | (functor ((functor-fn b) a (functor-val b)) 84 | (functor-fn b))) 85 | 86 | 87 | ;;; Symbol -> [A -> [Functor B]] -> Record -> [Functor Record] 88 | (define (((make-lens fname) xform) rec) 89 | (fmap (λ (new-val) (replace-field rec fname new-val)) 90 | (xform (record-ref rec fname)))) 91 | (define-syntax (lens stx) 92 | (syntax-parse stx 93 | [(_ field:id) #'(make-lens 'field)])) 94 | 95 | 96 | ;;; Use a lens to update a field using a passed-in updater function 97 | ;;; Lens -> [A -> B] -> [Record over A] -> [Record over B] 98 | (define (((over l) xform) rec) 99 | (functor-val 100 | ((l (λ (old-val) (functor (xform old-val) 101 | (λ (x y) (x y))))) 102 | rec))) 103 | (module+ test 104 | (check-equal? 105 | (((over (lens foo)) add1) FLAT) 106 | ((make-record 'foo 'bar 'baz 'quux) 107 | 11 1-3i #t "wut")) 108 | (check-equal? 109 | (((over (lens foo)) number->string) FLAT) 110 | ((make-record 'foo 'bar 'baz 'quux) 111 | "10" 1-3i #t "wut")) 112 | (check-equal? 113 | (((over (lens foo)) add1) NESTED) 114 | ((make-record 'foo 'bar 'baz 'quux) 115 | 11 1-3i ((make-record 'a 'b) "α" "β") "wut")) 116 | (check-equal? 117 | (((over (compose (lens baz) (lens a))) 118 | (λ (s) (string-append s s))) 119 | NESTED) 120 | ((make-record 'foo 'bar 'baz 'quux) 121 | 10 1-3i ((make-record 'a 'b) "αα" "β") "wut"))) 122 | 123 | ;;; Use a lens to extract a field 124 | ;;; Lens -> [Record over A] -> A 125 | (define ((view l) rec) 126 | (functor-val 127 | ((l (λ (old-val) (functor old-val 128 | (λ (x y) y)))) 129 | rec))) 130 | (module+ test 131 | (check-equal? 132 | ((view (lens bar)) 133 | NESTED) 134 | 1-3i) 135 | (check-equal? 136 | ((view (lens baz)) 137 | NESTED) 138 | ((make-record 'a 'b) "α" "β")) 139 | (check-equal? 140 | ((view (compose (lens baz) (lens a))) 141 | NESTED) 142 | "α") 143 | (check-equal? 144 | ((view (compose (lens baz) (lens b))) 145 | NESTED) 146 | "β")) 147 | 148 | ;;; Use a lens to replace a field with a passed-in value 149 | ;;; Lens -> B -> [Record over A] -> [Record over B] 150 | (define ((set l) new-val) 151 | ((over l) (const new-val))) 152 | (module+ test 153 | (check-equal? 154 | (((set (lens foo)) "eleven") FLAT) 155 | ((make-record 'foo 'bar 'baz 'quux) 156 | "eleven" 1-3i #t "wut")) 157 | (check-equal? 158 | (((set (lens foo)) 10) FLAT) 159 | ((make-record 'foo 'bar 'baz 'quux) 160 | 10 1-3i #t "wut")) 161 | (check-equal? 162 | (((set (lens foo)) #t) NESTED) 163 | ((make-record 'foo 'bar 'baz 'quux) 164 | #t 1-3i ((make-record 'a 'b) "α" "β") "wut")) 165 | (check-equal? 166 | (((set (compose (lens baz) (lens a))) 167 | "αβγδ") 168 | NESTED) 169 | ((make-record 'foo 'bar 'baz 'quux) 170 | 10 1-3i ((make-record 'a 'b) "αβγδ" "β") "wut"))) 171 | -------------------------------------------------------------------------------- /remora/dynamic/lang/semantics.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/list 4 | racket/vector 5 | racket/sequence 6 | racket/contract/base 7 | racket/string) 8 | (module+ test 9 | (require rackunit)) 10 | (define debug-mode (make-parameter #f)) 11 | (provide debug-mode) 12 | 13 | ;;;------------------------------------- 14 | ;;; Internal use structures: 15 | ;;;------------------------------------- 16 | 17 | ;;; Apply a Remora array (in Remora, an array may appear in function position) 18 | (provide 19 | (contract-out 20 | (apply-rem-array (->* (rem-array?) 21 | (#:result-shape 22 | (or/c symbol? 23 | (vectorof exact-nonnegative-integer?))) 24 | #:rest 25 | (listof rem-array?) 26 | rem-array?)))) 27 | (define (apply-rem-array fun 28 | #:result-shape [result-shape 'no-annotation] 29 | . args) 30 | ;; check whether the data portion of fun is Remora procedures 31 | (unless (for/and [(p (rem-array-data fun))] (rem-proc? p)) 32 | (error "Array in function position must contain only Remora functions" fun)) 33 | 34 | (when (debug-mode) (printf "\n\nResult shape is ~v\n" result-shape)) 35 | 36 | ;; check whether args actually are Remora arrays 37 | (unless (for/and [(arr args)] (rem-array? arr)) 38 | (error "Remora arrays can only by applied to Remora arrays" fun args)) 39 | (when (debug-mode) (printf "checked for Remora array arguments in ~v\n" args)) 40 | 41 | ;; identify expected argument cell ranks 42 | (define individual-exp-ranks 43 | (for/list [(p (rem-array-data fun))] 44 | (when (debug-mode) (printf "checking expected ranks for ~v\n" p)) 45 | (for/vector [(t (rem-proc-ranks p)) 46 | (arr args)] 47 | (when (debug-mode) (printf "~v - ~v\n" p t)) 48 | (if (equal? 'all t) 49 | (rem-array-rank arr) 50 | t)))) 51 | (when (debug-mode) (printf "individual expected ranks are ~v\n" 52 | individual-exp-ranks)) 53 | (define expected-rank 54 | (cond [(empty? individual-exp-ranks) 55 | 'empty-function-array] 56 | [(for/and [(p individual-exp-ranks)] 57 | (equal? p (first individual-exp-ranks))) 58 | (first individual-exp-ranks)] 59 | [else (error "Could not identify expected rank for function" fun)])) 60 | (when (debug-mode) (printf "expected-rank = ~v\n" expected-rank)) 61 | 62 | ;; find principal frame shape 63 | (define principal-frame 64 | (or (for/fold ([max-frame (rem-array-shape fun)]) 65 | ([arr args] 66 | [r expected-rank]) 67 | (prefix-max 68 | (vector-drop-right (rem-array-shape arr) r) 69 | max-frame)) 70 | (error "Incompatible argument frames" 71 | (cons (rem-array-shape fun) 72 | (for/list ([arr args] 73 | [r expected-rank]) 74 | (vector-drop-right (rem-array-shape arr) r)))))) 75 | (when (debug-mode) (printf "principal-frame = ~v\n" principal-frame)) 76 | 77 | ;; compute argument cell sizes 78 | (define cell-sizes 79 | (for/list ([arr args] 80 | [r expected-rank]) 81 | (sequence-fold * 1 (vector-take-right (rem-array-shape arr) r)))) 82 | (when (debug-mode) (printf "cell-sizes = ~v\n" cell-sizes)) 83 | 84 | ;; compute argument frame sizes 85 | (define frame-sizes 86 | (for/list ([arr args] 87 | [r expected-rank]) 88 | (sequence-fold * 1 (vector-drop-right (rem-array-shape arr) r)))) 89 | (when (debug-mode) (printf "frame-sizes = ~v\n" frame-sizes)) 90 | 91 | ;; compute each result cell 92 | (define result-cells 93 | (for/vector ([cell-id (sequence-fold * 1 principal-frame)]) 94 | (define function-cell-id 95 | (quotient cell-id 96 | (quotient (sequence-fold * 1 principal-frame) 97 | (sequence-fold * 1 (rem-array-shape fun))))) 98 | (when (debug-mode) 99 | (printf 100 | "using function cell #~v\n taken from ~v\n" 101 | function-cell-id 102 | (rem-array-data fun))) 103 | (define arg-cells 104 | (for/list ([arr args] 105 | [csize cell-sizes] 106 | [fsize frame-sizes] 107 | [r expected-rank]) 108 | (define offset 109 | (* csize 110 | (quotient cell-id 111 | (quotient (sequence-fold * 1 principal-frame) 112 | fsize)))) 113 | (when (debug-mode) 114 | (printf " arg cell #~v, csize ~v, pfr ~v, fr ~v" 115 | cell-id csize (sequence-fold * 1 principal-frame) fsize)) 116 | (define arg-cell 117 | (begin 118 | (when (debug-mode) (printf " (not single box)")) 119 | (rem-array (vector-take-right (rem-array-shape arr) r) 120 | (subvector (rem-array-data arr) 121 | offset 122 | csize)))) 123 | (when (debug-mode) 124 | (printf " -- ~v\n" arg-cell)) 125 | arg-cell)) 126 | (when (debug-mode) 127 | (printf " function: ~v\n" 128 | (vector-ref (rem-array-data fun) 129 | function-cell-id)) 130 | (printf " arg cells: ~v\n" arg-cells)) 131 | (apply (vector-ref (rem-array-data fun) function-cell-id) 132 | arg-cells))) 133 | (when (debug-mode) (printf "result-cells = ~v\n" result-cells)) 134 | 135 | (when (debug-mode) 136 | (printf "# of result cells: ~v\nresult-shape = ~v\n" 137 | (vector-length result-cells) result-shape)) 138 | ;; determine final result shape 139 | (define final-shape 140 | (cond 141 | ;; empty frame and no shape annotation -> error 142 | [(and (equal? result-shape 'no-annotation) 143 | (equal? 0 (vector-length result-cells))) 144 | (error "Empty frame with no shape annotation: ~v applied to ~v" 145 | fun args)] 146 | ;; empty frame -> use annotated shape 147 | ;; TODO: should maybe check for mismatch between annotated and actual 148 | ;; (i.e. frame-shape ++ cell-shape) result shapes 149 | [(equal? 0 (vector-length result-cells)) result-shape] 150 | [(for/and ([c result-cells]) 151 | (equal? (rem-array-shape (vector-ref result-cells 0)) 152 | (rem-array-shape c))) 153 | (when (debug-mode) 154 | (printf "using cell shape ~v\n" 155 | (rem-array-shape (vector-ref result-cells 0)))) 156 | (vector-append principal-frame 157 | (rem-array-shape (vector-ref result-cells 0)))] 158 | [else (error "Result cells have mismatched shapes: ~v" result-cells)])) 159 | (when (debug-mode) (printf "final-shape = ~v\n" final-shape)) 160 | 161 | ;; determine final result data: all result cells' data vectors concatenated 162 | (define final-data 163 | (apply vector-append 164 | (for/list ([r result-cells]) 165 | (rem-array-data r)))) 166 | (when (debug-mode) 167 | (printf "final-data = ~v\n" final-data) 168 | (printf "(equal? #() final-shape) = ~v\n" 169 | (equal? #() final-shape))) 170 | (rem-array final-shape final-data)) 171 | 172 | ;;; Contract constructor for vectors of specified length 173 | (define ((vector-length/c elts len) vec) 174 | (and ((vectorof elts #:flat? #t) vec) 175 | (equal? (vector-length vec) len))) 176 | 177 | ;;; Generate a whitespace pad to prepend when pretty-printing 178 | (define (pad n) (build-string n (λ _ #\space))) 179 | ;;; Generate a flat string representation of a rank-1 array (no line breaks) 180 | (define (remora-vector->string vec separator [left-col 0]) 181 | (cond [(= 0 (vector-length (rem-array-data vec))) "[]"] 182 | [(for/and ([e (rem-array-data vec)]) (void? e)) ""] 183 | ;; May later decide to make char vectors display like strings 184 | #; 185 | [(for/and ([e (rem-array-data vec)]) (char? e)) 186 | (apply string (vector->list (rem-array-data vec)))] 187 | [else (define atoms 188 | (for/list ([a (rem-array-data vec)]) (format "~v" a))) 189 | (string-append "[" (string-join atoms separator) "]")])) 190 | ;;; Generate a multi-line representation of a rank-n array 191 | ;;; left-col: tracks how deeply nested the cells we're currently rendering 192 | ;;; are within the array we started with (may start higher than 0 if we're 193 | ;;; nesting this pretty-printed array inside another thing) 194 | (define (frame->string arr [left-col 0]) 195 | ;; We only want to place the initial left-pad when we're dealing with the 196 | ;; outermost nesting level. Otherwise, the intra-cell padding ensures that we 197 | ;; start as far to the right as we should. 198 | (define (frame->string* arr left-col start) 199 | (string-append 200 | (if start (pad left-col) "") 201 | (cond 202 | ;; For scalar, print its sole atom 203 | [(= 0 (rem-array-rank arr)) 204 | (format "~v" (vector-ref (rem-array-data arr) 0))] 205 | ;; For (non-empty) array of #s of any shape, just show nothing 206 | [(and (> (vector-length (rem-array-data arr)) 0) 207 | (for/and ([e (rem-array-data arr)]) (void? e))) 208 | ""] 209 | ;; For non-void vectors, use the vector pretty-printer 210 | [(and (= 1 (rem-array-rank arr)) 211 | (for/and ([d (rem-array-data arr)]) 212 | (not (rem-box? d)))) 213 | (remora-vector->string arr " " #;atom-separator)] 214 | ;; For higher-rank things, join the cells' string representations with a 215 | ;; line break and an amount of space-padding given by nesting depth 216 | [else (define cell-strs 217 | (for/list ([c (-1-cells arr)]) 218 | (frame->string* c (add1 left-col) #f))) 219 | (define joined-cells 220 | (string-join 221 | cell-strs 222 | (string-append "\n" (pad (add1 left-col))))) 223 | (string-append "[" joined-cells "]")]))) 224 | (frame->string* arr left-col #t)) 225 | ;;; One-line string representation of an array, for print, write, or display mode 226 | ;;; TODO: consider changing how a vector of characters is represented 227 | (define (array->string arr [mode 0]) 228 | (cond [(equal? mode #t) ; write 229 | (format "(rem-array ~s ~s)" 230 | (rem-array-shape arr) 231 | (rem-array-data arr))] 232 | [(equal? mode #f) ; display 233 | (frame->string arr)] 234 | [(member mode '(0 1)) ; print 235 | (frame->string arr)])) 236 | #; 237 | (define (array->string arr [mode 0]) 238 | (define format-string 239 | (cond [(member mode '(0 1)) "~v"] ; print 240 | [(equal? mode #t) "~s"] ; write 241 | [(equal? mode #f) "~a"])) ; display 242 | (if (equal? mode #t) 243 | ;; write mode 244 | (format "(rem-array ~s ~s)" (rem-array-shape arr) (rem-array-data arr)) 245 | ;; print/display mode 246 | (cond [(and (not (= 0 (vector-length (rem-array-data arr)))) 247 | (for/and ([e (rem-array-data arr)]) (void? e))) 248 | ""] 249 | [(= 0 (rem-array-rank arr)) 250 | (format format-string (vector-ref (rem-array-data arr) 0))] 251 | [else (string-append 252 | (for/fold ([str "["]) 253 | ([cell (-1-cells arr)] 254 | [cell-id (length (-1-cells arr))]) 255 | (string-append str 256 | (if (equal? 0 cell-id) "" " ") 257 | (array->string cell mode))) 258 | "]" 259 | (if (>= (rem-array-rank arr) 2) "\n" ""))]))) 260 | ;;; Print, write, or display an array 261 | (define (show-array arr [port (current-output-port)] [mode 0]) 262 | (display (array->string arr mode) port)) 263 | 264 | ;;; A Remora array has 265 | ;;; - shape, a vector of numbers 266 | ;;; - data, a vector of any 267 | (provide 268 | (contract-out 269 | (rem-array (->i ([shape (vectorof exact-nonnegative-integer?)] 270 | [data (shape) (vector-length/c 271 | any/c 272 | (for/product ([dim shape]) dim))]) 273 | [result any/c])) 274 | (rem-array-shape (-> rem-array? 275 | (vectorof exact-nonnegative-integer?))) 276 | (rem-array-data (-> rem-array? 277 | (vectorof any/c))) 278 | (rem-array? (-> any/c boolean?)))) 279 | (struct rem-array (shape data) 280 | #:transparent 281 | #:property prop:procedure apply-rem-array 282 | #:methods gen:custom-write [(define write-proc show-array)]) 283 | (module+ test 284 | (define array-ex:scalar1 (rem-array #() #(4))) 285 | (define array-ex:scalar2 (rem-array #() #(2))) 286 | (define array-ex:vector1 (rem-array #(2) #(10 20))) 287 | (define array-ex:matrix1 (rem-array #(2 3) #(1 2 3 4 5 6)))) 288 | 289 | ;;; Find the rank of a Remora array 290 | (provide 291 | (contract-out 292 | (rem-array-rank (-> rem-array? exact-nonnegative-integer?)))) 293 | (define (rem-array-rank arr) (vector-length (rem-array-shape arr))) 294 | (module+ test 295 | (check-equal? 0 (rem-array-rank array-ex:scalar1)) 296 | (check-equal? 1 (rem-array-rank array-ex:vector1)) 297 | (check-equal? 2 (rem-array-rank array-ex:matrix1))) 298 | 299 | ;;; Convert a Remora vector (rank 1 Remora array) to a Racket vector 300 | (provide 301 | (contract-out (rem-array->vector 302 | (-> (λ (arr) (and (rem-array? arr) 303 | (equal? (rem-array-rank arr) 1))) 304 | vector?)))) 305 | (define (rem-array->vector arr) 306 | (if (equal? (rem-array-rank arr) 1) 307 | (rem-array-data arr) 308 | (error rem-array->vector "provided array does not have rank 1"))) 309 | 310 | 311 | ;;; Apply a Remora procedure (for internal convenience) 312 | ;;; TODO: consider eliminating this (see note in rem-proc struct defn) 313 | (define (apply-rem-proc fun . args) 314 | (when (debug-mode) (printf "applying Remora procedure ~v // ~v\n" 315 | fun (rem-proc-ranks fun))) 316 | (apply (rem-proc-body fun) (map racket->remora args))) 317 | 318 | ;;; A valid expected rank is either a natural number or 'all 319 | (define (rank? r) 320 | (or (exact-nonnegative-integer? r) (equal? 'all r))) 321 | 322 | ;;; Print, write, or display a Remora procedure 323 | (define (show-rem-proc proc [port (current-output-port)] [mode 0]) 324 | (display "#" port)) 325 | 326 | ;;; A Remora procedure has 327 | ;;; - body, a Racket procedure which consumes and produces Remora arrays 328 | ;;; - ranks, a list of the procedure's expected argument ranks 329 | ;;; TODO: tighten the contract on body to require the procedure to consume and 330 | ;;; produce arrays 331 | (provide 332 | (contract-out (struct rem-proc ([body procedure?] 333 | [ranks (listof rank?)])))) 334 | (define-struct rem-proc (body ranks) 335 | #:transparent 336 | ;; may decide to drop this part -- it seems to hide a common error: 337 | ;; using (R+ arr1 arr2) instead of ([scalar R+] arr1 arr2) means no lifting 338 | #:property prop:procedure apply-rem-proc 339 | #:methods gen:custom-write [(define write-proc show-rem-proc)]) 340 | (module+ test 341 | (define R+ (rem-scalar-proc + 2)) 342 | (define R- (rem-scalar-proc - 2)) 343 | (define R* (rem-scalar-proc * 2)) 344 | (check-equal? (R+ array-ex:scalar1 array-ex:scalar2) 345 | (rem-array #() #(6)))) 346 | 347 | ;;; Construct an array as a frame of cells 348 | (provide 349 | (contract-out (build-frame (->* ((vectorof exact-nonnegative-integer?) 350 | (sequence/c rem-array?)) 351 | ((or/c (vectorof exact-nonnegative-integer?) #f)) 352 | rem-array?)))) 353 | (define (build-frame fshp cells [cshp #f]) 354 | (define final-shape 355 | (cond [(and (= 0 (sequence-length cells)) (not cshp)) 356 | (error "Empty frame ~v with no shape annotation" fshp)] 357 | [(= 0 (sequence-length cells)) (vector-append fshp cshp)] 358 | [(for/and ([c cells]) 359 | (equal? (rem-array-shape (sequence-ref cells 0)) 360 | (rem-array-shape c))) 361 | (vector-append fshp (rem-array-shape (sequence-ref cells 0)))] 362 | [else (error "Result cells have mismatched shapes: ~v" cells)])) 363 | (rem-array final-shape 364 | (apply vector-append (for/list ([c cells]) (rem-array-data c))))) 365 | 366 | ;;; Construct an array as a vector of -1-cells 367 | (provide 368 | (contract-out (build-vec (->* () 369 | #:rest (listof rem-array?) 370 | rem-array?)))) 371 | (define (build-vec . arrs) 372 | (define (only-unique-element xs) 373 | (for/fold ([elt (sequence-ref xs 0)]) 374 | ([x xs]) 375 | (if (equal? x elt) 376 | x 377 | (error "cannot use vec on arrays of mismatched shape")))) 378 | (define cell-shape 379 | (if (empty? arrs) 380 | #() 381 | (only-unique-element 382 | (for/list ([a arrs]) (rem-array-shape a))))) 383 | (define num-cells (length arrs)) 384 | (if (equal? cell-shape 'box) 385 | (rem-array (vector num-cells) (list->vector arrs)) 386 | (rem-array 387 | (for/vector ([dim (cons num-cells (vector->list cell-shape))]) dim) 388 | (apply vector-append (for/list ([a arrs]) 389 | (rem-array-data a)))))) 390 | 391 | 392 | 393 | ;;; A Remora box (dependent sum) has 394 | ;;; - contents, a Remora array 395 | ;;; - indices, a list of the witness indices 396 | (define (box->string b mode [left-col 0]) 397 | (define opener "(box ") 398 | (define inset (+ 1 left-col (string-length opener))) 399 | (cond [(member mode '(0 1 #f)) 400 | (string-append opener 401 | (substring (frame->string (rem-box-contents b) inset) 402 | inset) 403 | ")")] 404 | [else (format "(box ~s)" (rem-box-contents b))])) 405 | (define (show-box b port mode) 406 | (display (box->string b mode) port)) 407 | (provide (contract-out 408 | (struct rem-box ([contents rem-array?])))) 409 | (struct rem-box (contents) 410 | #:transparent 411 | #:methods gen:custom-write [(define write-proc show-box)]) 412 | 413 | 414 | ;;; Identify which of two sequences is the prefix of the other, or return #f 415 | ;;; if neither is a prefix of the other (or if either sequence is #f) 416 | (define (prefix-max seq1 seq2) 417 | (and seq1 seq2 418 | (for/and ([a seq1] [b seq2]) 419 | (equal? a b)) 420 | (if (> (sequence-length seq1) (sequence-length seq2)) seq1 seq2))) 421 | (module+ test 422 | (check-equal? (prefix-max #(3 4) #(3 4)) #(3 4)) 423 | (check-equal? (prefix-max #(3 4) #(3 4 9)) #(3 4 9)) 424 | (check-equal? (prefix-max #(3 4 2) #(3 4)) #(3 4 2)) 425 | (check-equal? (prefix-max #(3) #(3 4)) #(3 4)) 426 | (check-equal? (prefix-max #(3 2) #(3 4)) #f) 427 | (check-equal? (prefix-max #(3 2) #(3 4 5)) #f)) 428 | 429 | 430 | ;;; Extract a contiguous piece of a vector 431 | (provide 432 | (contract-out (subvector (-> (vectorof any/c) 433 | exact-nonnegative-integer? 434 | exact-nonnegative-integer? 435 | (vectorof any/c))))) 436 | (define (subvector vec offset size) 437 | (for/vector #:length size ([i (in-range offset (+ offset size))]) 438 | (vector-ref vec i))) 439 | (module+ test 440 | (check-equal? (subvector #(2 4 6 3 5 7) 1 3) #(4 6 3)) 441 | (check-equal? (subvector #(2 4 6 3 5 7) 4 2) #(5 7)) 442 | (check-equal? (subvector #(2 4 6 3 5 7) 4 0) #())) 443 | 444 | 445 | ;;; Convert a rank-1 or higher array to a list of its -1-cells 446 | (define (-1-cells arr) 447 | (define cell-shape (vector-drop (rem-array-shape arr) 1)) 448 | (define cell-size (for/product ([dim cell-shape]) dim)) 449 | (define num-cells (vector-ref (rem-array-shape arr) 0)) 450 | (for/list ([cell-id num-cells]) 451 | (rem-array cell-shape 452 | (subvector (rem-array-data arr) 453 | (* cell-id cell-size) 454 | cell-size)))) 455 | 456 | 457 | 458 | ;;; tests for array application 459 | ;;; TODO: test array application for functions that consume/produce non-scalars 460 | (module+ test 461 | (check-equal? ((scalar R+) (scalar 3) (scalar 4)) 462 | (scalar 7)) 463 | (check-equal? ((scalar R+) (rem-array #(2 3) #(1 2 3 4 5 6)) 464 | (rem-array #(2) #(10 20))) 465 | (rem-array #(2 3) #(11 12 13 24 25 26))) 466 | (check-equal? ((rem-array #(2) (vector R+ R-)) 467 | (rem-array #(2 3) #(1 2 3 4 5 6)) 468 | (rem-array #(2) #(10 20))) 469 | (rem-array #(2 3) #(11 12 13 -16 -15 -14)))) 470 | 471 | ;;;------------------------------------- 472 | ;;; Integration utilities 473 | ;;;------------------------------------- 474 | ;;; Build a scalar Remora procedure from a Racket procedure 475 | (provide 476 | (contract-out 477 | (rem-scalar-proc (-> procedure? exact-nonnegative-integer? rem-proc?)))) 478 | (define (rem-scalar-proc p arity) 479 | ;; Cache the result of the application of the remora function, then 480 | ;; check if it's already been wrapped as a rem-array. If it has, then 481 | ;; return it, otherwise wrap it as it currently is 482 | (rem-proc (λ args 483 | (let [(result (apply p (for/list [(a args)] 484 | (vector-ref (rem-array-data a) 0))))] 485 | (if (rem-array? result) 486 | result 487 | (rem-array 488 | #() 489 | (vector-immutable result))))) 490 | (for/list [(i arity)] 0))) 491 | 492 | ;;; Build a scalar Remora array from a Racket value 493 | ;(provide (contract-out (scalar (-> any/c rem-array?)))) 494 | (define (scalar v) (rem-array #() (vector-immutable v))) 495 | 496 | ;;; Extract a racket value from a scalar Remora array 497 | (provide 498 | (contract-out 499 | (scalar->atom (-> (λ (arr) (and (rem-array? arr) 500 | (equal? (rem-array-shape arr) #()))) 501 | any/c)))) 502 | (define (scalar->atom a) (vector-ref (rem-array-data a) 0)) 503 | 504 | ;;; Build a Remora array from a nested Racket list of cells, themselves 505 | ;;; represented as Remora arrays. As the null case of nesting, a Remora array 506 | ;;; on its own instead of in a list will be left as is (i.e., put into a 507 | ;;; scalar frame). 508 | (provide 509 | (contract-out 510 | (list->array (-> (or/c rem-array? regular-list?) rem-array?)))) 511 | (define (list->array xs) 512 | (cond [(rem-array? xs) xs] 513 | [(empty? xs) (rem-array #(0) #())] 514 | [(list? (first xs)) 515 | (apply build-vec (for/list ([x xs]) (list->array x)))] 516 | [else (apply build-vec (for/list ([x xs]) (scalar x)))])) 517 | ;;; Check whether a nested list is regular (non-ragged) 518 | (define (regular-list? xs) 519 | (and (list? xs) 520 | (cond [(empty? xs) #t] 521 | [(for/and ([x xs]) (not (list? x))) #t] 522 | [(for/and ([x xs]) (and (regular-list? x) 523 | (equal? (length x) 524 | (length (first xs))))) #t] 525 | [else #f]))) 526 | (module+ test 527 | (check-false (regular-list? 'a)) 528 | (check-true (regular-list? '())) 529 | (check-true (regular-list? '(a b c))) 530 | (check-true (regular-list? '((a b c)(a b c)))) 531 | (check-true (regular-list? '(((a b c)(a b c))((a b c)(a b c))))) 532 | (check-false (regular-list? '(((a b c)(a b))((a b c)(a b c)))))) 533 | 534 | ;;; Build a nested Racket list or vector from a Remora array 535 | ;;; Note: in the rank 0 case, you may not get a list/vector 536 | (provide 537 | (contract-out 538 | (array->nest-list (-> rem-array? any/c)) 539 | (array->nest-vector (-> rem-array? any/c)))) 540 | (define (array->nest-list xs) 541 | (cond [(= 0 (rem-array-rank xs)) (scalar->atom xs)] 542 | [else (for/list ([item (-1-cells xs)]) 543 | (array->nest-list item))])) 544 | (define (array->nest-vector xs) 545 | (cond [(= 0 (rem-array-rank xs)) (scalar->atom xs)] 546 | [else (for/vector ([item (-1-cells xs)]) 547 | (array->nest-vector item))])) 548 | (module+ test 549 | ;; TODO: test array->nest-vector 550 | (check-equal? (array->nest-list (rem-array #() #(a))) 551 | 'a) 552 | (check-equal? (array->nest-list (rem-array #(3) #(a b c))) 553 | '(a b c)) 554 | (check-equal? (array->nest-list (rem-array #(3 2) #(a b c d e f))) 555 | '((a b) (c d) (e f))) 556 | (check-equal? (array->nest-list (rem-array #(2 3) #(a b c d e f))) 557 | '((a b c) (d e f)))) 558 | 559 | 560 | ;;; Apply what may be a Remora array or Racket procedure to some Remora arrays, 561 | ;;; with a possible result shape annotation 562 | (provide (contract-out 563 | (remora-apply (->* (procedure?) 564 | (#:result-shape 565 | (or/c symbol? 566 | (vectorof exact-nonnegative-integer?))) 567 | #:rest 568 | (listof rem-array?) 569 | rem-array?)))) 570 | (define (remora-apply 571 | fun 572 | #:result-shape [result-shape 'no-annotation] 573 | . orig-args) 574 | (define args (map racket->remora orig-args)) 575 | (cond [(rem-array? fun) 576 | (apply apply-rem-array 577 | (racket-proc-array->rem-proc-array fun (length args)) 578 | #:result-shape result-shape 579 | args)] 580 | [(rem-proc? fun) 581 | (apply apply-rem-array 582 | (rem-array #() (vector fun)) 583 | #:result-shape result-shape 584 | args)] 585 | [(procedure? fun) 586 | (apply apply-rem-array 587 | (rem-array #() 588 | (vector (rem-scalar-proc fun (length args)))) 589 | #:result-shape result-shape 590 | args)])) 591 | 592 | ;;; if given array contains Racket procedures, convert them to Remora procedures 593 | ;;; of the given arity 594 | (define (racket-proc-array->rem-proc-array arr arity) 595 | (rem-array (rem-array-shape arr) 596 | (for/vector ([elt (rem-array-data arr)]) 597 | (cond [(rem-proc? elt) elt] 598 | [(procedure? elt) (rem-scalar-proc elt arity)])))) 599 | 600 | (provide (contract-out (racket->remora (-> any/c rem-array?)))) 601 | (define (racket->remora val) 602 | (when (debug-mode) (printf "converting ~v\n" val)) 603 | (cond [(rem-array? val) (when (debug-mode) (printf " keeping as is\n")) 604 | val] 605 | [else (when (debug-mode) (printf " wrapping\n")) 606 | (rem-array #() (vector val))])) 607 | -------------------------------------------------------------------------------- /remora/dynamic/lang/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "records.rkt" 4 | "semantics.rkt" 5 | syntax/parse 6 | (rename-in racket/base [apply racket-apply]) 7 | (for-syntax syntax/parse 8 | (except-in racket/base apply unbox) 9 | (rename-in racket/base [apply racket-apply]) 10 | racket/list 11 | racket/syntax)) 12 | 13 | (provide Rλ 14 | define-primop 15 | remora 16 | fn 17 | all 18 | alit 19 | array 20 | apply/shape 21 | : 22 | unbox 23 | vec 24 | rerank 25 | def 26 | defstruct 27 | record 28 | record-literal 29 | lens) 30 | 31 | 32 | 33 | 34 | (begin-for-syntax 35 | (struct remora-macro (transformer)) 36 | (define-syntax-class CONST 37 | #:description "Remora constant" 38 | #:literals (quote) 39 | (pattern bool:boolean) 40 | (pattern numlit:number) 41 | (pattern strlit:str) 42 | (pattern charlit:char) 43 | (pattern (quote sexp))) 44 | (define-syntax-class RANK 45 | #:description "Remora argument rank" 46 | #:literals (all) 47 | (pattern all) 48 | (pattern cell-rank:nat)) 49 | (define-syntax-class ATOM 50 | #:description "Remora atom" 51 | #:literals (fn all) 52 | (pattern const:CONST) 53 | (pattern (fn ((var:id r:RANK) ...) body ...))) 54 | (define-syntax-class ALITERAL 55 | #:description "Remora array literal" 56 | #:literals (array alit) 57 | (pattern (array piece:ALITERAL ...)) 58 | (pattern (alit (dim:nat ...) elt:ATOM ...)))) 59 | 60 | 61 | (define-syntax (Rλ stx) 62 | (syntax-parse stx 63 | [(_ ((var:id rank:RANK) ...) body ...+) 64 | #'(rem-proc (λ (var ...) body ...) 65 | (list rank ...))])) 66 | (define-syntax (define-primop stx) 67 | (syntax-parse stx 68 | [(_ (funname:id (var:id rank:RANK) ...) body ...+) 69 | #'(define funname 70 | (rem-array (vector) (vector (Rλ ((var rank) ...) 71 | body ...))))])) 72 | 73 | (define-syntax (remora? stx) 74 | (syntax-parse stx 75 | [(_ const:CONST) #'"remora constant"] 76 | [(_ rank:RANK) #'"remora rank"] 77 | [(_ atom:ATOM) #'"remora atom"] 78 | [(_ aliteral:ALITERAL) #'"remora array literal"] 79 | [(_ otherwise) #'"not remora"])) 80 | 81 | (define-syntax (remora-const? stx) 82 | (syntax-parse stx 83 | [(_ const:CONST) #'#t] 84 | [(_ otherwise) #'#f])) 85 | (define-syntax (remora-rank? stx) 86 | (syntax-parse stx 87 | [(_ rank:RANK) #'#t] 88 | [(_ otherwise) #'#f])) 89 | (define-syntax (remora-atom? stx) 90 | (syntax-parse stx 91 | [(_ atom:ATOM) #'#t] 92 | [(_ otherwise) #'#f])) 93 | (define-syntax (remora-array-literal? stx) 94 | (syntax-parse stx 95 | [(_ aliteral:ALITERAL) #'#t] 96 | [(_ otherwise) #'#f])) 97 | 98 | (define-syntax (define-remora-syntax stx) 99 | (syntax-parse stx 100 | [(_ (macro-name:id macro-arg:id) macro-defn:expr) 101 | #'(define-syntax macro-name 102 | (remora-macro 103 | (λ (macro-arg) 104 | macro-defn)))])) 105 | 106 | ;;; transform a Remora expression into Racket code 107 | ;;; remora macros must explicitly recur on subterms that should be Remora code 108 | (define-syntax (remora stx) 109 | (syntax-parse stx 110 | #:literals (fn alit array apply apply/shape unbox vec require provide) 111 | ;; require and provide apparently need to be recognized specially, as 112 | ;; redefining them breaks lots of things 113 | [(_ (require subterms ...)) #'(require subterms ...)] 114 | [(_ (provide subterms ...)) #'(provide subterms ...)] 115 | ;; a bare ATOM in EXP position is converted to a scalar containing that ATOM 116 | [(_ bare-atom:ATOM) 117 | #'(rem-array (vector) (vector (remora-atom bare-atom)))] 118 | ;; check whether head is another Remora form (possibly a remora-macro) 119 | [(_ (head tail ...)) 120 | #:declare head (static remora-macro? "remora macro") 121 | ((remora-macro-transformer (syntax-local-value #'head)) 122 | #'(head tail ...))] 123 | ;; if not, this is function application 124 | [(_ (head tail ...)) 125 | ((remora-macro-transformer (syntax-local-value #'apply)) 126 | #'(apply head tail ...))] 127 | ;; identifiers get a dynamic check/coercion to convert Racket values 128 | ;; into Remora scalars 129 | [(_ var:id) #'(racket->remora var)] 130 | ;; multiple subterms are treated as having an implicit begin 131 | [(_ subterm ...) #'(begin (remora subterm) ...)])) 132 | ;;; transform a Remora atom into Racket code 133 | (define-syntax (remora-atom stx) 134 | (syntax-parse stx 135 | #:literals (fn) 136 | [(_ const:CONST) #'const] 137 | [(_ (fn ((arg:id rank:RANK) ...) body:expr ...)) 138 | ((remora-macro-transformer (syntax-local-value #'fn)) 139 | #'(fn ((arg rank) ...) body ...))] 140 | [(_ otherwise) 141 | (error "could not handle atom:" #'otherwise)])) 142 | 143 | 144 | (define-remora-syntax (fn stx) 145 | (syntax-parse stx 146 | [(_ ((var:id rank:RANK) ...) body ...+) 147 | #'(rem-proc (λ (var ...) (remora body) ...) 148 | (list (syntax->rank-value rank) ...))])) 149 | ;;; Need to provide some definition for `all` in order to use it as a literal 150 | (define-syntax all 151 | (syntax-id-rules () 152 | [_ 'all])) 153 | ;;; Transform surface syntax for a rank into the behind-the-scenes value. 154 | (define-syntax (syntax->rank-value stx) 155 | (syntax-parse stx 156 | [(_ finite-rank:nat) #'finite-rank] 157 | [(_ all) (syntax 'all)])) 158 | 159 | ;;; (alit (nat ...) atom ...) 160 | ;;; (rem-array (vector nat ...) (vector atom ...)) 161 | ;;; TODO: automated test 162 | (define-remora-syntax (alit stx) 163 | (syntax-parse stx 164 | [(_ (dim:nat ...) elt:ATOM ...) 165 | #'(rem-array (vector dim ...) 166 | (vector (remora-atom elt) ...))])) 167 | 168 | ;;; (apply expr1 expr2 ...) 169 | ;;; (apply-rem-array expr expr ...) 170 | ;;; TODO: automated test 171 | (define-remora-syntax (apply stx) 172 | (syntax-parse stx 173 | [(_ fun arg ...) 174 | #'(remora-apply (remora fun) 175 | (remora arg) ...)])) 176 | 177 | ;;; (apply/shape expr0 expr1 expr2 ...) 178 | ;;; (apply-rem-array (rem-array->vector expr0) expr expr ...) 179 | ;;; TODO: automated test 180 | (define-remora-syntax (apply/shape stx) 181 | (syntax-parse stx 182 | [(_ shp fun arg ...) 183 | #'(remora-apply (remora fun) 184 | #:result-shape (rem-array->vector (remora shp)) 185 | (remora arg) ...)])) 186 | (define-remora-syntax (: stx) 187 | (syntax-parse stx 188 | [(_ shp fun arg ...) 189 | #'(remora-apply (remora fun) 190 | #:result-shape (rem-array->vector (remora shp)) 191 | (remora arg) ...)])) 192 | 193 | ;;; (unbox var some-box expr) 194 | ;;; (let ([var (rem-box-contents some-box)]) expr) 195 | ;;; TODO: automated test 196 | (define-remora-syntax (unbox stx) 197 | (syntax-parse stx 198 | [(_ var:id some-box body) 199 | #'(let ([boxes (remora some-box)]) 200 | (when (debug-mode) (printf "Taking apart array of boxes: ~s\n" boxes)) 201 | (let ([result-cells (for/list ([b (rem-array-data boxes)]) 202 | (let ([var (rem-box-contents b)]) 203 | (when (debug-mode) (printf "box contained ~s\n" var)) 204 | (remora body)))]) 205 | (when (debug-mode) (printf "Unbox result cells: ~s\n" result-cells)) 206 | (build-frame (rem-array-shape boxes) 207 | result-cells)))])) 208 | 209 | ;;; (vec expr ...) 210 | ;;; (build-vec expr ...) 211 | ;;; TODO: automated test 212 | (define-remora-syntax (vec stx) 213 | (syntax-parse stx 214 | [(_ piece ...) #'(build-vec (remora piece) ...)])) 215 | 216 | ;;; (array . array-literals) 217 | ;;; "smart constructor" 218 | ;;; if all exps are (alit ...) with same shape, gather them into one alit form 219 | ;;; disallow (alit ...)s with mismatching forms 220 | ;;; otherwise, (apply build-array exps) 221 | ;;; TODO: automated test 222 | (define-remora-syntax (array stx) 223 | (syntax-parse stx 224 | #:literals (alit) 225 | [(_ (alit (dim:nat ...) elt:ATOM ...) ...+) 226 | #:when (all-equal? (syntax->datum (syntax ((dim ...) ...)))) 227 | #:with (old-dims ...) (first (syntax-e #'((dim ...) ...))) 228 | #:with outer-dim (datum->syntax 229 | stx 230 | (length (syntax->datum #'((elt ...) ...)))) 231 | #:with (joined-elts ...) (datum->syntax 232 | stx 233 | (racket-apply append 234 | (syntax->datum #'((elt ...) ...)))) 235 | #'(alit (outer-dim old-dims ...) joined-elts ...)] 236 | [(_ (alit (dim:nat ...) elt:ATOM ...) ...+) 237 | #:when (not (all-equal? (syntax->datum (syntax ((dim ...) ...))))) 238 | (error "array literal components with mismatched shapes at\n" 239 | (syntax-source stx) 240 | (syntax-line stx) 241 | (syntax-column stx))] 242 | [(_ piece ...) 243 | #'(remora (vec piece ...))])) 244 | (begin-for-syntax 245 | (define (all-equal? xs) 246 | (cond [(<= (length xs) 1) #t] 247 | [else (and (equal? (first xs) (second xs)) 248 | (all-equal? (rest xs)))]))) 249 | 250 | ;;; (def name defn-or-expr ... expr) 251 | (define-remora-syntax (def stx) 252 | (syntax-parse stx 253 | [(_ (funname:id (var:id rank:RANK) ...) body ...+) 254 | #'(remora (def funname (fn ((var rank) ...) body ...)))] 255 | [(_ name:id defn-or-expr ) 256 | #'(define name (remora defn-or-expr) )])) 257 | 258 | ;;; (struct name (field ...+)) 259 | (define-remora-syntax (defstruct stx) 260 | (syntax-parse stx 261 | [(_ structname:id (fieldname:id ...+)) 262 | #'(struct structname (fieldname ...) #:transparent)])) 263 | 264 | ;;; (record fname ...) produces a record-building function 265 | (define-remora-syntax (record stx) 266 | (syntax-parse stx 267 | [(_ fname:id ...) #'(racket->remora (make-record 'fname ...))])) 268 | 269 | ;;; (record-lit (fname val) ...) becomes a use of a record-builder 270 | (define-remora-syntax (record-literal stx) 271 | (syntax-parse stx 272 | [(_ (fname:id val) ...) 273 | #'(remora ((record fname ...) val ...))])) 274 | 275 | ;;; (lens fname) produces a record-building function 276 | (define-remora-syntax (lens stx) 277 | (syntax-parse stx 278 | [(_ fname:id ...) #'(racket->remora (compose (make-lens 'fname) ...))])) 279 | 280 | 281 | ;;; sugar for reranking by eta-expansion 282 | ;;; operates on function arrays (as names only stand for arrays, not functions), 283 | ;;; but constructs a scalar 284 | (define-remora-syntax (rerank stx) 285 | (syntax-parse stx 286 | [(_ (new-rank:RANK ...) original-function) 287 | #:with (param ...) (for/list ([i (length (syntax-e #'(new-rank ...)))]) 288 | (generate-temporary)) 289 | #'(remora 290 | (alit () (fn ((param new-rank) ...) 291 | (original-function param ...))))])) 292 | -------------------------------------------------------------------------------- /remora/dynamic/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | ;;; Environment setup for Remora-as-a-library 3 | (require "lang/syntax.rkt" 4 | "lang/basis-lib.rkt" 5 | "lang/semantics.rkt" 6 | "lang/reader.rkt") 7 | (provide (all-from-out "lang/semantics.rkt" 8 | "lang/syntax.rkt" 9 | "lang/basis-lib.rkt")) 10 | -------------------------------------------------------------------------------- /remora/examples/99-bottles.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | (def countdown (+ 1 (reverse (iota [99])))) 3 | (display 4 | (foldr 5 | string-append 6 | "" 7 | (format "~v bottles of beer on the wall, ~v bottles of beer.\nTake one down, pass it around, ~v bottles of beer on the wall.\n\n" 8 | countdown countdown (sub1 countdown)))) 9 | -------------------------------------------------------------------------------- /remora/examples/dsp.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (require racket/math) 4 | (require "idioms.rkt") 5 | (require "kernels.rkt") 6 | 7 | ;;; a simple yet naieve low pass filter 8 | ;;; y(n) = x(n) + x(n - 1) 9 | (define (simple-low-pass (seed 0) (data 1)) 10 | (define lpblock (append (curtail (rotate data 1)) [0])) 11 | (+ data lpblock)) 12 | 13 | ;;; a simple yet naieve high pass filter 14 | ;;; y(n) = x(n) - x(n - 1) 15 | (define (simple-high-pass (seed 0) (data 1)) 16 | (define hpblock (append (curtail (rotate data 1)) [0])) 17 | (- data hpblock)) 18 | 19 | ;;; a more reasonable low pass filter 20 | ;;; y(n) = y(n - 1) - alpha * (x(n - 1) - x(n)) 21 | (define (low-pass (seed 0) (alpha 0) (data 1)) 22 | (define (lp-step (x 0) (acc 2)) 23 | (define lx (head (head acc))) 24 | (define ly (tail (head acc))) 25 | (define ny (- ly (* alpha (- lx x)))) 26 | (append [[x ny]] acc)) 27 | (curtail (#r(1)tail (foldr lp-step [(reshape [2] seed)] data)))) 28 | 29 | ;;; a more reasonalbe high pass filter 30 | ;;; y(n) = α * (y(n - 1) + x(n) - x(n - 1)) 31 | (define (high-pass (seed 0) (alpha 0) (data 1)) 32 | (define (hp-step (x 0) (acc 2)) 33 | (define lx (head (head acc))) 34 | (define ly (tail (head acc))) 35 | (define ny (* alpha (- (+ ly x) lx))) 36 | (append [[x ny]] acc)) 37 | (curtail (#r(1)tail (foldr hp-step [(reshape [2] seed)] data)))) 38 | 39 | ;;; general FIR filter 40 | ;;; y(n) = sum k=0 -> M - 1 of h(k) * x(n - k) 41 | 42 | (define (dot (a all) (b all)) 43 | (foldr + 0 (* a b))) 44 | 45 | ;;; sample FIR coefficients based on http://t-filter.engineerjs.com/ 46 | (define low-pass-kernel 47 | [-0.02010411882885732 48 | -0.05842798004352509 49 | -0.061178403647821976 50 | -0.010939393385338943 51 | 0.05125096443534972 52 | 0.033220867678947885 53 | -0.05655276971833928 54 | -0.08565500737264514 55 | 0.0633795996605449 56 | 0.310854403656636 57 | 0.4344309124179415 58 | 0.310854403656636 59 | 0.0633795996605449 60 | -0.08565500737264514 61 | -0.05655276971833928 62 | 0.033220867678947885 63 | 0.05125096443534972 64 | -0.010939393385338943 65 | -0.061178403647821976 66 | -0.05842798004352509 67 | -0.02010411882885734]) 68 | 69 | (define high-pass-kernel 70 | [0.02857983994169657 71 | -0.07328836181028245 72 | 0.04512928732568175 73 | 0.03422632401030237 74 | -0.034724262386629436 75 | -0.05343090761376418 76 | 0.032914528649623416 77 | 0.09880818246272206 78 | -0.034135422078843417 79 | -0.3160339484471911 80 | 0.5341936566511765 81 | -0.3160339484471911 82 | -0.034135422078843417 83 | 0.09880818246272206 84 | 0.03291452864962342 85 | -0.0534309076137642 86 | -0.034724262386629436 87 | 0.03422632401030237 88 | 0.04512928732568176 89 | -0.07328836181028245 90 | 0.02857983994169657]) 91 | 92 | (define band-pass-kernel 93 | [0.008315515510919604 94 | 0.013703008819203135 95 | -0.008125257257844711 96 | -0.01649214060817737 97 | -0.0016884593471476288 98 | -0.006913035271285468 99 | -0.03139161346522045 100 | 0.022740863526439097 101 | 0.11984908724116743 102 | 0.05186355035523461 103 | -0.17137740316854042 104 | -0.20124347467075893 105 | 0.08441813048666601 106 | 0.2816314309336389 107 | 0.08441813048666601 108 | -0.20124347467075893 109 | -0.17137740316854042 110 | 0.05186355035523461 111 | 0.1198490872411674 112 | 0.022740863526439097 113 | -0.03139161346522045 114 | -0.006913035271285468 115 | -0.0016884593471476288 116 | -0.01649214060817737 117 | -0.008125257257844711 118 | 0.013703008819203135 119 | 0.008315515510919604]) 120 | 121 | (define band-stop-kernel 122 | [0.037391727827352596 123 | -0.03299884552335981 124 | 0.04423058396732136 125 | 0.0023050970833628126 126 | -0.06768087195950102 127 | -0.04634710540912466 128 | -0.011717387509232449 129 | -0.07073422841851829 130 | -0.04976651728299956 131 | 0.16086413543836361 132 | 0.21561058688743148 133 | -0.10159456907827959 134 | 0.6638637561392535 135 | -0.10159456907827963 136 | 0.21561058688743148 137 | 0.16086413543836361 138 | -0.049766517282999544 139 | -0.07073422841851829 140 | -0.011717387509232449 141 | -0.0463471054091247 142 | -0.06768087195950102 143 | 0.0023050970833628126 144 | 0.04423058396732135 145 | -0.0329988455233598 146 | 0.037391727827352596]) 147 | 148 | ;;; general FIR filter 149 | (define (fir-filter (coeffs 1) (data 1)) 150 | (dot coeffs (rotate data (iota [(length coeffs)])))) 151 | 152 | ;;; DFT 153 | (define (dft-angles (len 0)) 154 | (define transforms (position-matrix len)) 155 | (/ (* 2 pi (#r(1)head transforms) (#r(1)tail transforms)) len)) -------------------------------------------------------------------------------- /remora/examples/dtmf.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | (require racket/math 3 | (only-in racket/list first second)) 4 | 5 | (provide dtmf-encode) 6 | (provide dtmf-decode) 7 | 8 | ;;; Frequency associated with the row each key appears in 9 | (def row-freqs 10 | (array (list #\1 697) (list #\2 697) (list #\3 697) (list #\A 697) 11 | (list #\4 770) (list #\5 770) (list #\6 770) (list #\B 770) 12 | (list #\7 852) (list #\8 852) (list #\9 852) (list #\C 852) 13 | (list #\* 941) (list #\0 941) (list #\# 941) (list #\D 941))) 14 | 15 | ;;; Frequency associated with the column each key appears in 16 | (def col-freqs 17 | (array (list #\1 1209) (list #\2 1336) (list #\3 1477) (list #\A 1633) 18 | (list #\4 1209) (list #\5 1336) (list #\6 1477) (list #\B 1633) 19 | (list #\7 1209) (list #\8 1336) (list #\9 1477) (list #\C 1633) 20 | (list #\* 1209) (list #\0 1336) (list #\# 1477) (list #\D 1633))) 21 | 22 | ;;; Sample rate for an audio stream (used to convert analog frequencies to 23 | ;;; digital frequencies) 24 | (def audio-sample-rate 8000.) 25 | 26 | 27 | ;;; Generate a sinusoid with given (digital) frequency and phase 28 | (def (sinusoid (length 0) (freq 0) (phase 0)) 29 | (cos (+ (* (iota [length]) freq 2 pi) 30 | phase))) 31 | 32 | ;;; Construct a DTMF tone (two sinusoids) for a given key and number of seconds 33 | ;;; If the key is not a valid char (0-9, A-D, *, #), produces DC tone 34 | (def (dtmf-encode (key 0) (duration 0)) 35 | (def analog-freqs (lookup+ key [row-freqs col-freqs] 0)) 36 | (def digital-freqs (/ analog-freqs audio-sample-rate)) 37 | (def num-samples (inexact->exact (ceiling (* duration audio-sample-rate)))) 38 | (reduce + 0 (sinusoid num-samples digital-freqs 0))) 39 | ;;; Version with less naming of intermediate results 40 | (def (dtmf-encode* (key 0) (duration 0)) 41 | (reduce + 0 (sinusoid 42 | (inexact->exact (ceiling (* duration audio-sample-rate))) 43 | (/ (lookup+ key [row-freqs col-freqs] 0) audio-sample-rate) 44 | 0))) 45 | 46 | 47 | ;;; Goertzel algorithm (extract single frequency component) 48 | ;;; first stage is IIR, second is FIR 49 | ;;; Scan is used for demonstration purposes, but for selecting just the single 50 | ;;; DFT result, it may be better to use foldl, as only the final value of the 51 | ;;; accumulator is actually needed. 52 | (def (goertzel-iir-step (freq 0)) 53 | (fn ((next 0) (accum 1)) 54 | (array (- (+ next (* 2 (cos (* 2 pi freq)) (head accum))) 55 | (tail accum)) 56 | (head accum)))) 57 | (def (goertzel-iir (freq 0) (signal 1)) 58 | (#r(1)head (scan (goertzel-iir-step freq) (array 0 0) signal))) 59 | (def (goertzel-fir-step (freq 0) (win 1)) ; length-2 window of post-IIR signal 60 | (- (tail win) 61 | (* (head win) (exp (- 0 (* 2 (* pi (* 0+i freq)))))))) 62 | (def (goertzel-fir (freq 0) (post-iir 1)) 63 | (goertzel-fir-step freq (take-right 2 post-iir))) 64 | (def (goertzel (freq 0) (signal 1)) 65 | ;; magnitude must be scaled down by half the buffer length 66 | ;; result phase is how far from 0 (i.e., 2π) the buffer's last sample is 67 | (/ (goertzel-fir freq (goertzel-iir freq signal)) 68 | (/ (length signal) 2))) 69 | 70 | 71 | ;;; Identify the greatest number in a vector 72 | (def (vec-max (vec 1)) (reduce max (head vec) vec)) 73 | 74 | 75 | ;;; Get the normalized magnitudes of the row and column frequencies in a signal 76 | (def (r/c-freq-magnitudes (signal 1)) 77 | (def analog-freqs (#r(1)nub (second [row-freqs col-freqs]))) 78 | (def digital-freqs (/ analog-freqs audio-sample-rate)) 79 | (def components (goertzel digital-freqs signal)) 80 | (def mags (magnitude components)) 81 | (/ mags (vec-max mags))) 82 | ;;; Shortened version 83 | (def (r/c-freq-magnitudes* (signal 1)) 84 | (def mags (magnitude (goertzel (/ (#r(1)nub (second [row-freqs col-freqs])) 85 | audio-sample-rate) 86 | signal))) 87 | (/ mags (vec-max mags))) 88 | 89 | 90 | ;;; Select the single frequency which is at least 20 dB above the others. If 91 | ;;; there is no such frequency, return 0 (or 'invalid or #f?). 92 | (def (select-tone (ref-freqs 1) (normalized 1)) 93 | (def assoc (list normalized ref-freqs)) 94 | (unbox above-threshold (filter (> normalized 0.01) assoc) 95 | (select (= (length above-threshold) 1) 96 | (second (head above-threshold)) 97 | 0))) 98 | 99 | 100 | ;;; Given a signal, determine the corresponding DTMF key. If there is no such 101 | ;;; key, return #\nul. 102 | (def (dtmf-decode (signal 1)) 103 | (def freq-components (r/c-freq-magnitudes signal)) 104 | (def detected-tones 105 | (select-tone [(nub (second row-freqs)) (nub (second col-freqs))] 106 | freq-components)) 107 | (def row-tone (head detected-tones)) 108 | (def col-tone (tail detected-tones)) 109 | (def cross-match 110 | (unbox row-matches (filter (= row-tone (second row-freqs)) 111 | (first row-freqs)) 112 | (unbox col-matches (filter (= col-tone (second col-freqs)) 113 | (first col-freqs)) 114 | ; We actually want another shape annotation in the body of #r(1 0)list 115 | ; but there's no convenient way to put it there. The type system would 116 | ; take care of this problem, but we don't have that in this setting. 117 | (ravel (#r(1 0)list 118 | (append row-matches [#\nul]) 119 | (append col-matches [#\nul])))))) 120 | (unbox possibilities (filter ((fn ((pair 0)) 121 | (equal? (first pair) (second pair))) 122 | cross-match) 123 | (first cross-match)) 124 | (head (append possibilities [#\nul])))) 125 | -------------------------------------------------------------------------------- /remora/examples/idioms.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (require racket/function) 4 | 5 | (provide (all-defined-out)) 6 | 7 | ;;; An implementation of some sample items from the APL idioms list in Remora 8 | 9 | ;;; Drop leading spaces from a character vector 10 | (def (drop-leading-space-vec (str 1)) 11 | (filter (behead (scan or #f (not (equal? #\space str)))) 12 | str)) 13 | 14 | (def (drop-leading-space (str 0)) 15 | (array->string (drop-leading-space-vec (string->array str)))) 16 | 17 | ;;; Drop trailing spaces from a character vector 18 | (def (drop-trailing-space-vec (str 1)) 19 | (filter (reverse (behead (scan or #f (not (equal? #\space (reverse str)))))) 20 | str)) 21 | 22 | (def (drop-trailing-space (str 0)) 23 | (array->string (drop-trailing-space-vec (string->array str)))) 24 | 25 | ;;; Collapse multiple consecutive spaces to a single space 26 | (def (collapse-multiple-space-vec (str 1)) 27 | (filter (or (not (equal? #\space str)) 28 | (behead (rotate (append [#t] (not (equal? #\space str))) 1))) 29 | str)) 30 | 31 | ;;; Collapse multiple consectutive spaces in a string to a single space 32 | (def (collapse-multiple-space (str 0)) 33 | (array->string (collapse-multiple-space-vec (string->array str)))) 34 | 35 | ;;; ravel an array, apply a function to it, then reshape the new values 36 | ;;; to the shape of the original array 37 | (define (flat-apply (op 0) (arr all)) 38 | (reshape (shape-of arr) (op (ravel arr)))) 39 | 40 | ;;; count the occurances of a value 41 | (define (count-value (arr all) (value 0)) 42 | (foldr + 0 (bool->int ((curry equal value) (ravel arr))))) 43 | 44 | ;;; if the array contains the given atom 45 | (define (contains? (arr all) (element 0)) 46 | (foldr or #f ((curry equal element) (ravel arr)))) 47 | 48 | ;;; Change zero values to n 49 | (define (zero-to-n (v 0) (n 0)) 50 | (select (equal v 0) n v)) 51 | 52 | ;;; Implementations of sample functions from the J Phrases list 53 | 54 | ;;; Moves all blanks in a string to the end of the string 55 | (define (move-blanks (str 0)) 56 | (define chars (string->array str)) 57 | (define blanks ((curry equal? #\space) chars)) 58 | (define blank-count (foldr + 0 (bool->int blanks))) 59 | (array->string (append (filter (not blanks) chars) (reshape [blank-count] #\space)))) 60 | 61 | ;;; converts integer values to booleans 62 | (define (int->bool (n 0)) 63 | (select (equal n 0) #f #t)) 64 | 65 | ;;; creates a checkerboard of 0s and 1s of dimension n by n 66 | (define (checkerboard (n 0)) 67 | (define r1 (modulo (iota [n]) 2)) 68 | (define r2 (modulo (+ 1 (iota [n])) 2)) 69 | (reshape [n n] (append r1 r2))) 70 | 71 | ;;; creates a checkerboard of #f and #t of dimension n by n 72 | (define (boolean-checkerboard (n 0)) 73 | (int->bool (checkerboard n))) 74 | 75 | ;;; transpose a matrix 76 | (define (matrix-transpose (matrix 2)) 77 | (define cons (fn ((car 0) (cdr 1)) 78 | (append (itemize car) cdr))) 79 | (foldr cons [] matrix)) 80 | 81 | ;;; position matrix of size n by n with positions represented as '(x y) 82 | (define (position-matrix (n 0)) 83 | (define x (reshape [n n] (iota [n]))) 84 | (define y (matrix-transpose x)) 85 | (#r(0 0)array x y)) 86 | 87 | ;;; indices for a truth table of size n by n 88 | (define (truth-indices (n 0)) 89 | (reshape (append (reshape [n] 2) [n]) (antibase (reshape [n] 2) (iota [(expt n 2)])))) 90 | 91 | ;;; a truth table of order n of function f 92 | (define (truth-table (f all) (n 0)) 93 | (#r(1)f (int->bool (truth-indices n)))) 94 | 95 | ;;; Construct a histogram of a vector of naturals 96 | ;;; The "bar" for each number is a sequence of #t, followed by as many #f as 97 | ;;; needed to fill the remaining space. 98 | (def (histogram (vec 1)) 99 | (unbox count (iota [(inexact->exact (reduce max -inf.0 vec))]) 100 | (box (#r(0 1)>= vec (add1 count))))) 101 | 102 | ;;; Construct boxed vector of integers counting from left to right, either up 103 | ;;; or down as needed. 104 | (def (range (left 0) (right 0)) 105 | (unbox count (iota [(abs (- right left))]) 106 | (append [left] 107 | (+ left (* (signum (- right left)) 108 | (add1 count)))))) 109 | 110 | ;;; Determine how many decimal digits are needed to represent a positive number 111 | (def (num-digits (num 0)) 112 | (floor (add1 (log num)))) 113 | 114 | -------------------------------------------------------------------------------- /remora/examples/image-loading.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require racket/draw) 4 | (require racket/class) 5 | (require remora/dynamic) 6 | 7 | (provide (all-defined-out)) 8 | 9 | ;;; Initial attempt at image loading and saving for remora. 10 | ;;; Look into making this nicer by initializing bitmaps in a better 11 | ;;; way. (is there a way to load them with the size of the image?) 12 | 13 | (define (remora-load-image path) 14 | ;; initialize a bitmap of any size 15 | (define bmp (make-object bitmap% 100 100)) 16 | (send bmp load-file path) 17 | (define width (send bmp get-width)) 18 | (define height (send bmp get-height)) 19 | (define pixel-count (* width height)) 20 | (define pixels (make-bytes (* 4 pixel-count))) 21 | (send bmp get-argb-pixels 0 0 width height pixels) 22 | (define pixel-veclist 23 | (for/list ([i pixel-count]) 24 | (for/vector #:length 4 ([channel 4]) 25 | (bytes-ref pixels (+ channel (* i 4)))))) 26 | (define channel-vec (apply vector-append pixel-veclist)) 27 | (rem-array (list->vector (list width height 4)) 28 | channel-vec)) 29 | 30 | (define (remora-save-image path encoding width height image) 31 | ;; initialize a bitmap to the size of the image 32 | (define bmp (make-object bitmap% width height)) 33 | (send bmp set-argb-pixels 0 0 width height (list->bytes (vector->list image))) 34 | (send bmp save-file path encoding)) 35 | 36 | (define (remora-display-image width height image) 37 | (define bmp (make-object bitmap% width height)) 38 | (send bmp set-argb-pixels 0 0 width height (list->bytes (vector->list image))) 39 | (print bmp)) 40 | -------------------------------------------------------------------------------- /remora/examples/image.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (require "image-loading.rkt") 4 | (require racket/draw) 5 | (require racket/class) 6 | 7 | (define mario (remora-load-image "/Users/Sam/Documents/Development/remora/mario.png")) 8 | (define pumpkin (remora-load-image "/Users/Sam/Documents/Development/remora/pumpkin.jpg")) 9 | (define lenna (remora-load-image "/Users/Sam/Documents/Development/remora/lenna.png")) 10 | 11 | #| 12 | (define some-image (make-object bitmap% 100 100)) 13 | 14 | ;;; Not sure off-hand how DrRacket handles relative paths or ~ 15 | (send some-image load-file "/Users/jrslepak/Pictures/quincy.jpg" 'jpeg) 16 | 17 | (define width (send some-image get-width)) 18 | (define height (send some-image get-height)) 19 | (define pixel-count (* width height)) 20 | 21 | (define pixels (make-bytes (* 4 pixel-count))) 22 | 23 | (send some-image get-argb-pixels 0 0 width height pixels) 24 | 25 | (define pixel-vec 26 | (for/vector #:length pixel-count ([i pixel-count]) 27 | (for/vector #:length 4 ([channel 4]) 28 | (bytes-ref pixels (+ channel (* i 4)))))) 29 | |# 30 | 31 | (define (sum (vec all)) 32 | (foldr + 0 vec)) 33 | 34 | (define (dup (n 0) (x 1)) 35 | (reshape [n] x)) 36 | 37 | (define (average (m all)) 38 | (/ (sum m) (length m))) 39 | 40 | #| 41 | (define (remora-load-image (path 1)) 42 | (define bmp (make-object bitmap% 100 100)) 43 | (send bmp load-file path) 44 | (define width (send bmp get-width)) 45 | (define height (send bmp get-height)) 46 | (define pixel-count (* width height)) 47 | (define pixels (make-bytes (* 4 pixel-count))) 48 | (send bmp get-argb-pixels 0 0 width height pixels) 49 | (define pixel-vec 50 | (for/vector #:length pixel-count ([i pixel-count]) 51 | (for/vector #:length 4 ([channel 4]) 52 | (bytes-ref pixels (+ channel (* i 4)))))) 53 | (list->array pixel-vec)) 54 | |# 55 | 56 | ;;; consumes an image represented as a matrix of rgba vectors and applies a simple blur 57 | (define (blur (image 3) (frame-size 0)) 58 | (define rotation-amount (- (iota [frame-size]) (floor (/ frame-size 2)))) 59 | (define first-rotation (rotate image rotation-amount)) 60 | (define windows ((λ ((x 0)) (#r(2 all)rotate first-rotation x)) rotation-amount)) 61 | (round (average (average windows)))) 62 | 63 | (define (apply-blur-kernel (frame 5) (kernel 2)) 64 | (sum (sum (* frame kernel)))) 65 | 66 | (define 3x3-gaussian-kernel 67 | (* 1/16 68 | [[1 2 1] 69 | [2 4 2] 70 | [1 2 1]])) 71 | 72 | (define 7x7-gaussian-kernel 73 | [[0.00000067 0.00002292 0.00019117 0.00038771 0.00019117 0.00002292 0.00000067] 74 | [0.00002292 0.00078634 0.00655965 0.01330373 0.00655965 0.00078633 0.00002292] 75 | [0.00019117 0.00655965 0.05472157 0.11098164 0.05472157 0.00655965 0.00019117] 76 | [0.00038771 0.01330373 0.11098164 0.22508352 0.11098164 0.01330373 0.00038771] 77 | [0.00019117 0.00655965 0.05472157 0.11098164 0.05472157 0.00655965 0.00019117] 78 | [0.00002292 0.00078633 0.00655965 0.01330373 0.00655965 0.00078633 0.00002292] 79 | [0.00000067 0.00002292 0.00019117 0.00038771 0.00019117 0.00002292 0.00000067]]) 80 | 81 | 82 | (define (gaussian (image 3) (blur-kernel 2)) 83 | (define frame-size (head (shape-of blur-kernel))) 84 | (define rotation-amount (- (iota [frame-size]) (floor (/ frame-size 2)))) 85 | (define first-rotation (rotate image rotation-amount)) 86 | (define windows ((λ ((x 0)) (#r(2 all)rotate first-rotation x)) rotation-amount)) 87 | (inexact->exact (round (apply-blur-kernel windows blur-kernel)))) 88 | 89 | 90 | ;;; consumes an image represented as a vector of rgba vectors and applies a greyscale effect 91 | (define (greyscale (pixel 1)) 92 | (append [(head pixel)] (reshape [3] (round (average (behead pixel)))))) 93 | 94 | (define (expand-window (shape 1) (base 2)) 95 | (reshape shape (#r(1 1)reshape [(tail shape)] base))) 96 | 97 | (define dither-matrix-4x4 98 | (* 1/17 [[1 9 3 11] 99 | [13 5 15 7] 100 | [4 12 2 10] 101 | [16 8 14 6]])) 102 | 103 | (define dither-matrix-8x8 104 | (* 1/65 105 | [[1 49 13 61 4 52 16 64] 106 | [33 17 45 29 36 20 48 32] 107 | [9 57 5 53 12 60 8 56] 108 | [41 25 37 21 44 28 40 24] 109 | [3 51 15 63 2 50 14 62] 110 | [35 19 47 31 34 18 46 30] 111 | [11 59 7 55 10 58 6 54] 112 | [43 27 39 23 42 26 38 22]])) 113 | 114 | (define (dither (image 3) (dmatrix 2)) 115 | (define window-expanded-dither-matrix (expand-window (curtail (shape-of image)) dmatrix)) 116 | (define repeated-dither (#r(1 0)reshape [3] window-expanded-dither-matrix)) 117 | (define alpha (#r(1)head image)) 118 | (define rgb (#r(1)behead image)) 119 | (define modified-rgb (+ rgb (* rgb repeated-dither))) 120 | (min 255 (max 0 (round (#r(1 1)append (#r(0)itemize alpha) modified-rgb))))) 121 | 122 | (define (save-image (path 0) (encoding 0) (image 3)) 123 | (define width (head (shape-of image))) 124 | (define height (head (behead (shape-of image)))) 125 | (define flat (array->flat-vector image)) 126 | (remora-save-image path encoding width height flat)) 127 | 128 | (define (show-image (image 3)) 129 | (define width (head (shape-of image))) 130 | (define height (head (behead (shape-of image)))) 131 | (define flat (array->flat-vector image)) 132 | (remora-display-image width height flat)) 133 | 134 | ;; first (#r(1 1)reshape [width] frame) 135 | ;; then, reshape that to the full size 136 | 137 | (define (cons (car 0) (cdr 1)) (append (itemize car) cdr)) 138 | (define test-square 139 | (#r(0 1)cons 255 (#r(1 0)reshape [3] (round (/ (* (iota [6 6]) 255) 36))))) 140 | 141 | ;; gaussian blur function which takes a kernel -------------------------------------------------------------------------------- /remora/examples/kernels.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (require racket/math) 4 | 5 | (provide (all-defined-out)) 6 | 7 | ;;; Mean 8 | ;;; XCR shivers: tally -> length 9 | ;;; jrslepak: renamed operator 10 | (def (mean (samples 1)) 11 | (/ (reduce + 0 samples) 12 | (length samples))) 13 | 14 | 15 | ;;; XCR shivers: Indent lambda body (and other "bodies", e.g. let) 2 cols. 16 | ;;; Invest in remora emacs package with customised indenting. 17 | ;;; I'd say unbox is also a fn/let indent case. 18 | ;;; XCR shivers: Use classic semi convention, not bogus Racket ones: 19 | ;;; 3 top level. 2 indented like code. 1 at end of line. 20 | ;;; jrslepak: both should be fixed in 21 | ;;; commit d6a370db72c775d7ed4877b0233d9d08f553ee42 22 | ;;; Variance 23 | (def (variance (samples 1)) 24 | (mean (sqr (- samples (mean samples))))) 25 | 26 | 27 | ;;; Covariance 28 | (def (covariance (xs 1) (ys 1)) 29 | (mean (* (- xs (mean xs)) 30 | (- ys (mean ys))))) 31 | 32 | 33 | ;;; Autocovariance -- covariance of a signal and a delayed version of itself 34 | ;;; For this example, we pad out the end of the delayed signal with samples 35 | ;;; from the beginning of the signal 36 | (def (autocovariance (samples 1) (delay 0)) 37 | (covariance samples (rotate samples delay))) 38 | 39 | 40 | ;;; Pearson correlation 41 | (def (correlation (xs 1) (ys 1)) 42 | (/ (covariance xs ys) 43 | (* (sqrt (variance xs)) (sqrt (variance ys))))) 44 | 45 | 46 | ;;; Autocorrelation 47 | (def (autocorrelation (signal 1) (delay 0)) 48 | (correlation signal (rotate signal delay))) 49 | 50 | 51 | ;;; Convolution 52 | 53 | 54 | ;;; XCR shivers: Vas ist das R*? 55 | ;;; jrslepak: I was trying out the integration of variable-arity functions, so I 56 | ;;; pulled in Racket's * procedure under that name. At this point, Remora does 57 | ;;; not export its own *, so I've removed it. In the future, if we cut out 58 | ;;; support for importing Racket procedures with indeterminate arity, some 59 | ;;; of these multiplication exprs will have to be fixed. 60 | ;;; Generate a sinusoid with given (digital) frequency and phase 61 | (def (sinusoid (length 0) (freq 0) (phase 0)) 62 | (unbox count (iota* [length]) 63 | (cos (+ (* count freq 2 pi) 64 | phase)))) 65 | 66 | 67 | ;;; Goertzel algorithm (extract single frequency component) 68 | ;;; first stage is IIR, second is FIR 69 | ;;; Scan is used for demonstration purposes, but for selecting just the single 70 | ;;; DFT result, it may be better to use foldl, as only the final value of the 71 | ;;; accumulator is actually needed. 72 | (def (goertzel-iir-step (freq 0)) 73 | (fn ((next 0) (accum 1)) 74 | (array (- (+ next (* 2 (cos (* 2 pi freq)) (head accum))) 75 | (tail accum)) 76 | (head accum)))) 77 | (def (goertzel-iir (freq 0) (signal 1)) 78 | (#r(1)head (scan (goertzel-iir-step freq) (array 0 0) signal))) 79 | (def (goertzel-fir-step (freq 0) (win 1)) ; length-2 window of post-IIR signal 80 | (- (tail win) 81 | (* (head win) (exp (- 0 (* 2 (* pi (* 0+i freq)))))))) 82 | (def (goertzel-fir (freq 0) (post-iir 1)) 83 | (goertzel-fir-step freq (take-right 2 post-iir))) 84 | (def (goertzel (freq 0) (signal 1)) 85 | ;; magnitude must be scaled down by half the buffer length 86 | ;; result phase is how far from 0 (i.e., 2π) the buffer's last sample is 87 | (/ (goertzel-fir freq (goertzel-iir freq signal)) 88 | (/ (length signal) 2))) 89 | 90 | 91 | ;;; Butterfly split 92 | (def (butterfly (vec 1)) 93 | (filter ([#r(1)even? #r(1)odd?] (iota [(length vec)])) vec)) 94 | (def (ylfrettub (vec 1)) 95 | (#r(1 1)filter (#r(0)[even? odd?] (iota [(length vec)])) vec)) 96 | 97 | ;; Take LxM and MxN matrices as input. 98 | (def (m* (LxM 2) (MxN 2)) 99 | ;; We build a new-matrix entry by multiplying an m1 row by an m2 column and 100 | ;; summing the resulting collection of scalars. Alternatively, view this as 101 | ;; collapsing away the second axis of our LxMxN intermediate result. 102 | ;; We're sort of abusing the lack of type system here by using scalar 0 as the 103 | ;; identity value for reducing a collection of matrices. How to build a 104 | ;; properly-shaped all-zero array in the typed setting is left as an exercise 105 | ;; for the reader. 106 | (#r(all all 2)reduce + 0 107 | ;; Take each row of m1, multiply it by the entirety of m2 (rank expansion 108 | ;; treats the m1 row as a column vector when lifting to match m2). 109 | (#r(1 2)* LxM MxN))) 110 | ;; Example usage: 111 | #;(m* [[1 2 3] 112 | [4 5 6]] 113 | [[1 2 3 4] 114 | [0 1 0 1] 115 | [1 -1 0 0]]) 116 | -------------------------------------------------------------------------------- /remora/examples/lerp.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (provide lerp) 4 | 5 | ;;; Defining and using a function 6 | 7 | ;;; find the number part way between two boundaries 8 | (def (lerp (lo 0) (hi 0) (α 0)) 9 | (+ (* α hi) 10 | (* (- 1 α) lo))) 11 | 12 | ;;; three fifths of the way from -1 to 1 13 | (lerp -1 1 3/5) 14 | 15 | ;;; try several "middle" points 16 | (lerp -1 1 [0 1/3 2/3 1]) 17 | 18 | ;;; take the midpoint along multiple axes 19 | (lerp [0 1] [7 4] 0.5) 20 | 21 | ;;; find midpoints of three lines, formed by three low (x,y,z) points 22 | ;;; and one high (x,y,z) point 23 | ;;; reranking to 1,1,0 means to treat (x,y,z) coordinate (a rank-1 24 | ;;; structure) as the fundamental unit in lifting lerp 25 | (#r(1 1 0)lerp 26 | [[0 0 2] [0 1 1] [1 0 0]] 27 | [7 4 5] 28 | 0.5) 29 | 30 | -------------------------------------------------------------------------------- /remora/examples/naive-bayes.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | 4 | ;;; Naive Bayes classifier for the Spambase Data Set from UC Irvine's 5 | ;;; Machine Learning Repository 6 | 7 | ;;; Bache, K. & Lichman, M. (2013). UCI Machine Learning Repository 8 | ;;; [http://archive.ics.uci.edu/ml]. Irvine, CA: University of California, 9 | ;;; School of Information and Computer Science. 10 | 11 | ;;; Data set from https://archive.ics.uci.edu/ml/datasets/Spambase 12 | 13 | 14 | (require racket/flonum) 15 | (def spambase-file (open-input-file "spambase.data")) 16 | (def spambase-table (read spambase-file)) 17 | 18 | ;;; Training phase 19 | 20 | ;;; Split out 10% of the data as a training set 21 | (def shuffled-spambase (shuffle spambase-table)) 22 | (def train-set (take 460 shuffled-spambase)) 23 | (def test-set (drop 460 shuffled-spambase)) 24 | 25 | (def feature-means 26 | (fl/ (exact->inexact (foldr + 0 (#r(1)curtail train-set))) 27 | (exact->inexact (length train-set)))) 28 | 29 | 30 | ;;; Split the training set into spam and legit messages 31 | (def spam? (fn ((message 1)) (= 1 (tail message)))) 32 | (def train-spam (filter (spam? train-set) train-set)) 33 | (def train-legit (filter (not (spam? train-set)) train-set)) 34 | 35 | ;;; How many spam and legit messages had each feature below and above the mean? 36 | (def spam-below-mean 37 | (foldr + 0 (bool->int (#r(1 1)< 38 | (#r(1)curtail train-spam) 39 | feature-means)))) 40 | (def spam-above-mean 41 | (foldr + 0 (bool->int (#r(1 1)>= 42 | (#r(1)curtail train-spam) 43 | feature-means)))) 44 | (def legit-below-mean 45 | (foldr + 0 (bool->int (#r(1 1)< 46 | (#r(1)curtail train-legit) 47 | feature-means)))) 48 | (def legit-above-mean 49 | (foldr + 0 (bool->int (#r(1 1)>= 50 | (#r(1)curtail train-legit) 51 | feature-means)))) 52 | 53 | ;;; Smoothed conditional probabilities for each feature 54 | (def prob-spam-low (fl/ (exact->inexact (+ 1 spam-below-mean)) 55 | (exact->inexact (+ 2 (length train-spam))))) 56 | (def prob-legit-low (fl/ (exact->inexact (+ 1 legit-below-mean)) 57 | (exact->inexact (+ 2 (length train-legit))))) 58 | (def net-prob (fl/ (exact->inexact (+ 1 (length train-spam))) 59 | (exact->inexact (+ 2 (+ (length train-spam) 60 | (length train-legit)))))) 61 | 62 | 63 | ;;; Test phase 64 | 65 | ;;; Consider which side of the mean each feature is on. There's a probability of 66 | ;;; its being on that side if the message is spam. The product of those 67 | ;;; probabilities is this message's probability of that high/low arrangement if 68 | ;;; it is spam. (Similar for legit messages) 69 | (def (threshold-side-prob (val 0) (threshold 0) (below-prob 0)) 70 | (select (< val threshold) below-prob (- 1 below-prob))) 71 | 72 | ;;; Decide how confident we are in a message's spam/legit status 73 | (def (classify (message all)) 74 | ;; probability of this feature set given that this message is spam 75 | (def features-given-spam 76 | (#r(0 0 1)foldr 77 | * 78 | 1 79 | (#r(1 1 1)threshold-side-prob 80 | message 81 | feature-means 82 | prob-spam-low))) 83 | ;; probability of this feature set given that this message is legit 84 | (def features-given-legit 85 | (#r(0 0 1)foldr 86 | * 87 | 1 88 | (#r(1 1 1)threshold-side-prob 89 | message 90 | feature-means 91 | prob-legit-low))) 92 | ;; probability of this feature set independent of spam/legit status 93 | (def features-net 94 | (#r(0 0 1)foldr 95 | * 96 | 1 97 | (+ (* net-prob 98 | (#r(1 1 1)threshold-side-prob 99 | message 100 | feature-means 101 | prob-spam-low)) 102 | (* (- 1 net-prob) 103 | (#r(1 1 1)threshold-side-prob 104 | message 105 | feature-means 106 | prob-legit-low))))) 107 | ;; Apply Bayes's theorem to determine probability the message 108 | ;; is spam given its features 109 | (def prob-spam (fl/ (* net-prob features-given-spam) 110 | features-net)) 111 | (def prob-legit (fl/ (* (- 1 net-prob) features-given-legit) 112 | features-net)) 113 | (log (fl/ prob-spam prob-legit))) 114 | 115 | 116 | ;;; Find confidence level for every test message 117 | ;;; more positive -> more sure it's spam 118 | ;;; more negative -> more sure it's legit 119 | ;;; (can add a bias to trade sensitivity for specificity or vice versa) 120 | (def guesses 121 | (classify (#r(1)curtail test-set))) 122 | 123 | ;;; Determine which guesses were correct 124 | (def results 125 | (positive? (signum (* (sub1 (* 2 (#r(1)tail test-set))) guesses)))) 126 | 127 | (printf "correctly classified ~v of ~v test messages\n" 128 | (foldr + 0 (select results 1 0)) 129 | (length results)) 130 | (printf "\taccuracy ~v\n" 131 | (exact->inexact 132 | (/ (foldr + 0 (select results 1 0)) (length results)))) 133 | -------------------------------------------------------------------------------- /remora/examples/using-structs.rkt: -------------------------------------------------------------------------------- 1 | #lang remora/dynamic 2 | 3 | (struct book (title pages isbn)) 4 | (define SHELF-CONTENTS 5 | (book ["Types and Programming Languages" 6 | "Principles of Program Analysis" 7 | "Compiling with Continuations" 8 | "A Theory of Objects"] 9 | [623 452 260 396] 10 | ["978-0-262-16209-8" 11 | "978-3-642-08474-4" 12 | "0-521-03311-X" 13 | "0-387-94775-2"])) 14 | 15 | (define LONG-BOOK-ISBNS 16 | (book-isbn (filter (< 400 (book-pages SHELF-CONTENTS)) SHELF-CONTENTS))) 17 | 18 | (struct stanley-cup (year city name)) 19 | (define last-four 20 | (stanley-cup [2015 2016 2017 2018] 21 | ["Chicago" "Pittsburgh" "Pittsburgh" "Washington"] 22 | ["Blackhawks" "Penguins" "Penguins" "Capitals"])) 23 | 24 | 25 | 26 | -------------------------------------------------------------------------------- /remora/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | (define scribblings '(("scribblings/remora.scrbl"))) 3 | -------------------------------------------------------------------------------- /remora/scribblings/application.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label (except-in racket/base 3 | box unbox define λ) 4 | (only-in remora/dynamic/lang/language 5 | define λ) 6 | remora/dynamic)] 7 | 8 | @declare-exporting[remora/dynamic] 9 | 10 | @title{Function Application} 11 | 12 | A function application form applies an array of functions to arrays of 13 | arguments. All atoms in the function array must be functions with the same arity 14 | and expected ranks. The expected rank for each argument array determines how the 15 | array will be split into a ``frame'' of ``cells.'' The cells are the sub-arrays 16 | whose rank is that expected rank. The frame is the array structure around those 17 | cells. 18 | 19 | @section{Example: Scalar-vector addition} 20 | 21 | Consider the expression 22 | @codeblock[#:keep-lang-line? #f]{ 23 | #lang remora/dynamic 24 | (+ 1 [10 20 30]) 25 | } 26 | 27 | @code[#:lang "remora/dynamic"]{+} expects rank 0 arguments. 28 | The first argument has rank 0, so it is a single cell in a scalar frame --- 29 | a frame with shape @code[#:lang "remora/dynamic"]{[]}. 30 | The second argument has rank 1, so we split it into three cells, 31 | @code[#:lang "remora/dynamic"]{10}, @code[#:lang "remora/dynamic"]{20}, and 32 | @code[#:lang "remora/dynamic"]{30}. 33 | These three cells exist in a frame with shape 34 | @code[#:lang "remora/dynamic"]{[3]}. 35 | 36 | The function array itself also splits into a frame of cells, with an expected 37 | cell rank of 0. 38 | In this case, we have a single function cell in a scalar frame. 39 | 40 | In order to evaluate this application, the function and argument frames must be 41 | brought into agreement. 42 | Semantically, this is done by replicating cells and appending additional 43 | dimensions. 44 | This can only succeed if every frame is a prefix of some particular frame, which 45 | we call the ``principal frame.'' 46 | This rule is known as ``prefix agreement.'' 47 | Here, the principal frame is @code[#:lang "remora/dynamic"]{[3]}, from the 48 | @code[#:lang "remora/dynamic"]{[10 20 30]} argument. 49 | The other frames (from the function and first argument) are both 50 | @code[#:lang "remora/dynamic"]{[]}, which is a prefix of any frame. 51 | 52 | In our example, the single function cell is replicated to form the array 53 | @code[#:lang "remora/dynamic"]{[+ + +]}, 54 | and the single cell of the first argument is similarly replicated to form 55 | @code[#:lang "remora/dynamic"]{[1 1 1]}. 56 | 57 | We then have a new expression where all frames are equal: 58 | @codeblock[#:keep-lang-line? #f]{ 59 | #lang remora/dynamic 60 | ([+ + +] [1 1 1] [10 20 30]) 61 | } 62 | 63 | Evaluation proceeds with cell-wise application: 64 | @codeblock[#:keep-lang-line? #f]{ 65 | #lang remora/dynamic 66 | [(+ 1 10) (+ 1 20) (+ 1 30)] 67 | } 68 | 69 | Computing each result cell gives us our final result: 70 | @codeblock[#:keep-lang-line? #f]{ 71 | #lang remora/dynamic 72 | [11 21 31] 73 | } 74 | 75 | @section{Example: Vector-matrix addition} 76 | The frames in this application form also follow prefix agreement: 77 | @codeblock[#:keep-lang-line? #f]{ 78 | #lang remora/dynamic 79 | (+ [[1 2] [3 4] [5 6]] [10 20 30]) 80 | } 81 | 82 | Here, the frames are @code[#:lang "remora/dynamic"]{[]}, 83 | @code[#:lang "remora/dynamic"]{[3 2]}, and @code[#:lang "remora/dynamic"]{[3]}. 84 | It may be easier to see how the vector's cells replicate using array literal 85 | notation. We require two copies of each scalar cell of 86 | @code[#:lang "remora/dynamic"]{#A(3)(10 20 30)}, which turns it into 87 | @code[#:lang "remora/dynamic"]{#A(3 2)(10 10 20 20 30 30)}, or 88 | @code[#:lang "remora/dynamic"]{[[10 10] [20 20] [30 30]]}. 89 | 90 | This leads to a result of 91 | @codeblock[#:keep-lang-line? #f]{ 92 | #lang remora/dynamic 93 | [[11 12] [23 24] [35 36]] 94 | } 95 | which may be more easily read as 96 | @codeblock[#:keep-lang-line? #f]{ 97 | #lang remora/dynamic 98 | [[11 12] 99 | [23 24] 100 | [35 36]] 101 | } 102 | We have added a column vector to the matrix. 103 | 104 | @section{Example: Function with rank 1 arguments} 105 | 106 | The first argument to the @code[#:lang "remora/dynamic"]{base} function is a 107 | vector of numbers describing a place value interpretation. 108 | At each position in the vector is a number indicating how many distinct 109 | ``digits'' are allowed at the corresponding column. 110 | The second argument is a vector of these digits, to be interpreted according to 111 | the place values specified by the first. 112 | For example, converting 1 hour, 40 minutes, 15 seconds to the number of seconds: 113 | @codeblock[#:keep-lang-line? #f]{ 114 | #lang remora/dynamic 115 | (base [24 60 60] [1 40 15]) 116 | } 117 | 118 | The expected rank for both arguments is 1. 119 | This leads to different lifting behavior than @code[#:lang "remora/dynamic"]{+}: 120 | @codeblock[#:keep-lang-line? #f]{ 121 | #lang remora/dynamic 122 | (base [24 60 60] [[1 40 15] [3 8 10]]) 123 | } 124 | 125 | The argument shapes are @code[#:lang "remora/dynamic"]{[3]} and 126 | @code[#:lang "remora/dynamic"]{[2 3]}. Since the expected rank for both 127 | arguments is 1, the last 1 dimension of each argument's shape forms the cell 128 | shape: 129 | @code[#:lang "remora/dynamic"]{[3]} and @code[#:lang "remora/dynamic"]{[3]}. 130 | The pieces that remain, @code[#:lang "remora/dynamic"]{[]} and 131 | @code[#:lang "remora/dynamic"]{[2]}, are the frame shapes. 132 | The cell to replicate here is the vector 133 | @code[#:lang "remora/dynamic"]{[24 60 60]}, 134 | not the individual scalars, @code[#:lang "remora/dynamic"]{[24]}, 135 | @code[#:lang "remora/dynamic"]{[60]}, and @code[#:lang "remora/dynamic"]{[60]}. 136 | So we expand the first argument to the 2 × 3 array 137 | @code[#:lang "remora/dynamic"]{[[24 60 60] [24 60 60]]}. 138 | 139 | Notice that in both vector-matrix examples, the new dimension appears at the end 140 | of the frame portion of the shape. 141 | 142 | 143 | @section{Example: Applying multiple functions} 144 | 145 | Sometimes it is convenient to split a complex number into its polar 146 | representation. We can build an array containing the magnitude and phase angle 147 | by applying an array containing the appropriate functions: 148 | @codeblock[#:keep-lang-line? #f]{ 149 | #lang remora/dynamic 150 | ([magnitude angle] 1+2i) 151 | } 152 | 153 | The function array's frame is @code[#:lang "remora/dynamic"]{[2]}, and the 154 | argument's frame is @code[#:lang "remora/dynamic"]{[]}. 155 | Expanding the argument gives 156 | @codeblock[#:keep-lang-line? #f]{ 157 | #lang remora/dynamic 158 | ([magnitude angle] [1+2i 1+2i]) 159 | } 160 | 161 | Cell-wise evaluation leaves the two functions' results in the 162 | @code[#:lang "remora/dynamic"]{[2]} frame: 163 | @codeblock[#:keep-lang-line? #f]{ 164 | #lang remora/dynamic 165 | [2.23606797749979 1.1071487177940904] 166 | } 167 | 168 | @section{Reranking} 169 | 170 | Suppose we want our vector-matrix addition to treat the vector as a row instead 171 | of as a column. 172 | Recall that when an array in an application form is expanded, the new dimensions 173 | appear at the end of the frame portion of its shape. 174 | If we want to use the vector as a row, the new dimension must appear in position 175 | 0 instead of position 1. 176 | So what we want is a version of @code[#:lang "remora/dynamic"]{+} which expects 177 | rank 1 arguments instead of rank 0. 178 | We can write such a function: 179 | @codeblock[#:keep-lang-line? #f]{ 180 | #lang remora/dynamic 181 | (λ ((x 1) (y 1)) (+ x y)) 182 | } 183 | 184 | This is common enough to warrant its own syntactic sugar: 185 | 186 | @defform[(rerank (rank ...) expr)]{ 187 | Wrap a function in a function of different rank. 188 | Equivalent to @code[#:lang "remora/dynamic"]{(λ ((x rank) ...) (expr x ...))} 189 | with fresh variables @code[#:lang "remora/dynamic"]{x ...}. 190 | This causes the function produced by evaluating 191 | @code[#:lang "remora/dynamic"]{expr} to be lifted using the expected argument 192 | ranks @code[#:lang "remora/dynamic"]{rank ...} rather than its own. 193 | 194 | In @tt{#lang remora/dynamic}, @code[#:lang "remora/dynamic"]{#r(rank ...)expr} 195 | is read as @racket[(rerank (rank ...) expr)]. 196 | } 197 | 198 | Returning to vector-matrix addition, @code[#:lang "remora/dynamic"]{#r(1 1)+} 199 | operates on vector cells. 200 | @codeblock[#:keep-lang-line? #f]{ 201 | #lang remora/dynamic 202 | (#r(1 1)+ [[1 2] [3 4] [5 6]] [10 20]) 203 | } 204 | 205 | The first argument is a @code[#:lang "remora/dynamic"]{[3]} frame around cells 206 | of shape @code[#:lang "remora/dynamic"]{[2]}, 207 | and the second is a @code[#:lang "remora/dynamic"]{[]} frame, also around cells 208 | of shape @code[#:lang "remora/dynamic"]{[2]}. 209 | The second argument expands into a @code[#:lang "remora/dynamic"]{[3]} frame by 210 | replicating its vector cell, becoming 211 | @code[#:lang "remora/dynamic"]{[[10 20] [10 20] [10 20]]}. 212 | So we have 213 | @codeblock[#:keep-lang-line? #f]{ 214 | #lang remora/dynamic 215 | (#r(1 1)+ [[1 2] [3 4] [5 6]] [[10 20] [10 20] [10 20]]) 216 | } 217 | which evaluates to 218 | @codeblock[#:keep-lang-line? #f]{ 219 | #lang remora/dynamic 220 | [[11 22] [13 24] [15 26]] 221 | } 222 | 223 | 224 | @;{TODO: reranking can also "reset" a function array's rank, like in 225 | (#r(0)[magnitude angle] [1+i 3 0-i]) 226 | } 227 | 228 | @;{TODO: apply/shape} 229 | -------------------------------------------------------------------------------- /remora/scribblings/arrays.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label (except-in racket/base 3 | box unbox define λ) 4 | (only-in remora/dynamic/lang/language 5 | define λ) 6 | remora/dynamic/main)] 7 | @declare-exporting[remora/dynamic/main] 8 | @title{Arrays} 9 | 10 | All computation in array-oriented programming is performed on arrays. An array 11 | is a collection of ``atoms'' arranged in a rectangular, or ``regular'', layout. 12 | Atoms are basic data such as numbers, strings, and booleans. 13 | 14 | An array can have any natural number of @tech[#:key "axis" #:normalize? #f]{axes}. 15 | This number is called the array's ``rank.'' 16 | A vector extends along only one axis, so it is a rank 1 array. 17 | A matrix has two axes, making it a rank 2 array. 18 | This rule generalizes to higher-rank structures, though they do not have common names. 19 | The degenerate case of an array has zero axes---a scalar has rank 0 20 | (note: a scalar contains one atom, but an atom is not itself a scalar). 21 | 22 | The ``shape'' of an array is a sequence whose elements gives the array's size 23 | along each axis. For example, a 4 × 7 matrix (4 rows, 7 columns) has shape 24 | @code[#:lang "remora/dynamic"]{[4 7]}, whereas an individual row in that matrix 25 | has shape @code[#:lang "remora/dynamic"]{[7]}. Five such matrices could be 26 | collected into an array with shape @code[#:lang "remora/dynamic"]{[5 4 7]}. 27 | Regularity requires that each plane in this 5 × 4 × 7 array have four rows and 28 | that each of those rows have seven entries. A scalar (recall, rank 0 array) must 29 | have the empty sequence @code[#:lang "remora/dynamic"]{[]} as its shape. 30 | 31 | The product of an array's dimensions gives the number of ``atoms'' the array 32 | contains. Our 4 × 7 matrix contains 28 atoms. For a scalar, this product is 33 | 1, the empty product, so a scalar contains one atom. 34 | 35 | Expressions in @racket{#lang remora/dynamic} produce arrays, and variables can 36 | only be bound to arrays. As a syntactic convenience, atoms in expression 37 | position are converted to scalar array literals. 38 | 39 | 40 | @defform[(alit (natural ...) atom ...)]{ 41 | Array literal: Produces an array of the given atoms arranged according 42 | to the given shape, @code[#:lang "remora/dynamic"]{[natural ...]}. 43 | 44 | The 2 × 3 matrix whose rows are @code[#:lang "remora/dynamic"]{[1 0 2]} and 45 | @code[#:lang "remora/dynamic"]{[3 2 1]} can be described with the array literal 46 | @code[#:lang "remora/dynamic"]{(alit (3 2) 1 0 2 3 2 1)}. 47 | 48 | @;{TODO: variables are rendering weird in 'code' fragments} 49 | In @tt{#lang remora/dynamic}, 50 | @code[#:lang "remora/dynamic"]{#A(dimension ...)(atom ...)} 51 | is read as @racket[(alit (dimension ...) atom ...)], so the above example can 52 | be written @code[#:lang "remora/dynamic"]{#A(3 2)(1 0 2 3 2 1)}. 53 | } 54 | 55 | @defform[(vec expr ...+)]{ 56 | Array constructor: All @code[#:lang "remora/dynamic"]{expr}s must evaluate to 57 | arrays with the same shape. The number of fragments given is prepended to the 58 | fragments' shape to form the resulting array's shape. If there are no fragments, 59 | the resulting array has shape @code[#:lang "remora/dynamic"]{[0]}. The resulting 60 | array contains the concatenated contents of the given fragments. This form is 61 | more flexible than @code[#:lang "remora/dynamic"]{alit} as atoms which appear in 62 | expression position are automatically promoted to scalars. 63 | 64 | @code[#:lang "remora/dynamic"]{(vec (alit (3) 1 0 2) (alit (3) 3 2 1))} and 65 | @code[#:lang "remora/dynamic"]{(vec (vec 1 0 2) (vec 3 2 1))} both produce the 66 | same 2 × 3 matrix as @code[#:lang "remora/dynamic"]{(alit (3 2) 1 0 2 3 2 1)}. 67 | } 68 | 69 | @defform[(array fragment ...+)]{ 70 | "Smart" constructor: If the fragments are atoms, this form becomes a rank 1 71 | @racket[alit] form whose sole dimension is the number of atoms given. If the 72 | fragments are non-atoms, this form expands to a @racket[vec] form. 73 | 74 | In @tt{#lang remora/dynamic}, @tt{[expr ...]} is read as 75 | @racket[(array expr ...)] 76 | } 77 | 78 | @defform[(define id expr)]{ 79 | Definition form: binds @racket[id] to the result of @code{expr}. Recall that 80 | expressions produce arrays, so @code{(define x 3)} binds @code{x} to the scalar 81 | @code[#:lang "remora/dynamic"]{#A()(3)}, not the atom 3. Therefore 82 | @code[#:lang "remora/dynamic"]{[x x]} produces 83 | @code[#:lang "remora/dynamic"]{#A(2)(3 3)}, and 84 | @code[#:lang "remora/dynamic"]{#A(2)(x x)} is not permitted. 85 | } 86 | @defform[(def id expr)]{ 87 | Like @racket[define], but available in library mode, 88 | to avoid shadowing issues with the "ambient" language. 89 | } -------------------------------------------------------------------------------- /remora/scribblings/basis-lib.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label remora/dynamic)] 3 | @declare-exporting[remora/dynamic] 4 | @title{Built-in functions} 5 | 6 | @defproc[(and [x 0] [y 0]) 0]{Logical And} 7 | @defproc[(or [x 0] [y 0]) 0]{Logical Or} 8 | 9 | @defproc[(signum [x 0]) 0]{ 10 | Find the sign of a nonzero number, or more generally, 11 | normalize a complex number to unit magnitude.} 12 | @;{ 13 | @defthing[#:kind "procedure" signum (-> [x 0] 0)]{ 14 | Find the sign of a nonzero number, or more generally, 15 | normalize a complex number to unit magnitude.}} 16 | 17 | @defproc[(logb [b 0] [x 0]) 0]{ 18 | Logarithm of @racket[x] with base @racket[b]} 19 | 20 | @defproc[(ln [x 0]) 0]{ 21 | Logarithm of @racket[x] with base @italic[]{e} (Euler's number)} 22 | 23 | @defproc[(log [x 0]) 0]{ 24 | Logarithm of @racket[x] with base 10} 25 | 26 | @defproc[(lg [x 0]) 0]{ 27 | Logarithm of @racket[x] with base 2} 28 | 29 | @defproc[(array->flat-list [arr all]) 0]{ 30 | Produce a list of all atoms in an array.} 31 | 32 | @defproc[(array->flat-vector [arr all]) 0]{ 33 | Produce a vector of all atoms in an array.} 34 | 35 | @defproc[(array->nest-list [arr all]) 0]{ 36 | Produce a nested list representation of an array. 37 | Each axis is represented by a list nesting level. 38 | For example, an array with shape @code[#:lang "remora/dynamic"]{[3 2]} becomes 39 | a length-three list of length-two lists of atoms. 40 | For a scalar array, the 0-level nested list is just the array's single atom. 41 | Note that if a 0 appears in an array's shape, 42 | then lists at the corresponding nesting level will be empty.} 43 | 44 | @defproc[(array->nest-vector [arr all]) 0]{ 45 | Like @code[#:lang "remora/dynamic"]{array->nest-list}, 46 | but produces a vector of vectors instead of a list of lists.} 47 | 48 | @defproc[(string->array [s 0]) 1]{ 49 | Representation of @racket[s] as a character vector} 50 | 51 | @defproc[(array->string [x 1]) 0]{ 52 | String representation of character vector @racket[x]} 53 | 54 | @;{TODO: define "item" earlier in the tutorial, make uses of it link there} 55 | @defproc[(head [x 'all]) ★]{ 56 | Extract the first item of @racket[x]} 57 | 58 | @defproc[(behead [x 'all]) ★]{ 59 | Remove the first item of @racket[x]} 60 | 61 | @defproc[(tail [x 'all]) ★]{ 62 | Extract the last item of @racket[x]} 63 | 64 | @defproc[(curtail [x 'all]) ★]{ 65 | Remove the last item of @racket[x]} 66 | 67 | @defproc[(take [n 0] [x 'all]) ★]{ 68 | Extract the first @racket[n] items of @racket[x]} 69 | 70 | @defproc[(take* [n 0] [x 'all]) ★]{ 71 | Like @code[#:lang "remora/dynamic"]{take}, but with the result 72 | @code[#:lang "remora/dynamic"]{box}ed to make lifting to 73 | different @code[#:lang "remora/dynamic"]{n} values safe.} 74 | 75 | @defproc[(take-right [n 0] [x 'all]) ★]{ 76 | Extract the last @racket[n] items of @racket[x]} 77 | 78 | @defproc[(take-right* [n 0] [x 'all]) ★]{ 79 | Like @code[#:lang "remora/dynamic"]{take-right}, but with the result 80 | @code[#:lang "remora/dynamic"]{box}ed to make lifting to 81 | different @code[#:lang "remora/dynamic"]{n} values safe.} 82 | 83 | @defproc[(drop [n 0] [x 'all]) ★]{ 84 | Remove the first @racket[n] items of @racket[x]} 85 | 86 | @defproc[(drop* [n 0] [x 'all]) ★]{ 87 | Like @code[#:lang "remora/dynamic"]{drop}, but with the result 88 | @code[#:lang "remora/dynamic"]{box}ed to make lifting to 89 | different @code[#:lang "remora/dynamic"]{n} values safe.} 90 | 91 | @defproc[(drop-right [n 0] [x 'all]) ★]{ 92 | Remove the last @racket[n] items of @racket[x]} 93 | 94 | @defproc[(drop-right* [n 0] [x 'all]) ★]{ 95 | Like @code[#:lang "remora/dynamic"]{drop-right}, but with the result 96 | @code[#:lang "remora/dynamic"]{box}ed to make lifting to 97 | different @code[#:lang "remora/dynamic"]{n} values safe.} 98 | 99 | @defproc[(reverse [x 'all]) ★]{ 100 | Reverse the items of @racket[x]} 101 | 102 | @defproc[(rotate [x 'all] [n 0]) ★]{ 103 | Cyclically shift the items of @racket[x] by @racket[n] spaces} 104 | 105 | @defproc[(append [x 'all] [y 'all]) ★]{ 106 | Construct an array whose items are the items of @racket[x] followed by the items 107 | of @racket[y]. 108 | The items of both arguments are required to have matching shape.} 109 | 110 | @defproc[(deal [count 0] [x 'all]) ★]{ 111 | Randomly choose @racket[count] items from @racket[x] without replacement. 112 | } 113 | 114 | @defproc[(base [radix 1] [digits 1]) 0]{ 115 | Interpret @racket[digits] as a sequence of digits according to the place-value 116 | described by @racket[radix]. 117 | For example, 118 | @code[#:lang "remora/dynamic"]{(base [8 8 8] [2 7 3])} 119 | treats 2, 7, and 3 as a sequence of octal digits, returning 187. 120 | Not all columns are required to permit the same number of digits. 121 | The digits could be interpreted as days, hours, minutes, and seconds using the 122 | radix @code[#:lang "remora/dynamic"]{[7 24 60 60]}. 123 | } 124 | 125 | @defproc[(antibase [radix 1] [x 0]) 1]{ 126 | Reverses the calculation of @code[#:lang "remora/dynamic"]{base}. 127 | @code[#:lang "remora/dynamic"]{x} is converted to a sequence of digits. 128 | The number of digits specified in @code[#:lang "remora/dynamic"]{radix} prevents 129 | representation of numbers larger than the cumulative product of 130 | @code[#:lang "remora/dynamic"]{radix}. 131 | If x is too large, the result is as if @code[#:lang "remora/dynamic"]{x} were 132 | reduced modulo that product. 133 | } 134 | 135 | @defproc[(foldl [op 'all] [init 'all] [x 'all]) ★]{ 136 | Left-associative fold over @code[#:lang "remora/dynamic"]{x} using 137 | @code[#:lang "remora/dynamic"]{op}, with @code[#:lang "remora/dynamic"]{init} as 138 | the base case. 139 | } 140 | 141 | @defproc[(foldr [op 'all] [init 'all] [x 'all]) ★]{ 142 | Right-associative fold over @code[#:lang "remora/dynamic"]{x} using 143 | @code[#:lang "remora/dynamic"]{op}, with @code[#:lang "remora/dynamic"]{init} as 144 | the base case. 145 | } 146 | 147 | @defproc[(reduce [op 'all] [base 'all] [x 'all]) ★]{ 148 | Tree-shaped reduction of @code[#:lang "remora/dynamic"]{x} using 149 | @code[#:lang "remora/dynamic"]{op}. If @code[#:lang "remora/dynamic"]{x} has 150 | length @code[#:lang "remora/dynamic"]{0}, returns 151 | @code[#:lang "remora/dynamic"]{base}. Should not be used if 152 | @code[#:lang "remora/dynamic"]{op} is not associative. 153 | } 154 | 155 | @defproc[(scan [op 'all] [init 'all] [x 'all]) ★]{ 156 | Similar to a left-associative fold, but returns an array whose items are the 157 | intermediate results while folding. 158 | } 159 | 160 | @defproc[(shape-of [x 'all]) 1]{ 161 | Construct a vector whose elements are the dimensions of 162 | @code[#:lang "remora/dynamic"]{x} 163 | } 164 | 165 | @defproc[(reshape [new-shape 1] [x 'all]) ★]{ 166 | Construct an array whose dimensions are the atoms of 167 | @code[#:lang "remora/dynamic"]{new-shape} and whose atoms are the atoms of 168 | @code[#:lang "remora/dynamic"]{x} (with the sequence repeated as many times as 169 | necessary). 170 | } 171 | 172 | @defproc[(reshape* [new-shape 1] [x 'all]) ★]{ 173 | Like @code[#:lang "remora/dynamic"]{reshape}, but wraps the result in a 174 | @code[#:lang "remora/dynamic"]{box} so that this procedure is safe for lifting 175 | to multiple different @code[#:lang "remora/dynamic"]{new-shape}s. 176 | } 177 | 178 | @defproc[(iota [new-shape 1]) ★]{ 179 | Construct an array whose dimensions are the atoms of 180 | @code[#:lang "remora/dynamic"]{new-shape} and whose atoms are the first 181 | @italic{n} natural numbers, where @italic{n} is the product of the atoms of 182 | @code[#:lang "remora/dynamic"]{new-shape}. 183 | } 184 | 185 | @defproc[(iota* [new-shape 1]) ★]{ 186 | Like @code[#:lang "remora/dynamic"]{iota}, but wraps the result in a 187 | @code[#:lang "remora/dynamic"]{box} so that this procedure is safe for lifting 188 | to multiple different @code[#:lang "remora/dynamic"]{new-shape}s. 189 | } 190 | 191 | @defproc[(nub [x 'all]) ★]{ 192 | Remove all but the first occurrence of each item from 193 | @code[#:lang "remora/dynamic"]{x}. 194 | } 195 | 196 | @defproc[(nub-sieve [x 'all]) 1]{ 197 | Construct a vector of booleans which indicate whether the corresponding item 198 | in @code[#:lang "remora/dynamic"]{x} is the first occurrence of that item. 199 | } 200 | 201 | @defproc[(ravel [x 'all]) 1]{ 202 | Construct a vector whose atoms are the atoms of 203 | @code[#:lang "remora/dynamic"]{x}. 204 | } 205 | 206 | @defproc[(itemize [x 'all]) ★]{ 207 | Construct an array whose sole item is 208 | @code[#:lang "remora/dynamic"]{x}, @italic{i.e.} an array with the same atoms as 209 | @code[#:lang "remora/dynamic"]{x} but whose shape has a @racket[1] added to the 210 | beginning. This result is equivalent to @code[#:lang "remora/dynamic"]{[x]}. 211 | } 212 | 213 | @defproc[(length [x 'all]) 0]{ 214 | Extract the first element of @code[#:lang "remora/dynamic"]{x}'s shape, the 215 | length along its major axis. 216 | } 217 | 218 | @defproc[(equal [x 'all] [y 'all]) 0]{ 219 | Return @racket[#t] if @code[#:lang "remora/dynamic"]{x} and 220 | @code[#:lang "remora/dynamic"]{y} have the same atoms and shape. 221 | Return @racket[#f] otherwise. 222 | } 223 | 224 | @defproc[(show [x 'all]) void]{ 225 | Print a whole array. Using Racket's built-in functions such as @racket[print] 226 | will cause them to be applied to each scalar individually. 227 | } 228 | 229 | @defproc[(read [port 0]) ★]{ 230 | Read an array from the designated input port. 231 | } 232 | 233 | @defproc[(filter [bools 1] [x 'all]) ★]{ 234 | Keep or discard each item of @code[#:lang "remora/dynamic"]{x} according to the 235 | corresponding element of @code[#:lang "remora/dynamic"]{bools}. Not safe for 236 | lifting on the @code[#:lang "remora/dynamic"]{bools} argument. 237 | } 238 | 239 | @defproc[(filter* [bools 1] [x 'all]) ★]{ 240 | Like @code[#:lang "remora/dynamic"]{filter}, but with a 241 | @code[#:lang "remora/dynamic"]{box}ed result to allow lifting on 242 | @code[#:lang "remora/dynamic"]{bools}. 243 | } 244 | 245 | @defproc[(window [l 0] [x 'all]) ★]{ 246 | Construct an array whose items are the first @code[#:lang "remora/dynamic"]{l} 247 | rotations of @code[#:lang "remora/dynamic"]{x}. 248 | This is an array with length @code[#:lang "remora/dynamic"]{l} on its major axis 249 | and subsequences of the items of @code[#:lang "remora/dynamic"]{x} laid out 250 | along its second axis. 251 | } 252 | 253 | @defproc[(select [bool 0] [x 'all] [y 'all]) ★]{ 254 | If @code[#:lang "remora/dynamic"]{bool} is true, return 255 | @code[#:lang "remora/dynamic"]{x}. Otherwise, return 256 | @code[#:lang "remora/dynamic"]{y}. 257 | } 258 | 259 | @defproc[(unsafe-unbox [b 0]) ★]{ 260 | Extract the contents of the box @code[#:lang "remora/dynamic"]{b}. 261 | This is present for historical reasons. 262 | It is not safe for use on an aggregate of boxes because their contents may not 263 | have matching shapes. 264 | } 265 | 266 | -------------------------------------------------------------------------------- /remora/scribblings/boxes.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label remora/dynamic)] 3 | 4 | @declare-exporting[remora/dynamic/main] 5 | @title{Boxes: handling irregular data} 6 | 7 | A box wraps an array of arbitrary shape in a scalar structure. 8 | This allows irregular data with some additional processing to ensure that 9 | aggregate lifting of functions is only done with regular data. 10 | 11 | @defform[(box expr)]{ 12 | Construct a box around the array produced by 13 | @code[#:lang "remora/dynamic"]{expr}. 14 | } 15 | 16 | Suppose we wish to find the means of several samples of differing size. 17 | The samples themselves can only be put together in a single array if they are 18 | boxed: 19 | @;{TODO: figure out why this only generates proper hyperlinks with 20 | #lang racket instead of #lang remora/dynamic} 21 | @codeblock[#:keep-lang-line? #f]{ 22 | #lang racket 23 | [(box [2 7 1 8 2 8]) 24 | (box [3 1 4 1 5]) 25 | (box [2 2 2 3 2 0 0])] 26 | } 27 | 28 | In order to operate on the boxes' contents, we must use the 29 | @code[#:lang "remora/dynamic"]{unbox} form: 30 | @defform[(unbox id box-expr body)]{ 31 | Evaluate @code[#:lang "remora/dynamic"]{body} with 32 | @code[#:lang "remora/dynamic"]{id} bound to the contents of 33 | @code[#:lang "remora/dynamic"]{box-expr}. 34 | } 35 | 36 | We can use this to write a function which finds the mean of a boxed vector: 37 | @codeblock[#:keep-lang-line? #f]{ 38 | #lang remora/dynamic 39 | (def box-mean 40 | (λ ((some-box 0)) 41 | (unbox xs some-box 42 | (/ (foldr + 0 xs) 43 | (tally xs))))) 44 | } 45 | Note that @code[#:lang "remora/dynamic"]{box-mean} expects a scalar argument (a 46 | single box) but operates on the box's contents as an aggregate an produces an 47 | unboxed scalar. 48 | Applying @code[#:lang "remora/dynamic"]{box-mean} to our vector of boxed vectors 49 | gives @code[#:lang "remora/dynamic"]{[14/3 14/5 11/7]} 50 | 51 | Some functions produce arrays whose shape depends on the contents of the 52 | arguments. 53 | For example, @code[#:lang "remora/dynamic"]{iota} consumes a vector describing 54 | an array's shape and produces an array of that shape. 55 | Using such functions on higher-ranked arguments could produce result cells of 56 | differing shapes, which would form an irregular array when collected together. 57 | -------------------------------------------------------------------------------- /remora/scribblings/functions.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label (except-in racket/base 3 | box unbox define λ) 4 | (only-in remora/dynamic/lang/language 5 | define λ) 6 | remora/dynamic)] 7 | 8 | @declare-exporting[remora/dynamic] 9 | @title{Functions} 10 | 11 | @defform[(λ ((id rank) ...) body ...+)]{ 12 | An array function expects each argument to have a particular rank. This rank is 13 | basic unit the function operates on, and the function implicitly lifts to 14 | operate on arguments of higher rank. For example, @racket[+] expects rank 0 15 | arguments, and @racket[antibase] expects its first argument to be a rank 1 array 16 | of digits. The operators are implicitly lifted to higher-rank arguments. Some 17 | functions expect rank @racket[all] for certain arguments. This means the 18 | function is never lifted over that argument---it consumes any argument as its 19 | basic unit, no matter the rank. 20 | 21 | The function body is one or more expressions, which are evaluated in sequence. 22 | The result of the final expression is returned as the result of the function. 23 | 24 | Functions are atoms, so a @racket[λ] form can be used as an element of an 25 | @racket[alit] form or in expression position where it will be converted to a 26 | rank 0 array. 27 | } 28 | 29 | @defform[(fn ((id rank) ...) body ...+)]{ 30 | Like @racket[λ], but available in library mode, 31 | to avoid shadowing issues with the "ambient" language. 32 | } 33 | 34 | @defidform[all]{ 35 | Rank annotation for an argument which should be treated as a single cell, 36 | regardless of the actual argument's shape. 37 | } 38 | -------------------------------------------------------------------------------- /remora/scribblings/integration.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label (except-in racket/base 3 | box unbox define λ) 4 | (only-in remora/dynamic/lang/language 5 | define λ) 6 | remora/dynamic) 7 | scribble/eval] 8 | @title{Integration with Racket code} 9 | 10 | @section{Importing and exporting} 11 | 12 | @code[]{#lang remora/dynamic} includes Racket's @racket[require] and 13 | @racket[provide] to allow programs to be split into modules and use of 14 | pre-existing Racket procedures. 15 | When a Racket procedure is applied in Remora, it is automatically converted 16 | into a Remora procedure with arity matching the supplied number of arguments 17 | and an expected rank of 0 for all arguments. 18 | For example, Racket's built-in @racket[gcd] can be applied to Remora arrays: 19 | @codeblock[#:keep-lang-line? #f]{ 20 | #lang remora/dynamic 21 | (gcd 15 [10 11 12]) 22 | } 23 | 24 | 25 | 26 | @section{Using Remora as a Library} 27 | A Racket program can embed small pieces of Remora code. 28 | Primitive operations (@italic{i.e.}, those provided by the 29 | @racket[remora/dynamic] library) have ``@code[]{R_}'' prepended to their names 30 | to avoid conflict with Racket's own built-in procedures. 31 | 32 | @defform[(remora expr ...)]{ 33 | Evaluate each @racket[expr] in turn as a @code[]{#lang remora/dynamic} 34 | expression, returning the result of the last one. 35 | Within a @racket[remora] form, only @code[]{remora/dynamic} syntax can be used, 36 | though the reader extensions (@code[#:lang "remora/dynamic"]{#A}, 37 | @code[#:lang "remora/dynamic"]{#r}, and bracketed arrays) are not available. 38 | The result of a @racket[remora] form is a @racket[rem-array] struct. 39 | } 40 | 41 | @defstruct[rem-array ([shape (vectorof exact-nonnegative-integer?)] 42 | [data vector?]) 43 | #:transparent]{ 44 | The array's dimensions are stored as the @racket[shape] field, and the atoms are 45 | stored as the @racket[data] field. 46 | The constructor is protected by a dependent contract which requires that the 47 | number of atoms be equal to the product of the dimensions. 48 | } 49 | 50 | Procedures can also be constructed directly. 51 | @defstruct[rem-proc ([body procedure?] 52 | [ranks (listof (or/c exact-nonnegative-integer? 'all))]) 53 | #:transparent]{ 54 | Wrap the given Racket procedure as a @code[]{remora/dynamic} procedure with the 55 | given expected ranks. 56 | The @racket[body] must be a procedure which consumes and produces 57 | Remora arrays. 58 | } 59 | 60 | @interaction[ 61 | (require remora/dynamic) 62 | (define elts-sum 63 | (rem-proc 64 | (λ (arr) 65 | (rem-array #() 66 | (vector (for/sum ([i (rem-array-data arr)]) i)))) 67 | '(all))) 68 | (remora 69 | (elts-sum (alit (2 3) 1 2 3 4 5 6))) 70 | ] 71 | -------------------------------------------------------------------------------- /remora/scribblings/records.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[racket/sandbox 3 | scribble/eval 4 | (for-label remora/dynamic 5 | (only-in remora/dynamic/lang/language 6 | define λ))] 7 | @declare-exporting[remora/dynamic/main] 8 | 9 | @(sandbox-output 'string) 10 | @(define example-evaluator 11 | (parameterize ([sandbox-output 'string] 12 | [sandbox-error-output 'string]) 13 | (make-evaluator 'remora/dynamic/lang/language))) 14 | 15 | @title{Records} 16 | Records are heterogeneous aggregate data. 17 | Computing on record data is done by extracting individual elements, 18 | in constrast to arrays, 19 | which are normally consumed by lifting a function over every cell. 20 | In Remora, a record is a collection of named fields, each containing an atom. 21 | A record is itself an atom as well. 22 | 23 | To write out a record datum, 24 | each field's name and value are paired together in parenthesis, 25 | with the entire collection of fields enclosed in brases. 26 | For example, we might write a city's location and name like this: 27 | 28 | @codeblock[#:keep-lang-line? #f]{ 29 | #lang remora/dynamic 30 | {(name "Boston") (lat 42.36) (long -71.06)}} 31 | 32 | A record can have many fields, only one field, or no fields at all. 33 | @code[#:lang "remora/dynamic"]{{(answer 42)}} and 34 | @code[#:lang "remora/dynamic"]{{}} are valid records. 35 | 36 | Since records are atoms, they can be used as record fields: 37 | 38 | @codeblock[#:keep-lang-line? #f]{ 39 | #lang remora/dynamic 40 | {(airline "AA") (departure {(hour 10) (min 30) (airport "BOS")}) 41 | (arrival {(hour 12) (min 15) (airport "ORD")})}} 42 | 43 | Working on particular elements of a record is done with @tech{lenses}. 44 | A @deftech{lens} is a function which "focuses" on 45 | a particular piece of a data structure 46 | and can be used to look at or change that piece. 47 | For Remora records, lenses are built by the 48 | @code[#:lang "remora/dynamic"]{lens} form. 49 | @defform[(lens fname)]{ 50 | Construct a lens for record field @code[#:lang "remora/dynamic"]{fname}. 51 | This does not depend on the particular record or collection of fields. 52 | The resulting lens will work on any record which has a field with that name. 53 | } 54 | 55 | There are three operations on lenses, called 56 | @code[#:lang "remora/dynamic"]{view}, 57 | @code[#:lang "remora/dynamic"]{set}, and 58 | @code[#:lang "remora/dynamic"]{over}. 59 | They are curried functions, so they can easily be used in partial application. 60 | For example, @code[#:lang "remora/dynamic"]{(view (lens lat))} is a function 61 | which extracts the @code[#:lang "remora/dynamic"]{lat} field from a record, 62 | and @code[#:lang "remora/dynamic"]{((over (lens lat)) add1)} is a function which 63 | increases a record's @code[#:lang "remora/dynamic"]{lat} field by 1. 64 | 65 | @defproc[(view [L 0]) 0]{ 66 | Build a procedure which extracts 67 | the field focused by the lens @code[#:lang "remora/dynamic"]{L} 68 | from an argument record. 69 | That is, @code[#:lang "remora/dynamic"]{((view L) R)} 70 | is equal to the field of @code[#:lang "remora/dynamic"]{R} 71 | focused by @code[#:lang "remora/dynamic"]{L}. 72 | 73 | @code[#:lang "remora/dynamic"]{(view (compose (lens fname) ...))} 74 | can also be written as 75 | @code[#:lang "remora/dynamic"]{#_(fname ...)}.} 76 | 77 | @;{Extract from @code[#:lang "remora/dynamic"]{R} the field 78 | focused by the lens @code[#:lang "remora/dynamic"]{L}.} 79 | 80 | @defproc[(set [L 0]) 0]{ 81 | Build a curried procedure which takes 82 | a new value @code[#:lang "remora/dynamic"]{V} 83 | and then a record @code[#:lang "remora/dynamic"]{R} 84 | and produces a new version of @code[#:lang "remora/dynamic"]{R} 85 | with the field focused by the lens @code[#:lang "remora/dynamic"]{L} 86 | changed to @code[#:lang "remora/dynamic"]{V}. 87 | That is, @code[#:lang "remora/dynamic"]{(((set L) V) R)} 88 | is equal to @code[#:lang "remora/dynamic"]{R} except that 89 | @code[#:lang "remora/dynamic"]{L}'s focused field has changed to 90 | @code[#:lang "remora/dynamic"]{V}. 91 | 92 | @code[#:lang "remora/dynamic"]{(set (compose (lens fname ...)))} 93 | can also be written as 94 | @code[#:lang "remora/dynamic"]{#=(fname ...)}.} 95 | 96 | @;{Build a version of @code[#:lang "remora/dynamic"]{R} 97 | with the field focused by the lens @code[#:lang "remora/dynamic"]{L} 98 | changed to @code[#:lang "remora/dynamic"]{V}.} 99 | 100 | @defproc[(over [L 0]) 0]{ 101 | Build a curried procedure which takes 102 | a unary function @code[#:lang "remora/dynamic"]{F} 103 | and then a record @code[#:lang "remora/dynamic"]{R} 104 | and produces a new version of @code[#:lang "remora/dynamic"]{R} 105 | with the field focused by the lens @code[#:lang "remora/dynamic"]{L} 106 | changed by applying the function @code[#:lang "remora/dynamic"]{F}. 107 | That is, @code[#:lang "remora/dynamic"]{(((over L) F) R)} 108 | is equal to @code[#:lang "remora/dynamic"]{R} except that 109 | @code[#:lang "remora/dynamic"]{L}'s focused field has changed 110 | from its original value @code[#:lang "remora/dynamic"]{V} to 111 | @code[#:lang "remora/dynamic"]{(F V)}. 112 | 113 | @code[#:lang "remora/dynamic"]{(over (compose (lens fname ...)))} 114 | can also be written as 115 | @code[#:lang "remora/dynamic"]{#^(fname ...)}.} 116 | 117 | @;{Extract from @code[#:lang "remora/dynamic"]{R} the field 118 | focused by the lens @code[#:lang "remora/dynamic"]{L}.} 119 | 120 | Composing multiple lenses narrows the focus. 121 | In the airline flight record above, we could focus on the departure airport 122 | with @code[#:lang "remora/dynamic"]{(compose (lens departure) (lens airport))}. 123 | 124 | @nested[#:style 'code-inset]{ 125 | @racketinput0[((view (compose (lens departure) (lens airport))) 126 | {(airline "AA") 127 | (departure {(hour 10) (min 30) (airport "BOS")}) 128 | (arrival {(hour 12) (min 15) (airport "ORD")})})] 129 | @racket[#,(racketresultfont "\"BOS\"")]} 130 | 131 | Alternatively, using the syntactic sugar for lens operations: 132 | @nested[#:style 'code-inset]{ 133 | @racketinput0[(#,(tt "#_")(departure airport) 134 | {(airline "AA") 135 | (departure {(hour 10) (min 30) (airport "BOS")}) 136 | (arrival {(hour 12) (min 15) (airport "ORD")})})] 137 | @racket[#,(racketresultfont "\"BOS\"")]} 138 | 139 | 140 | @section{Arrays of records} 141 | By collecting multiple records into an array, 142 | we can make a table where different columns contain different types of data, 143 | but each individual column is homogeneous. 144 | The record constructor is an ordinary Remora function, 145 | so it lifts to handle array arguments 146 | using the same machinery as other rank-polymorphic functions. 147 | This means we can build a table either by rows: 148 | 149 | @codeblock[#:keep-lang-line? #f]{ 150 | #lang remora/dynamic 151 | [{(loc "Dallas") (day 28) (month 3) (year 2019) (hi 74) (lo 57)} 152 | {(loc "Dublin") (day 1) (month 4) (year 2019) (hi 11) (lo 5)} 153 | {(loc "Nome") (day 31) (month 3) (year 2019) (hi 31) (lo 26)} 154 | {(loc "Tunis") (day 31) (month 3) (year 2019) (hi 21) (lo 12)}]} 155 | 156 | or by columns: 157 | 158 | @codeblock[#:keep-lang-line? #f]{ 159 | #lang remora/dynamic 160 | {(loc ["Dallas" "Dublin" "Nome" "Tunis"]) 161 | (day [28 1 31 31]) 162 | (month [3 4 3 3]) 163 | (year 2019) 164 | (hi [74 11 31 21]) 165 | (lo [57 5 26 12])}} 166 | 167 | Both of these expressions produce the same array, 168 | which we will call @code[#:lang "remora/dynamic"]{temp-readings} 169 | in our running example. 170 | Note that in the column-wise construction, 171 | where we lift the record constructor over a 4-vector frame, 172 | we can still include scalar-frame arguments. 173 | 174 | Functions for operating on records also lift. 175 | When we @code[#:lang "remora/dynamic"]{view} a particular field, 176 | that lifts to extracting a particular column from the table: 177 | @nested[#:style 'code-inset]{ 178 | @racketinput0[(#,(tt "#_")(loc) temp-readings)] 179 | @;{@racket[#,(racketresultfont "[\"Dallas\" \"Dublin\" \"Nome\" \"Tunis\"]")]} 180 | @racket[["Dallas" "Dublin" "Nome" "Tunis"]] 181 | } 182 | 183 | Similarly, applying a function @code[#:lang "remora/dynamic"]{over} a field 184 | turns into updating the entire column: 185 | @nested[#:style 'code-inset]{ 186 | @racketinput0[((#,(tt "#^")(loc) string-upcase) temp-readings)]} 187 | @codeblock[#:keep-lang-line? #f]{ 188 | #lang remora/dynamic 189 | [{(loc "DALLAS") (day 28) (month 3) (year 2019) (hi 74) (lo 57)} 190 | {(loc "DUBLIN") (day 1) (month 4) (year 2019) (hi 11) (lo 5)} 191 | {(loc "NOME") (day 31) (month 3) (year 2019) (hi 31) (lo 26)} 192 | {(loc "TUNIS") (day 31) (month 3) (year 2019) (hi 21) (lo 12)}]} 193 | 194 | Data cleaning often requires changing only certain entries in a column, 195 | such as in @code[#:lang "remora/dynamic"]{temp-readings}, 196 | where some temperatures (those from US cities) 197 | are given in Fahrenheit and others in Celsius. 198 | We only need a function that updates a single record. 199 | Assuming we already have a function @code[#:lang "remora/dynamic"]{in-usa?} 200 | which recognizes whether a location is in the US 201 | and a temperature conversion function @code[#:lang "remora/dynamic"]{f->c}, 202 | we can @code[#:lang "remora/dynamic"]{view} the location field 203 | to determine whether to use @code[#:lang "remora/dynamic"]{f->c} 204 | or the identity function @code[#:lang "remora/dynamic"]{id} 205 | as the temperature-fixing function. 206 | Then we apply our chosen @code[#:lang "remora/dynamic"]{fix-temp} 207 | to the @code[#:lang "remora/dynamic"]{hi} 208 | and @code[#:lang "remora/dynamic"]{lo} fields: 209 | 210 | @codeblock[#:keep-lang-line? #f]{ 211 | #lang remora/dynamic 212 | (define (normalize-temps (w 0)) 213 | (define fix-temp 214 | (select (in-usa? (#_(loc) w)) f->c id)) 215 | ((#^(hi) fix-temp) ((#^(lo) fix-temp) w)))} 216 | 217 | Function application automatically lifts 218 | @code[#:lang "remora/dynamic"]{normalize-temps} 219 | over the entire table. 220 | 221 | @nested[#:style 'code-inset]{ 222 | @racketinput0[(define fixed-readings (normalize-temps temp-readings))] 223 | @racketinput0[fixed-readings]} 224 | @codeblock[#:keep-lang-line? #f]{ 225 | #:lang remora/dynamic 226 | [{(loc "Dallas") (day 28) (month 3) (year 2019) (hi 23.33) (lo 13.89)} 227 | {(loc "Dublin") (day 1) (month 4) (year 2019) (hi 11) (lo 5)} 228 | {(loc "Nome") (day 31) (month 3) (year 2019) (hi -0.56) (lo -3.33)} 229 | {(loc "Tunis") (day 31) (month 3) (year 2019) (hi 21) (lo 12)}]} 230 | 231 | We can also look at just the US-originating rows using 232 | @code[#:lang "remora/dynamic"]{filter*}, 233 | which takes a boolean vector (effectively a bit mask) identifying 234 | the vector elements to keep. 235 | We can build a mask for US temperature readings: 236 | 237 | @nested[#:style 'code-inset]{ 238 | @racketinput0[(define us-locs (in-usa? (#,(tt "#_")(loc) fixed-readings)))] 239 | @racketinput0[us-locs] 240 | @racket[[#t #f #t #f]] 241 | @racketinput0[(filter* us-locs fixed-readings)] 242 | } 243 | @codeblock[#:keep-lang-line? #f]{ 244 | #:lang remora/dynamic 245 | (box 246 | [{(loc "Dallas") (day 28) (month 3) (year 2019) (hi 23.33) (lo 13.89)} 247 | {(loc "Nome") (day 31) (month 3) (year 2019) (hi -0.56) (lo -3.33)}])} 248 | 249 | Lifting @code[#:lang "remora/dynamic"]{filter*} over multiple masks 250 | gives us a way to partition the table into multiple pieces: 251 | @nested[#:style 'code-inset]{ 252 | @racketinput0[(filter* [us-locs (not us-locs)] fixed-readings)] 253 | } 254 | @codeblock[#:keep-lang-line? #f]{ 255 | #:lang remora/dynamic 256 | [(box 257 | [{(loc "Dallas") (day 28) (month 3) (year 2019) (hi 23.33) (lo 13.89)} 258 | {(loc "Nome") (day 31) (month 3) (year 2019) (hi -0.56) (lo -3.33)}]) 259 | (box 260 | [{(loc "Dublin") (day 1) (month 4) (year 2019) (hi 11) (lo 5)} 261 | {(loc "Tunis") (day 31) (month 3) (year 2019) (hi 21) (lo 12)}])]} 262 | 263 | Hierarchical column nesting is the lifted form of record nesting. 264 | @codeblock[#:keep-lang-line? #f]{ 265 | #lang remora/dynamic 266 | (define flights 267 | (append 268 | {(airline "AA") 269 | (departure {(hour [7 9 10]) (min [0 2 20]) (airport "BOS")}) 270 | (arrival {(hour [8 11 12]) (min [57 0 15]) (airport "ORD")})} 271 | {(airline "JB") 272 | (departure {(hour [8 11]) (min [47 18]) (airport "BOS")}) 273 | (arrival {(hour [10 13]) (min [45 14]) (airport "ORD")})}))} 274 | 275 | Each row has a @code{departure} entry and an @code{arrival} entry, 276 | which both contain their own respective times and locations. 277 | Asking for the departure time uses nested lenses: 278 | one for @code{departure}, composed with each of @code{hour} and @code{min}. 279 | This code lifts @code[#:lang "remora/dynamic"]{view} over a 2-vector of lenses, 280 | so we then wrap the resulting 2-vector of field accessors 281 | as a scalar function before applying it. 282 | @nested[#:style 'code-inset]{ 283 | @racketinput0[(~(0)(view (compose (lens departure) [(lens hour) (lens min)])) flights)] 284 | } 285 | @codeblock[#:keep-lang-line? #f]{ 286 | #:lang remora/dynamic 287 | [[7 0] 288 | [9 2] 289 | [10 20] 290 | [8 47] 291 | [11 18]]} 292 | 293 | 294 | 295 | -------------------------------------------------------------------------------- /remora/scribblings/remora.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[(for-label (except-in racket/base 3 | box unbox define λ) 4 | (only-in remora/dynamic/lang/language 5 | define λ) 6 | (lib "remora/dynamic"))] 7 | 8 | @title[#:tag '("rackmora" 9 | "remora" 10 | "remora/dynamic")]{Array-oriented programming} 11 | 12 | @author[(author+email "Justin Slepak" "jrslepak@ccs.neu.edu" #:obfuscate? #t)] 13 | 14 | @;{maybe add a bit about motivation here?} 15 | 16 | @;{TODO: sections: 17 | 1. pieces of an array 18 | shape, atoms; 19 | rank; 20 | scalar/atom distinction; 21 | syntax for arrays 22 | 23 | 2. pieces of a function 24 | arguments, their ranks; 25 | function body; 26 | syntax for functions 27 | 28 | 3. function appliction 29 | frame-of-cells decomposition; 30 | prefix agreement; 31 | examples w/ increasing principal frame rank; 32 | reranking 33 | 34 | 4. boxes for irregular data 35 | functions w/ indeterminate result shape (like iota); 36 | unbox syntax; 37 | unsafe-unbox function 38 | 39 | 5. racket integration 40 | importing & exporting in #lang mode; 41 | library/EDSL mode} 42 | 43 | @defmodulelang[remora/dynamic] 44 | @local-table-of-contents[] 45 | 46 | @include-section["tutorial.scrbl"] 47 | @include-section["arrays.scrbl"] 48 | @include-section["functions.scrbl"] 49 | @include-section["application.scrbl"] 50 | @include-section["boxes.scrbl"] 51 | @include-section["records.scrbl"] 52 | @include-section["integration.scrbl"] 53 | @include-section["basis-lib.scrbl"] 54 | -------------------------------------------------------------------------------- /remora/scribblings/tutorial.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @require[scribble/eval 3 | scribble/core 4 | racket/sandbox 5 | remora/dynamic/lang/reader 6 | (for-label remora/dynamic 7 | (only-in remora/dynamic/lang/language 8 | define λ))] 9 | 10 | @title[#:version "" #:date ""]{Remora Tutorial} 11 | 12 | @(sandbox-output 'string) 13 | @(define example-evaluator 14 | (parameterize ([sandbox-output 'string] 15 | [sandbox-error-output 'string]) 16 | (make-evaluator 'remora/dynamic/lang/language))) 17 | 18 | @;{TODO: using #:lang option with `code' keeps hyperlinks from generating} 19 | 20 | Much of Remora is not too different from other functional languages. 21 | 22 | @;{ 23 | @interaction[#:eval example-evaluator 24 | (+ 1 3) 25 | ((compose sqrt add1) 3) 26 | ] 27 | @interaction-eval-show[#:eval example-evaluator (+ 2 6)] 28 | } 29 | 30 | @nested[#:style 'code-inset]{ 31 | @racketinput0[(+ 1 3)] 32 | @racket[#,(racketresultfont (tt "4"))]} 33 | 34 | @nested[#:style 'code-inset]{ 35 | @racketinput0[((compose sqrt add1) 3)] 36 | @racket[#,(racketresultfont (tt "2"))]} 37 | 38 | @nested[#:style 'code-inset]{ 39 | @racketinput0[(foldr + 0 [0 1 2 3])] 40 | @racket[#,(racketresultfont (tt "6"))]} 41 | 42 | Wait, something is a little different there. 43 | @code[#:lang "remora/dynamic"]{[0 1 2 3]} is an array, not a list. 44 | It's made of four ``@deftech{atoms},'' laid out in a row of length four. 45 | We could write out this structure more explicitly as: 46 | 47 | @codeblock[#:keep-lang-line? #f]{ 48 | #lang remora/dynamic 49 | #A(4)(0 1 2 3) 50 | } 51 | 52 | Instead of a single row of four, we could have two rows of two: 53 | @tabular[#:sep @hspace[3] 54 | (list 55 | (append 56 | (list 57 | @codeblock[#:keep-lang-line? #f]{#lang remora/dynamic 58 | [[0 1] [2 3]]}) 59 | (list "or" @hspace[2]) 60 | (list 61 | @codeblock[#:keep-lang-line? #f]{#lang remora/dynamic 62 | #A(2 2)(0 1 2 3)})))] 63 | 64 | But what we had before wasn't really @emph{one} row of four. 65 | It doesn't have any rows, just the four atoms. 66 | One row of four would be 67 | @tabular[#:sep @hspace[3] 68 | (list 69 | (append 70 | (list 71 | @codeblock[#:keep-lang-line? #f]{#lang remora/dynamic 72 | [[0 1 2 3]]}) 73 | (list "or" @hspace[2]) 74 | (list 75 | @codeblock[#:keep-lang-line? #f]{#lang remora/dynamic 76 | #A(1 4)(0 1 2 3)})))] 77 | 78 | This is like the difference between a line and a narrow rectangle. 79 | A rectangle has a length and a width, while a line has just a length. 80 | The line doesn't have a very small width --- it has no width at all. 81 | The line extends along just one @deftech[#:normalize? #f]{axis}, 82 | and the rectangle extends along two axes. 83 | How many axes an array has is called its @deftech{rank}. 84 | The @deftech{shape} of an array is how far it extends along each axis. 85 | @code[#:lang "remora/dynamic"]{[0 1 2 3]}, or 86 | @code[#:lang "remora/dynamic"]{#A(4)(0 1 2 3)}, is a @tech{rank}-1 array with 87 | shape @code[#:lang "remora/dynamic"]{[4]}. 88 | @code[#:lang "remora/dynamic"]{[[0 1] [2 3]]}, or 89 | @code[#:lang "remora/dynamic"]{#A(2 2)(0 1 2 3)}, is a @tech{rank}-2 array with 90 | shape @code[#:lang "remora/dynamic"]{[2 2]}. 91 | 92 | Actually, we've been working with arrays since the beginning: 93 | @racketblock[(+ 1 3)] 94 | 95 | These three things are @tech{rank}-0 arrays --- each one has shape 96 | @code[#:lang "remora/dynamic"]{[]}. 97 | ``@racket[+]'' is the name of an array whose only atom is the addition function. 98 | @racket[1] in the above expression doesn't really stand for the number one, 99 | but this @racket[1] does: 100 | @codeblock[#:keep-lang-line? #f]{ 101 | #lang remora/dynamic 102 | #A()(1) 103 | } 104 | That notation is an @deftech{array literal}. 105 | It gets some numbers to describe the shape and some atoms. 106 | We cannot have @code[#:lang "remora/dynamic"]{#A()((+ 1 3))} because 107 | @code[#:lang "remora/dynamic"]{(+ 1 3)} is not an atom (it is an expression). 108 | Inside an array literal is the only place we talk about atoms. 109 | Even in @code[#:lang "remora/dynamic"]{[0 1 2 3]}, these are expressions. 110 | This means @code[#:lang "remora/dynamic"]{[(+ 1 3)]} is allowed --- 111 | it produces @code[#:lang "remora/dynamic"]{[4]}, or 112 | @code[#:lang "remora/dynamic"]{#A()(4)}. 113 | 114 | If the pieces of @code[#:lang "remora/dynamic"]{(+ 1 3)} are arrays, 115 | what happens when we use different arrays? 116 | @racketinput[(+ [10 20 30] 3)] 117 | @racketblock[#,(racketresultfont (tt "[13 23 33]"))] 118 | 119 | Function application in Remora does a bit more than we saw before. 120 | Addition and 3 were repeated with each of 10, 20, and 30, as if we'd written 121 | @codeblock[#:keep-lang-line? #f]{ 122 | #lang remora/dynamic 123 | [(+ 10 3) (+ 20 3) (+ 30 3)] 124 | } 125 | 126 | We'd get the same result from 127 | @codeblock[#:keep-lang-line? #f]{ 128 | #lang remora/dynamic 129 | ([+ + +] [10 20 30] [3 3 3]) 130 | } 131 | 132 | In that version, there's some similarity the arrays' shapes all share. 133 | Each is a @deftech{frame} of @code[#:lang "remora/dynamic"]{[3]} 134 | built around the fundamental unit we're computing on. 135 | We call those units @deftech{cells}. 136 | In our vector-and-scalars expression, 137 | @code[#:lang "remora/dynamic"]{(+ [10 20 30] 3)}, 138 | the @tech{frames} are @code[#:lang "remora/dynamic"]{[]}, 139 | @code[#:lang "remora/dynamic"]{[3]}, and @code[#:lang "remora/dynamic"]{[]}. 140 | They're not all the same, but they're close enough: 141 | We can add extra @tech[#:key "axis" #:normalize? #f]{axes} 142 | at the right ends of lower-@tech{rank}ed @tech{frames} 143 | in order to make them the same as the highest-@tech{rank}ed @tech{frame}. 144 | Adding more axes to an array means its @tech{cells} get replicated too: 145 | @code[#:lang "remora/dynamic"]{+} becomes 146 | @code[#:lang "remora/dynamic"]{[+ + +]}, and @code[#:lang "remora/dynamic"]{3} 147 | becomes @code[#:lang "remora/dynamic"]{[3 3 3]}. 148 | 149 | Let's try higher-@tech{rank} arrays: 150 | @nested[#:style 'code-inset]{ 151 | @racketinput0[(+ [[1 2 3] [4 5 6]] [10 20])] 152 | @racket[#,(racketresultfont (tt "[[11 12 13] [24 25 26]]"))]} 153 | Now, the @tech{frames} are @code[#:lang "remora/dynamic"]{[]}, 154 | @code[#:lang "remora/dynamic"]{[2 3]}, and @code[#:lang "remora/dynamic"]{[2]}. 155 | That means the shape of @code[#:lang "remora/dynamic"]{+} needs to be extended 156 | with @code[#:lang "remora/dynamic"]{[2 3]}, 157 | and the shape of @code[#:lang "remora/dynamic"]{[10 20]} needs to be exteneded 158 | with @code[#:lang "remora/dynamic"]{[3]}. 159 | 160 | @code[#:lang "remora/dynamic"]{+} has only one @tech{cell}, so we make 2 × 3 = 6 161 | copies of it: @code[#:lang "remora/dynamic"]{[[+ + +] [+ + +]]}. 162 | @code[#:lang "remora/dynamic"]{[10 20]} has two @tech{cells}, 163 | @code[#:lang "remora/dynamic"]{10} and @code[#:lang "remora/dynamic"]{20}. 164 | We make 3 copies of each: 165 | @code[#:lang "remora/dynamic"]{[[10 10 10] [20 20 20]]}. 166 | 167 | So the matrix-vector addition is the same as the all-matrix expressions 168 | @codeblock[#:keep-lang-line? #f]{ 169 | #lang remora/dynamic 170 | ([[+ + +] [+ + +]] 171 | [[1 2 3] [4 5 6]] 172 | [[10 10 10] [20 20 20]]) 173 | } 174 | and 175 | @codeblock[#:keep-lang-line? #f]{ 176 | #lang remora/dynamic 177 | [[(+ 1 10) (+ 2 10) (+ 3 10)] 178 | [(+ 4 20) (+ 5 20) (+ 6 20)]] 179 | } 180 | 181 | We effectively treated @code[#:lang "remora/dynamic"]{[10 20]} as a column by 182 | adding another @tech[#:normalize? #f]{axis} to its shape after the 183 | @code[#:lang "remora/dynamic"]{2}. 184 | Not all operations behave like @code[#:lang "remora/dynamic"]{+} in this regard. 185 | The @code[#:lang "remora/dynamic"]{base} operator interprets a vector of digits 186 | according to a given radix vector. 187 | @nested[#:style 'code-inset]{ 188 | @racketinput0[(base [8 8] [3 1])] 189 | @racket[#,(racketresultfont (tt "25"))]} 190 | In octal, the digits @code[#:lang "remora/dynamic"]{[3 1]} represent the decimal 191 | number @code[#:lang "remora/dynamic"]{25}. 192 | The fundamental unit in each of @code[#:lang "remora/dynamic"]{base}'s arguments 193 | is a vector, a @tech{rank}-1 array. 194 | So we say that @code[#:lang "remora/dynamic"]{base} has an 195 | @deftech{expected rank} of 1 for both arguments, 196 | whereas @code[#:lang "remora/dynamic"]{+} had 0. 197 | @tech{Expected rank} is the property that determines how an argument array is 198 | split into a @tech{frame} of @tech{cells}. 199 | 200 | With @code[#:lang "remora/dynamic"]{+}, the @tech{cells} were scalars, 201 | and with @code[#:lang "remora/dynamic"]{base}, the @tech{cells} are vectors: 202 | @nested[#:style 'code-inset]{ 203 | @racketinput0[(base [[8 8 8] [7 24 60]] [2 6 7])] 204 | @racket[#,(racketresultfont (tt "[183 3274]"))]} 205 | The @tech{frames} are @code[#:lang "remora/dynamic"]{[]}, 206 | @code[#:lang "remora/dynamic"]{[2]}, and @code[#:lang "remora/dynamic"]{[]}. 207 | The last @tech[#:normalize? #f]{axis} of each argument is the shape of its 208 | @tech{rank}-1 @techlink{cells}. 209 | 210 | Expanding the second argument's frame to match the first makes it a 211 | @code[#:lang "remora/dynamic"]{[2]} frame of @code[#:lang "remora/dynamic"]{[3]} 212 | cells. 213 | Its shape becomes @code[#:lang "remora/dynamic"]{[2 3]}. 214 | This effectively treats the vector as a row, whereas 215 | @code[#:lang "remora/dynamic"]{+} treated it as a column. 216 | 217 | What if we wanted to add a matrix and a row vector? 218 | We need a function which expects @tech{rank}-1 arguments and adds them. 219 | A function is written like this: 220 | @codeblock[#:keep-lang-line? #f]{ 221 | #lang remora/dynamic 222 | (λ ((x 1) (y 1)) (+ x y)) 223 | } 224 | 225 | @code[#:lang "remora/dynamic"]{x} and @code[#:lang "remora/dynamic"]{y} are the 226 | names of the function's arguments. 227 | They are each marked with a @code[#:lang "remora/dynamic"]{1} to indicate that 228 | our function expects @tech{rank} 1 for each argument. 229 | The function body @code[#:lang "remora/dynamic"]{(+ x y)} simply adds the two 230 | @tech{rank}-1 arguments. 231 | Even if the function is applied to higher-ranked arguments, inside the function 232 | body, @code[#:lang "remora/dynamic"]{x} and @code[#:lang "remora/dynamic"]{y} 233 | always refer to rank-1 cells of those arguments. 234 | 235 | For convenience, we'll give this function a name: 236 | @codeblock[#:keep-lang-line? #f]{ 237 | #lang remora/dynamic 238 | (def vec+ (λ ((x 1) (y 1)) (+ x y))) 239 | } 240 | The @code[#:lang "remora/dynamic"]{def} form takes a name and an expression and 241 | binds the name to the result of that expression. 242 | 243 | Now let's add a matrix and a row vector: 244 | @nested[#:style 'code-inset]{ 245 | @racketinput0[(vec+ [[1 2 3] [4 5 6]] [10 20 30])] 246 | @racket[#,(racketresultfont (tt "[[11 22 33] [14 25 36]]"))]} 247 | Frames are @code[#:lang "remora/dynamic"]{[]}, 248 | @code[#:lang "remora/dynamic"]{[2]}, and @code[#:lang "remora/dynamic"]{[]}, 249 | just like when we used @code[#:lang "remora/dynamic"]{base}. 250 | 251 | We changed how the vector was expanded into a matrix by @deftech{reranking} 252 | @code[#:lang "remora/dynamic"]{+}. 253 | That is, we made a version of @code[#:lang "remora/dynamic"]{+} with different 254 | expected ranks for its arguments. 255 | Reranking is common enough in array-oriented programming that it gets special 256 | shorthand in Remora: 257 | @codeblock[#:keep-lang-line? #f]{ 258 | #lang remora/dynamic 259 | #r(1 1)+ 260 | } 261 | That's the same function as @code[#:lang "remora/dynamic"]{vec+}, written in 262 | reranking shorthand. 263 | It gives the same result: 264 | @;{TODO: this lets reader macros appear in racketinput0 but doesn't generate 265 | hyperlinks for reranked function names} 266 | @nested[#:style 'code-inset]{ 267 | @racketinput0[#,(code #:lang "remora/dynamic" 268 | "(#r(1 1)+ [[1 2 3] [4 5 6]] [10 20 30])")] 269 | @racket[#,(racketresultfont (tt "[[11 22 33] [14 25 36]]"))]} 270 | 271 | All this talk about expected rank has focused on the argument arrays, but the 272 | function array is a frame of cells too. 273 | It doesn't have to be a scalar, with just one function. 274 | @nested[#:style 'code-inset]{ 275 | @racketinput0[([magnitude angle] 3+4i)] 276 | @racket[#,(racketresultfont (tt "[5 0.9272952180016122]"))]} 277 | 278 | The expected rank for the function array is 0, no matter what functions it 279 | contains. 280 | So our frames here are @code[#:lang "remora/dynamic"]{[2]} and 281 | @code[#:lang "remora/dynamic"]{[]}. 282 | Each function cell gets applied to the one argument cell. 283 | Suppose we want both @code[#:lang "remora/dynamic"]{magnitude} and 284 | @code[#:lang "remora/dynamic"]{angle} applied to each of two complex numbers. 285 | Directly applying @code[#:lang "remora/dynamic"]{[magnitude angle]} is not what 286 | we want. 287 | That would apply @code[#:lang "remora/dynamic"]{magnitude} to one scalar cell 288 | and @code[#:lang "remora/dynamic"]{angle} to the other. 289 | 290 | Instead, we can make @code[#:lang "remora/dynamic"]{[magnitude angle]} into a 291 | single function (really, an array containing one function) which expects scalar 292 | cells: 293 | @nested[#:style 'code-inset]{ 294 | @racketinput0[#,(code #:lang "remora/dynamic" 295 | "(#r(0)[magnitude angle] [3+4i -5-12i])")] 296 | @racket[#,(racketresultfont 297 | (tt "[[5 0.9272952180016122] [13 -1.965587446494658]]"))]} 298 | 299 | The frames here are @code[#:lang "remora/dynamic"]{[]} for the function position 300 | and @code[#:lang "remora/dynamic"]{[2]} for the argument. 301 | So the whole function is replicated and applied to each of 302 | @code[#:lang "remora/dynamic"]{3+4i} and @code[#:lang "remora/dynamic"]{-5-12i}. 303 | 304 | Some functions don't expect arguments of a specific rank. 305 | They have expected rank @code[#:lang "remora/dynamic"]{all}, meaning the 306 | argument is always considered to have a scalar frame. 307 | One such function is @code[#:lang "remora/dynamic"]{head}. 308 | It extracts the first @deftech{item}, that is a sub-array with one less 309 | @tech[#:normalize? #f]{axis}. 310 | @nested[#:style 'code-inset]{ 311 | @racketinput0[(head [0 1 2 3])] 312 | @racket[#,(racketresultfont (tt "0"))]} 313 | 314 | @nested[#:style 'code-inset]{ 315 | @racketinput0[(head [[0 1] [2 3]])] 316 | @racket[#,(racketresultfont (tt "[0 1]"))]} 317 | 318 | @nested[#:style 'code-inset]{ 319 | @racketinput0[(head [[[0 1] [2 3]] [[4 5] [6 7]]])] 320 | @racket[#,(racketresultfont (tt "[[0 1] [2 3]]"))]} 321 | 322 | From a vector, we get the first element. 323 | From a matrix, we get the first row. 324 | From a rank-3 array, we get the first plane, and so on. 325 | 326 | Instead of getting a row from a matrix, we could get a column by getting the 327 | first element of each row, that is of each rank-1 cell. 328 | @nested[#:style 'code-inset]{ 329 | @racketinput0[#,(code #:lang "remora/dynamic" 330 | "(#r(1)head [[0 1] [2 3]])")] 331 | @racket[#,(racketresultfont (tt "[0 2]"))]} 332 | 333 | Another @code[#:lang "remora/dynamic"]{all}-ranked function is 334 | @code[#:lang "remora/dynamic"]{append}, which joins two arrays along their major 335 | @tech[#:normalize? #f]{axis}. 336 | @nested[#:style 'code-inset]{ 337 | @racketinput0[(append [[0 1] [2 3]] [[10 20] [30 40]])] 338 | @racket[#,(racketresultfont (tt "[[0 1] [2 3] [10 20] [30 40]]"))]} 339 | 340 | @nested[#:style 'code-inset]{ 341 | @racketinput0[(append [0 1] [2 3])] 342 | @racket[#,(racketresultfont (tt "[0 1 2 3]"))]} 343 | 344 | Reranking @code[#:lang "remora/dynamic"]{append} lets us join arrays along a 345 | different @tech[#:normalize? #f]{axis}: 346 | @nested[#:style 'code-inset]{ 347 | @racketinput0[#,(code #:lang "remora/dynamic" 348 | "(#r(1 1)append [[0 1] [2 3]] [[10 20] [30 40]])")] 349 | @racket[#,(racketresultfont (tt "[[0 1 10 20] [2 3 30 40]]"))]} 350 | 351 | @code[#:lang "remora/dynamic"]{#r(1 1)append} concatenates vectors. 352 | Applying it to two matrices concatenates corresponding vector cells and 353 | reassembles them in the vector frame to produce a new matrix. 354 | 355 | For most functions, the output shape is determined by the argument shapes. 356 | When we append a @code[#:lang "remora/dynamic"]{[2]}-vector and a 357 | @code[#:lang "remora/dynamic"]{[3]}-vector, we know we will get a 358 | @code[#:lang "remora/dynamic"]{[5]}-vector. 359 | Adding a @code[#:lang "remora/dynamic"]{[3 6]}-matrix and a 360 | @code[#:lang "remora/dynamic"]{[3]}-vector will always produce a 361 | @code[#:lang "remora/dynamic"]{[3 6]}-matrix. 362 | 363 | Some functions' output shape depends on the actual values of the input atoms, 364 | not just shapes. 365 | If we apply such a function to a multi-celled array, we could get result cells 366 | with differing shapes. 367 | We can't put those together in a single array. 368 | There is no valid shape that describes that array. 369 | An array can only have one size along each @tech[#:normalize? #f]{axis}. 370 | 371 | In order to make such functions safe to use on higher-ranked arguments, they 372 | produce @deftech{boxes}. 373 | @nested[#:style 'code-inset]{ 374 | @racketinput0[(iota [2 3])] 375 | @racket[#,(racketresultfont (tt "(box [[0 1 2] [3 4 5]])"))]} 376 | 377 | @nested[#:style 'code-inset]{ 378 | @racketinput0[(iota [4 2])] 379 | @racket[#,(racketresultfont (tt "(box [[0 1] [2 3] [4 5] [6 7]])"))]} 380 | 381 | A box is a scalar datum which may contain an array of any shape. 382 | Producing boxes makes it safe to lift @code[#:lang "remora/dynamic"]{iota}: 383 | @nested[#:style 'code-inset]{ 384 | @racketinput0[(iota [[2 3] [4 2]])] 385 | @racket[#,(racketresultfont 386 | (tt (string-append "[(rem-box [[0 1 2] [3 4 5]]) " 387 | "(rem-box [[0 1] [2 3] [4 5] [6 7]])]")))]} 388 | 389 | The result has shape @code[#:lang "remora/dynamic"]{[2]}. 390 | Its items are boxes. 391 | The first box contains a @code[#:lang "remora/dynamic"]{[2 3]}-array, and the 392 | second contains a @code[#:lang "remora/dynamic"]{[4 2]}-array. 393 | The @code[#:lang "remora/dynamic"]{unbox} form allows the contents of a box to 394 | be bound to a variable: 395 | @nested[#:style 'code-inset]{ 396 | @racketinput0[(unbox nats (iota [5]) 397 | (foldr * 1 (add1 nats)))] 398 | @racket[#,(racketresultfont (tt "120"))]} 399 | 400 | We temporarily had a vector with ``unknown'' length while computing 5!. 401 | Folding eliminates the unknown length by producing a scalar. 402 | This means we could safely replace @code[#:lang "remora/dynamic"]{5} with an 403 | unknown natural number. 404 | Our unknown-length vector is folded into a scalar, making it safe to return 405 | without boxing it. 406 | This means we could write a factorial function: 407 | @codeblock[#:keep-lang-line? #f]{ 408 | #lang remora/dynamic 409 | (λ ((n 0)) 410 | (unbox nats (iota [n]) 411 | (foldr * 1 (add1 nats)))) 412 | } 413 | However, if we write a function that adds 1 to a box's contents, safety demands 414 | that the function return a box. 415 | Otherwise, applying it to an argument like 416 | @code[#:lang "remora/dynamic"]{(iota [[2 3] [4 2]])} would fail. 417 | -------------------------------------------------------------------------------- /semantics/Readme.md: -------------------------------------------------------------------------------- 1 | # Semantic model 2 | This is the PLT Redex model developed for the Remora array language. Syntax and reduction semantics for the untyped calculus are defined in `language.rkt`. Syntax and type judgment for the typed calculus are in `dependent-lang.rkt`, and `typed-reduction.rkt` defines reduction semantics. 3 | 4 | The files' `test` submodules include code examples. These tests/examples can also be run individually via DrRacket's REPL. Redex also allows the user to get a step-by-step view of a reduction or typing derivation. 5 | 6 | To see a reduction step-by-step, run `(traces ->Array expr-to-reduce)`. For example, 7 | 8 | ``` 9 | (traces 10 | ->Array 11 | (term ((scalar +) (A (3 3) (1 2 3 12 | 4 5 6 13 | 7 8 9)) 14 | (A (3) (10 20 30))))) 15 | ``` 16 | 17 | should show all reduction steps in the maxtrix-vector addition. For long reductions, Redex may choose not to generate the entire reduction graph right away. A "Reduce" button at the bottom of the "Traces" window instructs Redex to generate more nodes in the graph. 18 | 19 | To see a typing derivation, run `(show-derivations (build-derivations judgment-to-render))`. This requires a judgment that actually holds. Thus 20 | 21 | ``` 22 | (show-derivations 23 | (build-derivations 24 | (type-of () () () (A (3 2) (4 1 6 2 3 5)) type))) 25 | ``` 26 | 27 | produces a derivation tree, while 28 | 29 | ``` 30 | (show-derivations 31 | (build-derivations 32 | (type-of () () () (A (3 3) (4 1 6 2 3 5)) type))) 33 | ``` 34 | 35 | produces an error. 36 | -------------------------------------------------------------------------------- /semantics/redex-utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require redex) 4 | (provide deterministic-reduce) 5 | 6 | (define (deterministic-reduce reln expr) 7 | (define next-exprs 8 | ; redex-match sometimes produces multiple copies of the same matching, 9 | ; leading to multiple copies of the same reduction result 10 | (remove-duplicates 11 | (apply-reduction-relation/tag-with-names reln expr))) 12 | (cond [(= 0 (length next-exprs)) expr] ; no results -- term is fully reduced 13 | [(= 1 (length next-exprs)) ; one result -- continue reducing 14 | (deterministic-reduce reln 15 | ; extract the first term from the results list 16 | (second (first next-exprs)))] 17 | ; multiple results -- raise error 18 | [else (error 'deterministic-reduce 19 | "\n~v steps to any of\n~v" 20 | expr 21 | next-exprs)])) 22 | -------------------------------------------------------------------------------- /semantics/typed-reduction.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require (except-in redex shadow) 4 | "dependent-lang.rkt" 5 | "language.rkt" 6 | "redex-utils.rkt") 7 | 8 | (define-extended-language Annotated Dependent 9 | ; fully-annotated expression forms 10 | (expr:t (expr:t expr:t ... : type) 11 | var:t 12 | arr:t 13 | (T-λ [var ...] expr:t : type) 14 | (T-APP expr:t type ... : type) 15 | (PACK idx ... expr:t : type) 16 | (UNPACK ([var ... var] ⇐ expr:t) expr:t : type) 17 | (I-λ [(var sort) ...] expr:t : type) 18 | (I-APP expr:t idx ... : type)) 19 | ; add type annotation to variable/array 20 | (var:t (var : type)) 21 | ; 1st type (if present) describes el-exprs 22 | ; 2nd type describes entire array 23 | (arr:t (A type (num ...) (el-expr:t ...) : type) 24 | (A (num ...) (el-expr:t ...) : type)) 25 | (el-expr:t expr:t 26 | base 27 | fun:t) 28 | (elt:t base 29 | fun:t) 30 | (fun:t op 31 | (λ [(var type) ...] expr:t : type)) 32 | (op + - * / 33 | < > <= >= = 34 | and or not 35 | exp log 36 | (I-APP (T-APP reshape type) idx idx) 37 | head behead tail curtail 38 | (I-APP iota idx) 39 | (I-APP (T-APP append type) idx idx idx) 40 | (I-APP (T-APP itemize type) idx) 41 | (I-APP (T-APP length type) idx idx) 42 | reduce 43 | fold/r 44 | fold/l) 45 | 46 | (expr:t-env (e:t-bind ...)) (e:t-bind [var expr:t]) 47 | 48 | (val:t elt:t 49 | (A (num ...) (elt:t ...) : type) 50 | (PACK idx ... val:t : type)) 51 | 52 | (E hole 53 | (E expr:t ... : type) 54 | (val:t ... E expr:t ... : type) 55 | (A (num ...) (val:t ... E el-expr:t ...) : type) 56 | (PACK idx ... E : type) 57 | (UNPACK ([var ... var] ⇐ E) expr:t : type))) 58 | 59 | (define ->Typed 60 | (reduction-relation 61 | Annotated 62 | #:domain expr:t 63 | [--> (in-hole E ((A [] [op] : (Array (S) (type_arg ... -> type_ret))) 64 | val:t ... : type_e)) 65 | (in-hole E (annotate/cl (apply-op op [(type-erase val:t) ...]))) 66 | (where (type_arg/canon ...) ((canonicalize-type type_arg) ...)) 67 | (where (type_val/canon ...) 68 | ((canonicalize-type (extract-annotation val:t)) ...)) 69 | (side-condition (equal? (term (type_arg/canon ...)) 70 | (term (type_val/canon ...)))) 71 | op] 72 | [--> (in-hole E ((A [] [(λ [(var type_arg) ...] expr:t : type_fun)] 73 | : type_arr) 74 | val:t ... : type_app)) 75 | (in-hole E (expr:t/expr:t-sub [(var val:t) ...] expr:t)) 76 | (where (type_arg/canon ...) ((canonicalize-type type_arg) ...)) 77 | (where (type_val/canon ...) 78 | ((canonicalize-type (extract-annotation val:t)) ...)) 79 | (side-condition (equal? (term (type_arg/canon ...)) 80 | (term (type_val/canon ...)))) 81 | apply] 82 | [--> (in-hole E ((A [num_f ...] [fun:t ...] 83 | : (Array (S num_f ...) (type_arg ... -> type_ret))) 84 | val:t ... 85 | : (Array (S num_f ... num_c ...) type_app))) 86 | (in-hole E (A [num_f ...] 87 | [((A [] [fun:t] : (Array (S) (type_arg ... -> type_ret))) 88 | arr:t_cell ... : type_app/c) ...] 89 | : (Array (S num_f ...) type_app/c))) 90 | (side-condition (< 0 (length (term (num_f ...))))) 91 | (where type_app/c (canonicalize-type (Array (S num_c ...) type_app))) 92 | (side-condition (term (equiv-type? (Array (S) type_ret) type_app/c))) 93 | (side-condition 94 | (term (all ((equiv-type? (extract-annotation val:t) 95 | (Array (S num_f ...) type_arg)) ...)))) 96 | (where (Array (S num_c ...) type_retatom) 97 | (canonicalize-type (Array (S) type_ret))) 98 | (where ((arr:t_cell ...) ...) 99 | (transpose/m 100 | ((cells/shape:t (num_c ...) val:t) ...))) 101 | map] 102 | [--> (in-hole E ((A [num_f ...] [fun:t ...] 103 | : (Array (S num_f ...) (type_arg ... -> type_ret))) 104 | val:t ... 105 | : (Array (S num_app ...) type_app))) 106 | (in-hole E (arr:t_lifted val:t_lifted ... 107 | : (Array (S num_app ...) type_app))) 108 | ; identify cell shape for fun/args 109 | (where ((Array (S num_argcell ...) type_argelt) ...) 110 | ((canonicalize-type (Array (S) type_arg)) ...)) 111 | ; make sure frame ranks aren't all the same 112 | ; (for well-typed code, equivalent to "shapes aren't all the same") 113 | (where ((Array (S num_argframe ... num_argcell ...) type_elt) ...) 114 | ((canonicalize-type (extract-annotation val:t)) ...)) 115 | (side-condition 116 | (not (term (all-equal? ((num_f ...) (num_argframe ...) ...))))) 117 | ; duplicate the cells 118 | (where (arr:t_lifted val:t_lifted ...) 119 | (frame-lift:t 120 | [(0 (A [num_f ...] [fun:t ...] 121 | : (Array (S num_f ...) 122 | (type_arg ... -> type_ret)))) 123 | ((length/m (num_argcell ...)) val:t) ...])) 124 | lift] 125 | [--> (in-hole E (A [num_f ...] [(A [num_c ...] [elt:t ...] : type_c) ...] 126 | : type_f)) 127 | (in-hole E (A [num_f ... num_c0 ...] [any_v ...] 128 | : (canonicalize-type type_f))) 129 | (where (Array (S num_f ... num_c0 ...) type_atom) 130 | (canonicalize-type type_f)) 131 | (side-condition (or (< 0 (length (term [type_c ...]))) 132 | (< 0 (length (term (num_c0 ...)))))) 133 | #;(where (num_c0 ...) (unique-elt ((num_c ...) ...))) 134 | (where (any_v ...) ,(foldr append '() (term ((elt:t ...) ...)))) 135 | collapse] 136 | [--> (in-hole E (T-APP (T-λ [var ...] expr:t : type_abst) 137 | type_arg ... 138 | : type_app)) 139 | (in-hole E (type/expr:t-sub ([var type_arg] ...) expr:t)) 140 | type-apply] 141 | [--> (in-hole E (I-APP (I-λ [(var sort) ...] expr:t : type_abst) 142 | idx_arg ... 143 | : type_app)) 144 | (in-hole E (idx/expr:t-sub ([var idx_arg] ...) expr:t)) 145 | idx-apply] 146 | [--> (in-hole E (UNPACK ([var_witness ... var_contents] 147 | ⇐ (PACK idx ... val:t : type_sum)) 148 | expr:t_body : type_unpack)) 149 | (in-hole E (idx/expr:t-sub ([var_witness idx] ...) 150 | (expr:t/expr:t-sub ([var_contents val:t]) 151 | expr:t_body))) 152 | unpack])) 153 | 154 | ;; grow argument arrays by duplication so they all have their desired ranks 155 | ;; cell ranks must be naturalized 156 | (define-metafunction Annotated 157 | ; [(cell-rank array) ...] 158 | frame-lift:t : [(num arr:t) ...] -> (arr:t ...) or #f 159 | [(frame-lift:t []) ()] 160 | ; make sure arrays can be lifted into same frame 161 | ; (need prefix relation for frame shapes) 162 | ; "principal frame" comes from least-overranked array 163 | [(frame-lift:t [(num_cr arr:t) ...]) 164 | ((cell-dup:t num_cr (num_pr-frame-dim ...) arr:t) ...) 165 | ; extract frame shapes 166 | (where ((num_fr ...) ...) 167 | ((drop-right/m (shape:t arr:t) num_cr) ...)) 168 | ; find the longest one -- that is the principal frame 169 | (where (num_pr-frame-dim ...) (longest ((num_fr ...) ...))) 170 | ; all other frames must be prefixes of it 171 | (side-condition 172 | (term (all ((prefix? (num_fr ...) (num_pr-frame-dim ...)) ...))))] 173 | ; not a frame-liftable input (e.g. due to frame mismatch) 174 | [(frame-lift:t any) #f]) 175 | 176 | ;; extract shape of array 177 | (define-metafunction Annotated 178 | shape:t : arr:t -> (num ...) 179 | [(shape:t (A (num ...) (el-expr:t ...) : type)) (num ...)]) 180 | 181 | ;; extract rank of array 182 | (define-metafunction Annotated 183 | rank:t : arr:t -> num 184 | [(rank:t (A (num ...) (el-expr:t ...) : type)) 185 | ,(length (term (num ...)))]) 186 | 187 | ;; duplicate cells of given array to lift it into desired frame 188 | (define-metafunction Annotated 189 | ; cell rank, frame shape, initial array 190 | cell-dup:t : num (num ...) arr:t -> arr:t 191 | ; All elements of a single cell should appear consecutively in value segment 192 | ; Just split value into chunks, repeat chunks right number of times, and 193 | ; update the shape. 194 | [(cell-dup:t num_cell-rank (num_frame-dim ...) arr:t) 195 | ; new array's shape is frame-portion ++ growth-portion ++ cell-shape 196 | ; new array's value comes from repeating the cells (number of copies is 197 | ; product of the "growth" portion of the shape) 198 | (A ,(append (term (drop-right/m (shape:t arr:t) num_cell-rank)) 199 | (term (num_growth ...)) 200 | (term (take-right/m (shape:t arr:t) num_cell-rank))) 201 | ,(foldr append '() 202 | (term ((repeat ,(foldr * 1 (term (num_growth ...))) 203 | (el-expr:t_cell ...)) ...))) 204 | : (Array (S num_frame-dim ... num_cell-dim ...) type_atom)) 205 | ; constructing the result annotation based on the original annotation 206 | (where (Array (S num_orig ...) type_atom) 207 | (extract-annotation arr:t)) 208 | (where (num_cell-dim ...) 209 | (take-right/m (num_orig ...) num_cell-rank)) 210 | ; break the array's value segment into its cells 211 | (where ((el-expr:t_cell ...) ...) 212 | (cell-values:t (take-right/m (shape:t arr:t) num_cell-rank) arr:t)) 213 | ; identify the part of the result shape that comes from lifting 214 | ; drop frame portion of array from left side of frame 215 | (where (num_growth ...) 216 | (drop/m (num_frame-dim ...) 217 | ,(- (term (rank:t arr:t)) (term num_cell-rank)))) 218 | ; require that the array actually be liftable into the frame 219 | ; i.e. frame portion of array must be prefix of given frame 220 | (side-condition (term (prefix? (drop-right/m (shape:t arr:t) num_cell-rank) 221 | (num_frame-dim ...))))]) 222 | 223 | ;; extract the value segments of an array's cells 224 | (define-metafunction Annotated 225 | ; cell shape, array 226 | cell-values:t : (num ...) arr:t -> ((el-expr:t ...) ...) 227 | [(cell-values:t (num_cellshape ...) arr:t) 228 | ((el-expr:t ...) ...) 229 | (where ((A (num ...) (el-expr:t ...) : type) ...) 230 | (cells/shape:t (num_cellshape ...) arr:t))]) 231 | 232 | ;; split an array into cells 233 | (define-metafunction Annotated 234 | ; cell shape, array 235 | cells/shape:t : (num ...) arr:t -> (arr:t ...) 236 | [(cells/shape:t (num_cell-dim ...) (A (num_arr-dim ...) () : type)) ()] 237 | [(cells/shape:t (num_cell-dim ...) 238 | (A (num_arr-dim ...) (el-expr:t ...) : type)) 239 | ,(cons (term (A (num_cell-dim ...) (take/m (el-expr:t ...) num_cellsize) 240 | : (Array (S num_cell-dim ...) type_elt))) 241 | ; drop one cell's elements from array, and split remaining elements 242 | (term (cells/shape:t (num_cell-dim ...) 243 | (A (num_arr-dim ...) 244 | (drop/m (el-expr:t ...) num_cellsize) 245 | : type)))) 246 | (where (Array idx type_elt) (canonicalize-type type)) 247 | (where num_cellsize ,(foldr * 1 (term (num_cell-dim ...))))]) 248 | 249 | ; select the unique element from a list that repeats only that element 250 | (define-metafunction Annotated 251 | unique-elt : (any any ...) -> any 252 | [(unique-elt (any)) any] 253 | [(unique-elt (any_0 any_0 any_1 ...)) (unique-elt (any_0 any_1 ...))]) 254 | 255 | ; check whether two types are equivalent 256 | (define-metafunction Dependent 257 | equiv-type? : type type -> bool 258 | [(equiv-type? type_0 type_1) 259 | #t 260 | (side-condition (equal? (term (canonicalize-type type_0)) 261 | (term (canonicalize-type type_1))))] 262 | [(equiv-type? type_0 type_1) #f]) 263 | 264 | ; use type-of judgment to identify the unique type that matches a given expr 265 | (define-metafunction Dependent 266 | unique-type-of : sort-env kind-env type-env el-expr -> type or #f 267 | [(unique-type-of sort-env kind-env type-env el-expr) 268 | type_result 269 | (where (type_result) 270 | ,(judgment-holds (type-of sort-env kind-env type-env el-expr type) 271 | type))] 272 | [(unique-type-of sort-env kind-env type-env el-expr) #f]) 273 | 274 | 275 | ; use kind-of judgment to determine whether a given type is well-formed 276 | (define-metafunction Dependent 277 | well-kinded : sort-env kind-env type -> bool 278 | [(well-kinded sort-env el-expr) 279 | ,(judgment-holds (sort-of sort-env idx type))]) 280 | 281 | ; use sort-of judgment to identify the unique sort that matches a given idx 282 | (define-metafunction Dependent 283 | unique-sort-of : sort-env idx -> sort or #f 284 | [(unique-sort-of sort-env idx) 285 | sort_result 286 | (where (sort_result) 287 | ,(judgment-holds (sort-of sort-env idx sort) 288 | sort))] 289 | [(unique-sort-of sort-env idx) #f]) 290 | 291 | ; add type annotations to convert from expr to expr:t 292 | ; assumes the expr is actually well-typed 293 | ; annotating the body of an abstraction requires looking up the vars it binds 294 | (define-metafunction Annotated 295 | annotate : sort-env kind-env type-env el-expr -> el-expr:t 296 | [(annotate sort-env kind-env type-env (expr_fun expr_arg ...)) 297 | ((annotate sort-env kind-env type-env expr_fun) 298 | (annotate sort-env kind-env type-env expr_arg) ... : type) 299 | (where type (unique-type-of sort-env kind-env type-env 300 | (expr_fun expr_arg ...)))] 301 | [(annotate sort-env kind-env type-env var) 302 | (var : type) 303 | (where type (unique-type-of sort-env kind-env type-env var))] 304 | 305 | [(annotate sort-env kind-env type-env (A (num ...) (el-expr ...))) 306 | (A (num ...) ((annotate sort-env kind-env type-env el-expr) ...) : type) 307 | (where type (unique-type-of sort-env kind-env type-env 308 | (A (num ...) (el-expr ...))))] 309 | [(annotate sort-env kind-env type-env (A type_elt (num ...) (el-expr ...))) 310 | (A (num ...) ((annotate sort-env kind-env type-env el-expr) ...) : type) 311 | (where type (unique-type-of sort-env kind-env type-env 312 | (A type_elt (num ...) (el-expr ...))))] 313 | 314 | [(annotate sort-env kind-env type-env (T-λ [var ...] expr)) 315 | (T-λ [var ...] (annotate sort-env 316 | (kind-env-update [var ★] ... kind-env) 317 | type-env 318 | expr) : type) 319 | (where type (unique-type-of sort-env kind-env type-env 320 | (T-λ [var ...] expr)))] 321 | [(annotate sort-env kind-env type-env (T-APP expr type_arg ...)) 322 | (T-APP (annotate sort-env kind-env type-env expr) type_arg ... : type) 323 | (where type (unique-type-of sort-env kind-env type-env 324 | (T-APP expr type_arg ...)))] 325 | 326 | [(annotate sort-env kind-env type-env (I-λ [(var sort) ...] expr)) 327 | (I-λ [(var sort) ...] 328 | (annotate (sort-env-update (var sort) ... sort-env) 329 | kind-env type-env 330 | expr) : type) 331 | (where type (unique-type-of sort-env kind-env type-env 332 | (I-λ [(var sort) ...] expr)))] 333 | [(annotate sort-env kind-env type-env (I-APP expr idx ...)) 334 | (I-APP (annotate sort-env kind-env type-env expr) idx ... : type) 335 | (where type (unique-type-of sort-env kind-env type-env 336 | (I-APP expr idx ...)))] 337 | 338 | [(annotate sort-env kind-env type-env (PACK idx ... expr type)) 339 | (PACK idx ... (annotate sort-env kind-env type-env expr) : type)] 340 | [(annotate sort-env kind-env type-env (UNPACK ([var_witness ... var_contents] 341 | ⇐ expr_sum) expr_body)) 342 | (UNPACK ([var_witness ... var_contents] 343 | ⇐ (annotate sort-env kind-env type-env expr_sum)) 344 | (annotate (sort-env-update [var_witness sort] ... sort-env) 345 | kind-env 346 | (type-env-update [var_contents type_contents] type-env) 347 | expr_body) : type_unpack) 348 | (where type_unpack (unique-type-of sort-env kind-env type-env 349 | (UNPACK ([var_witness ... var_contents] 350 | ⇐ expr_sum) expr_body))) 351 | (where (Σ ([var sort] ...) type_contents) 352 | (unique-type-of sort-env kind-env type-env expr_sum))] 353 | 354 | [(annotate sort-env kind-env type-env (λ [(var type_arg) ...] expr)) 355 | (λ [(var type_arg) ...] 356 | (annotate sort-env kind-env 357 | (type-env-update (var type_arg) ... type-env) 358 | expr) : type) 359 | (where type (unique-type-of sort-env kind-env type-env 360 | (λ [(var type_arg) ...] expr)))] 361 | [(annotate sort-env kind-env type-env op) op] 362 | [(annotate sort-env kind-env type-env base) base]) 363 | ; specialized version for closed terms 364 | (define-metafunction Annotated 365 | annotate/cl : el-expr -> el-expr:t 366 | [(annotate/cl el-expr) (annotate [] [] [] el-expr)]) 367 | 368 | ; drop type annotations to convert from expr:t to expr 369 | ; assumes the expr:t is actually well-typed 370 | (define-metafunction Annotated 371 | type-erase : el-expr:t -> el-expr 372 | [(type-erase (expr:t_fun expr:t_arg ... : type)) 373 | ((type-erase expr:t_fun) (type-erase expr:t_arg) ...)] 374 | [(type-erase (var : type)) var] 375 | 376 | [(type-erase (A type_elt (num ...) (el-expr:t ...) : type_arr)) 377 | (A type_elt (num ...) ((type-erase el-expr:t) ...))] 378 | [(type-erase (A (num ...) (el-expr:t_0 el-expr:t_1 ...) : type_arr)) 379 | (A (num ...) ((type-erase el-expr:t_0) (type-erase el-expr:t_1) ...))] 380 | ; if the array has no elements, we must identify the element type and 381 | ; put an element annotation for it 382 | [(type-erase (A (num ...) (el-expr:t ...) : type)) 383 | (A type_elt (num ...) ((type-erase el-expr:t) ...)) 384 | (where (Array (S num ... num_extras ...) type_atom) (canonicalize-type type)) 385 | (where type_elt (canonicalize-type (Array (S num_extras ...) type_atom)))] 386 | 387 | [(type-erase (T-λ [var ...] expr:t : type)) 388 | (T-λ [var ...] (type-erase expr:t))] 389 | [(type-erase (T-APP expr:t type_arg ... : type)) 390 | (T-APP (type-erase expr:t) type_arg ...)] 391 | 392 | [(type-erase (PACK idx ... expr:t : type)) 393 | (PACK idx ... (type-erase expr:t) type)] 394 | [(type-erase (UNPACK ([var_witness ... var_contents] ⇐ expr:t_sum) 395 | expr:t_body : type)) 396 | (UNPACK ([var_witness ... var_contents] ⇐ (type-erase expr:t_sum)) 397 | (type-erase expr:t_body))] 398 | 399 | [(type-erase (I-λ [(var sort) ...] expr:t : type)) 400 | (I-λ [(var sort) ...] (type-erase expr:t))] 401 | [(type-erase (I-APP expr:t idx ... : type)) 402 | (I-APP (type-erase expr:t) idx ...)] 403 | 404 | [(type-erase (λ [(var type_arg) ...] expr:t : type_fun)) 405 | (λ [(var type_arg) ...] (type-erase expr:t))] 406 | [(type-erase op) op] 407 | [(type-erase base) base]) 408 | 409 | ; extract an el-expr:t's type 410 | (define-metafunction Annotated 411 | extract-annotation : el-expr:t -> type 412 | [(extract-annotation (any ... : type)) type]) 413 | 414 | ; substitute an expr:t into an expr:t 415 | (define-metafunction Annotated 416 | expr:t/expr:t-sub : expr:t-env el-expr:t -> el-expr:t 417 | [(expr:t/expr:t-sub ([var_0 expr:t_0] ... [var expr:t] [var_1 expr:t_1] ...) 418 | (var : type)) 419 | expr:t] 420 | [(expr:t/expr:t-sub expr:t-env var) (var : type)] 421 | 422 | [(expr:t/expr:t-sub expr:t-env (expr:t_fun expr:t_arg ... : type)) 423 | ((expr:t/expr:t-sub expr:t-env expr:t_fun) 424 | (expr:t/expr:t-sub expr:t-env expr:t_arg) ... : type)] 425 | 426 | [(expr:t/expr:t-sub expr:t-env (A type_elt (num ...) (el-expr:t ...) : type)) 427 | (A type_elt (num ...) [(expr:t/expr:t-sub expr:t-env el-expr:t) ...] : type)] 428 | [(expr:t/expr:t-sub expr:t-env (A (num ...) (el-expr:t ...) : type)) 429 | (A (num ...) [(expr:t/expr:t-sub expr:t-env el-expr:t) ...] : type)] 430 | 431 | [(expr:t/expr:t-sub expr:t-env (T-λ [var ...] expr:t : type)) 432 | (T-λ [var ...] (expr:t/expr:t-sub expr:t-env expr:t) : type)] 433 | [(expr:t/expr:t-sub expr:t-env (T-APP expr:t type_arg ... : type)) 434 | (T-APP (expr:t/expr:t-sub expr:t-env expr:t) type_arg ... : type)] 435 | 436 | [(expr:t/expr:t-sub expr:t-env (PACK idx ... expr:t : type)) 437 | (PACK idx ... (expr:t/expr:t-sub expr:t-env expr:t) : type)] 438 | [(expr:t/expr:t-sub 439 | expr:t-env (UNPACK ([var_witness ... var_contents] ⇐ expr:t_sum) 440 | expr:t_body : type)) 441 | (UNPACK ([var_witness ... var_contents] 442 | ⇐ (expr:t/expr:t-sub expr:t-env expr:t_sum)) 443 | (expr:t/expr:t-sub (shadow [var_contents] expr:t-env) 444 | expr:t_body) : type)] 445 | [(expr:t/expr:t-sub expr:t-env (I-λ [(var sort) ...] expr:t : type)) 446 | (I-λ [(var sort) ...] (expr:t/expr:t-sub expr:t-env expr:t) : type)] 447 | [(expr:t/expr:t-sub expr:t-env (T-APP expr:t type_arg ... : type)) 448 | (T-APP (expr:t/expr:t-sub expr:t-env expr:t) type_arg ... : type)] 449 | 450 | [(expr:t/expr:t-sub expr:t-env op) op] 451 | [(expr:t/expr:t-sub expr:t-env base) base] 452 | [(expr:t/expr:t-sub expr:t-env (λ [(var type_arg) ...] expr:t : type_fun)) 453 | (λ [(var type_arg) ...] 454 | (expr:t/expr:t-sub (shadow (var ...) expr:t-env) expr:t) : type_fun)]) 455 | 456 | ; substitute a type into an expr:t 457 | (define-metafunction Annotated 458 | type/expr:t-sub : type-env el-expr:t -> el-expr:t 459 | [(type/expr:t-sub type-env (var : type)) 460 | (var : (type/type-sub type-env type))] 461 | 462 | [(type/expr:t-sub type-env (expr:t_fun expr:t_arg ... : type)) 463 | ((type/expr:t-sub type-env expr:t_fun) 464 | (type/expr:t-sub type-env expr:t_arg) ... 465 | : (type/type-sub type-env type))] 466 | 467 | [(type/expr:t-sub type-env (A type_elt (num ...) (el-expr:t ...) : type)) 468 | (A (type/expr:t-sub type-env type_elt) 469 | (num ...) ((type/expr:t-sub type-env el-expr:t) ...) 470 | : (type/type-sub type-env type))] 471 | [(type/expr:t-sub type-env (A (num ...) (el-expr:t ...) : type)) 472 | (A (num ...) ((type/expr:t-sub type-env el-expr:t) ...) 473 | : (type/type-sub type-env type))] 474 | 475 | [(type/expr:t-sub type-env (T-λ [var ...] expr:t : type)) 476 | (T-λ [var ...] 477 | (type/expr:t-sub (shadow (var ...) type-env) expr:t) 478 | : (type/type-sub type-env type))] 479 | [(type/expr:t-sub type-env (T-APP expr:t type_arg ... : type)) 480 | (T-APP (type/expr:t-sub type-env expr:t) 481 | (type/type-sub type-env type_arg) ... 482 | : (type/type-sub type-env type))] 483 | 484 | [(type/expr:t-sub type-env (PACK idx ... expr:t : type)) 485 | (PACK idx ... (type/expr:t-sub type-env expr:t) 486 | : (type/type-sub type-env type))] 487 | [(type/expr:t-sub type-env 488 | (UNPACK ([var_witness ... var_contents] ⇐ expr:t_sum) 489 | expr:t_body : type)) 490 | (UNPACK ([var_witness ... var_contents] 491 | ⇐ (type/expr:t-sub type-env expr:t_sum)) 492 | (type/expr:t-sub type-env expr:t_body) 493 | : (type/type-sub type-env type))] 494 | 495 | [(type/expr:t-sub type-env (I-λ [(var sort) ...] expr:t : type)) 496 | (I-λ [var ...] (type/expr:t-sub type-env expr:t) 497 | : (type/type-sub type-env type))] 498 | [(type/expr:t-sub type-env (I-APP expr:t idx_arg ... : type)) 499 | (I-APP (type/expr:t-sub type-env expr:t) idx_arg ... 500 | : (type/type-sub type-env type))] 501 | 502 | [(type/expr:t-sub type-env op) op] 503 | [(type/expr:t-sub type-env base) base] 504 | [(type/expr:t-sub type-env (λ [(var type_arg) ...] expr:t : type_fun)) 505 | (λ [(var (type/type-sub type-env type_arg)) ...] 506 | (type/expr:t-sub type-env expr:t) 507 | : (type/type-sub type-env type_fun))]) 508 | 509 | ; substitute an index into an expr:t 510 | (define-metafunction Annotated 511 | idx/expr:t-sub : idx-env el-expr:t -> el-expr:t 512 | [(idx/expr:t-sub idx-env (var : type)) (var : (idx/type-sub idx-env type))] 513 | 514 | [(idx/expr:t-sub idx-env (expr:t_fun expr:t_arg ... : type)) 515 | ((idx/expr:t-sub idx-env expr:t_fun) 516 | (idx/expr:t-sub idx-env expr:t_arg) ... 517 | : (idx/type-sub idx-env type))] 518 | 519 | [(idx/expr:t-sub idx-env (A type_elt (num ...) (el-expr:t ...) : type)) 520 | (A (idx/type-sub idx-env type_elt) 521 | (num ...) ((idx/expr:t-sub idx-env el-expr:t) ...) 522 | : (idx/type-sub idx-env type))] 523 | [(idx/expr:t-sub idx-env (A (num ...) (el-expr:t ...) : type)) 524 | (A (num ...) ((idx/expr:t-sub idx-env el-expr:t) ...) 525 | : (idx/type-sub idx-env type))] 526 | 527 | [(idx/expr:t-sub idx-env (T-λ [var ...] expr:t : type)) 528 | (T-λ [var ...] (idx/expr:t-sub idx-env expr:t) 529 | : (idx/type-sub idx-env type))] 530 | [(idx/expr:t-sub idx-env (T-APP expr:t type_arg ... : type)) 531 | (T-APP (idx/expr:t-sub idx-env expr:t) (idx/type-sub idx-env type_arg) ... 532 | : (idx/type-sub idx-env type))] 533 | 534 | [(idx/expr:t-sub idx-env (PACK idx ... expr:t : type)) 535 | (PACK (idx/idx-sub idx-env idx) ... (idx/expr:t-sub idx-env expr:t) 536 | : (idx/type-sub idx-env type))] 537 | [(idx/expr:t-sub idx-env (UNPACK ([var_witness ... var_contents] ⇐ expr:t_sum) 538 | expr:t_body : type)) 539 | (UNPACK ([var_witness ... var_contents] 540 | ⇐ (idx/expr:t-sub idx-env expr:t_sum)) 541 | (idx/expr:t-sub idx-env expr:t_body) 542 | : (idx/type-sub idx-env type))] 543 | 544 | [(idx/expr:t-sub idx-env (I-λ [(var sort) ...] expr:t : type)) 545 | (I-λ [(var sort) ...] (idx/expr:t-sub (shadow (var ...) idx-env) expr:t) 546 | : (idx/type-sub idx-env type))] 547 | [(idx/expr:t-sub idx-env (I-APP expr:t idx ... : type)) 548 | (I-APP (idx/expr:t-sub idx-env expr:t) (idx/idx-sub idx) ... 549 | : (idx/type-sub idx-env type))] 550 | 551 | [(idx/expr:t-sub idx-env op) op] 552 | [(idx/expr:t-sub idx-env base) base] 553 | [(idx/expr:t-sub idx-env (λ [(var type_arg) ...] expr:t : type_fun)) 554 | (λ [(var (idx/type-sub idx-env type_arg)) ...] 555 | (idx/expr:t-sub idx-env expr:t) 556 | : (idx/type-sub idx-env type_fun))]) 557 | 558 | ; like using traces with ->Typed, but hide the type annotations 559 | (define (simple-trace t) 560 | (define t/ann 561 | (cond [(redex-match Annotated expr:t t) t] 562 | [(redex-match Annotated expr t) (term (annotate/cl ,t))])) 563 | (traces #:pp (λ (v port width text) 564 | (default-pretty-printer 565 | (term (type-erase ,v)) 566 | port width text)) 567 | ->Typed t/ann)) 568 | 569 | 570 | (module+ 571 | test 572 | (require rackunit) 573 | 574 | (check-equal? 575 | (deterministic-reduce 576 | ->Typed 577 | (term (annotate/cl ((A [] [+]) (A [] [1]) (A [] [1]))))) 578 | (term (A [] [2] : (Array (S) Num)))) 579 | 580 | (check-equal? 581 | (deterministic-reduce 582 | ->Typed 583 | (term (annotate/cl ((A [] [+]) (A [] [1]) 584 | ((A [] [+]) (A [] [1]) (A [] [1])))))) 585 | (term (A [] [3] : (Array (S) Num)))) 586 | 587 | (check-equal? 588 | (deterministic-reduce 589 | ->Typed 590 | (term (annotate/cl ((A [] [+]) ((A [] [+]) (A [] [1]) (A [] [1])) 591 | (A [] [1]))))) 592 | (term (A [] [3] : (Array (S) Num)))) 593 | 594 | (check-equal? 595 | (deterministic-reduce 596 | ->Typed 597 | (term (annotate/cl ((A [2] [+ -]) (A [2] [10 20]) (A [2] [3 4]))))) 598 | (term (annotate/cl (A [2] [13 16])))) 599 | 600 | (check-equal? 601 | (deterministic-reduce 602 | ->Typed 603 | (term (annotate/cl ((A [] [+]) (A [2 3] [1 2 3 4 5 6]) (A [2] [10 20]))))) 604 | (term (annotate/cl (A [2 3] [11 12 13 24 25 26])))) 605 | 606 | (check-equal? 607 | (deterministic-reduce 608 | ->Typed 609 | (term (annotate/cl ((A [] [+]) (A [3 2] [1 2 3 4 5 6]) (A [3] [10 20 30]))))) 610 | (term (annotate/cl (A [3 2] [11 12 23 24 35 36])))) 611 | 612 | (check-equal? 613 | (deterministic-reduce 614 | ->Typed 615 | (term (annotate/cl ((A [2] [+ -]) (A [2 3] [1 2 3 4 5 6]) (A [2] [10 20]))))) 616 | (term (annotate/cl (A [2 3] [11 12 13 -16 -15 -14])))) 617 | 618 | (check-equal? 619 | (deterministic-reduce 620 | ->Typed 621 | (term (annotate/cl ((A [] [(λ [(x (Array (S) Num))] x)]) 622 | (A [6] [1 2 3 4 5 6]))))) 623 | (term (annotate/cl (A [6] [1 2 3 4 5 6])))) 624 | 625 | (check-equal? 626 | (deterministic-reduce 627 | ->Typed 628 | (term (annotate/cl ((T-APP (T-λ [l] (A [] [(λ [(x (Array (S) l))] x)])) Num) 629 | (A [6] [1 2 3 4 5 6]))))) 630 | (term (annotate/cl (A [6] [1 2 3 4 5 6])))) 631 | 632 | (check-equal? 633 | (deterministic-reduce 634 | ->Typed 635 | (term (annotate/cl ((I-APP (I-λ [(n Nat)] 636 | (A [] [(λ [(x (Array (S n) Num))] 637 | ((A [] [+]) (A [] [1]) x))])) 3) 638 | (A [3] [20 30 40]))))) 639 | (term (annotate/cl (A [3] [21 31 41])))) 640 | 641 | (check-equal? 642 | (deterministic-reduce 643 | ->Typed 644 | (term (annotate/cl ((I-APP (I-λ [(n Nat)] 645 | (A [] [(λ [(x (Array (S n) Num))] 646 | ((A [] [+]) (A [] [1]) x))])) 3) 647 | (A [2 3] [20 30 40 500 600 700]))))) 648 | (term (annotate/cl (A [2 3] [21 31 41 501 601 701])))) 649 | 650 | (check-equal? 651 | (deterministic-reduce 652 | ->Typed 653 | (term (annotate/cl (UNPACK ([a b x] 654 | ⇐ (PACK 3 2 ((A [] [+]) (A [3 2] [1 2 3 4 5 6]) 655 | (A [] [2])) 656 | (Σ ([a Nat] [b Nat]) 657 | (Array (S a b) Num)))) 658 | (PACK a b ((A [] [+]) (A [] [1]) x) 659 | (Σ ([a Nat] [b Nat]) 660 | (Array (S a b) Num))))))) 661 | (term (annotate/cl (PACK 3 2 (A [3 2] [4 5 6 7 8 9]) 662 | (Σ ([a Nat] [b Nat]) 663 | (Array (S a b) Num)))))) 664 | 665 | (check-equal? 666 | (term (annotate [][][] ((A [] [+]) (A Num [2] [1 3]) (A [] [4])))) 667 | (term ((A [] [+] : (Array (S) ((Array (S) Num) 668 | (Array (S) Num) 669 | -> (Array (S) Num)))) 670 | (A [2] [1 3] : (Array (S 2) Num)) 671 | (A [] [4]: (Array (S) Num)) 672 | : (Array (S 2) Num)))) 673 | 674 | (check-equal? 675 | (term (annotate 676 | [][][] 677 | (I-λ [(s1 Shape) (s2 Shape) (s3 Shape)] 678 | (T-λ [α β γ] 679 | (A [] [(λ [(f (Array (S) ((Array s1 α) -> (Array s2 β)))) 680 | (g (Array (S) ((Array s2 β) -> (Array s3 γ))))] 681 | (A [] [(λ [(x (Array s1 α))] (g (f x)))]))]))))) 682 | (term (I-λ [(s1 Shape) (s2 Shape) (s3 Shape)] 683 | (T-λ [α β γ] 684 | (A [] [(λ [(f (Array (S) ((Array s1 α) -> (Array s2 β)))) 685 | (g (Array (S) ((Array s2 β) -> (Array s3 γ))))] 686 | (A [] [(λ [(x (Array s1 α))] 687 | ([g : (Array (S) ((Array s2 β) 688 | -> (Array s3 γ)))] 689 | ([f : (Array (S) ((Array s1 α) 690 | -> (Array s2 β)))] 691 | [x : (Array s1 α)] 692 | : (Array s2 β)) 693 | : (Array s3 γ)) 694 | : ((Array s1 α) -> (Array s3 γ)))] 695 | : (Array (S) ((Array s1 α) -> (Array s3 γ)))) 696 | : ((Array (S) ((Array s1 α) -> (Array s2 β))) 697 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 698 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))] 699 | : (Array (S) 700 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 701 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 702 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))) 703 | : (∀ [α β γ] 704 | (Array (S) 705 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 706 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 707 | -> (Array (S) ((Array s1 α) -> (Array s3 γ))))))) 708 | : (Π [(s1 Shape) (s2 Shape) (s3 Shape)] 709 | (∀ [α β γ] 710 | (Array (S) 711 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 712 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 713 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))))))) 714 | 715 | (check-equal? 716 | (term (type-erase (A (3) [(A (2) [1 2] : (Array (S 2) Num)) 717 | (A (2) [3 4] : (Array (S 2) Num)) 718 | (A (2) [5 6] : (Array (S 2) Num))] 719 | : (Array (S 3) (Array (S 2) Num))))) 720 | (term (A [3] [(A [2] [1 2]) 721 | (A [2] [3 4]) 722 | (A [2] [5 6])]))) 723 | 724 | (check-equal? 725 | (term 726 | (type-erase 727 | (I-λ [(s1 Shape) (s2 Shape) (s3 Shape)] 728 | (T-λ [α β γ] 729 | (A [] [(λ [(f (Array (S) ((Array s1 α) -> (Array s2 β)))) 730 | (g (Array (S) ((Array s2 β) -> (Array s3 γ))))] 731 | (A [] [(λ [(x (Array s1 α))] 732 | ([g : (Array (S) ((Array s2 β) 733 | -> (Array s3 γ)))] 734 | ([f : (Array (S) ((Array s1 α) 735 | -> (Array s2 β)))] 736 | [x : (Array s1 α)] 737 | : (Array s2 β)) 738 | : (Array s3 γ)) 739 | : ((Array s1 α) -> (Array s3 γ)))] 740 | : (Array (S) ((Array s1 α) -> (Array s3 γ)))) 741 | : ((Array (S) ((Array s1 α) -> (Array s2 β))) 742 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 743 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))] 744 | : (Array (S) 745 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 746 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 747 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))) 748 | : (∀ [α β γ] 749 | (Array (S) 750 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 751 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 752 | -> (Array (S) ((Array s1 α) -> (Array s3 γ))))))) 753 | : (Π [(s1 Shape) (s2 Shape) (s3 Shape)] 754 | (∀ [α β γ] 755 | (Array (S) 756 | ((Array (S) ((Array s1 α) -> (Array s2 β))) 757 | (Array (S) ((Array s2 β) -> (Array s3 γ))) 758 | -> (Array (S) ((Array s1 α) -> (Array s3 γ)))))))))) 759 | (term (I-λ [(s1 Shape) (s2 Shape) (s3 Shape)] 760 | (T-λ [α β γ] 761 | (A [] [(λ [(f (Array (S) ((Array s1 α) -> (Array s2 β)))) 762 | (g (Array (S) ((Array s2 β) -> (Array s3 γ))))] 763 | (A [] [(λ [(x (Array s1 α))] 764 | (g (f x)))]))])))))) 765 | --------------------------------------------------------------------------------