Believe
A Bel interpreter built with C11

Table of Contents

Acknowledgements

This is an open-source project which anyone can contribute to. I'd like to thank the people who helped me so far with this project.

Many thanks to Carl Mäsak (github.com/masak) not only for contributing with code, but also for highlighting a lot of important aspects in the Bel specification, and also for taking time to discuss other implementation aspects of the interpreter. This kind of contribution is priceless, since it is easy to overlook important details on technical documents. An extra pair of eyes on that regard is always welcome.

1 Introduction

The goal of this project is to provide a fully-functioning implementation of the Bel language, proposed by Paul Graham. The main goal is not to provide performance; instead, it is supposed to be a didatic approach to implementing a Lisp interpreter.

The code here contained is also a study on how to build a Lisp interpreter from scratch in C. Given that Bel is so simple and is supposed to be a formalism before a commercial language, it seems like the perfect didatic resource to do so.

Here are some useful links with language resources:

Note that this software is still a work-in-progress. Do not expect it to work fully yet.

1.1 About literate programming

This interpreter is built using Org with Org-mode in Emacs. Its website specifies that Org is "a format for keeping notes, maintaining TODO lists, planning projects, and authoring documents with a fast and effective plain-text system".

All the code here appears in the order it is written on the actual code files. By using Donald Knuth's concept of literate programming, the relevant code blocks are tangled and written in their specified code files, and then the application can be compiled.

By using this approach, I hope to maintain an application where the understanding of what is being written comes before the code itself, so that the reader is able to take and analyse parts of said code based on the prose that accompanies it.

1.2 Licensing

The Believe project is composed of two relevant documents: one being the textbook, which contains all the prose parts plus the code blocks in relevant places; and another being the code, which is composed solely of the code blocks contained in this textbook, and can be understood both as the code blocks of the textbook or as a separate, tangled file containing the relevant discussed code.

When redistributing the textbook, one should take the textbook license into consideration. But anyone using the code parts of the textbook or the tangled code file included in the project's repository, for any purpose, should take the code license into consideration as well.

1.2.1 Textbook license

This work is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License. This means that you are free to:

  • Share: copy and redistribute the material in any medium or format
  • Adapt: remix, transform, and build upon the material for any purpose, even commercially.

But only if you follow the terms below:

  • Attribution: You must give appropriate credit1, provide a link to the license, and indicate if changes were made2. You may do so in any reasonable manner, but not in any way that suggests the licensor endorses you or your use.
  • ShareAlike: If you remix, transform, or build upon the material, you must distribute your contributions under the same license3 as the original.

See the CC-BY-SA 4.04 link for more information.

cc-by-sa.png

1.2.2 Code license

This software's code is distributed under the MIT License, Copyright (c) 2019 Lucas S. Vieira.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

1.3 Contribution guidelines

Below are described a few guidelines to contribute to this project. It is important to follow them to avoid confusion when contributing.

1.3.1 Code contribution guidelines

  1. This is a literate program.
    The meaning of this statement is that the software is primarily written as a prose with code blocks. So the way to make an addition to Believe is to open a section on the relevant part and add a code block with a proper code explanation in prose.
  2. The code is written as a C code file.
    Any new code should be added in a proper C code block. In the end, all C code blocks can be tangled into a single believe.c file.
  3. The code uses indentation similar to K&R.
    Therefore we put types one line above the rest of the function declaration (except for prototypes), and we put the function declaration braces on the next line. As for code inside function scopes, the braces should be in front of the block declaration, separated by a single space.
  4. Use snake_case and respect naming conventions.
    All definitions use snake case with lowercase names (e.g. bel_car), except for enumerations (where the name of the enum and its definitions must be uppercase – e.g. BEL_SYMBOL) and structs (the default struct definition must be uppercase, while a typedef for the struct must be lowercase with the first letter in uppercase – e.g. Bel_pair).
  5. Indentation must be done with spaces, and each indentation level takes four spaces.
    Though this is mostly arbitrary, this is the way most of the software was written. This rule is invalid for Makefiles only, where the use of tabs is relevant.
  6. Do not change the code file directly.
    Files such as believe.c are automatically generated by tangling the code blocks in this file. When creating pull requests, it is also desired that the believe.c file is not commited with the rest of the changes.
  7. Code without a relevant prose explaining the rationale of what was programmed will not be accepted as contribution.
    The rationale behind this project is partly related to providing a didatic implementation of a Lisp interpreter, which can be read as a book and implemented by anyone.

These contribution guidelines are subject to change at any time during the software development, as any necessity to clear up confusion appears.

1.3.2 Project communication guidelines

This project does not have a code of conduct. Instead, we rely on the spirit of joyful creation of the participants and on the understanding and cordiality of the people taking part on the project.

By contributing, you understand that the project maintainers are in no way responsible for the misconduct of any participants outside of the scope of this project. In addition, any contributions will be discussed in the light of good faith, not taking into consideration personal aspects such as race, skin color, gender, political views, or any other aspect which is unrelated to the produced code itself. Having said that, any harrassment will not be tolerated, as it is out of the scope of the project; the maintainers of the project will handle the situation in the best possible manner they can.

The maintainers may also remove any other off-topic discussions which are completely unrelated to the subject, to avoid pollution on issues, pull requests and such.

It is also important to state that, by contributing, you will also be relying on the good faith and sensibility of the project maintainers to handle the topics above described; again, these are stated merely as a general mentality of moderation, and not as fixed rules which could be circumvented.

To increment this general mentality, we also follow the GNU Kind Communication Guidelines5, which are not a code of conduct nor a list of rules as well, but more of a reference on how one could approach the discussions and contributions on this software. These guidelines are reproduced below in an adapted fashion, with a few changes to accomodate to this project.

  1. Please assume other participants are posting in good faith, even if you disagree with what they say. When people present code or text as their own work, please accept it as their work. Please do not criticize people for wrongs that you only speculate they may have done; stick to what they actually say and actually do.
  2. Please think about how to treat other participants with respect, especially when you disagree with them. For instance, call them by the names they use, and honor their preferences about their gender identity6.
  3. Please do not take a harsh tone towards other participants, and especially don't make personal attacks against them. Go out of your way to show that you are criticizing a statement, not a person.
  4. Please recognize that criticism of your statements is not a personal attack on you. If you feel that someone has attacked you, or offended your personal dignity, please don't “hit back” with another personal attack. That tends to start a vicious circle of escalating verbal aggression. A private response, politely stating your feelings as feelings, and asking for peace, may calm things down. Write it, set it aside for hours or a day, revise it to remove the anger, and only then send it.
  5. Please avoid statements about the presumed typical desires, capabilities or actions of some demographic group. They can offend people in that group, and they are always off-topic in Believe discussions.
  6. Please be especially kind to other contributors when saying they made a mistake. Programming means making lots of mistakes, and we all do so —- this is why regression tests are useful. Conscientious programmers make mistakes, and then fix them. It is helpful to show contributors that being imperfect is normal, so we don't hold it against them, and that we appreciate their imperfect contributions though we hope they follow through by fixing any problems in them.
  7. Likewise, be kind when pointing out to other contributors that they should stop using certain software. We welcome their contributions to our software even if they don't do that. So these reminders should be gentle and not too frequent —- don't nag.
  8. Please respond to what people actually said, not to exaggerations of their views. Your criticism will not be constructive if it is aimed at a target other than their real views.
  9. If in a discussion someone brings up a tangent to the topic at hand, please keep the discussion on track by focusing on the current topic rather than the tangent. This is not to say that the tangent is bad, or not interesting to discuss —- only that it shouldn't interfere with discussion of the issue at hand. In most cases, it is also off-topic, so those interested ought to discuss it somewhere else.
    If you think the tangent is an important and pertinent issue, please bring it up as a separate discussion, if it applies to Believe development.
  10. Rather than trying to have the last word, look for the times when there is no need to reply, perhaps because you already made the relevant point clear enough. If you know something about the game of Go, this analogy might clarify that: when the other player's move is not strong enough to require a direct response, it is advantageous to give it none and instead move elsewhere.
  11. Please don't argue unceasingly for your preferred course of action when a decision for some other course has already been made. That tends to block the activity's progress.
  12. If other participants complain about the way you express your ideas, please make an effort to cater to them. You can find ways to express the same points while making others more comfortable. You are more likely to persuade others if you don't arouse ire about secondary things.
  13. Please don't raise any political issues in Believe discussions, because they are off-topic.

These communication guidelines are subject to change at any time during the software development, as any necessity to clear up confusion appears.

2 Tools and scripts

2.1 Makefile

This software was primarily developed on Void Linux x8664, using the Clang compiler. The following Makefile is the one used for building Believe.

CC     = clang
CFLAGS = --std=c11 -g -O2 -Wall -DBEL_DEBUG
CLIBS  = -lgc -lm
BIN    = believe
OBJ    = believe.o

.PHONY: clean

$(BIN): $(OBJ)
        $(CC) $(CFLAGS) $(CLIBS) -o $@ $^

%.o: %.c
        $(CC) $(CFLAGS) -c -o $@ $^

clean:
        rm -rf *.o $(BIN)

2.2 Memory leak testing

This script generates a log file with memory leak information using Valgrind. Valgrind's output is stored in believe.log.

valgrind --check_leaks=full --log-file="believe.log" -v ./believe

2.3 Tangling

The following snippet can be run from Emacs to enable tangling on save for this file only.

Tangling is the process of taking each block of code and adding it to its specific file. Believe's code will be written in C source files; the Makefile will be written in its own file; and so on. Notice that some blocks (like this one) is not written anywhere, and is meant to be evaluated from inside Emacs.

2.4 Running the program

This script attempts to build and run the Bel interpreter. It will also enable verbose output for the garbage collector.

make
export GC_PRINT_STATS=1
./believe

3 Libraries and headers

3.1 Default headers

We'll be using stdio.h for default console I/O, plus stdint.h for some standard integer types. string.h provides definitions to handle string manipulation on the C side, however Bel is supposed to have its own string representation, to be discussed later. errno.h is used to fetch error strings from streams, for example; and math.h is useful for math operations.

#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <stdint.h>
#include <string.h>
#include <errno.h>
#include <math.h>

3.2 Definitions

We'll use a flag for debug which influences the building process. Let's call this flag BEL_DEBUG.

When building, if you pass this flag to Clang (see the Makefile), some debug outputs will be available.

By default we'll leave it on, at least for now.

Let's also add a modest copyright notice to the program's header.

/* Believe v0.2                                           *
 * A Bel Lisp interpreter.                                *
 * Copyright (c) 2019 Lucas Vieira.                       *
 * This program is distributed under the MIT License. See *
 * the LICENSE file for details.                          *
 *                                                        *
 * Development information can also be consulted on the   *
 * book which accompanies this software, which was        * 
 * written in literate programming form. For more         *
 * information, see https://github.com/luksamuk/believe.  */

3.3 Boehm-Demers-Weiser Garbage Collector

We also use Boehm-Demers-Weiser GC for garbage collection, instead of programming our own. The GC_DEBUG flag helps on debugging. See that we use -lgc on the Makefile to link the relevant library to the application.

#ifdef BEL_DEBUG
#define GC_DEBUG
#endif

#include <gc.h>

Plus, one could check the Boehm-Demers-Weiser GC tutorial slides by Hans-J. Boehm, for a quick overview of this library.

3.4 Software-related definitions

These definitions relate to program metadata which is going to be displayed on its startup.

#define BELIEVE_VERSION   "0.2"
#define BELIEVE_COPYRIGHT "2019 Lucas Vieira"
#define BELIEVE_LICENSE   "MIT"

4 Fundamental data types

The first thing to do is specify how the data is going to be handled by the interpreter. Here, we define each of these kinds of data. Any procedure for data manipulation will be defined afterwards.

4.1 Enumerating Bel types

We begin by specifying all data types, which Bel has four: symbols, pairs, characters and streams. We also add a number type, which is non-standard, but will be useful; this decision will be explained in its section.

typedef enum
{
    BEL_SYMBOL,
    BEL_PAIR,
    BEL_CHAR,
    BEL_STREAM,
    BEL_NUMBER
} BEL_TYPE;

4.2 Pair

A pair can have two things, which can in return be one of the four data types themselves. Since this is sort of a recursive definition, we need to make a forward declaration of the general Bel type, which encloses all four data types.

typedef struct BEL Bel; // Forward declaration

typedef struct
{
    Bel *car;
    Bel *cdr;
} Bel_pair;

4.3 Character

A character is nothing but an integer in standard C. For now we'll support only ASCII, so there is no actual need to instantiate the proposed table of characters – this might change in the future.

We say that a character is nothing but a signed 8-bit integer. Should be enough for now.

typedef int8_t Bel_char;

4.4 Symbol

A symbol is nothing but a specific index on the symbol table, so that's how we'll define it.

typedef uint64_t Bel_sym;

4.5 Stream

The stream type is somewhat implementation-dependent. In C, a standard way to refer to streams is to use a FILE pointer, since stdout and stdin themselves are of such type. So we just wrap these pointers in a stream type.

Plus, as per Bel's specification, a stream has three statuses: closed, open for reading, open for writing. Therefore, we use a single enumeration to represent these three states.

Since Bel's specification writes to a stream bit by bit, we need to cache the currently filled byte inside the structure, from left to right, dumping each byte as it is filled. Upon closing, the stream shall write the cache at the end of the file, plus the incomplete remaining bits. A "new" (not written and not dumped) cache is a single byte, and is guaranteed to be filled with zero (\0 \0 \0 \0 \0 \0 \0 \0).

When dealing with reading from a stream, since Bel also reads bit by bit only, we take the same advantage of the cache, however as the opposite approach: we read a single byte from stream and keep the cache full. As we read each bit, we convert it to a Bel character (\0 or \1). Once all bits of the cache have been read, another byte is fetched, stored on cache, and so on.

typedef enum BEL_STREAM_STATUS
{
    BEL_STREAM_CLOSED,
    BEL_STREAM_READ,
    BEL_STREAM_WRITE
} BEL_STREAM_STATUS;

typedef struct
{
    BEL_STREAM_STATUS  status;
    FILE              *raw_stream;
    uint8_t            cache;
    uint8_t            cache_used;
} Bel_stream;

4.6 Number

Bel does not specify any numeric types in its standard. In fact, numbers could be reproduced in Bel by using Church numerals, for example. However, this approach has a huge impact on performance, enough to make us want actual numeric types in our interpreter.

A number in Believe is a union of many number subtypes. The number can be an integer, a float, a fraction or even a complex number in its constitution, but this coercion happens away from the eyes of the Bel programmer; from his standpoint, there is only an opaque number type.

Let's start by defining the enumeration of types. Integers are C 64-bit signed ints, and floats are, in fact, C doubles.

typedef enum {
    BEL_NUMBER_INT,
    BEL_NUMBER_FLOAT,
    BEL_NUMBER_FRACTION,
    BEL_NUMBER_COMPLEX
} BEL_NUMBER_TYPE;

typedef int64_t Bel_longint;
typedef double  Bel_float;

We forward declare the Bel_number structure as a typedef for a struct BEL_NUMBER.

typedef struct BEL_NUMBER Bel_number; // Forward declaration

Now we define our fraction and complex subtypes. Notice that they use Bel_number in their constitution. This is on purpose, as it allows us to create recursive definitions of numbers.

typedef struct {
    Bel *numer;
    Bel *denom;
} Bel_fraction;

typedef struct {
    Bel *real;
    Bel *imag;
} Bel_complex;

All that is left is to define our Bel_number formally.

struct BEL_NUMBER {
    BEL_NUMBER_TYPE type;
    union {
        Bel_longint  num_int;
        Bel_float    num_float;
        Bel_fraction num_frac;
        Bel_complex  num_compl;
    };
};

4.7 The Bel structure

The remaining thing to do is join all the types into the Bel type, which will serve as our generic way of dealing with things.

// Aliased as 'Bel' before
struct BEL
{
    BEL_TYPE type;
    union {
        Bel_sym     sym;
        Bel_pair   *pair;
        Bel_char    chr;
        Bel_stream  stream;
        Bel_number  number;
    };
};

5 Essential structures and manipulation of data

5.1 Basic definitions

These definitions relate to essential symbols of the Bel global environment. They also encode the symbols' position on the global symbol table, to be defined later.

#define BEL_NIL   ((Bel_sym)0)
#define BEL_T     ((Bel_sym)1)
#define BEL_O     ((Bel_sym)2)
#define BEL_APPLY ((Bel_sym)3)

The following symbols are axioms which are global to the program. One is expected to use them instead of creating new symbols, though it is not strictly necessary.

