ulambda/build-aux/bootstrap/libprebirth.js

/**
 * Transition library for Prebirth
 *
 *  Copyright (C) 2017 Mike Gerwitz
 *
 *  This file is part of Gibble.
 *
 *  Gibble 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 GIBBLE LISP ITSELF after
 * a very basic bootstrap is complete.  It is retained as an important
 * artifact for those who wish to build Gibble from scratch without using
 * another version of Gibble 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'.
 */

const $h$t = true;
const $h$f = false;

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 );


// Node.js stuff
const fs = require( 'fs' );

// stdin->string
const $$js$stdin$_$$g$string = () =>
  fs.readFileSync( '/dev/stdin' ).toString();

const $$js$regexp = ( s, opts ) => new RegExp( s, opts );
const $$js$match  = ( r, s ) => s.match( r ) || false;


/** =============== end of libprebirth =============== **/