209 lines
6.2 KiB
Scheme
209 lines
6.2 KiB
Scheme
;;;; libprebirth Replacement for Rebirth Lisp
|
||
;;;;
|
||
;;;; Copyright (C) 2017, 2018 Mike Gerwitz
|
||
;;;;
|
||
;;;; This file is part of Ulambda Scheme.
|
||
;;;;
|
||
;;;; Ulambda Scheme is free software: you can redistribute it and/or modify
|
||
;;;; it under the terms of the GNU Affero General Public License as
|
||
;;;; published by the Free Software Foundation, either version 3 of the
|
||
;;;; License, or (at your option) any later version.
|
||
;;;;
|
||
;;;; This program is distributed in the hope that it will be useful,
|
||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;;; GNU General Public License for more details.
|
||
;;;;
|
||
;;;; You should have received a copy of the GNU Affero General Public License
|
||
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
;;;;
|
||
|
||
|
||
|
||
;;; Commentary:
|
||
|
||
;;; THIS IS BOOTSTRAP CODE INTENDED FOR USE ONLY IN REBIRTH.
|
||
;;;
|
||
;;;
|
||
;;; === STEP 0 ===
|
||
;;;
|
||
;;; The first step in the Rebirth process is to liberate ourselves from
|
||
;;; libprebirth.
|
||
;;;
|
||
;;; Here we define the libprebirth primitives. When we first compile
|
||
;;; Rebirth with Birth, `string->es' is not yet available, because it is
|
||
;;; only implemented in Rebirth. Further, Birth includes libprebirth in
|
||
;;; its output, so we cannot blindly redefine the procedures without
|
||
;;; producing an error.
|
||
;;;
|
||
;;; Once Rebirth is compiled with Birth, Rebirth can then compile
|
||
;;; itself. Since Rebirth _does_ implement `string->es', and further _does
|
||
;;; not_ include libprebirth in its output, we can define the libprebirth
|
||
;;; primitives ourselves in Rebirth Lisp. Cut the cord.
|
||
;;;
|
||
;;; Some of these definitions aren't valid: variable arguments, for
|
||
;;; example, aren't represented _at all_---the `define' form will be
|
||
;;; properly implemented in the future to correct this.
|
||
;;;
|
||
|
||
;;; Code:
|
||
|
||
|
||
|
||
(cond-expand
|
||
(string->es
|
||
(define #t (string->es "true"))
|
||
(define #f (string->es "false"))
|
||
|
||
;; _truep is used only internally and is still defined as a JS function
|
||
;; for brevity
|
||
(string->es "const _truep = x => x !== false")
|
||
|
||
;; intended for whether a procedure is defined, mostly
|
||
(define (es:defined? x)
|
||
(let ((id (tname->id x)))
|
||
(string->es "eval('typeof ' + $$id) !== 'undefined'")))
|
||
(define es:null (string->es "null"))
|
||
(define (es:null? x)
|
||
(string->es "$$x === null"))
|
||
|
||
(define (es:typeof x)
|
||
(string->es "typeof $$x"))
|
||
|
||
(define (symbol=? x y)
|
||
(and (string=? (es:typeof x) "symbol")
|
||
(eq? x y)))
|
||
|
||
(define (es:arg->arr args)
|
||
(string->es "Array.prototype.slice.call($$args)"))
|
||
(define (list . xs) xs)
|
||
|
||
;; warning: only compares two values
|
||
(define (= x y)
|
||
(string->es "+$$x === +$$y"))
|
||
(define (> x y)
|
||
(string->es "+$$x > +$$y"))
|
||
(define (< x y)
|
||
(string->es "+$$x < +$$y"))
|
||
|
||
;; warning: doesn't verify that it's a pair
|
||
(define (length xs)
|
||
(string->es "$$xs.length"))
|
||
|
||
(define (es:array? xs)
|
||
(string->es "Array.isArray($$xs)"))
|
||
|
||
(define (es:-assert-list xs)
|
||
(or (es:array? xs)
|
||
(error "expecting list")))
|
||
|
||
(define (es:-assert-pair xs)
|
||
(es:-assert-list xs)
|
||
(if (= 0 (length xs))
|
||
(error "expecting pair")
|
||
#t))
|
||
|
||
;; ignore obj for now
|
||
(define (error msg obj)
|
||
(string->es "throw Error($$msg)")
|
||
#f) ; prevent above from being in tail position and prefixing "return"
|
||
|
||
;; warning: these only operate on arrays
|
||
(define (cons obj1 obj2)
|
||
(es:-assert-list obj2)
|
||
(string->es "[$$obj1].concat($$obj2)"))
|
||
(define (car pair)
|
||
(es:-assert-pair pair)
|
||
(string->es "$$pair[0]"))
|
||
(define (cdr pair)
|
||
(es:-assert-pair pair)
|
||
(string->es "$$pair.slice(1)"))
|
||
|
||
(define (append . args)
|
||
(fold (lambda (x xs)
|
||
(es:-assert-list x)
|
||
(string->es "$$xs.concat($$x)"))
|
||
(list)
|
||
args))
|
||
|
||
;; warning: these two are wholly inadequate
|
||
(define (list? xs)
|
||
(string->es "Array.isArray($$xs)"))
|
||
(define (pair? xs)
|
||
(and (list? xs)
|
||
(not (zero? (length xs)))))
|
||
|
||
;; R7RS string
|
||
(define (substring s start end)
|
||
(string->es "$$s.substring($$start, $$end)"))
|
||
(define (string-length s)
|
||
(string->es "$$s.length"))
|
||
(define (string=? s1 s2)
|
||
(string->es "typeof $$s1 === 'string' && $$s1 === $$s2"))
|
||
(define (string-append . xs)
|
||
(string->es "$$xs.join('')"))
|
||
|
||
(define (eq? x y)
|
||
(string->es "$$x === $$y"))
|
||
|
||
;; R7RS math
|
||
(define (+ . xs)
|
||
(fold (lambda (x y)
|
||
(string->es "$$x + $$y"))
|
||
0
|
||
xs))
|
||
(define (- . xs)
|
||
(if (= (length xs) 1)
|
||
(- 0 (car xs))
|
||
(fold (lambda (y x)
|
||
(string->es "$$x - $$y"))
|
||
(car xs)
|
||
(cdr xs))))
|
||
(define (zero? x)
|
||
(= x 0))
|
||
|
||
;; SRFI-1
|
||
;; warning: fold here only supports one list
|
||
(define (fold f init xs)
|
||
(string->es "$$xs.reduce((prev, x) => $$f(x, prev), $$init)"))
|
||
|
||
;; warning: map here uses the length of the first list, not the shortest
|
||
(define (map f . xs)
|
||
(string->es
|
||
"$$xs[0].map((_, i) => $$f.apply(null, $$xs.map(x => x[i])))"))
|
||
|
||
(define (es:regexp s opts)
|
||
(string->es "new RegExp($$s, $$opts)"))
|
||
(define (es:match r s)
|
||
(string->es "$$s.match($$r) || false"))
|
||
(define (es:replace r repl s)
|
||
(string->es "$$s.replace($$r, $$repl)"))
|
||
|
||
|
||
(define *fsdata*
|
||
(if (string->es "typeof __fsinit === 'undefined'")
|
||
(string->es "{}")
|
||
(string->es "__fsinit")))
|
||
|
||
(define *fs*
|
||
(if (string->es "typeof require === 'undefined'")
|
||
(string->es
|
||
"{
|
||
readFileSync(path)
|
||
{
|
||
throw Error(`Cannot load ${path} (no fs module)`);
|
||
},
|
||
}")
|
||
(string->es "require('fs')")))
|
||
|
||
;; so that we do not have to modify existing compiler output (which would
|
||
;; break the first round of compilation before these are defined)
|
||
(string->es "const fsdata = $$$k$fsdata$k$")
|
||
(string->es "const fs = $$$k$fs$k$")
|
||
|
||
(define (es:file->string path)
|
||
(if (string->es "fsdata[$$path] === undefined")
|
||
(string->es
|
||
"fsdata[$$path] = fs.readFileSync($$path).toString()")
|
||
(string->es "fsdata[$$path]")))))
|