Bel *bel_g_nil;
Bel *bel_g_t;
Bel *bel_g_o;
Bel *bel_g_apply;

These other variables are responsible for holding other axioms on the system. More on then will be specified later.

Bel *bel_g_chars;
Bel *bel_g_ins_sys;
Bel *bel_g_outs_sys;
Bel *bel_g_ins;
Bel *bel_g_outs;
Bel *bel_g_prim;
Bel *bel_g_clo;

We may also define temporary variables for the global, lexical and dynamic environments.

Bel *bel_g_scope;
Bel *bel_g_globe;
Bel *bel_g_dynae;

5.1.1 Forward declarations

We need to forward declare a few functions which will be useful for certain operations. For example, it is important that we make a forward declaration of bel_mkerror, since the primitives should depend on it; also, providing bel_mkstring ensures that the error format can be easily created, and so on.

Bel *bel_mkerror(Bel *format, Bel *vars);   // Forward declaration
Bel *bel_mkstring(const char*);             // Forward declaration
Bel *bel_mksymbol(const char*);             // Forward declaration
Bel *bel_car(Bel*);                         // Forward declaration
Bel *bel_cdr(Bel*);                         // Forward declaration

5.2 Predicates

It is important to have a few predicates which will help us check for errors. These predicates do not check for argument nullability (e.g. unmanaged pointers), so use it wisely and only on initialized data!

5.2.1 symbolp

bel_symbolp tests whether the element is a symbol.

#define bel_symbolp(x) ((x)->type==BEL_SYMBOL)

5.2.2 nilp

bel_nilp tests whether the element is the symbol nil.

#define bel_nilp(x)                             \
    (bel_symbolp(x) && ((x)->sym==BEL_NIL))

5.2.3 pairp

bel_pairp tests whether the element is a pair.

#define bel_pairp(x) ((x)->type==BEL_PAIR)

5.2.4 atomp

bel_atomp tests whether an element is not a pair – that is, if it is not "divisible".

#define bel_atomp(x) (!bel_pairp(x))

5.2.5 charp

bel_charp tests whether the object is a character.

#define bel_charp(x)                            \
    (((x)->type==BEL_CHAR))

5.2.6 streamp

bel_streamp tests whether the object is a stream.

#define bel_streamp(x)                          \
    (((x)->type==BEL_STREAM))

5.2.7 numberp

bel_numberp determines whether x is a number or not. Notice that numbers are non-standard to Bel's definition.

#define bel_numberp(x)                          \
    ((x)->type==BEL_NUMBER)

5.2.8 idp

bel_idp tests whether an object is identical to another. According to the Bel specification, identity is stricter than equality: there is only one of each symbol and character. Pairs and streams are compared by their references, so they are identical if and only if they reside in the same memory address.

This is the first predicate that is implemented as a proper C function, and it is used only internally; therefore, it outputs a C integer value for truth and falsity.

int bel_idp_nums(Bel *x, Bel *y); // Forward declaration
int
bel_idp(Bel *x, Bel *y)
{
    if(bel_symbolp(x))
        return (x->sym == y->sym);
    else if(bel_charp(x))
        return (x->chr == y->chr);
    else if(bel_numberp(x)) {
        // Non-standard
        return bel_idp_nums(x, y);
    }

    // For pairs and streams, check for
    // pointer aliasing
    return (x == y);
}

Numbers are non-standard, so we develop our own identity test for them: if two numbers have the same subtype (integer, float, fraction, complex) and the same value, they are identical. In the case of numbers with components (fraction, complex) we recursively test for component identity instead of comparing values directly.

int
bel_idp_nums(Bel *x, Bel *y)
{
    if(x->number.type == y->number.type) {
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            return (x->number.num_int
                    == y->number.num_int);
        case BEL_NUMBER_FLOAT:
            return (x->number.num_float
                    == y->number.num_float);
        case BEL_NUMBER_FRACTION:
            return
                (bel_idp_nums(
                    x->number.num_frac.numer,
                    y->number.num_frac.numer)
                 && bel_idp_nums(
                     x->number.num_frac.denom,
                     y->number.num_frac.denom));
        case BEL_NUMBER_COMPLEX:
            return
                (bel_idp_nums(
                    x->number.num_compl.real,
                    y->number.num_compl.real)
                 && bel_idp_nums(
                     x->number.num_compl.imag,
                     y->number.num_compl.imag));
        };
    }
    return 0;
}

5.2.9 errorp

bel_errorp tests whether a specific object is a list in the format (lit err . rest).

int
bel_errorp(Bel *x)
{
    if(!bel_pairp(x)) return 0;
    if(!bel_idp(bel_car(x), bel_mksymbol("lit")))
        return 0;
    Bel *cdr = bel_cdr(x);
    if(!bel_idp(bel_car(cdr), bel_mksymbol("err")))
        return 0;
    return 1;
}

5.2.10 proper-list-p

A proper list is any list which ends in an appropriate nil symbol. So for example, (1 2 3) is a proper list, but (1 2 3 . 4) is not. Compare how these lists can be expressed by using dot notation:

  • (1 . (2 . (3 . nil)))
  • (1 . (2 . (3 . 4)))

An empty list is considered a proper list as well.

bel_proper_list_p checks whether a list is indeed a proper list. We do that by traversing the list, pair by pair. If the cdr is nil, it is proper; if it is a pair, it proceeds with the traversal. But if the cdr is anything else, then it is not a proper list.

int
bel_proper_list_p(Bel *x)
{
    if(!bel_pairp(x) && !bel_nilp(x))
        return 0;
    
    Bel *itr = x;
    while(!bel_nilp(itr)) {
        if(!bel_pairp(itr))
            return 0;
        itr = bel_cdr(itr);
    }

    return 1;
}

5.2.11 stringp

An object is a string if and only if:

  • it is a proper list;
  • it contains characters only.

bel_stringp tests for this. However, this first implementation is a little naïve, since it performs a proper list check, which involves traversing an entire list, and then it traverses the list again, checking for characters in the car. This overhead can be reduced in the future.

int
bel_stringp(Bel *x)
{
    if(!bel_proper_list_p(x)) {
        return 0;
    }

    Bel *itr = x;
    while(!bel_nilp(itr)) {
        Bel *car = bel_car(itr);

        if(!bel_charp(car))
            return 0;

        itr = bel_cdr(itr);
    }

    return 1;
}

5.2.12 literalp

bel_literalp takes a proper list and tells whether the list is a literal, that is, if the first element of the list is the symbol lit.

int
bel_literalp(Bel *x)
{
    if(!bel_proper_list_p(x))
        return 0;

    return bel_idp(bel_car(x),
                   bel_mksymbol("lit"));
}

5.2.13 primitivep

bel_primitivep takes a literal and tests whether it is a primitive, that is, if the second element of the list is the symbol prim.

int
bel_primitivep(Bel *x)
{
    return bel_literalp(x)
        && bel_idp(bel_car(bel_cdr(x)),
                   bel_mksymbol("prim"));
}

5.2.14 closurep

bel_closurep takes a literal and tests whether it is a closure, that is, if the second element of the list is the symbol clo.

int
bel_closurep(Bel *x)
{
    return bel_literalp(x)
        && bel_idp(bel_car(bel_cdr(x)),
                   bel_mksymbol("clo"));
}

5.2.15 quotep

bel_quotep takes a proper list and determines whether it is a quoted form.

int
bel_quotep(Bel *x)
{
    if(!bel_proper_list_p(x))
        return 0;

    return bel_idp(bel_car(x),
                   bel_mksymbol("quote"));
}

5.2.16 number-list-p

bel_number_list_p determines whether x is a proper list of numbers.

int
bel_number_list_p(Bel *x)
{
    if(!bel_proper_list_p(x)) {
        return 0;
    }

    Bel *itr = x;
    while(!bel_nilp(itr)) {
        Bel *car = bel_car(itr);

        if(!bel_numberp(car))
            return 0;

        itr = bel_cdr(itr);
    }

    return 1;
}

5.3 Symbol Table and Symbols

The symbol table is an array that grows as necessary, doubling in size, but never shrinks on the program's lifetime. Each element of the table is a const C string.

We begin by defining such structure and a global symbol table.

typedef struct {
    const char **tbl;
    uint64_t     n_syms;
    uint64_t     size;
} _Bel_sym_table;

_Bel_sym_table g_sym_table;

To initialize the symbol table, we give it an initial size of four, just enough to enclose Bel's four fundamental symbols: nil, t, o and apply. Notice that the order of these symbols relate to their predefined macros, so any failure here is unexpected.

void
bel_sym_table_init(void)
{
    g_sym_table.n_syms = 4;
    g_sym_table.size   = 4;
    g_sym_table.tbl    =
        GC_MALLOC(g_sym_table.size * sizeof(char*));

    g_sym_table.tbl[BEL_NIL]   = "nil";
    g_sym_table.tbl[BEL_T]     = "t";
    g_sym_table.tbl[BEL_O]     = "o";
    g_sym_table.tbl[BEL_APPLY] = "apply";
}

The lookup function bel_sym_table_find does a linear search for the presented literal on the symbol table. However, if it doesn't find the symbol, it implicitly calls bel_sym_table_add, which appends the symbol to the table.

This is obviously not a very wise approach as it opens up for some exploits on interning symbols, but should be enough as long as these symbols are only really interned on lit or quote scopes.

Bel_sym bel_sym_table_add(const char*); // Forward declaration

Bel_sym
bel_sym_table_find(const char *sym_literal)
{
    uint64_t i;
    for(i = 0; i < g_sym_table.n_syms; i++) {
        if(!strcmp(sym_literal, g_sym_table.tbl[i])) {
            return i;
        }
    }

    return bel_sym_table_add(sym_literal);
}

Bel_sym
bel_sym_table_add(const char *sym_literal)
{
    if(g_sym_table.n_syms == g_sym_table.size) {
        uint64_t new_size = 2 * g_sym_table.size;
        g_sym_table.tbl = GC_REALLOC(g_sym_table.tbl,
                                     new_size * sizeof(char*));
        g_sym_table.size = new_size;
    }
    g_sym_table.tbl[g_sym_table.n_syms++] = sym_literal;
    return (g_sym_table.n_syms - 1);
}

Eventually we'll also need to take a symbol and find its character counterpart. Since the table is immutable, we can do that instantaneously by taking the character string at the symbol's position on the table. Notice that we do not check whether the given argument is a symbol, since it is also an internal function.

const char*
bel_sym_find_name(Bel *sym)
{
    return g_sym_table.tbl[sym->sym];
}

Last but not least, we create a proper tool to build a symbol. Just give it your desired symbol as a string literal and the runtime takes care of the rest.

Bel*
bel_mksymbol(const char *str)
{
    Bel *ret  = GC_MALLOC(sizeof (*ret));
    ret->type = BEL_SYMBOL;
    ret->sym  = bel_sym_table_find(str);
    return ret;
}

5.4 Pairs

Pairs are the kernel of every Lisp, so we need tools to manipulate them.

We begin by specifying the function which builds pairs. Notice that the function itself takes two references to values, so pairs cannot exist without their car and cdr.

Bel*
bel_mkpair(Bel *car, Bel *cdr)
{
    Bel *ret  = GC_MALLOC(sizeof (*ret));
    ret->type = BEL_PAIR;
    ret->pair = GC_MALLOC(sizeof (Bel_pair));
    ret->pair->car = car;
    ret->pair->cdr = cdr;
    return ret;
}

Now we may easily extract information from pairs, using the car and cdr operations.

Bel*
bel_car(Bel *p)
{
    if(bel_nilp(p))
        return bel_g_nil;
    
    if(!bel_pairp(p)) {
        return bel_mkerror(
            bel_mkstring("Cannot extract the car of ~a."),
            bel_mkpair(p, bel_g_nil));
    }
    
    return p->pair->car;
}
Bel*
bel_cdr(Bel *p)
{
    if(bel_nilp(p))
        return bel_g_nil;
    
    if(!bel_pairp(p)) {
        return bel_mkerror(
            bel_mkstring("Cannot extract the cdr of ~a."),
            bel_mkpair(p, bel_g_nil));
    }
    
    return p->pair->cdr;
}

Let's also build a utility to return the size of a list. This is a O(n) operation which takes a well-formed list and iterates over it.

Note that calculating the length of something that is not a proper list makes no sense and will crash this operation. So before calling bel_length, it is probably a good idea to check for a valid proper list using bel_proper_list_p or a similar procedure.

uint64_t
bel_length(Bel *list)
{
    Bel *itr = list;
    uint64_t len = 0;
    while(!bel_nilp(itr)) {
        len++;
        itr = bel_cdr(itr);
    }
    return len;
}

5.5 Characters and Strings

Let's begin by adding a small function to wrap a character in a Bel object.

Bel*
bel_mkchar(Bel_char c)
{
    Bel *ret  = GC_MALLOC(sizeof *ret);
    ret->type = BEL_CHAR;
    ret->chr  = c;
    return ret;
}

Characters have the size of one byte, so if we take a single list of 8 \1 and \0 characters, we should be able to generate a bitmask of the corresponding character in question.

Bel*
bel_char_from_binary(Bel *list)
{
    if(!bel_pairp(list)) {
        return bel_mkerror(
            bel_mkstring("The binary representation of "
                         "a character must be a string of "
                         "characters \\0 and \\1."),
            bel_g_nil);
    }

    if(!bel_proper_list_p(list)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not a proper "
                         "list, and therefore not a list "
                         "of characters \\0 and \\1."),
            bel_mkpair(list, bel_g_nil));
    }

    size_t len = bel_length(list);

    if(len != 8) {
        return bel_mkerror(
            bel_mkstring("The binary representation of "
                         "a character must have exactly "
                         "eight characters \\0 or \\1."),
            bel_g_nil);
    }
    
    Bel_char mask = '\0';
    size_t i;
    Bel *current = list;
    
    for(i = 0; i < len; i++) {
        Bel *bitchar = bel_car(current);

        if(!bel_charp(bitchar)) {
            return bel_mkerror(
                bel_mkstring("The provided binary "
                             "representation of a "
                             "character does not contain "
                             "only characters."),
                bel_g_nil);
        }

        if(bitchar->chr != '0' && bitchar->chr != '1') {
            return bel_mkerror(
                bel_mkstring("The binary representation of "
                             "a character must have exactly "
                             "eight characters \\0 or \\1."),
                bel_g_nil);
        }
        
        if(bitchar->chr == '1') {
            mask |= (1 << (7 - i));
        }
        current = bel_cdr(current);
    }
    return bel_mkchar(mask);
}

Strings on the Bel environment are nothing more than a list of characters, therefore we need a way to convert C strings to proper Bel lists.

Bel*
bel_mkstring(const char *str)
{
    size_t len = strlen(str);

    if(len == 0)
        return bel_g_nil;
    
    Bel **pairs = GC_MALLOC(len * sizeof (Bel));

    // Create pairs where CAR is a character and CDR is nil
    size_t i;
    for(i = 0; i < len; i++) {
        Bel *chr  = GC_MALLOC(sizeof *chr);
        chr->type = BEL_CHAR;
        chr->chr  = str[i];
        pairs[i]  = bel_mkpair(chr, bel_g_nil);
    }

    // Link all pairs properly
    for(i = 0; i < len - 1; i++) {
        pairs[i]->pair->cdr = pairs[i + 1];
    }

    return pairs[0];
}

We also add a utility to take back a Bel string and turn it into a garbage-collected C string.

Note that the errors it can produce are instead dumped to the console and we return a null pointer; proper manipulation of this function is a responsibility of the programmer, since this is an internal function.

char*
bel_cstring(Bel *belstr)
{
    if(!bel_pairp(belstr)) {
        puts("INTERNAL ERROR on bel_cstring: "
             "argument is not a pair");
        return NULL;
    }
    
    if(!bel_stringp(belstr)) {
        puts("INTERNAL ERROR on bel_cstring: "
             "argument is not a string");
        return NULL;
    }
    
    uint64_t len = bel_length(belstr);
    if(len == 0) return NULL;
    
    char *str    = GC_MALLOC((len + 1) * sizeof (*str));

    Bel *itr     = belstr;
    size_t i     = 0;

    while(!bel_nilp(itr)) {
        str[i] = bel_car(itr)->chr;
        itr    = bel_cdr(itr);
        i++;
    }
    str[i] = '\0';
    return str;
}

5.6 Streams

We start by creating tools to manipulate streams. First, we create a raw stream from a file.

