166 lines
5.0 KiB
JavaScript
166 lines
5.0 KiB
JavaScript
/**
|
||
* Transition library for Prebirth
|
||
*
|
||
* Copyright (C) 2017 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/>.
|
||
*
|
||
* THIS IS TEMPORARY CODE that will be REWRITTEN IN REBIRTH LISP ITSELF after
|
||
* a very basic bootstrap is complete. It is retained as an important
|
||
* artifact for those who wish to build Ulambda Scheme from scratch without
|
||
* using another version of Ulambda itself. This is called "self-hosting".
|
||
*
|
||
* For the actual Prebirth compiler before self-hosting, see `prebirth.js'
|
||
* in the same directory as this file.
|
||
*
|
||
* This library is intended to be concatenated with the compiled
|
||
* Prebirth Lisp to ease the transition by providing a set of functions that
|
||
* will Just Work™ without a Prebirth Lisp implementation. They will be
|
||
* removed as they are rewritten in Prebirth Lisp.
|
||
*
|
||
* By convention, everything is prefixed with `js:' in Prebirth (not `es:',
|
||
* because we're using JavaScript-specific features). For character
|
||
* transformation rules, see `Compiler#_idFromName' in `prebirth.js'.
|
||
*
|
||
* These implementations are largely flawed in some manner, but that's okay,
|
||
* because they do their job. Some flaws are noted.
|
||
*/
|
||
|
||
const $$$h$t = true;
|
||
const $$$h$f = false;
|
||
|
||
const $$symbol$q$$7$ = ( a, b ) => ( ( typeof a === 'symbol' ) && ( a === b ) );
|
||
|
||
const argToArr = args => Array.prototype.slice.call( args );
|
||
|
||
function $$list() { return argToArr( arguments ); }
|
||
|
||
const _error = str =>
|
||
{
|
||
throw Error( str );
|
||
}
|
||
|
||
const _assertPair = xs =>
|
||
{
|
||
_assertList( xs );
|
||
|
||
if ( xs.length === 0 ) {
|
||
throw TypeError( "expecting pair" );
|
||
}
|
||
|
||
return true;
|
||
}
|
||
|
||
const _assertList = xs =>
|
||
{
|
||
if ( !Array.isArray( xs ) ) {
|
||
throw TypeError( "expecting list" );
|
||
}
|
||
|
||
return true;
|
||
}
|
||
|
||
// only false (#f in Scheme) is non-true
|
||
const _truep = x => x !== false;
|
||
|
||
// ignore obj for now
|
||
const $$error = ( msg, obj ) => _error( msg );
|
||
|
||
const $$cons = ( item, list ) => _assertList( list ) && [ item ].concat( list )
|
||
const $$car = xs => _assertPair( xs ) && xs[ 0 ];
|
||
const $$cdr = xs => _assertPair( xs ) && xs.slice( 1 );
|
||
|
||
// warning: blows up if any items are non-lists, whereas the proper RnRS
|
||
// implementation will set the cdr to the final item even if it's not a pair
|
||
function $$append()
|
||
{
|
||
return argToArr( arguments )
|
||
.reduce( ( xs, x ) => xs.concat( _assertList( x ) && x ) );
|
||
}
|
||
|
||
const $$list$7$ = xs => Array.isArray( xs );
|
||
const $$pair$7$ = xs => Array.isArray( xs ) && ( xs.length > 0 );
|
||
|
||
|
||
// R7RS string
|
||
const $$substring = ( s, start, end ) => s.substring( start, end );
|
||
const $$string$_$length = s => s.length;
|
||
const $$string$q$$7$ = ( x, y ) => x === y;
|
||
const $$string$_$ref = ( s, i ) => s[ i ]
|
||
|| _error( `value out of range: ${i}`);
|
||
|
||
function $$string$_$append()
|
||
{
|
||
return argToArr( arguments ).join( "" );
|
||
}
|
||
|
||
// R7RS math
|
||
function $$$p$()
|
||
{
|
||
return argToArr( arguments ).reduce( ( ( x, y ) => x + y ), 0 );
|
||
}
|
||
function $$$_$()
|
||
{
|
||
const args = argToArr( arguments );
|
||
const first = args.shift();
|
||
|
||
return args.reduce( ( ( x, y ) => x - y ), first );
|
||
}
|
||
const $$zero$7$ = x => x === 0;
|
||
|
||
// SRFI-1
|
||
// warning: fold here only supports one list
|
||
const $$fold = ( f, init, xs ) =>
|
||
xs.reduce( ( prev, x ) => f( x, prev ), init );
|
||
// warning: map here uses the length of the first list, not the shortest
|
||
// (we implement this in ES for now so that we don't have to augment
|
||
// Prebirth Lisp to support the "rest" procedure definition syntax)
|
||
const $$map = ( f, ...xs ) =>
|
||
xs[ 0 ].map(
|
||
( _, i ) => f.apply( null,
|
||
xs.map( x => x[ i ] ) ) );
|
||
|
||
|
||
const $$es$regexp = ( s, opts ) => new RegExp( s, opts );
|
||
const $$es$match = ( r, s ) => s.match( r ) || false;
|
||
const $$es$replace = ( r, repl, s ) => s.replace( r, repl );
|
||
|
||
|
||
// the variable __fsinit, if defined, can be used to stub the filesystem
|
||
const fsdata = ( typeof __fsinit !== 'undefined' ) ? __fsinit : {};
|
||
|
||
const fs = ( typeof require !== 'undefined' )
|
||
? require( 'fs' )
|
||
: {
|
||
readFileSync( path )
|
||
{
|
||
throw Error( `Cannot load ${path} (no fs module)` );
|
||
},
|
||
}
|
||
|
||
// file->string
|
||
const $$es$file$_$$g$string = ( path ) =>
|
||
{
|
||
if ( fsdata[ path ] !== undefined ) {
|
||
return fsdata[ path ];
|
||
}
|
||
|
||
return fsdata[ path ] = fs.readFileSync( path ).toString();
|
||
};
|
||
|
||
|
||
/** =============== end of libprebirth =============== **/
|