├── .gitignore ├── package.json ├── __snapshots__ └── test.js.snap ├── README.md ├── test.js └── compiler.scm /.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "devDependencies": { 3 | "jest": "^23.3.0", 4 | "prettier": "^1.13.7" 5 | }, 6 | "scripts": { 7 | "test": "jest" 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /__snapshots__/test.js.snap: -------------------------------------------------------------------------------- 1 | // Jest Snapshot v1, https://goo.gl/fbAQLP 2 | 3 | exports[`+ should work 1`] = ` 4 | "3 + 4; 5 | " 6 | `; 7 | 8 | exports[`arrays should be able to car lists 1`] = ` 9 | "Array(1, 2, 3)[0]; 10 | " 11 | `; 12 | 13 | exports[`arrays should be able to car lists 2`] = `1`; 14 | 15 | exports[`arrays should be able to cdr lists 1`] = ` 16 | "Array(1, 2, 3).slice(1); 17 | " 18 | `; 19 | 20 | exports[`arrays should be able to cdr lists 2`] = ` 21 | Array [ 22 | 2, 23 | 3, 24 | ] 25 | `; 26 | 27 | exports[`arrays should be able to recurse until an empty list 1`] = ` 28 | "(() => { 29 | function sum(ns) { 30 | return 0 === ns.length ? 0 : ns[0] + sum(ns.slice(1)); 31 | } 32 | return sum(Array(1, 3, 5, 7, 9)); 33 | })(); 34 | " 35 | `; 36 | 37 | exports[`arrays should be able to recurse until an empty list 2`] = `25`; 38 | 39 | exports[`big block of code from main should match snapshots 1`] = ` 40 | "(() => { 41 | function string$join(strs, joiner) { 42 | return (() => { 43 | function helper(strs, acc) { 44 | return 0 === strs.length 45 | ? acc 46 | : helper(strs.slice(1), acc + (joiner + strs[0])); 47 | } 48 | return 0 === strs.length ? \\"\\" : helper(strs.slice(1), strs[0]); 49 | })(); 50 | } 51 | return string$join(Array(\\"apples\\", \\"bananas\\", \\"cucumbers\\"), \\",\\"); 52 | })(); 53 | " 54 | `; 55 | 56 | exports[`big block of code from main should match snapshots 2`] = `"apples,bananas,cucumbers"`; 57 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## scheme-to-js 2 | a scheme->js compiler written in scheme 3 | 4 | ### Hi 👋 5 | 6 | This is a Scheme compiler written in Scheme that produces JavaScript. 7 | 8 | I've done this before (in JavaScript) - https://github.com/jdan/lispjs. You'll find that writing the 9 | compiler in Scheme itself means I can effectively skip parsing. 10 | 11 | ### Running 12 | 13 | I've written this repository with [Chez Scheme](https://github.com/cisco/ChezScheme) in mind. It's pretty 14 | tiny and easy to install. I typically [build it without X11](https://github.com/cisco/ChezScheme/issues/84#issuecomment-401233680). 15 | 16 | ### Example 17 | 18 | ``` 19 | $ cat example.scm 20 | (load "compiler.scm") 21 | 22 | (display 23 | (scheme->js 24 | (begin 25 | (define (string-join strs joiner) 26 | (define (helper strs acc) 27 | (if (null? strs) 28 | acc 29 | (helper (cdr strs) 30 | (+ acc 31 | (+ joiner (car strs)))))) 32 | (if (null? strs) 33 | "" 34 | (helper (cdr strs) (car strs)))) 35 | (println (string-join (Array "apples" "bananas" "cucumbers") ","))))) 36 | $ scheme --script example.scm | prettier --parser babylon 37 | (() => { 38 | function string$join(strs, joiner) { 39 | return (() => { 40 | function helper(strs, acc) { 41 | return 0 === strs.length 42 | ? acc 43 | : helper(strs.slice(1), acc + (joiner + strs[0])); 44 | } 45 | return 0 === strs.length ? "" : helper(strs.slice(1), strs[0]); 46 | })(); 47 | } 48 | return console.log(string$join(Array("apples", "bananas", "cucumbers"), ",")); 49 | })(); 50 | $ scheme --script example.scm | prettier --parser babylon | node 51 | apples,bananas,cucumbers 52 | ``` 53 | -------------------------------------------------------------------------------- /test.js: -------------------------------------------------------------------------------- 1 | const { spawn } = require("child_process") 2 | const prettier = require("prettier") 3 | 4 | function compile(code, cb) { 5 | const scheme = spawn("scheme", ["-q"]) 6 | 7 | let output = "" 8 | scheme.stdout.on("data", data => { 9 | output += data 10 | }) 11 | scheme.on("close", () => { 12 | cb(prettier.format(output, { parser: "babylon" })) 13 | }) 14 | 15 | scheme.stdin.end(` 16 | (load "compiler.scm") 17 | (display (scheme->js ${code})) 18 | `) 19 | } 20 | 21 | describe("+", () => { 22 | it("should work", done => { 23 | compile(`(+ 3 4)`, output => { 24 | expect(output).toMatchSnapshot() 25 | done() 26 | }) 27 | }) 28 | }) 29 | 30 | describe("big block of code from main", () => { 31 | it("should match snapshots", done => { 32 | compile( 33 | ` 34 | (begin 35 | (define (string-join strs joiner) 36 | (define (helper strs acc) 37 | (if (null? strs) 38 | acc 39 | (helper (cdr strs) 40 | (+ acc 41 | (+ joiner (car strs)))))) 42 | (if (null? strs) 43 | "" 44 | (helper (cdr strs) (car strs)))) 45 | (string-join (Array "apples" "bananas" "cucumbers") ",")))) 46 | `, 47 | output => { 48 | expect(output).toMatchSnapshot() 49 | expect(eval(output)).toMatchSnapshot() 50 | done() 51 | } 52 | ) 53 | }) 54 | }) 55 | 56 | describe("arrays", () => { 57 | it("should be able to car lists", done => { 58 | compile("(car (Array 1 2 3))", output => { 59 | expect(output).toMatchSnapshot() 60 | expect(eval(output)).toMatchSnapshot() 61 | done() 62 | }) 63 | }) 64 | 65 | it("should be able to cdr lists", done => { 66 | compile("(cdr (Array 1 2 3))", output => { 67 | expect(output).toMatchSnapshot() 68 | expect(eval(output)).toMatchSnapshot() 69 | done() 70 | }) 71 | }) 72 | 73 | it("should be able to recurse until an empty list", done => { 74 | compile( 75 | ` 76 | (begin 77 | (define (sum ns) 78 | (if (null? ns) 79 | 0 80 | (+ (car ns) (sum (cdr ns))))) 81 | (sum (Array 1 3 5 7 9)))) 82 | `, 83 | output => { 84 | expect(output).toMatchSnapshot() 85 | expect(eval(output)).toMatchSnapshot() 86 | done() 87 | } 88 | ) 89 | }) 90 | }) 91 | -------------------------------------------------------------------------------- /compiler.scm: -------------------------------------------------------------------------------- 1 | (define (scheme->js* expr) 2 | (cond [(tagged-expr? 'if expr) (if-expr->js expr)] 3 | [(tagged-expr? 'lambda expr) (lambda-expr->js expr)] 4 | [(tagged-expr? 'define expr) (define-expr->js expr)] 5 | [(tagged-expr? 'begin expr) (begin-expr->js expr)] 6 | [(tagged-expr? 'println expr) (println-expr->js expr)] 7 | 8 | [(tagged-expr? '= expr) (js-infix "===" expr)] 9 | [(tagged-expr? '+ expr) (js-infix "+" expr)] 10 | [(tagged-expr? '- expr) (js-infix "-" expr)] 11 | [(tagged-expr? '* expr) (js-infix "*" expr)] 12 | [(tagged-expr? '/ expr) (js-infix "/" expr)] 13 | 14 | ; Some array methods 15 | [(tagged-expr? 'null? expr) (null?-expr->js expr)] 16 | [(tagged-expr? 'get expr) (get-expr->js expr)] 17 | [(tagged-expr? 'car expr) (car-expr->js expr)] 18 | [(tagged-expr? 'cdr expr) (cdr-expr->js expr)] 19 | 20 | [(pair? expr) 21 | (cond [(null? expr) "[]"] 22 | [(map-expr? expr) (map-expr->js expr)] 23 | [else (apply-expr->js expr)])] 24 | 25 | [(boolean? expr) 26 | (if expr "true" "false")] 27 | [(string? expr) 28 | (string-append "\"" expr "\"")] 29 | [(number? expr) 30 | (number->string expr)] 31 | [(symbol? expr) 32 | (symbol->string* expr)] 33 | 34 | [else 35 | (error "Undefined expression type:" expr)])) 36 | 37 | ; A quick macro so we don't need to quote the body 38 | (define-syntax scheme->js 39 | (syntax-rules () 40 | [(_ expr) 41 | (scheme->js* (quote expr))])) 42 | 43 | (define (tagged-expr? tag expr) 44 | (and (pair? expr) 45 | (eq? (car expr) tag))) 46 | 47 | (define (if-expr->js expr) 48 | (let [(condition (scheme->js* (cadr expr))) 49 | (consequent (scheme->js* (caddr expr))) 50 | (alternate (scheme->js* (cadddr expr)))] 51 | (string-append 52 | "(" condition ")" 53 | "?" 54 | "(" consequent ")" 55 | ":" 56 | "(" alternate ")"))) 57 | 58 | (define (lambda-expr->js expr) 59 | (let [(vars (map symbol->string* (cadr expr))) 60 | (body (scheme->js* (caddr expr)))] 61 | (string-append 62 | "((" (string-join vars ",") ") => " body ")"))) 63 | 64 | (define (define-expr->js expr) 65 | (let* [(name (symbol->string* (caadr expr))) 66 | (vars (map symbol->string* (cdadr expr))) 67 | (body (scheme->js* (cons 'begin (cddr expr))))] 68 | (string-append 69 | "function " name "(" (string-join vars ",") ") {" 70 | "return " body 71 | "}"))) 72 | 73 | (define (begin-expr->js expr) 74 | (define optimized-single-statement car) 75 | 76 | (let [(statements (map scheme->js* (cdr expr)))] 77 | (if (= 1 (length statements)) 78 | (optimized-single-statement statements) 79 | (let* [(flipped* (reverse statements)) 80 | (last (car flipped*)) 81 | (all-but-last (reverse (cdr flipped*)))] 82 | (string-append 83 | "(() => {" 84 | (string-join all-but-last ";") 85 | "return " last 86 | "})()"))))) 87 | 88 | (define (apply-expr->js expr) 89 | (let [(fn (scheme->js* (car expr))) 90 | (vars (map scheme->js* (cdr expr)))] 91 | (string-append 92 | "((" fn ")(" (string-join vars ",") "))"))) 93 | 94 | (define (println-expr->js expr) 95 | (scheme->js* (cons 'console.log (cdr expr)))) 96 | 97 | (define (null?-expr->js expr) 98 | (let [(ls (scheme->js* (cadr expr)))] 99 | (string-append "(0 === (" ls ").length)"))) 100 | 101 | (define (get-expr->js expr) 102 | (let [(ls (scheme->js* (cadr expr))) 103 | (idx (scheme->js* (caddr expr)))] 104 | (string-append "(" ls ")[" idx "]"))) 105 | 106 | (define (car-expr->js expr) 107 | (get-expr->js `(get ,(cadr expr) 0))) 108 | 109 | (define (cdr-expr->js expr) 110 | (let [(ls (scheme->js* (cadr expr)))] 111 | (string-append "(" ls ").slice(1)"))) 112 | 113 | (define (map-expr? expr) 114 | (and (pair? expr) 115 | (> (length expr) 0) 116 | (even? (length expr)) 117 | (eq? #\: (string-ref (symbol->string (car expr)) 0)))) 118 | 119 | (define (map-expr->js expr) 120 | (define (make-term key value) 121 | (string-append "\"" (symbol->string* key) "\": " 122 | (scheme->js* value) 123 | ",")) 124 | (define (helper terms acc) 125 | (if (null? terms) 126 | acc 127 | (helper (cddr terms) 128 | (cons (make-term (car terms) (cadr terms)) 129 | acc)))) 130 | (string-join 131 | (list "{" 132 | (string-join (helper expr '()) "") 133 | "}") 134 | "")) 135 | 136 | (define (js-infix op expr) 137 | (string-append 138 | "(" 139 | (scheme->js* (cadr expr)) 140 | op 141 | (scheme->js* (caddr expr)) 142 | ")")) 143 | 144 | (define (string-join strs joiner) 145 | (define (helper strs acc) 146 | (if (null? strs) 147 | acc 148 | (helper (cdr strs) 149 | (string-append 150 | acc 151 | joiner 152 | (car strs))))) 153 | (if (null? strs) 154 | "" 155 | (helper (cdr strs) (car strs)))) 156 | 157 | (define (string-replace str targets replacement) 158 | (let [(replacement* (string-ref replacement 0)) 159 | (targets* (string->list targets))] 160 | (list->string 161 | (map (lambda (char) 162 | (if (member char targets*) 163 | replacement* 164 | char)) 165 | (string->list str))))) 166 | 167 | (define (symbol->string* sym) 168 | (string-replace (symbol->string sym) ":->*?" "$")) 169 | --------------------------------------------------------------------------------