Bel*
bel_mkstream(const char* name, BEL_STREAM_STATUS status)
{
    Bel *ret           = GC_MALLOC(sizeof *ret);
    ret->type          = BEL_STREAM;

    if(status == BEL_STREAM_CLOSED) {
        return bel_mkerror(
            bel_mkstring("Cannot create a stream with "
                         "CLOSED status."),
            bel_g_nil);
    }

    if(!strncmp(name, "ins", 3)) {
        ret->stream.raw_stream = stdin;
    } else if(!strncmp(name, "outs", 4)) {
        ret->stream.raw_stream = stdout;
    } else {
        ret->stream.raw_stream =
            fopen(name,
                  status == BEL_STREAM_READ ? "rb" : "wb");
        
        if(!ret->stream.raw_stream) {
            return bel_mkerror(
                bel_mkstring("Unable to open stream ~a."),
                bel_mkpair(
                    bel_mkstring(name), bel_g_nil));
        }
    }

    ret->stream.status     = status;
    ret->stream.cache      = 0u;
    ret->stream.cache_used = 0u;
    return ret;
}

One important thing to have is a function which inputs a single bit in a file. We use the previously defined cache system for that; by filling the bits from left to right, we'll enable output as a single bit.

First we define the function which dumps and resets the cache of a specific stream when the cache is full; this should come in handy when closing the stream as well. After that, we do the actual bit writing. And of course, writing a bit returns t or nil for success and failure; this will most likely not be external to the Bel environment itself, since a failure in writing must signal an error. But that is not the job for this primitive.

Bel*
bel_stream_dump_cache(Bel_stream *stream)
{
    if(!fwrite(&stream->cache, 1, 1, stream->raw_stream)) {
        return bel_g_nil;
    }
    stream->cache_used = 0u;
    stream->cache      = 0u;
    return bel_g_t;
}

Bel*
bel_stream_write_bit(Bel_stream *stream, Bel_char bit)
{
    if(bit != '0' || bit != '1') {
        return bel_mkerror(
            bel_mkstring("Written bit must be represented "
                         "as a character 0 or 1"),
            bel_g_nil);
    }

    if(stream->status != BEL_STREAM_WRITE) {
        return bel_mkerror(
            bel_mkstring("Write stream is not at WRITE "
                         "state"),
            bel_g_nil);
    }

    if(stream->cache_used >= 8) {
        return bel_stream_dump_cache(stream);
    } else {
        if(bit == '1') {
            stream->cache |= (1 << (7 - stream->cache_used));
        }
        stream->cache_used++;
    }
    
    return bel_mkchar(bit);
}

We can take advantage of the same variables to read single bits from a file, as described before too. Keep the cache full, read single bits as Bel characters, fill the cache when the read bits are exhausted.

Bel*
bel_stream_fill_cache(Bel_stream *stream)
{
    if(!fread(&stream->cache, 1, 1, stream->raw_stream)) {
        // Return nil on EOF
        return bel_g_nil;
    }
    stream->cache_used = 8;
    return bel_g_t;
}

Bel*
bel_stream_read_bit(Bel_stream *stream)
{
    if(stream->status != BEL_STREAM_READ) {
        return bel_mkerror(
            bel_mkstring("Read stream is not at READ "
                         "state"),
            bel_g_nil);
    }
    
    Bel *ret;
    if(stream->cache_used == 0) {
        ret = bel_stream_fill_cache(stream);
        if(bel_nilp(ret)) {
            return bel_mksymbol("eof");
        }
    }

    uint8_t mask = (1 << (stream->cache_used - 1));
    ret = bel_mkchar(((mask & stream->cache) == mask)
                     ? ((Bel_char)'1') : ((Bel_char)'0'));
    stream->cache_used--;
    return ret;
}

We'll also need a tool to close a certain stream. Here we're being a little more careful, since streams are managed more directly, by using the C API. And of course, if we're dealing with output, dump the stream cache before closing the file.

Bel*
bel_stream_close(Bel *obj)
{
    if(obj->type != BEL_STREAM) {
        return bel_mkerror(
            bel_mkstring("Cannot close something that "
                         "is not a stream."),
            bel_g_nil);
    }
    
    if(obj->stream.status == BEL_STREAM_CLOSED) {
        return bel_mkerror(
            bel_mkstring("Cannot close a closed stream."),
            bel_g_nil);
    }

    // Dump cache before closing
    if(obj->stream.status == BEL_STREAM_WRITE) {
        bel_stream_dump_cache(&obj->stream);
    }
    
    if(!fclose(obj->stream.raw_stream)) {
        obj->stream.raw_stream = NULL;
        obj->stream.status     = BEL_STREAM_CLOSED;
        return bel_g_t;
    }

    return bel_mkerror(
        bel_mkstring("Error closing stream: ~a."),
        bel_mkpair(
            bel_mkstring(strerror(errno)),
            bel_g_nil));
}

The default input and output streams are enclosed in Bel objects here, however they relate to stdin and stdout respectively. To the system, by default they have nil value.

void
bel_init_streams(void)
{
    bel_g_ins      = bel_g_nil;
    bel_g_outs     = bel_g_nil;
    bel_g_ins_sys  = bel_mkstream("ins",  BEL_STREAM_READ);
    bel_g_outs_sys = bel_mkstream("outs", BEL_STREAM_WRITE);
}

5.6.1 Stream manipulation safety

Since streams are defined taking advantage of the C API for manipulating files, unfortunately these demand careful usage on Bel programs. When handling streams, it is absolutely necessary to close them. The Boehm GC does not have finalizers for C bindings, so unfortunately it is not possible for now to call a finalizer which automatically closes the stream when the stream object is garbage collected.

5.7 Numbers

As stated before, numbers are not described in Bel specification, however we're implementing it for minimal ease and performance for arithmetic manipulation.

We've built a resilient and recursive model for constituting numbers, so we begin by arranging tools to create them.

5.7.1 Number generation

Integers are pretty straightforward: we just allocate a proper space and store them.

Bel*
bel_mkinteger(int64_t num)
{
    Bel *ret            = GC_MALLOC(sizeof (*ret));
    ret->type           = BEL_NUMBER;
    ret->number.type    = BEL_NUMBER_INT;
    ret->number.num_int = num;
    return ret;
}

The same goes for the float type (which is actually a C double).

Bel*
bel_mkfloat(double num)
{
    Bel *ret              = GC_MALLOC(sizeof (*ret));
    ret->type             = BEL_NUMBER;
    ret->number.type      = BEL_NUMBER_FLOAT;
    ret->number.num_float = num;
    return ret;
}

A fraction has a layer of complexity, though. We take a numerator and a denominator as numbers, but we need to make sure they are numbers. Plus, even if they were, we need to make sure that the denominator is not zero. However, the only checks we perform here are related to the numberness of numerator and denominator.

Bel*
bel_mkfraction(Bel *numer, Bel *denom)
{
    if(!bel_numberp(numer)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not "
                         "a number."),
            bel_mkpair(numer, bel_g_nil));
    }

    if(!bel_numberp(denom)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not "
                         "a number."),
            bel_mkpair(numer, bel_g_nil));
    }
    
    Bel *ret                   = GC_MALLOC(sizeof (*ret));
    ret->type                  = BEL_NUMBER;
    ret->number.type           = BEL_NUMBER_FRACTION;
    ret->number.num_frac.numer = numer;
    ret->number.num_frac.denom = denom;
    return ret;
}

We follow the same principle for a complex number: real and imaginary parts need to be a number themselves.

Bel*
bel_mkcomplex(Bel *real, Bel *imag)
{
    if(!bel_numberp(real)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not "
                         "a number."),
            bel_mkpair(real, bel_g_nil));
    }

    if(!bel_numberp(imag)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not "
                         "a number."),
            bel_mkpair(imag, bel_g_nil));
    }
    
    Bel *ret                   = GC_MALLOC(sizeof (*ret));
    ret->type                  = BEL_NUMBER;
    ret->number.type           = BEL_NUMBER_COMPLEX;
    ret->number.num_compl.real = real;
    ret->number.num_compl.imag = imag;
    return ret;
}

5.7.2 Number arithmetic

The following operations always happen between two numbers. We make sure they are of compatible types to perform these operations, and then we return numbers of a proper subtype afterwards.

  1. Forward declarations
    Bel *bel_num_add(Bel *x, Bel *y); // Forward declaration
    Bel *bel_num_sub(Bel *x, Bel *y); // Forward declaration
    Bel *bel_num_mul(Bel *x, Bel *y); // Forward declaration
    Bel *bel_num_div(Bel *x, Bel *y); // Forward declaration
    
  2. Coercion

    Let's start with subtype coercion. Given a number and a number type flag, we coerce that number to a new number of that subtype. Returns a new number, and does not modify the old one.

    Coercing a float to a fraction uses a naïve approach: we multiply the number by 10 until it has no significant digits on the decimal part. We count the i multiplications we've made, and then we build a fraction where the numerator is a truncated, converted to integer result, and the denominator is exactly ten to the power of i.

    Bel*
    bel_num_coerce(Bel *number, BEL_NUMBER_TYPE type)
    {
        if(number->number.type == type)
            return number;
    
        switch(number->number.type) {
        case BEL_NUMBER_INT:
        {
            switch(type) {
            case BEL_NUMBER_FLOAT:
                return bel_mkfloat(
                    (double)number->number.num_int);
            case BEL_NUMBER_FRACTION:
                return bel_mkfraction(
                    number,
                    bel_mkinteger(1));
            case BEL_NUMBER_COMPLEX:
                return bel_mkcomplex(
                    number,
                    bel_mkinteger(0));
            default: break;
            };
        }
        break;
        case BEL_NUMBER_FLOAT:
        {
            switch(type) {
            case BEL_NUMBER_INT:
                return bel_mkinteger(
                    (int64_t)trunc(number->number.num_float));
            case BEL_NUMBER_FRACTION:
            {
                double num  = number->number.num_float;
                double trun = trunc(num);
                int i = 0;
                while(num != trun) {
                    num *= 10.0;
                    trun = trunc(num);
                    i++;
                }
                return bel_mkfraction(
                    bel_mkinteger((int64_t)num),
                    bel_mkinteger((int64_t)pow(10, i)));
            }
            case BEL_NUMBER_COMPLEX:
                return bel_mkcomplex(number,
                                     bel_mkfloat(0.0));
            default: break;
            };
        }
        break;
        case BEL_NUMBER_FRACTION:
        {
            switch(type) {
            case BEL_NUMBER_INT:
            {
                Bel *float_res =
                    bel_num_div(
                        bel_num_coerce(
                            number->number.num_frac.numer,
                            BEL_NUMBER_FLOAT),
                        bel_num_coerce(
                            number->number.num_frac.denom,
                            BEL_NUMBER_FLOAT));
                
                return bel_mkinteger(
                    (int64_t)trunc(
                        float_res->number.num_float));
            }
            case BEL_NUMBER_FLOAT:
                return bel_num_div(
                    bel_num_coerce(
                        number->number.num_frac.numer,
                        BEL_NUMBER_FLOAT),
                    bel_num_coerce(
                        number->number.num_frac.denom,
                        BEL_NUMBER_FLOAT));
            case BEL_NUMBER_COMPLEX:
                return bel_mkcomplex(number,
                                     bel_mkinteger(0));
            default: break;
            };
        }
        break;
        case BEL_NUMBER_COMPLEX:
        {
            switch(type) {
            case BEL_NUMBER_INT:
            {
                Bel *coerced =
                    bel_num_coerce(
                        number->number.num_compl.real,
                        BEL_NUMBER_FLOAT);
                
                return bel_mkinteger(
                    (int64_t)trunc(
                        coerced->number.num_float));
            }
            case BEL_NUMBER_FLOAT:
                return bel_num_coerce(
                    number->number.num_compl.real,
                    BEL_NUMBER_FLOAT);
            case BEL_NUMBER_FRACTION:
                return bel_num_coerce(
                    number->number.num_compl.real,
                    BEL_NUMBER_FRACTION);
            default: break;
            };
        }
        break;
        default: break;
        };
    
        return number;
    }
    
  3. Force same type

    The following function takes two numbers, and makes sure they both have a subtype where both retain full information. Returns a pair containing both numbers.

    Bel*
    bel_num_mksametype(Bel *x, Bel *y)
    {
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            switch(y->number.type) {
            case BEL_NUMBER_INT:
                // int -> int -> int
                return bel_mkpair(x, y);
            case BEL_NUMBER_FLOAT:
                // int -> float -> float
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_FLOAT),
                    y);
            case BEL_NUMBER_FRACTION:
                // int -> fraction -> fraction
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_FRACTION),
                    y);
            case BEL_NUMBER_COMPLEX:
                // int -> complex -> complex
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_COMPLEX),
                    y);
            default: break;
            }
            break;
        case BEL_NUMBER_FLOAT:
            switch(y->number.type) {
            case BEL_NUMBER_INT:
                // float -> int -> float
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_FLOAT:
                // float -> float -> float
                // same type
                return bel_mkpair(x, y);
            case BEL_NUMBER_FRACTION:
                // float -> fraction -> fraction
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_FRACTION),
                    y);
            case BEL_NUMBER_COMPLEX:
                // float -> complex -> complex
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_COMPLEX),
                    y);
                break;
            default: break;
            }
            break;
        case BEL_NUMBER_FRACTION:
            switch(y->number.type) {
            case BEL_NUMBER_INT:
                // fraction -> int -> int
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_FLOAT:
                // fraction -> float -> fraction
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_FRACTION:
                // fraction -> fraction -> fraction
                // same type
                return bel_mkpair(x, y);
            case BEL_NUMBER_COMPLEX:
                // fraction -> complex -> complex
                return bel_mkpair(
                    bel_num_coerce(x, BEL_NUMBER_COMPLEX),
                    y);
                break;
            default: break;
            }
            break;
        case BEL_NUMBER_COMPLEX:
            switch(y->number.type) {
            case BEL_NUMBER_INT:
                // complex -> int -> complex
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_FLOAT:
                // complex -> float -> complex
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_FRACTION:
                // complex -> fraction -> complex
                // duplicate
                return bel_num_mksametype(y, x);
            case BEL_NUMBER_COMPLEX:
                // complex -> complex -> complex
                // same type
                return bel_mkpair(x, y);
            default: break;
            }
            break;
        default: break;
        }
    }
    
    1. Helper macro for functions

      The following macro does an inline conversion of Bel pointers to same number subtype. Only the locals x and y will be affected; the original pointed objects won't be modified.

      #define BEL_NUM_SAMETYPE(x, y)                  \
          {                                           \
          Bel *p = bel_num_mksametype(x, y);          \
          x = bel_car(p);                             \
          y = bel_cdr(p);                             \
          }
      
  4. Checking for zero

    This function checks whether the argument is zero.

    Comparing directly for zero on a double is not a really good idea. We're doing a naïve approach here, but it is not completely guaranteed.

    int
    bel_num_zerop(Bel *x)
    {
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            return (x->number.num_int == 0);
        case BEL_NUMBER_FLOAT:
            return (x->number.num_float == 0.0)
                || (x->number.num_float == -0.0);
        case BEL_NUMBER_FRACTION:
            return bel_num_zerop(
                x->number.num_frac.numer);
        case BEL_NUMBER_COMPLEX:
            return (bel_num_zerop(
                        x->number.num_compl.real))
                && (bel_num_zerop(
                        x->number.num_compl.imag));
        }
    
        // This should not be reached...
        return 0;
    }
    
  5. Addition

    The following function adds two arbitrary numbers.

    Bel*
    bel_num_add(Bel *x, Bel *y)
    {
        BEL_NUM_SAMETYPE(x, y);
        
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            return bel_mkinteger(
                x->number.num_int + y->number.num_int);
        case BEL_NUMBER_FLOAT:
            return bel_mkfloat(
                x->number.num_float + y->number.num_float);
        case BEL_NUMBER_FRACTION:
        {
            Bel *new_numer_x =
                bel_num_mul(x->number.num_frac.numer,
                            y->number.num_frac.denom);
            Bel *new_numer_y =
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.numer);
            Bel *new_denom =
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.denom);
    
            return bel_mkfraction(
                bel_num_add(new_numer_x, new_numer_y),
                new_denom);
        }
        case BEL_NUMBER_COMPLEX:
            return bel_mkcomplex(
                bel_num_add(x->number.num_compl.real,
                            y->number.num_compl.real),
                bel_num_add(x->number.num_compl.imag,
                            y->number.num_compl.imag));
        default: break;
        };
        
        return bel_mkerror(
            bel_mkstring("Error while adding ~a and ~a."),
            bel_mkpair(x, bel_mkpair(y, bel_g_nil)));
    }
    
  6. Subtraction

    This function is identical to bel_num_add, however it subtracts two numbers.

    Bel*
    bel_num_sub(Bel *x, Bel *y)
    {
        BEL_NUM_SAMETYPE(x, y);
    
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            return bel_mkinteger(
                x->number.num_int - y->number.num_int);
        case BEL_NUMBER_FLOAT:
            return bel_mkfloat(
                x->number.num_float - y->number.num_float);
        case BEL_NUMBER_FRACTION:
        {
            Bel *new_numer_x =
                bel_num_mul(x->number.num_frac.numer,
                            y->number.num_frac.denom);
            Bel *new_numer_y =
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.numer);
            Bel *new_denom =
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.denom);
    
            return bel_mkfraction(
                bel_num_sub(new_numer_x, new_numer_y),
                new_denom);
        }
        case BEL_NUMBER_COMPLEX:
            return bel_mkcomplex(
                bel_num_sub(x->number.num_compl.real,
                            y->number.num_compl.real),
                bel_num_sub(x->number.num_compl.imag,
                            y->number.num_compl.imag));
        default: break;
        };
        
        return bel_mkerror(
            bel_mkstring("Error while subtracting ~a "
                         "and ~a."),
            bel_mkpair(x, bel_mkpair(y, bel_g_nil)));
    }
    
  7. Multiplication

    This function multiplies two arbitrary numbers.

    Bel*
    bel_num_mul(Bel *x, Bel *y)
    {
        BEL_NUM_SAMETYPE(x, y);
        
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            return bel_mkinteger(
                x->number.num_int * y->number.num_int);
        case BEL_NUMBER_FLOAT:
            return bel_mkfloat(
                x->number.num_float * y->number.num_float);
        case BEL_NUMBER_FRACTION:
            return bel_mkfraction(
                bel_num_mul(x->number.num_frac.numer,
                            y->number.num_frac.numer),
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.denom));
        case BEL_NUMBER_COMPLEX:
        {
            Bel *real =
                bel_num_sub(
                    bel_num_mul(x->number.num_compl.real,
                                y->number.num_compl.real),
                    bel_num_mul(x->number.num_compl.imag,
                                y->number.num_compl.imag));
            Bel *imag =
                bel_num_add(
                    bel_num_mul(x->number.num_compl.real,
                                y->number.num_compl.imag),
                    bel_num_mul(x->number.num_compl.imag,
                                y->number.num_compl.real));
    
            return bel_mkcomplex(real, imag);
        }
        break;
        default: break;
        };
    
        return bel_mkerror(
            bel_mkstring("Error while multiplying "
                         "~a and ~a."),
            bel_mkpair(x, bel_mkpair(y, bel_g_nil)));
    }
    
  8. Division

    This function divides two arbitrary numbers. Notice that we check whether the second argument is zero.

    Bel*
    bel_num_div(Bel *x, Bel *y)
    {
        BEL_NUM_SAMETYPE(x, y);
    
        if(bel_num_zerop(y)) {
            return bel_mkerror(
                bel_mkstring("Cannot divide by zero."),
                bel_g_nil);
        }
        
        switch(x->number.type) {
        case BEL_NUMBER_INT:
            if(x->number.num_int % y->number.num_int) {
                return bel_mkfraction(x, y);
            } else {
                return bel_mkinteger(
                    x->number.num_int / y->number.num_int);
            }
        case BEL_NUMBER_FLOAT:
            return bel_mkfloat(
                x->number.num_float / y->number.num_float);
        case BEL_NUMBER_FRACTION:
            return bel_mkfraction(
                bel_num_mul(x->number.num_frac.numer,
                            y->number.num_frac.denom),
                bel_num_mul(x->number.num_frac.denom,
                            y->number.num_frac.numer));
        case BEL_NUMBER_COMPLEX:
        {
            Bel *numer = bel_mkcomplex(
                bel_num_add(
                    bel_num_mul(x->number.num_compl.real,
                                y->number.num_compl.real),
                    bel_num_mul(x->number.num_compl.imag,
                                y->number.num_compl.imag)),
                bel_num_add(
                    bel_num_mul(
                        bel_mkinteger(-1),
                        bel_num_mul(x->number.num_compl.real,
                                    y->number.num_compl.imag)),
                    bel_num_mul(x->number.num_compl.imag,
                                y->number.num_compl.real)));
    
            Bel *denom = bel_num_add(
                bel_num_mul(y->number.num_compl.real,
                            y->number.num_compl.real),
                bel_num_mul(y->number.num_compl.imag,
                            y->number.num_compl.imag));
    
            return bel_mkfraction(numer, denom);
        }
        default: break;
        }
    
        return bel_mkerror(
            bel_mkstring("Error while dividing "
                         "~a and ~a."),
            bel_mkpair(x, bel_mkpair(y, bel_g_nil)));
    }
    

5.8 Errors

Bel does not have a formal specification on errors in primitives, other than saying that there might be an err function which throws an error in the system.

I will therefore specify that, in Believe, an error is a literal (much like closures and primitives) which obeys the pattern…

(lit err format . args)

…where lit is the expected symbol for something that evaluates to itself, err is the symbol which specifies that the object is an error, format is a Bel string which contains a format for the given arguments, and args is a list of arguments which should be parsed within the format.

For a first implementation, I intend to make the format specification follow loosely the conventions of the format macro in Common Lisp, having ~a as the format for any object and ~% as the format for a new line, for example.

Here's how it could look like:

> (err "Cannot use ~a on ~a.~%" '(1 2 3) square)
Error: Cannot use (1 2 3) on (lit clo nil (x) (* x x)).

However, since this is a detail which can be implemented in Bel itself, we'll just go ahead and say that there is a string format and a list of arguments.

Bel*
bel_mkerror(Bel *format, Bel *arglist)
{
    return bel_mkpair(
        bel_mksymbol("lit"),
        bel_mkpair(
            bel_mksymbol("err"),
            bel_mkpair(format, arglist)));
}

6 Axioms

To save memory, some of the following things will be globally defined.

6.1 Variables and constants

Define global symbols which can be used across the program. These symbols should be used repeatedly, and that's why they were already declared. See the bel_init function to refer to their initialization.

void
bel_init_ax_vars(void)
{
    bel_g_nil   = bel_mksymbol("nil");
    bel_g_t     = bel_mksymbol("t");
    bel_g_o     = bel_mksymbol("o");
    bel_g_apply = bel_mksymbol("apply");

    bel_g_prim  = bel_mksymbol("prim");
    bel_g_clo   = bel_mksymbol("clo");
}

bel_g_prim is not part of the axiom variables, but we'll define it here since we'll need this symbol for generating primitives later.

6.2 List of all characters

First, we build an auxiliary function which converts an 8-bit number into a string, where each character represents a bit.

char*
bel_conv_bits(uint8_t num)
{
    char *str = GC_MALLOC(9 * sizeof(*str));
    
    uint8_t i;
    for(i = 0; i < 8; i++) {
        int is_bit_set = num & (1 << i);
        str[7 - i] = is_bit_set ? '1' : '0';
    }
    str[8] = '\0';
    
    return str;
}

We build a list of all characters so that the specification gets happy. It will be stored in the previously defined bel_g_chars global variable. This might seem unecessary in the future, though.

The list is supposed to be built out of pairs, therefore we start by creating 255 Bel instances, representing list nodes; every node is supposed to hold the pointer to a Bel_pair. These pairs will be linked to one another: the cdr of the first Bel_pair (again, contained inside a Bel instance) points to the second Bel; the cdr of the second Bel_pair (also contained on its Bel instance) points to the third Bel, and so on. The last cdr of the last Bel_pair, also enclosed on a Bel instance, contains the symbol nil.

Now, we discuss what should be held in the car of each of these pairs. And that would be other pairs, which will hold the actual information we desire. Each of these secondary pairs is comprised of a character at its car, and a Bel string representing the bits of the character as its cdr.

void
bel_init_ax_chars(void)
{
    // Create a vector of 255 list nodes
    Bel **list = GC_MALLOC(255 * sizeof(*list));

    size_t i;
    for(i = 0; i < 255; i++) {        
        // Build a pair which holds the character information
        Bel *pair = bel_mkpair(bel_mkchar((Bel_char)i),
                               bel_mkstring(bel_conv_bits(i)));
        // Assign the car of a node to the current pair,
        // set its cdr temporarily to nil
        list[i] = bel_mkpair(pair, bel_g_nil);
    }

    // Assign each pair cdr to the pair on the front.
    // Last pair should have a nil cdr still.
    for(i = 0; i < 254; i++) {
        list[i]->pair->cdr = list[i + 1];
    }

    // Hold reference to first element only
    bel_g_chars = list[0];
}

6.3 Environment

Any environment is nothing but a list of pairs, where each pair (var . val) represents the binding of a specific symbol var to the value val.

We begin by creating a function which pushes, non-destructively, a new pair to any environment. The result is the new environment.

Bel*
bel_env_push(Bel *env, Bel *var, Bel *val)
{
    Bel *new_pair = bel_mkpair(var, val);
    return bel_mkpair(new_pair, env);
}

Notice that this non-destructive approach is important, since a lexical enviroment is supposed to extend the enviroment it is called on – for example, the environment of a function called from top-level is a list where the first elements are lexical bindings, and (conceptually) the latter elements are bindings belonging to the global environment.

Now we register all our axioms to our global environment. This way, a lookup operation on the global scope will yield proper values.

First, we define a macro which uses bel_env_push to modify the globe environment variable. This macro just takes a SYMSTR, turns it into a symbol, and generates a new environment, which is then assigned to the global environment.

#define BEL_ENV_GLOBAL_PUSH(SYMSTR, VAL)           \
    (bel_g_globe =                                 \
     bel_env_push(bel_g_globe,                     \
                  bel_mksymbol(SYMSTR), VAL))

Initializing the global environment involves pushing certain values to it. But the dynamic and lexical environments are initialized to nil.

void
bel_init_ax_env(void)
{
    bel_g_globe = bel_g_nil;
    bel_g_dynae = bel_g_nil;
    bel_g_scope = bel_g_nil; // TODO: is this really necessary?
    
    BEL_ENV_GLOBAL_PUSH("chars", bel_g_chars);
    BEL_ENV_GLOBAL_PUSH("ins",   bel_g_ins);
    BEL_ENV_GLOBAL_PUSH("outs",  bel_g_outs);
}

Then, we create a lookup function. This function traverses an environment in linear time, so it is not fast, but it does its job. A lookup process either returns the associated value or returns nil.

Bel*
bel_env_lookup(Bel *env, Bel *sym)
{
    if(bel_nilp(env)) {
        return bel_g_nil;
    }
    
    if(!bel_symbolp(sym)) {
        return bel_mkerror(
            bel_mkstring("Cannot perform lookup of ~a, "
                         "which is not a symbol."),
            bel_mkpair(sym, bel_g_nil));
    }

    Bel *itr = env;
    while(!bel_nilp(itr)) {
        Bel *p = bel_car(itr);
        if(bel_car(p)->type == BEL_SYMBOL
           && bel_car(p)->sym == sym->sym) {
            return bel_cdr(p);
        }
        
        itr = bel_cdr(itr);
    }
    return bel_g_nil;
}

We also implement a proper lookup function which takes a lexical environment and a symbol. The function traverses all environments in order (dynamic, lexical, global) to find the associated value of the given symbol. If the symbol is not found, returns an error.

Bel*
bel_lookup(Bel *lenv, Bel *sym)
{
    Bel *value;

    // Dynamic scope lookup
    value = bel_env_lookup(bel_g_dynae, sym);
    if(!bel_nilp(value)) {
        return value;
    }
    
    // Lexical scope lookup
    value = bel_env_lookup(lenv, sym);
    if(!bel_nilp(value)) {
        return value;
    }

    // Global scope lookup
    value = bel_env_lookup(bel_g_globe, sym);
    if(bel_nilp(value)) {
        return bel_mkerror(
            bel_mkstring("The symbol ~a is unbound."),
            bel_mkpair(sym, bel_g_nil));
    }

    return value;
}

Another thing to do is enable assignment. We begin by creating a function which finds a specific symbol on a specific environment and replaces its value by the given one. On success, it returns the symbol; on failure, it returns nil. If the environment is empty, we also return nil. Oh, we also don't check if the given symbol is really a symbol, since this is an internal function.

Bel*
bel_env_replace_val(Bel *env, Bel *sym, Bel *new_val)
{
    if(bel_nilp(env)) {
        return bel_g_nil;
    }
    
    Bel *itr = env;
    while(!bel_nilp(itr)) {
        Bel *p = bel_car(itr);
        if(bel_idp(sym, bel_car(p))) {
            p->pair->cdr = new_val;
            return sym;
        }
        itr = bel_cdr(itr);
    }
    return bel_g_nil;
}

We also need a function which takes the reference to an environment and a symbol, and unbinds that symbol from the value in the environment. This can be achieved by simply iterating over the list and "unlinking" the relevant pair. We also don't perform all the checks on this internal function.

This function might modify the environment passed as reference by argument. We only return a non-nil answer (which is the same environment, but modified) if and only if the unbinding was successful.

Bel*
bel_env_unbind(Bel **env, Bel *sym)
{
    if(bel_nilp(*env)) {
        return bel_g_nil;
    }
    
    // If first element is a match, return
    // cdr of environment
    if(bel_idp(bel_car(bel_car(*env)), sym)) {
        *env = bel_cdr(*env);
        return bel_g_t;
    }

    // Iterate looking at the next element always.
    // If next element is a match, set current cdr
    // to cdr of next element
    Bel *itr = *env;
    while(!bel_nilp(bel_cdr(itr))) {
        Bel *p = bel_car(bel_cdr(itr));
        if(bel_idp(bel_car(p), sym)) {
            itr->pair->cdr = p->pair->cdr;
            return bel_g_t;
        }
        
        itr = bel_cdr(itr);
    }

    // On no substitution, return nil
    return bel_g_nil;
}

The assignment operation itself respects the hierarchy of environments, to be described in the next subsection. We attempt to make an assignment on the three kinds of environment (lexical – given as argument –, dynamic and global). If the assignment fails in any of these, the symbol is bound to the given new value, on the global environment.

Bel*
bel_assign(Bel *lenv, Bel *sym, Bel *new_val)
{
    Bel *ret;

    // Dynamic assignment
    ret = bel_env_replace_val(bel_g_dynae, sym, new_val);
    if(!bel_nilp(ret)) return sym;
    
    // Lexical assignment
    ret = bel_env_replace_val(lenv, sym, new_val);
    if(!bel_nilp(ret)) return sym;

    // Global assignment
    ret = bel_env_replace_val(bel_g_globe, sym, new_val);
    if(!bel_nilp(ret)) return sym;

    // When not assignment was made, we push a global value
    bel_g_globe = bel_env_push(bel_g_globe, sym, new_val);
    return sym;
}

We proceed by the same principle for the actual unbinding function: we respect the hierarchy of environments. Like bel_env_unbind, this function might modify the passed environment, and that is why we take a reference to it.

Bel*
bel_unbind(Bel **lenv, Bel *sym)
{
    Bel *ans;

    // Dynamic unbinding
    ans = bel_env_unbind(&bel_g_dynae, sym);
    if(!bel_nilp(ans)) {
        return sym;
    }
    
    // Lexical unbinding
    ans = bel_env_unbind(lenv, sym);
    if(!bel_nilp(ans)) {
        return sym;
    }

    // Global unbinding
    ans = bel_env_unbind(&bel_g_globe, sym);
    if(!bel_nilp(ans)) {
        return sym;
    }

    // On no unbinding, return nil
    return bel_g_nil;
}

6.3.1 Types and hierarchy of environments

There are three kinds of environments in Bel: Global, Lexical and Dynamic. The global environment (bel_g_globe, globe) contains symbols which are always visible from all scopes. This environment lives for the lifetime of the interpreter.

The lexical environment (bel_g_scope, scope) contains symbols which are visible only inside the current scope, and lives for a short period of time, linked to its scope. It is the environment captured by closures, and also the environment created when a closure is applied (as a specific symbol is bound to evaluate a closure's body).

The dynamic environment (bel_g_dynae) is like the global environment on its regards to access (symbols are visible to the whole application). However, the dynamic environment lives for a short period of time, linked to the scope it is used.

In Bel, any symbol lookup is performed by traversing the environments in the following order: Dynamic, Lexical, Global.

6.3.2 Environment extension and capturing

Being a sequential list of pairs, where the values are pushed to their top, environments (such as the lexical) can share symbols. For example, suppose the following closure called orig-fun.

(def orig-fun (x y)
  (join (new-fun x) y))

Suppose further that this closure is applied to the symbols foo and bar. They are then bound respectively to x and y. The closure's lexical environment during application would look like this:

((y . bar)  (x . foo))

Suppose also that the closure new-fun is defined like this:

(def new-fun (x)
  (id x 'foo))

When new-fun is applied inside orig-fun, it captures orig-fun's lexical environment. Additionally, new-fun binds foo (associated with the original x symbol) to a new x symbol. So new-fun's lexical environment looks like this:

((x . foo)  (y . bar)  (x . foo))

Since the environment stacks up definitions, a lookup process begins at top (here displayed as the leftmost pair) and finds the first binding of the requested symbol that it can find. So in new-fun, the value associated to the symbol x can only be the first pair represented above; however, after the evaluation of new-fun, back at orig-fun, the associated value of x would be the last pair.

Another interesting fact is that, if new-fun were to make a blind assignment to y after being called inside orig-fun, y's associated value would be changed in orig-fun's lexical environment, so the new value of y would be seen not only at new-fun; it would still be different when we returned to orig-fun.

If new-fun were called from outside orig-fun (more specifically, at top level), such assignment to y would create a new binding on the global environment, effectively creating a new global variable.

6.4 Literals

Although literals have already been seen on error implementation, but here we reuse the concept to generate literals that should exist on the global environment.

A literal is a list, where the first element is the symbol lit. Literals are described like persistent quotes, since evaluating a quoted form strips away the quoting. A literal is what should be used to describe things that evaluate to themselves.

Literals follow the form (lit . rest), where lit is a symbol, and rest is a proper list of things that should be treated as a literal.

Primitives and functions are internally described as literals.

The first thing to do is create a tool for generating a literal; in general, what it does is create a pair, where the car is the symbol lit, and the cdr is anything that should be treated as a literal.

Bel*
bel_mkliteral(Bel *rest)
{
    if(!bel_proper_list_p(rest)) {
        return bel_mkerror(
            bel_mkstring("The object ~a is not a "
                         "proper list to be turned "
                         "into a literal."),
            bel_mkpair(rest, bel_g_nil));
    }

    return bel_mkpair(bel_mksymbol("lit"),
                      rest);
}

6.4.1 Primitives

As stated above, primitives are represented as literals, since they evaluate to themselves. We start by defining a tool to create a certain primitive; it should be noted that, since primitives are internal to the Bel implementation, this function does not check for errors.

A primitive has the form (lit prim name), where lit and prim are constant symbols, and name is a symbol for the primitive name.

Bel*
bel_mkprim(Bel *sym)
{
    return bel_mkliteral(
        bel_mkpair(bel_g_prim,
                   bel_mkpair(sym, bel_g_nil)));
}

The next definition is a macro where, given an environment env and a C string literal x, it generates a primitive for x and pushes it to the enviroment env.

#define BEL_REGISTER_PRIM(env, x)               \
    {                                           \
    Bel *sym = bel_mksymbol(x);                 \
    env = bel_env_push(env, sym,                \
                       bel_mkprim(sym));        \
    }

Then we create a function where, given an environment env, it registers all Bel primitives on it, creating a new environment which is returned. Notice that this new environment is in fact making use of the original one.

Bel*
bel_gen_primitives(Bel *env)
{
    // Primitive functions
    BEL_REGISTER_PRIM(env, "id");
    BEL_REGISTER_PRIM(env, "join");
    BEL_REGISTER_PRIM(env, "car");
    BEL_REGISTER_PRIM(env, "cdr");
    BEL_REGISTER_PRIM(env, "type");
    BEL_REGISTER_PRIM(env, "xar");
    BEL_REGISTER_PRIM(env, "xdr");
    BEL_REGISTER_PRIM(env, "sym");
    BEL_REGISTER_PRIM(env, "nom");
    BEL_REGISTER_PRIM(env, "wrb");
    BEL_REGISTER_PRIM(env, "rdb");
    BEL_REGISTER_PRIM(env, "ops");
    BEL_REGISTER_PRIM(env, "cls");
    BEL_REGISTER_PRIM(env, "stat");
    BEL_REGISTER_PRIM(env, "coin");
    BEL_REGISTER_PRIM(env, "sys");

    // Primitive operators
    BEL_REGISTER_PRIM(env, "+");
    BEL_REGISTER_PRIM(env, "-");
    BEL_REGISTER_PRIM(env, "*");
    BEL_REGISTER_PRIM(env, "/");
    BEL_REGISTER_PRIM(env, "<");
    BEL_REGISTER_PRIM(env, "<=");
    BEL_REGISTER_PRIM(env, ">");
    BEL_REGISTER_PRIM(env, ">=");
    BEL_REGISTER_PRIM(env, "=");

    // Other primitives
    BEL_REGISTER_PRIM(env, "err");
    
    return env;
}

The last step is to have a function which pushes these primitives automatically to the globe environment.

void
bel_init_ax_primitives()
{
    bel_g_globe = bel_gen_primitives(bel_g_globe);
}

6.4.2 Closures

Creating a closure is very straightforward. We take an environment and a list. Such list must have two elements, where the first is a lambda list, and the second is the body of the function.

Bel*
bel_mkclosure(Bel *lenv, Bel *rest)
{
    return bel_mkliteral(
        bel_mkpair(bel_g_clo,
                   bel_mkpair(lenv, rest)));
}

7 Printing

The following functions are used to print a certain object on standard output.

7.1 Forward declarations

We forward declare the bel_print function since printing pairs calls it for the pairs' parts.

void bel_print(Bel*); // Forward declaration

7.2 Printing pairs

The first function is a specialization for printing pairs in general. This function should also handle the printing of lists gracefully.

void
bel_print_pair(Bel *obj)
{
    if(bel_nilp(obj)) return;
    
    Bel *itr = obj;
    
    putchar('(');
    while(!bel_nilp(itr)) {
        Bel *car = bel_car(itr);
        Bel *cdr = bel_cdr(itr);

        bel_print(car);
        
        if(bel_nilp(cdr)) {
            break;
        } else if(cdr->type != BEL_PAIR) {
            putchar(' ');
            putchar('.');
            putchar(' ');
            bel_print(cdr);
            break;
        }
        putchar(' ');
        itr = cdr;
    }
    putchar(')');
}

7.3 Printing strings

A string is a very specific type of list: it is a proper list comprised only of characters. However, this function is not supposed to test for the object's type; instead, it must be called when we are certain that the object in question is a string.

void
bel_print_string(Bel *obj)
{
    putchar('\"');
    Bel *itr = obj;
    while(!bel_nilp(itr)) {
        Bel_char c = bel_car(itr)->chr;

        switch(c) {
        case '\a': printf("\\bel"); break;
        default:   putchar(c);      break;
        }

        itr = bel_cdr(itr);
    }
    putchar('\"');
}

7.4 Printing streams

Printing a stream involves printing something that cannot be read back in, so it can be considered merely aestethic. I made an option of either printing that it is closed, or printing its status along with the raw pointer.

void
bel_print_stream(Bel *obj)
{
    printf("#<stream :status ");
    if(obj->stream.status == BEL_STREAM_CLOSED) {
        printf("closed>");
    } else {
        switch(obj->stream.status) {
        case BEL_STREAM_READ:  printf("input ");  break;
        case BEL_STREAM_WRITE: printf("output "); break;
        default: printf("unknown ");              break;
        }
        printf("{0x%08lx}>", (uint64_t)obj->stream.raw_stream);
    }
}

7.5 Printing numbers

We develop a function to print an arbitrary number. The function takes the number itself and a parameter which tells whether the sign should be explicit (the reason for that will be evident soon).

To print an integer, the only thing to do is to print a long int. We prepend it with a plus if the number is positive and the explicit sign flag is on.

To print a float, we print a double with reduced notation. If the number is round, we append .0 to it. We also follow the same rule of integers when prepending the plus sign.

A fraction is a pair of two numbers. We just enclose them in a textual representation like #(f number), where number is the numerator and the denominator separated by a slash. These two components can also be numbers of any kind, so we print them recursively, without forcing the plus sign.

A complex is also a pair of two numbers of any kind, where the first number is the real part and the second number is the imaginary part, which multiplies i. So we enclose it in a textual representation like #(c number), where number is a complex number in the form R+Ai. In this form, R is the real part, printed as any Bel number; A is the imaginary part, but we force it to print its sign on screen, and then we prepend it with an i. To force A's sign to appear, we call this function recursively, with the force_sign flag active.

void
bel_print_number(Bel *num, int force_sign)
{
    switch(num->number.type) {
    case BEL_NUMBER_INT:
        if(force_sign && (num->number.num_int >= 0))
            putchar('+');
        printf("%ld", num->number.num_int);
        break;
    case BEL_NUMBER_FLOAT:
        if(force_sign && (num->number.num_float >= 0.0))
            putchar('+');
        printf("%lg", num->number.num_float);
        // Trailing .0 on round number
        if(num->number.num_float
           == trunc(num->number.num_float)) {
            printf(".0");
        }
        break;
    case BEL_NUMBER_FRACTION:
        printf("#(f ");
        bel_print_number(num->number.num_frac.numer, 0);
        putchar('/');
        bel_print_number(num->number.num_frac.denom, 0);
        putchar(')');
        break;
    case BEL_NUMBER_COMPLEX:
        printf("#(c ");
        bel_print_number(num->number.num_frac.numer, 0);
        bel_print_number(num->number.num_frac.denom, 1);
        printf("i)");
        break;
    default:
        printf("#<\?\?\?>");
        break;
    }
}

7.6 Generic printing

The next function handles the printing of any data type. Notice that it does not automatically print a newline character.

void
bel_print(Bel *obj)
{
    switch(obj->type) {
    case BEL_SYMBOL:
        printf("%s", g_sym_table.tbl[obj->sym]);
        break;
    case BEL_PAIR:
        if(!bel_stringp(obj)) {
            bel_print_pair(obj);
        } else {
            bel_print_string(obj);
        }
        break;
    case BEL_CHAR:
        if(obj->chr == '\a')
            printf("\\bel"); // There is no Bel without \bel
        else printf("\\%c", obj->chr);
        break;
    case BEL_STREAM:
        bel_print_stream(obj);
        break;
    case BEL_NUMBER:
        bel_print_number(obj, 0);
        break;
    default:
        printf("#<\?\?\?>"); // wat
        break;
    };
}

8 Evaluator

The evaluator is the most crucial part of the Bel system. We follow the pattern of the metacircular evaluator: by having two functions, eval and apply, we make them call themselves mutually, equipping them with auxiliary functions and special forms to produce a working interpreter for a Lisp language.

8.1 Forward declarations

These declarations specify the most crucial functions of the interpreter. Forward declarations are important for the mutual calling part.

Bel *bel_eval(Bel *exp, Bel *lenv);             // Forward declaration
Bel *bel_apply(Bel *proc, Bel *args);           // Forward declaration
Bel *bel_evlist(Bel *elist, Bel *lenv);         // Forward declaration
Bel *bel_apply_primop(Bel *sym, Bel *args);     // Forward declaration
Bel *bel_bind(Bel *vars, Bel *vals, Bel *lenv); // Forward declaration

The following forward declarations are related to special forms on the evaluator. These special forms are handled outside of the eval function to make it more succinct.

Bel *bel_special_if(Bel *exp, Bel *lenv);       // Forward declaration
Bel *bel_special_quote(Bel *exp, Bel *lenv);    // Forward declaration
Bel *bel_special_dyn(Bel *rest, Bel *lenv);     // Forward declaration
Bel *bel_special_set(Bel *clauses, Bel *lenv);  // Forward declaration

8.2 The eval function

bel_eval is the evaluation function. The objective is to take a particular expression, identify what it is (whether it is a special form or a simple function application), and dispatch it accordingly.

When a simple application is performed, we take a list and consider that the first element is the symbol that the function is bound to. So we evaluate every element of the list, including the function, and then we apply the closure (produced by evaluation of the function) to the rest of the evaluated elements, which will be passed as arguments.

It is also important to notice that the closure captures the lexical environment where it is evaluated.

Bel*
bel_eval(Bel *exp, Bel *lenv)
{
#ifdef BEL_DEBUG
    printf("eval>  ");
    bel_print(exp);
    putchar(10);
#endif

    // numbers eval to themselves
    if(bel_numberp(exp))
        return exp;
    
    // symbol
    if(bel_symbolp(exp)) {
        // If one of axiom symbols, eval to itself
        if(bel_idp(exp, bel_g_nil)
           || bel_idp(exp, bel_g_t)
           || bel_idp(exp, bel_g_o)
           || bel_idp(exp, bel_g_apply))
            return exp;
        // else lookup on table
        return bel_lookup(lenv, exp);
    }

    // quote
    if(bel_quotep(exp))
        return bel_special_quote(exp, lenv);
    
    // lit
    else if(bel_literalp(exp))
        return exp; // eval to itself

    // string
    else if(bel_stringp(exp))
        return exp; // eval to itself

    // Special forms
    else if(bel_proper_list_p(exp)) {
        // fn: closure
        if(bel_idp(bel_car(exp), bel_mksymbol("fn")))
            return bel_mkclosure(lenv, bel_cdr(exp));
    
        // if
        if(bel_idp(bel_car(exp), bel_mksymbol("if")))
            return bel_special_if(exp, lenv);

        // TODO:
        // apply
        // where (not straightforward)
        
        // dyn
        if(bel_idp(bel_car(exp), bel_mksymbol("dyn")))
            return bel_special_dyn(bel_cdr(exp), lenv);
        
        // after
        
        // set (global binding)
        if(bel_idp(bel_car(exp), bel_mksymbol("set")))
            return bel_special_set(bel_cdr(exp), lenv);
        
        // ccc (call/cc)
        // thread (does not share dynamic binding)

        // otherwise it is the case of an application
        return bel_apply(bel_eval(bel_car(exp), lenv),
                         bel_evlist(bel_cdr(exp), lenv));
    }

    return bel_mkerror(
        bel_mkstring("~a is not a proper list "
                     "for the application of "
                     "a function."),
        bel_mkpair(exp, bel_g_nil));
}

8.3 The apply function

bel_apply is the application function. It takes a certain function and applies to the list of evaluated arguments. A function can be a primitive, but can also be a literal closure.

To apply a closure, we bind all arguments to the closure's formal parameters, creating an extended lexical environment; then we proceed to evaluate the closure's body under that new lexical environment.

Bel*
bel_apply(Bel *fun, Bel *args)
{
#ifdef BEL_DEBUG
    printf("apply> ");
    bel_print(fun);
    printf(" -> ");
    bel_print(args);
    putchar(10);
#endif
    
    // Check for errors on fun
    if(bel_errorp(fun)) {
        return fun;
    }
    
    // Primitive procedure
    else if(bel_primitivep(fun)) {
        return bel_apply_primop(
            bel_car(bel_cdr(bel_cdr(fun))),
            args);
    }
    
    // Closure
    else if(bel_closurep(fun)) {
        Bel *lenv =
            bel_car(
                bel_cdr(bel_cdr(fun)));
        Bel *lambda_list =
            bel_car(
                bel_cdr(bel_cdr(bel_cdr(fun))));
        Bel *body =
            bel_car(
                bel_cdr(bel_cdr(bel_cdr(
                                    bel_cdr(fun)))));
        
        // Generate a new environment with the
        // arguments bound in it
        Bel *new_env = bel_bind(lambda_list,
                                args,
                                lenv);

        if(bel_errorp(new_env)) {
            return new_env;
        }

        // Evaluate body on the new environment
        return bel_eval(body, new_env);
    }

    // Error
    else {
        return bel_mkerror(
            bel_mkstring("~a is not a procedure"),
            bel_mkpair(fun, bel_g_nil));
    }
}

8.4 Auxiliary functions

The following functions are also essential to the evaluator, but have a more secondary role, such as handling special forms, applying primitive operators, and other kinds of things.

8.4.1 Evaluating special forms

Some special forms require greater attention, and so it is a little better to give them their own function.

  1. (quote x)

    In Lisp languages, quoting an atom, like the expression 'a, translates to an expression such as (quote a), which will then be evaluated by returning only the symbol a.

    Bel*
    bel_special_quote(Bel *exp, Bel *lenv)
    {
        uint64_t len = bel_length(exp);
        if(len != 2) {
            return bel_mkerror(
                bel_mkstring("Malformed quote: can only "
                             "quote one object."),
                bel_g_nil);
        }
    
        return bel_car(bel_cdr(exp));
    }
    
  2. (if . clauses)

    The conditional if takes any number of clauses (at least two), and does their evaluation in pairs of clauses (not to be confused with the pair data type).

    Suppose that we have a conditional such as

    (if cond1 pred1 cond2 pred2)
    

    We evaluate cond1. If its result is not nil, we return the evaluation of pred1.

    If evaluation of cond1 is nil, however, we don't evaluate pred1; we proceed to test the evaluation of cond2. If cond2 yields a non-nil result, however, we return the evaluation of pred2.

    There can also be a different scenario, where the number of clauses is odd, like

    (if cond1 pred1 cond2 pred2 altern)
    

    If, during evaluation, cond2 did not yield a non-nil result, then pred2 would be skipped; however, as there are no more pairs, but only the a single altern clause, it will be evaluated and its results will be returned, as an alternative.

    Bel*
    bel_special_if(Bel *exp, Bel *lenv)
    {
        Bel *body       = bel_cdr(exp);
        uint64_t length = bel_length(body);
    
        if(length < 2) {
            return bel_mkerror(
                bel_mkstring("if statement must have at "
                             "least one predicate with "
                             "a consequent."),
                bel_g_nil);
        }
    
        Bel *predicate;
        Bel *consequent;
                
        while(1) {
            predicate  = bel_car(body);
            consequent = bel_car(bel_cdr(body));
            body = bel_cdr(bel_cdr(body));
    
            // nil consequent = return-eval predicate
            if(bel_nilp(consequent)) {
                return bel_eval(predicate, lenv);
            }
    
            if(!bel_nilp(bel_eval(predicate, lenv))) {
                return bel_eval(consequent, lenv);
            }
        }
                
        return bel_g_nil;
    }
    
  3. (dyn v x y)

    The special form dyn evaluates x and dynamically binds it to symbol v. After this dynamic binding, it then evaluates y, and finally unbinds x.

    This implementation of dyn is not thread-happy yet, since every thread is supposed to have its dynamic bindings, which are not shared. This, however, is something that will be solved later.

    Bel*
    bel_special_dyn(Bel *rest, Bel *lenv)
    {
        uint64_t len = bel_length(rest);
    
        if(len > 3) {
            return bel_mkerror(
                bel_mkstring("Too many arguments on "
                             "dynamic binding."),
                bel_g_nil);
        }
        
        Bel *sym = bel_car(rest);
        Bel *x   = bel_car(bel_cdr(rest));
        Bel *y   = bel_car(bel_cdr(bel_cdr(rest)));
    
        if(!bel_symbolp(sym)) {
            return bel_mkerror(
                bel_mkstring("Dynamic bindings can only "
                             "be attributed to symbols."),
                bel_g_nil);
        }
    
        if(bel_nilp(sym)) {
            return bel_mkerror(
                bel_mkstring("Cannot bind value to nil."),
                bel_g_nil);
        }
    
    #ifdef BEL_DEBUG
        printf("dynb>  ");
        bel_print(sym);
        printf(" := ");
        bel_print(x);
        putchar(10);
    #endif
        
        bel_g_dynae =
            bel_env_push(bel_g_dynae,
                         sym,
                         bel_eval(x, lenv));
    
        Bel *ret = bel_eval(y, lenv);
        bel_env_unbind(&bel_g_dynae, sym);
        
        return ret;
    }
    
  4. (set . rest)

    This form works with pairs in an expression like (set s1 v1 s2 v2...) in such a way that vn is evaluated and globally bound to sn.

    This is the form behind definitions of functions, for example.

    For the global assignments to happen properly, we evaluate all expressions before binding. This does not prevent side effects on the evaluation of values being assigned, but the values will only be assigned if no evaluation error happened. Plus, assignment can only be done to non nil symbols.

    Bel*
    bel_special_set(Bel *clauses, Bel *lenv)
    {
        Bel *syms = bel_g_nil;
        Bel *vals = bel_g_nil;
    
        Bel *itr = clauses;
        while(!bel_nilp(itr)) {
            Bel *sym = bel_car(itr);
    
            if(!bel_symbolp(sym) || bel_nilp(sym)) {
                return bel_mkerror(
                    bel_mkstring("Global bindings can only "
                                 "be attributed to valid "
                                 "symbols."),
                    bel_g_nil);
            }
            
            Bel *val =
                bel_eval(bel_car(bel_cdr(itr)),
                         lenv);
    
            if(bel_errorp(val)) {
                return val;
            }
            
            syms = bel_mkpair(sym, syms);
            vals = bel_mkpair(val, vals);
            
            itr = bel_cdr(bel_cdr(itr));
        }
    
        while(!bel_nilp(syms)) {
    #ifdef BEL_DEBUG
            printf("glob>  ");
            bel_print(bel_car(syms));
            printf(" := ");
            bel_print(bel_car(vals));
            putchar(10);
    #endif
            bel_assign(bel_g_nil, bel_car(syms), bel_car(vals));
            syms = bel_cdr(syms);
            vals = bel_cdr(vals);
        }
    
        return bel_g_nil;
    }
    

8.4.2 Evaluate a list of values

bel_evlist evaluates a list of expressions under the given lexical environment. This function should only be called for a proper list.

Bel*
bel_evlist(Bel *elist, Bel *lenv)
{
    if(bel_nilp(elist)) {
        return bel_g_nil;
    }

    Bel *eval_result =
        bel_eval(bel_car(elist), lenv);

    if(bel_errorp(eval_result)) {
        return eval_result;
    }

    Bel *ev_rest =
        bel_evlist(bel_cdr(elist), lenv);

    if(bel_errorp(ev_rest)) {
        return ev_rest;
    }

    return bel_mkpair(eval_result, ev_rest);
}

8.4.3 Apply a primitive operator to a list

Applying a primitive to a list involves checking for the symbol which specifies it and dispatching the arguments to a specific function which checks arity and performs the job.

  1. Forward declarations

    These forward declarations are related to the actual implementation of primitive functions in the Bel environment. We forward-declare them so that we can define a function which redirects to each one of them, and after that we give their proper definitions.

    // Forward declarations of primitive functions
    Bel *bel_prim_id(Bel *args);
    Bel *bel_prim_join(Bel *args);
    Bel *bel_prim_car(Bel *args);
    Bel *bel_prim_cdr(Bel *args);
    Bel *bel_prim_type(Bel *args);
    Bel *bel_prim_xar(Bel *args);
    Bel *bel_prim_xdr(Bel *args);
    Bel *bel_prim_sym(Bel *args);
    Bel *bel_prim_nom(Bel *args);
    Bel *bel_prim_wrb(Bel *args);
    Bel *bel_prim_rdb(Bel *args);
    Bel *bel_prim_ops(Bel *args);
    Bel *bel_prim_cls(Bel *args);
    Bel *bel_prim_stat(Bel *args);
    Bel *bel_prim_coin(Bel *args);
    Bel *bel_prim_sys(Bel *args);
    
    // Forward declarations of primitive operators
    Bel *bel_prim_add(Bel *args);
    Bel *bel_prim_sub(Bel *args);
    Bel *bel_prim_mul(Bel *args);
    Bel *bel_prim_div(Bel *args);
    //Bel *bel_prim_less(Bel *args);
    //Bel *bel_prim_leq(Bel *args);
    //Bel *bel_prim_great(Bel *args);
    //Bel *bel_prim_geq(Bel *args);
    //Bel *bel_prim_eq(Bel *args);
    
    //  Forward declarations of other primitives
    Bel *bel_prim_err(Bel *args);
    
  2. Applying primitive operations

    The bel_apply_primop function is the function which applies a primitive operation, identified as a symbol, to a list of evaluated values. It is important to know that this function does not usually do the job; instead, we just dispatch the arguments to a function which will perform as needed.

    The macro bel_is_prim compares whether sym is the symbol which represents the literal lit.

    #define bel_is_prim(sym, lit)                     \
        (bel_idp(sym, bel_mksymbol(lit)))
    

    The macro bel_unimplemented takes the symbol sym for a primitive function and generates an error, stating that the function has not been implemented. This is important while the interpreter is under development.

    #define bel_unimplemented(sym)                                  \
        bel_mkerror(                                                \
        bel_mkstring("~a is not implemented."),                     \
        bel_mkpair(sym, bel_g_nil))
    

    bel_apply_primop is the crucial function for the operations described above. It enumerates the core functions and dispatches the arguments accordingly.

    Notice that an attempt to apply a primitive operation which does not exist results in error.

    Bel*
    bel_apply_primop(Bel *sym, Bel *args)
    {
        // Primitive functions
        if(bel_is_prim(sym, "id"))        return bel_prim_id(args);
        else if(bel_is_prim(sym, "join")) return bel_prim_join(args);
        else if(bel_is_prim(sym, "car"))  return bel_prim_car(args);
        else if(bel_is_prim(sym, "cdr"))  return bel_prim_cdr(args);
        else if(bel_is_prim(sym, "type")) return bel_prim_type(args);
        else if(bel_is_prim(sym, "xar"))  return bel_prim_xar(args);
        else if(bel_is_prim(sym, "xdr"))  return bel_prim_xdr(args);
        else if(bel_is_prim(sym, "sym"))  return bel_prim_sym(args);
        else if(bel_is_prim(sym, "nom"))  return bel_prim_nom(args);
        else if(bel_is_prim(sym, "wrb"))  return bel_prim_wrb(args);
        else if(bel_is_prim(sym, "rdb"))  return bel_prim_rdb(args);
        else if(bel_is_prim(sym, "ops"))  return bel_prim_ops(args);
        else if(bel_is_prim(sym, "cls"))  return bel_prim_cls(args);
        else if(bel_is_prim(sym, "stat")) return bel_prim_stat(args);
        else if(bel_is_prim(sym, "coin")) return bel_prim_coin(args);
        else if(bel_is_prim(sym, "sys"))  return bel_prim_sys(args);
    
        // Primitive operators
        else if(bel_is_prim(sym, "+"))    return bel_prim_add(args);
        else if(bel_is_prim(sym, "-"))    return bel_prim_sub(args);
        else if(bel_is_prim(sym, "*"))    return bel_prim_mul(args);
        else if(bel_is_prim(sym, "/"))    return bel_prim_div(args);
        else if(bel_is_prim(sym, "<"))    return bel_unimplemented(sym);
        else if(bel_is_prim(sym, "<="))   return bel_unimplemented(sym);
        else if(bel_is_prim(sym, ">"))    return bel_unimplemented(sym);
        else if(bel_is_prim(sym, ">="))   return bel_unimplemented(sym);
        else if(bel_is_prim(sym, "="))    return bel_unimplemented(sym);
        
        // Other primitives
        else if(bel_is_prim(sym, "err"))  return bel_prim_err(args);
    
        // Otherwise, unknown application operation
        else {
            return bel_mkerror(
                bel_mkstring("Unknown primitive ~a."),
                bel_mkpair(sym, bel_g_nil));
        }
    }
    
  3. Maximum arity check

    The following macro is a helper for checking the arity of a specific function. Passing the arguments list and the number of desired arguments performs such a check. If the arity is greater than the given number, it returns an error complaining about it.

    Notice that this macro expects two things: to be called inside a function that returns a Bel* type, and that the arguments themselves are a proper list.

    It is also important to notice that Bel specifies that, when handling primitives, missing arguments default to nil, therefore passing less arguments than expected is not considered an error; since collecting arguments is handled by bel_car and bel_cdr, the missing arguments are guaranteed to be nil when retrieval is attempted.

    #define BEL_CHECK_MAX_ARITY(args, num)                  \
        {                                                   \
        uint64_t length = bel_length(args);                 \
        if(length > num) {                                  \
        return bel_mkerror(                                 \
            bel_mkstring("Arity error"), bel_g_nil);        \
        }                                                   \
        }
    
  4. Primitive functions

    The next functions implement primitive functions for the environment.

    1. (id x y)

      id checks whether x and y are identical. This is stricter than equality, since identity can only be tested for things that are always the same – namely, characters and symbols.

      Bel*
      bel_prim_id(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          return (bel_idp(bel_car(args),
                          bel_car(bel_cdr(args)))
                  ? bel_g_t : bel_g_nil);
      }
      
    2. (join x y)

      join creates a pair with x as its car and y as its cdr.

      Bel*
      bel_prim_join(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          return bel_mkpair(bel_car(args),
                            bel_car(bel_cdr(args)));
      }
      
    3. (car x) and (cdr x)

      car returns the first element of a pair x.

      Bel*
      bel_prim_car(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          return bel_car(bel_car(args));
      }
      

      cdr returns the second element of a pair x.

      Bel*
      bel_prim_cdr(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          return bel_cdr(bel_car(args));
      }
      
    4. (type x)

      type returns a symbol which specifies the type of x. The returning values can be symbol, pair, char, stream or number.

      Bel*
      bel_prim_type(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          switch(bel_car(args)->type) {
          case BEL_SYMBOL: return bel_mksymbol("symbol");  break;
          case BEL_PAIR:   return bel_mksymbol("pair");    break;
          case BEL_CHAR:   return bel_mksymbol("char");    break;
          case BEL_STREAM: return bel_mksymbol("stream");  break;
          case BEL_NUMBER: return bel_mksymbol("number");  break;
          default:         return bel_mksymbol("unknown"); break;
          };
      }
      
    5. (xar x y) and (xdr x y)

      xar replaces the car of a pair x with the given value y.

      Bel*
      bel_prim_xar(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          Bel *pair = bel_car(args);
          Bel *val  = bel_car(bel_cdr(args));
          if(!bel_pairp(pair)) {
              return bel_mkerror(
                  bel_mkstring("~a is not a pair."),
                  bel_mkpair(pair, bel_g_nil));
          }
      
          pair->pair->car = val;
          return val;
      }
      

      xdr replaces the cdr of a pair x with the given value y.

      Bel*
      bel_prim_xdr(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          Bel *pair = bel_car(args);
          Bel *val  = bel_car(bel_cdr(args));
          if(!bel_pairp(pair)) {
              return bel_mkerror(
                  bel_mkstring("~a is not a pair."),
                  bel_mkpair(pair, bel_g_nil));
          }
      
          pair->pair->cdr = val;
          return val;
      }
      
    6. (sym x) and (nom x)

      sym takes a Bel string and converts it into a symbol.

      Bel*
      bel_prim_sym(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          Bel *str = bel_car(args);
          if(!bel_stringp(str)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a must be a string."),
                  bel_mkpair(str, bel_g_nil));
          }
      
          char *cstr = bel_cstring(str);
          if(!cstr || !strcmp(cstr, "")) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a proper string."),
                  bel_mkpair(str, bel_g_nil));
          }
      
          return bel_mksymbol(cstr);
      }
      

      nom takes a symbol and discovers its name as a Bel string.

      Bel*
      bel_prim_nom(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          Bel *sym = bel_car(args);
          if(!bel_symbolp(sym)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a string."),
                  bel_mkpair(sym, bel_g_nil));
          }
      
          return bel_mkstring(
              bel_sym_find_name(sym));
      }
      
    7. (wrb x y) and (rdb x)

      wrb and rdb are functions responsible for input and output on a stream.

      wrb takes a bit x and a stream y, and writes that bit to the stream. If the stream is nil, it writes instead to outs.

      Bel*
      bel_prim_wrb(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          Bel *x = bel_car(args);
          Bel *y = bel_car(bel_cdr(args));
      
          if(!bel_charp(x)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a character."),
                  bel_mkpair(x, bel_g_nil));
          }
      
          if(bel_nilp(y)) {
              y = bel_lookup(bel_g_nil, bel_mksymbol("outs"));
          } else {
              if(!bel_streamp(y)) {
                  return bel_mkerror(
                      bel_mkstring("The object ~a must be a stream."),
                      bel_mkpair(y, bel_g_nil));
              }
          }
      
          return bel_stream_write_bit(&y->stream, y->chr);
      }
      

      rdb simply reads a bit from the stream x.

      Bel*
      bel_prim_rdb(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          Bel *x = bel_car(args);
      
          if(bel_nilp(x)) {
              bel_lookup(bel_g_nil, bel_mksymbol("ins"));
          } else {
              if(!bel_streamp(x)) {
                  return bel_mkerror(
                      bel_mkstring("The object ~a must be a stream."),
                      bel_mkpair(x, bel_g_nil));
              }
          }
      
          return bel_stream_read_bit(&x->stream);
      }
      
    8. (ops x y), (cls x) and (stat x)

      ops, cls and stat are functions related to the status of a stream.

      ops opens a stream to the file x, depending on the direction specified by symbol y, which can be either in or out.

      Bel*
      bel_prim_ops(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 2);
          Bel *x = bel_car(args);
          Bel *y = bel_car(bel_cdr(args));
      
          if(!bel_stringp(x)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a string."),
                  bel_mkpair(x, bel_g_nil));
          }
      
          if(!bel_symbolp(y)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a symbol."),
                  bel_mkpair(y, bel_g_nil));
          }
      
          if(bel_idp(y, bel_mksymbol("in"))) {
              return bel_mkstream(bel_cstring(x), BEL_STREAM_READ);
          } else if(bel_idp(y, bel_mksymbol("out"))) {
              return bel_mkstream(bel_cstring(x), BEL_STREAM_WRITE);
          }
      
          return bel_mkerror(
              bel_mkstring("The object ~a is not one of the "
                           "symbols `in` and `out`."),
              bel_mkpair(y, bel_g_nil));
      }
      

      cls closes a stream x, as long as it is open. If it was closed, returns t; if it is already closed, returns nil.

      Bel*
      bel_prim_cls(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          Bel *stream = bel_car(args);
      
          if(!bel_streamp(stream)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a stream."),
                  bel_mkpair(stream, bel_g_nil));
          }
      
          if(stream->stream.status == BEL_STREAM_CLOSED) {
              return bel_g_nil;
          }
      
          return bel_stream_close(stream);
      }
      

      stat takes a stream x and gives back symbols closed, in or out, depending on stream status.

      Bel*
      bel_prim_stat(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
          Bel *stream = bel_car(args);
          if(!bel_streamp(stream)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not a stream."),
                  bel_mkpair(stream, bel_g_nil));
          }
      
          switch(stream->stream.status) {
          case BEL_STREAM_CLOSED: return bel_mksymbol("closed");
          case BEL_STREAM_READ:   return bel_mksymbol("in");
          case BEL_STREAM_WRITE:  return bel_mksymbol("out");
          default: // ...wat
              return bel_mkerror(
                  bel_mkstring("The stream ~a has an unknown "
                               "status."),
                  bel_mkpair(stream, bel_g_nil));
          }
      }
      
    9. (coin)

      coin returns symbols t and nil at random.

      Bel*
      bel_prim_coin(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 0);
          return (rand() % 2) ? bel_g_t : bel_g_nil;
      }
      
    10. (sys x)

      sys takes a string x and sends it to the operational system, as a console command, and returns the command's value as a proper Bel number.

      Number types are non-standard to the Bel language, however Bel does not specify the return value of sys, therefore we have a degree of freedom to specify that the return of sys is a number.

      This function specifically is somewhat a matter of concern, because it opens up for the execution of an arbitrary command on the operational system.

      Bel*
      bel_prim_sys(Bel *args)
      {
          BEL_CHECK_MAX_ARITY(args, 1);
      
          Bel *str = bel_car(args);
          
          if(!bel_stringp(str)) {
              return bel_mkerror(
                  bel_mkstring("The object ~a is not "
                               "a string."),
                  bel_mkpair(str, bel_g_nil));
          }
          
          const char *com = bel_cstring(str);
      
          int64_t ret = system(com);
      
          return bel_mkinteger(ret);
      }
      
  5. Primitive operators

    These primitive operations take an arbitrary number of arguments and does the desired operation across the given values.

    1. Addition

      Adds all given values on the list, reducing them to a single number. If not argument is given, returns 0. If called with a single argument, it returns that single argument (identity).

      Bel*
      bel_prim_add(Bel *args)
      {
          if(!bel_number_list_p(args)) {
              return bel_mkerror(
                  bel_mkstring("Cannot add a non-number."),
                  bel_g_nil);
          }
      
          uint64_t length = bel_length(args);
          // No args: return 0
          if(length == 0) {
              return bel_mkinteger(0);
          }
      
          // One arg: identity
          if(length == 1) {
              return bel_car(args);
          }
      
          Bel *ret = bel_car(args);
          Bel *itr = bel_cdr(args);
          while(!bel_nilp(itr)) {
              ret = bel_num_add(ret, bel_car(itr));
              itr = bel_cdr(itr);
          }
      
          return ret;
      }
      
    2. Subtraction

      Subtracts all given values on the list, reducing them to a single number. If no argument is given, returns zero. If called with a single argument, inverts that argument, multiplying it by -1.

      Bel*
      bel_prim_sub(Bel *args)
      {
          if(!bel_number_list_p(args)) {
              return bel_mkerror(
                  bel_mkstring("Cannot subtract a "
                               "non-number."),
                  bel_g_nil);
          }
      
          uint64_t length = bel_length(args);
          // No args: return zero
          if(length == 0) {
              return bel_mkinteger(0);
          }
      
          // One arg: invert
          if(length == 1) {
              return bel_num_mul(bel_mkinteger(-1),
                                 bel_car(args));
          }
      
          Bel *ret = bel_car(args);
          Bel *itr = bel_cdr(args);
          while(!bel_nilp(itr)) {
              ret = bel_num_sub(ret, bel_car(itr));
              itr = bel_cdr(itr);
          }
      
          return ret;
      }
      
    3. Multiplication

      Multiplies all given values on the list, reducing them to a single number. If no argument is given, returns 1. If called with a single argument, returns that single argument (identity).

      Bel*
      bel_prim_mul(Bel *args)
      {
          if(!bel_number_list_p(args)) {
              return bel_mkerror(
                  bel_mkstring("Cannot multiply a "
                               "non-number."),
                  bel_g_nil);
          }
      
          uint64_t length = bel_length(args);
          // No args: return 1
          if(length == 0) {
              return bel_mkinteger(1);
          }
      
          // One arg: identity
          if(length == 1) {
              return bel_car(args);
          }
      
          Bel *ret = bel_car(args);
          Bel *itr = bel_cdr(args);
          while(!bel_nilp(itr)) {
              ret = bel_num_mul(ret, bel_car(itr));
              itr = bel_cdr(itr);
          }
      
          return ret;
      }
      
    4. Division

      Divides all given arguments on the given list, reducing them to a single number. If no argument is given, returns 1. If called with a single argument, returns the given number.

      If any division yields an error (e.g. a division by zero), returns that error immediately.

      Bel*
      bel_prim_div(Bel *args)
      {
          if(!bel_number_list_p(args)) {
              return bel_mkerror(
                  bel_mkstring("Cannot divide a "
                               "non-number."),
                  bel_g_nil);
          }
      
          uint64_t length = bel_length(args);
          // No args: return 1
          if(length == 0) {
              return bel_mkinteger(1);
          }
      
          // One arg: return such number
          if(length == 1) {
              return bel_car(args);
          }
      
          Bel *ret = bel_car(args);
          Bel *itr = bel_cdr(args);
          while(!bel_nilp(itr)) {
              ret = bel_num_div(ret, bel_car(itr));
      
              // If there is a division by zero
              // or something, return immediately
              if(bel_errorp(ret)) {
                  return ret;
              }
              
              itr = bel_cdr(itr);
          }
      
          return ret;
      }
      
  6. Other primitives

    These primitives are not specified in the Bel language, but are useful.

    1. (err x . rest)

      err creates an error using x as a format string, and appends the rest to the error as format arguments.

      There is no arity check in err, though we do verify whether the first argument is a string. Problems with the arguments should appear when printing the error.

      Bel*
      bel_prim_err(Bel *args)
      {
          Bel *string = bel_car(args);
          if(!bel_stringp(string)) {
              return bel_mkerror(
                  bel_mkstring("First argument of `err` must "
                               "be a string format."),
                  bel_g_nil);
          }
      
          // TODO: Maybe quote?
          return bel_mkerror(string, bel_cdr(args));
      }
      

8.4.4 Bind a list of variables to values

bel_bind binds each variable to an associated value. If the binding fails at any point, an error is returned; if not, a new environment with the bindings is returned.

Bel*
bel_bind(Bel *vars, Bel *vals, Bel *lenv)
{
    int vars_ended = bel_nilp(vars);
    int vals_ended = bel_nilp(vals);

    if(vars_ended && !vals_ended) {
        return bel_mkerror(
            bel_mkstring("Too few variables in "
                         "function application"),
            bel_g_nil);
    } else if(!vars_ended && vals_ended) {
        return bel_mkerror(
            bel_mkstring("Too few values in "
                         "function application"),
            bel_g_nil);
    } else if(vars_ended && vals_ended) {
        return lenv;
    }

    Bel *binding = bel_mkpair(bel_car(vars),
                              bel_car(vals));

    return bel_bind(bel_cdr(vars),
                    bel_cdr(vals),
                    bel_mkpair(binding, lenv));
}

9 Debug

The following definitions are related to testing what we have so far.

9.1 Tests

9.1.1 String manipulation and printing

A string test which shows the conversion between C strings and Bel strings, and vice-versa.

void
string_test()
{
    Bel *bel  = bel_mkstring("Hello, Bel!");
    bel_print(bel);
    printf(" => %s\n", bel_cstring(bel));

    bel = bel_mkstring("There is no Bel without \a");
    bel_print(bel);
    putchar(10);
}

9.1.2 List/pair/dotted list notation

The following notation tests the printing capabilities of the list printing algorithm. Should be able to handle printing lists and dot-notation when necessary.

The data input reads as ((foo . bar) . (baz . quux)), but the expected output is ((foo . bar) baz . quux).

void
notation_test()
{
    Bel*
    bel = bel_mkpair(bel_mkpair(bel_mksymbol("foo"),
                                bel_mksymbol("bar")),
                     bel_mkpair(bel_mksymbol("baz"),
                                bel_mksymbol("quux")));
    bel_print(bel);
    putchar(10);
}

9.1.3 Proper list notation

This next test outputs the list (The quick brown fox jumps over the lazy dog), which is a proper list of symbols.

void
list_test()
{
    Bel*
    bel = bel_mkpair(
        bel_mksymbol("The"),
        bel_mkpair(
            bel_mksymbol("quick"),
            bel_mkpair(
                bel_mksymbol("brown"),
                bel_mkpair(
                    bel_mksymbol("fox"),
                    bel_mkpair(
                        bel_mksymbol("jumps"),
                        bel_mkpair(
                            bel_mksymbol("over"),
                            bel_mkpair(
                                bel_mksymbol("the"),
                                bel_mkpair(
                                    bel_mksymbol("lazy"),
                                    bel_mkpair(
                                        bel_mksymbol("dog"),
                                        bel_g_nil)))))))));
    bel_print(bel);
    putchar(10);
}

9.1.4 Closure representation

This test is also a list of symbols, but with nested lists also. Plus, this is a proper list, representing the internal representation of a closure such as (fn (x) (* x x)). Expected output is (lit clo nil (x) (* x x)).

void
closure_repr_test()
{
    Bel*
    bel = bel_mkpair(bel_mksymbol("lit"),
                     bel_mkpair(
                         bel_mksymbol("clo"),
                         bel_mkpair(
                             bel_g_nil,
                             bel_mkpair(
                                 bel_mkpair(bel_mksymbol("x"),
                                            bel_g_nil),
                                 bel_mkpair(
                                     bel_mkpair(
                                         bel_mksymbol("*"),
                                         bel_mkpair(
                                             bel_mksymbol("x"),
                                             bel_mkpair(
                                                 bel_mksymbol("x"),
                                                 bel_g_nil))),
                                     bel_g_nil)))));
    bel_print(bel);
    putchar(10);
}

9.1.5 Character list printing and environment lookup

This next test prints the first ten characters in the global chars, which is a list of pairs, each pair (c . d) containing a character c, and its string representation in binary d.

It is also interesting to notice that the chars global is obtained by a lookup operation on the environment, rather than using the global variable directly.

void
character_list_test()
{
    // Character list
    // Char: 000 (?) => "00000000"
    // Char: 001 (?) => "00000001"
    // etc
    const int first_char = 'a';
    
    Bel *bel = bel_env_lookup(bel_g_globe, bel_mksymbol("chars"));
    
    int i;

    // Get nth cdr
    for(i = 0; i < first_char; i++) {
        bel = bel_cdr(bel);
    }

    i = 'a';
    while(!bel_nilp(bel) && i < first_char + 10) {
        Bel *car = bel_car(bel);
        printf("Char: %03d (%c) => ",
               bel_car(car)->chr,
               ((Bel_char)i));
        bel_print(bel_cdr(car));
        putchar(10);
        bel = bel_cdr(bel);
        i++;
    }
}

9.1.6 Read file bit by bit

This test opens up the Believe C source code file as a read stream, using Bel's stream structure, then proceeds to read ten bytes from it (meaning that it will read 80 bits). Every eight bit will be stored in a Bel list and then converted to a proper Bel character, which will be displayed on screen along with its bits.

It is interesting to notice that, since the bit-reading operation itself returns characters \0 or \1, the bit list composing a character is always a Bel string.

void
read_file_test()
{
    // We are going to read ten bytes from Bel's
    // own source code file.
    Bel *file = bel_mkstream("believe.c", BEL_STREAM_READ);

    if(bel_errorp(file)) {
        bel_print(file);
        return;
    }

    printf("Stream: ");
    bel_print(file);
    putchar(10);
    
    int n_bytes = 10;
    while(n_bytes > 0) {
        // 1 byte = 8 bits, so we make a list of
        // eight characters
        Bel **char_nodes = GC_MALLOC(8 * sizeof(Bel*));

        int i;
        for(i = 0; i < 8; i++) {
            Bel *read_char =
                bel_stream_read_bit(&file->stream);
            char_nodes[i] = bel_mkpair(read_char, bel_g_nil);
        }

        // Link nodes
        for(i = 0; i < 7; i++) {
            char_nodes[i]->pair->cdr = char_nodes[i + 1];
        }

        // Display on screen
        bel_print(char_nodes[0]);
        printf(" => ");
        bel_print(
            bel_char_from_binary(char_nodes[0]));
        putchar(10);
        
        n_bytes--;
    }

    bel_stream_close(file);
}

9.1.7 Display errors

We generate a few errors and grab them, then we print these errors on screen to show their literal structure.

void
show_errors_test()
{
    Bel *err;
    
    // Unexisting file
    err = bel_mkstream("waddawaddawadda", BEL_STREAM_READ);
    bel_print(err);
    putchar(10);
    printf("Is this an error? %c\n",
           bel_errorp(err) ? 'y' : 'n');

    // Incorrect use of car and cdr
    err = bel_car(bel_g_t);
    bel_print(err); putchar(10);
    err = bel_cdr(bel_g_t);
    bel_print(err); putchar(10);

    // Incorrect generation of Bel character from binary
    /* Bel *str = bel_mkstring("110"); */
    /* err = bel_char_from_binary(str); */
    /* bel_print(err); putchar(10); */

    /* str = bel_mkstring("110a1101"); */
    /* err = bel_char_from_binary(str); */
    /* bel_print(err); putchar(10); */
}

9.1.8 Lookup primitives

We look up a few registered primitives in the global environment, and print them in their literal form.

void
lookup_primitives_test()
{
    Bel *bel;
    bel = bel_lookup(bel_g_nil, bel_mksymbol("car"));
    bel_print(bel);
    putchar(10);

    bel = bel_lookup(bel_g_nil, bel_mksymbol("cdr"));
    bel_print(bel);
    putchar(10);

    bel = bel_lookup(bel_g_nil, bel_mksymbol("coin"));
    bel_print(bel);
    putchar(10);
    
    bel = bel_lookup(bel_g_nil, bel_mksymbol("stat"));
    bel_print(bel);
    putchar(10);

    // Undefined primitive
    bel_print(bel_g_nil); putchar(10);
    bel = bel_lookup(bel_g_nil, bel_mksymbol("wadawada"));
    bel_print(bel);
    putchar(10);
}

9.1.9 Environment tests

The first test involves creating a temporary lexical environment, pushing a few literals, assigning values, unbinding values too.

void
lexical_environment_test()
{
    Bel *lexenv = bel_g_nil;
    Bel *ret;

    puts("    -- Registering local `foo`");
    lexenv = bel_env_push(lexenv,
                          bel_mksymbol("foo"),
                          bel_mksymbol("bar"));
    
    printf("Environment:       ");
    bel_print(lexenv);
    printf("\nLookup:            ");
    bel_print(bel_lookup(lexenv, bel_mksymbol("foo")));
    putchar(10); putchar(10);

    // Assignment
    puts("    -- Assigning new value to `foo`");
    ret =
        bel_assign(lexenv,
                   bel_mksymbol("foo"),
                   bel_mkliteral(bel_mkpair(bel_mksymbol("baz"),
                                            bel_g_nil)));

    printf("Environment:       ");
    bel_print(lexenv);
    printf("\nAssignment result: ");
    bel_print(ret);
    printf("\nLookup:            ");
    bel_print(bel_lookup(lexenv, bel_mksymbol("foo")));
    putchar(10); putchar(10);

    // Unbinding
    puts("    -- Unbinding `foo`");
    ret = bel_unbind(&lexenv, bel_mksymbol("foo"));
    
    printf("Environment:       ");
    bel_print(lexenv);
    printf("\nUnbinding result:  ");
    bel_print(ret);
    printf("\nLookup:            ");
    bel_print(bel_lookup(lexenv, bel_mksymbol("foo")));
    putchar(10);
}

Second test is creating a global variable through assignment, creating a variable bound to the same symbol on a lexical environment, unbinding both, then performing a last invalid unbinding.

void
global_assignment_test()
{
    Bel *lexenv = bel_g_nil;
    Bel *ret;

    // Global creation through assignment
    puts("    -- Assigning `foo` without previous definition");
    ret = bel_assign(bel_g_nil,
                     bel_mksymbol("foo"),
                     bel_mksymbol("bar"));

    printf("Assignment result: ");
    bel_print(ret);
    printf("\nLookup:            ");
    bel_print(bel_lookup(bel_g_nil, bel_mksymbol("foo")));
    putchar(10); putchar(10);

    // Local creation of variable bound to
    // same symbol
    puts("    -- Shadowing global `foo` with a local");
    lexenv =
        bel_env_push(lexenv,
                     bel_mksymbol("foo"),
                     bel_mksymbol("quux"));

    printf("Environment:       ");
    bel_print(lexenv);
    printf("\nLookup:            ");
    bel_print(bel_lookup(lexenv, bel_mksymbol("foo")));

    // Three unbindings
    printf("\n    -- Unbinding `foo` three times");
    int i;
    for(i = 0; i < 3; i++) {
        ret = bel_unbind(&lexenv, bel_mksymbol("foo"));

        printf("\n\n      After unbinding.");
        printf("\nEnvironment:       ");
        bel_print(lexenv);
        printf("\nUnbinding result:  ");
        bel_print(ret);
        printf("\nLookup:            ");
        bel_print(bel_lookup(lexenv, bel_mksymbol("foo")));
    }
    putchar(10);
}

9.1.10 Number test

void
number_test()
{
    Bel *a;
    Bel *b;

    // Integer sum
    a = bel_mkinteger(4);
    b = bel_mkinteger(2);

    bel_print(a);
    printf(" + ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_add(a, b));
    putchar(10);

    
    // Float subtraction
    a = bel_mkfloat(4.0);
    b = bel_mkfloat(3.5);

    bel_print(a);
    printf(" - ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_sub(a, b));
    putchar(10);


    // Fraction sum
    a = bel_mkfraction(bel_mkinteger(1),
                       bel_mkinteger(3));
    b = bel_mkfraction(bel_mkinteger(1),
                       bel_mkinteger(6));

    bel_print(a);
    printf(" + ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_add(a, b));
    putchar(10);

    
    // Complex multiplication
    a = bel_mkcomplex(bel_mkinteger(3),
                      bel_mkinteger(2));
    b = bel_mkcomplex(bel_mkinteger(1),
                      bel_mkinteger(4));

    bel_print(a);
    printf(" * ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_mul(a, b));
    putchar(10);

    // Complex division
    // Reusing a and b from last example
    bel_print(a);
    printf(" / ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_div(a, b));
    putchar(10);

    // Integer division (inexact)
    a = bel_mkinteger(7);
    b = bel_mkinteger(2);

    bel_print(a);
    printf(" / ");
    bel_print(b);
    printf(" = ");
    bel_print(bel_num_div(a, b));
    putchar(10);
}

9.1.11 Debriefing macro

This macro is a helper for debriefing results of evaluation tests.

#define BEL_EVAL_DEBRIEF(exp, res, env) \
    {                                   \
    printf("Expression: ");             \
    bel_print(exp); putchar(10);        \
    res = bel_eval(exp, env);           \
    printf("Result: ");                 \
    bel_print(res); putchar(10);        \
    putchar(10);                        \
    }

9.1.12 Evaluator test

void
eval_test()
{
    Bel *form;
    Bel *result;

    // (quote foo)
    form = bel_mkpair(
        bel_mksymbol("quote"),
        bel_mkpair(
            bel_mksymbol("foo"),
            bel_g_nil));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);
    
    // (join (quote foo) (quote bar))
    form =
        bel_mkpair(
            bel_mksymbol("join"),
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("quote"),
                    bel_mkpair(
                        bel_mksymbol("foo"),
                        bel_g_nil)),
                bel_mkpair(
                    bel_mkpair(
                        bel_mksymbol("quote"),
                        bel_mkpair(
                            bel_mksymbol("bar"),
                            bel_g_nil)),
                    bel_g_nil)));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);


    // (fn (x) (id x x))
    form = bel_mkpair(
        bel_mksymbol("fn"),
        bel_mkpair(
            bel_mkpair(
                bel_mksymbol("x"),
                bel_g_nil),
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("id"),
                    bel_mkpair(
                        bel_mksymbol("x"),
                        bel_mkpair(
                            bel_mksymbol("x"),
                            bel_g_nil))),
                bel_g_nil)));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    
    // ((fn (x) (id x x)) (quote foo))
    form =
        bel_mkpair(
            form, // Use closure from last example
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("quote"),
                    bel_mkpair(
                        bel_mksymbol("foo"),
                        bel_g_nil)),
                bel_g_nil));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    
    // (if (id (quote bar) (quote foo)) (quote okay)
    //     (id (quote foo) (quote bar)) (quote okay)
    //                                  (quote nope))
    form = bel_mkpair(
        bel_mksymbol("if"),
        bel_mkpair(
            bel_mkpair(
                bel_mksymbol("id"),
                bel_mkpair(
                    bel_mkpair(
                        bel_mksymbol("quote"),
                        bel_mkpair(
                            bel_mksymbol("bar"),
                            bel_g_nil)),
                    bel_mkpair(
                        bel_mkpair(
                            bel_mksymbol("quote"),
                            bel_mkpair(
                                bel_mksymbol("foo"),
                                bel_g_nil)),
                        bel_g_nil))),
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("quote"),
                    bel_mkpair(
                        bel_mksymbol("okay"),
                        bel_g_nil)),
                bel_mkpair(
                    bel_mkpair(
                        bel_mksymbol("id"),
                        bel_mkpair(
                            bel_mkpair(
                                bel_mksymbol("quote"),
                                bel_mkpair(
                                    bel_mksymbol("foo"),
                                    bel_g_nil)),
                            bel_mkpair(
                                bel_mkpair(
                                    bel_mksymbol("quote"),
                                    bel_mkpair(
                                        bel_mksymbol("bar"),
                                        bel_g_nil)),
                                bel_g_nil))),
                    bel_mkpair(
                        bel_mkpair(
                            bel_mksymbol("quote"),
                            bel_mkpair(
                                bel_mksymbol("okay"),
                                bel_g_nil)),
                        bel_mkpair(
                            bel_mkpair(
                                bel_mksymbol("quote"),
                                bel_mkpair(
                                    bel_mksymbol("nope"),
                                    bel_g_nil)),
                            bel_g_nil))))));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);


    // (sys "echo Hello, world!")
    // NOTE: I am commenting out this test since
    //       this function could open some security
    //       holes in systems unadvertedly using it.
    /* form = bel_mkpair( */
    /*     bel_mksymbol("sys"), */
    /*     bel_mkpair( */
    /*         bel_mkstring("echo Hello, world!"), */
    /*         bel_g_nil)); */
    /* BEL_EVAL_DEBRIEF(form, result, bel_g_nil); */

    
    // Eval some axioms
    puts("Evaluating some axioms");
    form = bel_g_t;
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);
    
    form = bel_g_o;
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    form = bel_g_apply;
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    form = bel_g_nil;
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    
    // Eval some numbers
    form = bel_mkinteger(42);
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    form = bel_mkfloat(42.0);
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    form = bel_mkfraction(bel_mkinteger(2),
                          bel_mkinteger(3));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);

    
    form = bel_mkcomplex(bel_mkfloat(2.0),
                         bel_mkfloat(3.4));
    BEL_EVAL_DEBRIEF(form, result, bel_g_nil);
}

9.1.13 Arithmetic evaluation test

void
arithmetic_eval_test()
{
    Bel *exp;
    Bel *result;

    // (+ 2 #(c 3+7i) #(f 1/3))
    exp = bel_mkpair(
        bel_mksymbol("+"),
        bel_mkpair(
            bel_mkinteger(2),
            bel_mkpair(
                bel_mkcomplex(bel_mkinteger(3),
                              bel_mkinteger(7)),
                bel_mkpair(
                    bel_mkfraction(bel_mkinteger(1),
                                   bel_mkinteger(3)),
                    bel_g_nil))));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    // (id #(c 1+3i) #(c 1+3i))
    exp = bel_mkpair(
        bel_mksymbol("id"),
        bel_mkpair(
            bel_mkcomplex(bel_mkinteger(1),
                          bel_mkinteger(3)),
            bel_mkpair(
                bel_mkcomplex(bel_mkinteger(1),
                              bel_mkinteger(3)),
                bel_g_nil)));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    
    //(- #(c 3-8i))
    exp = bel_mkpair(
        bel_mksymbol("-"),
        bel_mkpair(
            bel_mkcomplex(bel_mkinteger(3),
                          bel_mkinteger(8)),
            bel_g_nil));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    
    // (* 1 2 3 4 5)
    exp = bel_mkpair(
        bel_mksymbol("*"),
        bel_mkpair(
            bel_mkinteger(1),
            bel_mkpair(
                bel_mkinteger(2),
                bel_mkpair(
                    bel_mkinteger(3),
                    bel_mkpair(
                        bel_mkinteger(4),
                        bel_mkpair(
                            bel_mkinteger(5),
                            bel_g_nil))))));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    exp = bel_mkpair(
        bel_mksymbol("/"),
        bel_mkpair(
            bel_mkfloat(45.0),
            bel_g_nil));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    
    // Spec conformity tests
    // (-) should return 0
    exp = bel_mkpair(
        bel_mksymbol("-"),
        bel_g_nil);
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    // (/) should return 1
    exp = bel_mkpair(
        bel_mksymbol("/"),
        bel_g_nil);
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    // (/ 5) should return 5
    exp = bel_mkpair(
        bel_mksymbol("/"),
        bel_mkpair(
            bel_mkinteger(5),
            bel_g_nil));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);
}

9.1.14 Arity tests

The following tests check for the arity of primitive functions. By default, a small number of arguments is not a bug, and the missing arguments are traded for nil.

void
arity_test()
{
    Bel *exp;
    Bel *result;

    // (id) => t
    exp = bel_mkpair(
        bel_mksymbol("id"),
        bel_g_nil);
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    // (join) => (nil . nil)
    exp = bel_mkpair(
        bel_mksymbol("join"),
        bel_g_nil);
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    // (type) => symbol
    exp = bel_mkpair(
        bel_mksymbol("type"),
        bel_g_nil);
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);
}

9.1.15 Dynamic binding test

void
dynamic_binding_test()
{
    Bel *exp;
    Bel *result;

    // (dyn x (/ 1 2)
    //   (+ x 1))
    exp = bel_mkpair(
        bel_mksymbol("dyn"),
        bel_mkpair(
            bel_mksymbol("x"),
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("/"),
                    bel_mkpair(
                        bel_mkinteger(1),
                        bel_mkpair(
                            bel_mkinteger(2),
                            bel_g_nil))),
                bel_mkpair(
                    bel_mkpair(
                        bel_mksymbol("+"),
                        bel_mkpair(
                            bel_mksymbol("x"),
                            bel_mkpair(
                                bel_mkinteger(1),
                                bel_g_nil))),
                    bel_g_nil))));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);
}

9.1.16 Global binding test

void
global_binding_test()
{
    Bel *exp;
    Bel *result;

    // function definition
    // (fn (x) (* x x))
    exp = bel_mkpair(
        bel_mksymbol("fn"),
        bel_mkpair(
            bel_mkpair(
                bel_mksymbol("x"),
                bel_g_nil),
            bel_mkpair(
                bel_mkpair(
                    bel_mksymbol("*"),
                    bel_mkpair(
                        bel_mksymbol("x"),
                        bel_mkpair(
                            bel_mksymbol("x"),
                            bel_g_nil))),
                bel_g_nil)));
    
    // assignment
    // (set square (fn (x) (* x x)))
    exp = bel_mkpair(
        bel_mksymbol("set"),
        bel_mkpair(
            bel_mksymbol("square"),
            bel_mkpair(exp, bel_g_nil)));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);

    
    // (square #(f 1/2))
    exp = bel_mkpair(
        bel_mksymbol("square"),
        bel_mkpair(
            bel_mkfraction(bel_mkinteger(1),
                           bel_mkinteger(2)),
            bel_g_nil));
    BEL_EVAL_DEBRIEF(exp, result, bel_g_nil);
}

10 Entry point

10.1 Initialization

This is the initialization function for the Bel interpreter. Once this function is called, the Bel system is ready to be used.

Bel*
bel_init(void)
{
    // Initialize garbage collector
    GC_INIT();

    // Initialize random number generation
    // Warning: This is a VERY naive approach
    srand(time(NULL));

    // Initialize symbol table
    bel_sym_table_init();

    // Axioms
    bel_init_ax_vars();
    bel_init_ax_chars();
    bel_init_streams();
    bel_init_ax_env();
    bel_init_ax_primitives();

    // TODO: Return an environment?
    return bel_g_nil;
}

10.2 Tests

This is the entry point for tests. All running tests are to be put here.

We also make sure that these tests are run as a menu, so that only the desired test is shown when needed.

void
run_tests()
{
    int opt;

    do {
        puts("-- Believe test menu\n"
             "   Choose a test to run:\n"
             " 1. String test\n"
             " 2. Notation test\n"
             " 3. List test\n"
             " 4. Closure representation test\n"
             " 5. Character List & Lookup test\n"
             " 6. Read five bytes from Believe's source\n"
             " 7. Show a few errors on screen\n"
             " 8. Lookup a few primitives and print them\n"
             " 9. Lexical environment test\n"
             "10. Globals and assignment tests\n"
             "11. Number arithmetic tests\n"
             "12. Evaluator test\n"
             "13. Arithmetic evaluation test\n"
             "14. Primitive arity test\n"
             "15. Dynamic binding test\n"
             "16. Global binding test\n"
             
             " 0. Exit menu");
        printf("Option >> ");
        scanf("%d", &opt);

        // flush here

        putchar(10);
        switch(opt) {
        default: puts("Invalid option.");    break;
        case 0:  break;
        case  1: string_test();              break;
        case  2: notation_test();            break;
        case  3: list_test();                break;
        case  4: closure_repr_test();        break;
        case  5: character_list_test();      break;
        case  6: read_file_test();           break;
        case  7: show_errors_test();         break;
        case  8: lookup_primitives_test();   break;
        case  9: lexical_environment_test(); break;
        case 10: global_assignment_test();   break;
        case 11: number_test();              break;
        case 12: eval_test();                break;
        case 13: arithmetic_eval_test();     break;
        case 14: arity_test();               break;
        case 15: dynamic_binding_test();     break;
        case 16: global_binding_test();      break;
        }
        
    } while(opt != 0);
}

10.3 main function

This is the program entry point. It is supposed to only print the ribbon, initialize Bel and perform some tests, for now.

int
main(void)
{
    printf("Believe %s\n", BELIEVE_VERSION);
    printf("A Bel Lisp interpreter\n");
    printf("Copyright (c) %s\n", BELIEVE_COPYRIGHT);
    printf("This software is distributed under the %s license.\n",
          BELIEVE_LICENSE);

    bel_init();

#ifdef BEL_DEBUG
    run_tests();
#endif
    
    return 0;
}

Footnotes:

1

You must provide the name of the creator and attribution parties, a copyright notice, a license notice, a disclaimer notice, and a link to the original material.

2

You must indicate if you modified the material and retain an indication of previous modifications.

3

You can see a list of compatible licenses at https://creativecommons.org/compatible-licenses.

6

Please see the GNU Kind Communication Guidelines for more information on better usage of pronouns and such. Maintainers will not be enforcing the usage of particular pronouns, but any misuse of language for blatant purpose of offense will not be tolerated, as it can easily take a discussion to an off-topic argument. Finally, always assume that any confusion about pronoun usage from the participants was commited with no offending intention as well, and let the maintainers handle the situation if necessary.

Author: Lucas S. Vieira

Created: 2019-11-26 ter 13:50

Validate