exp.llm

;**********************************************************************
; exp.llm
;
; Expression implementation--the heart of any lisp.
;
; FIXME: most of these routines are general implementations that
; sanity-check their arguments.  But when used internally the calling
; code often knows that the checks are not necessary.  Those checks
; could someday be optimized away by creating unchecked versions for
; internal use, since both the parser and the string uniqueifier always
; know the run-time type of their objects.
;
; Also, we might be able to save a comparison or two by having a separate
; internal tag for nil and/or tricky choices for the bit patterns of the
; tag values (testing a subfield gives us a test for a set of types and
; if arranged properly could replace a common series of tests for
; membership in one of several types that will be treated the same).  The
; most likely place this would be useful would be having a single-compare
; test for both "atom, including nil" and "atom but not nil."
;
; There are interesting bitwise intrinsics (such as the count of the
; number of trailing zeroes in an int) which might be usable to make the
; tag manipulations go faster.  I may have relied too heavily on what
; is available from C when I wrote the tag code.
;
; Copyright 2009-2010 by Dustin Laurence.  Distributed under the terms of
; the LGPLv3.
;
;**********************************************************************

#include "exp.llh"
#include "nil.llh"
#include "memory.llh"

;**********************************************************************
; Private declarations
;
;**********************************************************************

    declare NILCC void @PrintAtom(%Exp %exp)
    declare NILCC void @PrintCDR(%Exp %exp)
    declare NILCC void @PrintPrimitive(%Exp %exp)
    declare NILCC void @PrintException(%Exp %exp)

;**********************************************************************
; Tag manipulation functions
;
; These functions manipulate the low-order bits as a tag field.  They
; are implemented this way instead of as a structure with bitfields
; because these are independent of the actual size of %Word and thus
; work without modification on any architecture.
;
; Of course it is inefficient to pay for function calls, but inlining
; them would fix that without duplicating source and is thus the Right
; Thing.
;
;**********************************************************************

;**********************************************************************
; GetTag
;
; Returns a small integer whose value is the expression type tag.
;
;**********************************************************************

define NILCC %Tag
@GetTag(%Exp %exp)
{
    %tag = trunc %Exp %exp to %Tag
    ret %Tag %tag
}

;**********************************************************************
; TagIs
;
; Returns true if the expression has the given tag.
;
;**********************************************************************

define NILCC i1
@TagIs(%Exp %exp, %Tag %tag)
{
    %expTag = call NILCC %Tag @GetTag(%Exp %exp)
    %sameTag = icmp eq %Tag %expTag, %tag
    ret i1 %sameTag
}

;**********************************************************************
; TagIsNot
;
; Returns true if the expression has the given tag.
;
;**********************************************************************

define NILCC i1
@TagIsNot(%Exp %exp, %Tag %tag)
{
    %expTag = call NILCC %Tag @GetTag(%Exp %exp)
    %differentTag = icmp ne %Tag %expTag, %tag
    ret i1 %differentTag
}

;**********************************************************************
; SameTag
;
; Returns true if the expressions have the same tag
;
;**********************************************************************

define NILCC i1
@SameTag(%Exp %lhs, %Exp %rhs)
{
    %lhsTag = call NILCC %Tag @GetTag(%Exp %lhs)
    %rhsTag = call NILCC %Tag @GetTag(%Exp %rhs)
    %sameTag = icmp eq %Tag %lhsTag, %rhsTag
    ret i1 %sameTag
}

;**********************************************************************
; ClearTag
;
; Returns an expression with the same value as %exp (points to the same
; object or contains the same embedded number), but with the type tag
; cleared (so, for example, it is a valid pointer again).
;
;**********************************************************************

define NILCC %Exp
@ClearTag(%Exp %exp)
{
    ; Size-independent way to express the mask we need
    %mask = xor %Exp MAX_TAG, -1 ; %mask = "bitwise not" MAX_TAG
    %clearedExp = and %Exp %exp, %mask

        #ifndef NDEBUG
        %tag = call NILCC %Tag @GetTag(%Exp %clearedExp)
        %isZero = icmp eq %Tag %tag, 0
        assert(%isZero)
        #endif

    ret %Exp %clearedExp
}

;**********************************************************************
; AddTag
;
; Returns an expression with the same value as %exp (points to the same
; object or contains the same embedded number), but with the type tag
; set to %tag.
;
; The difference betweeen this and SetTag is that this assumes the tag
; field is already clear, and will produce chaos if it is not.
; (Precisely, the new tag will be xord with the old one, which is
; not a behavior anyone should be wanting.)  In debug mode this error
; is detected, however.
;
;**********************************************************************

define NILCC %Exp
@AddTag(%Exp %exp, %Tag %tag)
{
    %tagExp = zext %Tag %tag to %Exp
    %newExp = xor %Exp %exp, %tagExp

        #ifndef NDEBUG
        %newTag = call NILCC %Tag @GetTag(%Exp %newExp)
        %same = icmp eq %Tag %tag, %newTag
        assert(%same)
        #endif

    ret %Exp %newExp
}

;**********************************************************************
; SetTag
;
; Returns an expression with the same value as %exp (points to the same
; object or contains the same embedded number), but with the type tag
; set to %tag.
;
;**********************************************************************

define NILCC %Exp
@SetTag(%Exp %exp, %Tag %tag)
{
    %clearedExp = call NILCC %Exp @ClearTag(%Exp %exp)
    %newExp = call NILCC %Exp @AddTag(%Exp %clearedExp, %Tag %tag)

    ret %Exp %newExp
}

;**********************************************************************
; TagIsClear
;
; Checks to see that the given Exp has a zero tag field (and is
; therefore convertible to a valid pointer).
;
; Same semantics as Aligned(), but acts on Exps and not on pointers.
;
;**********************************************************************

define NILCC i1
@TagIsClear(%Exp %exp)
{
    %tag = call NILCC %Tag @GetTag(%Exp %exp)
    %isZero = icmp eq %Tag %tag, 0

    ret i1 %isZero
}

;**********************************************************************
; ShiftOutTag
;
; This and its opposite are one-instruction functions, but still useful
; for abstraction and documentation.  Inlining would be the right way
; to optimize.
;
;**********************************************************************

define NILCC %Word
@ShiftOutTag(%Exp %exp)
{
    %value = lshr %Exp %exp, TAG_BITS

    ret %Word %value
}

;**********************************************************************
; SignedShiftOutTag
;
; Same as ShiftOutTag, but with a sign-preserving shift.
;
;**********************************************************************

define NILCC %Word
@SignedShiftOutTag(%Exp %exp)
{
    %value = ashr %Exp %exp, TAG_BITS

    ret %Word %value
}

;**********************************************************************
; ShiftInTag
;
; Warning: this low-level function leaves a blank tag field to be
; filled in.
;
;**********************************************************************

define NILCC %Exp
@ShiftInTag(%Word %word)
{
    %exp = shl %Word %word, TAG_BITS

    ret %Exp %exp
}

;**********************************************************************
; Conversions
;
;**********************************************************************

;**********************************************************************
; str2Exp
;
; Converts the char* pointer to an Expression with the correct tag.
; THIS IS ONLY A CONVERSION FUNCTION--use NewSymbol to get a unique
; string.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %Exp
@str2Exp(%c_char* %str)
{
        ; FIXME: what if %str is null?  This is almost certainly the wrong
        ; behavior but what is the correct lisp semantics?
        ; need to be careful about the precise meaning of nil in lisp.
        ; For now, assert that it isn't so it can't silently do The Wrong
        ; Thing
        %notNull = icmp ne %c_char* %str, null
        assert(%notNull)

        #ifndef NDEBUG
        ; Also it obviously must be aligned
        %voidPtr = bitcast %c_char* %str to i8* ; should never be necessary
        %aligned = call NILCC i1 @Aligned(i8* %voidPtr)
        assert(%aligned)
        #endif

    %untaggedExp = ptrtoint %c_char* %str to %Exp
    %exp = call NILCC %Exp @AddTag(%Exp %untaggedExp, %Tag SYMBOL_TAG)

    ret %Exp %exp
}

;**********************************************************************
; Exp2str
;
; Converts a Symbol expression back to a char*.  IT RETURNS A POINTER
; TO THE CANONICAL STRING OBJECT, so do *not* modify it!
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %c_char*
@Exp2str(%Exp %exp)
{
        #ifndef NDEBUG
        %isSymbol = call NILCC i1 @IsSymbol(%Exp %exp)
        assert(%isSymbol)
        #endif

    %untaggedExp = call NILCC %Exp @ClearTag(%Exp %exp)
    %str = inttoptr %Exp %untaggedExp to %c_char*

    ret %c_char* %str
}

;**********************************************************************
; nil_cell2Exp
;
; Converts the nil_cell* pointer to an Expression with the correct
; tag.  THIS IS ONLY A CONVERSION FUNCTION and has no idea if the
; pointer actually points to anything sane.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %Exp
@nil_cell2Exp(%nil_cell* %cell)
{
        ; FIXME: what if %cell is null?  This is almost certainly the wrong
        ; behavior but what is the correct lisp semantics?
        ; need to be careful about the precise meaning of nil in lisp.
        ; For now, assert that it isn't so it can't silently do The Wrong
        ; Thing
        %notNull = icmp ne %nil_cell* %cell, null
        assert(%notNull)

        #ifndef NDEBUG
        ; Also it obviously must be aligned
        %voidPtr = bitcast %nil_cell* %cell to i8*
        %aligned = call NILCC i1 @Aligned(i8* %voidPtr)
        assert(%aligned)
        #endif

    %untaggedExp = ptrtoint %nil_cell* %cell to %Exp
    %exp = call NILCC %Exp @AddTag(%Exp %untaggedExp, %Tag CELL_TAG)

    ret %Exp %exp
}

;**********************************************************************
; Exp2nil_cell
;
; Converts an Expression to a cell pointer.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %nil_cell*
@Exp2nil_cell(%Exp %exp)
{
        #ifndef NDEBUG
        %isCell = call NILCC i1 @IsCell(%Exp %exp)
        assert(%isCell)
        #endif

    %untaggedExp = call NILCC %Exp @ClearTag(%Exp %exp)
    %cell = inttoptr %Exp %untaggedExp to %nil_cell*

    ret %nil_cell* %cell
}

;**********************************************************************
; nil_primitive2Exp
;
; Converts the nil_primitive* pointer to an Expression with the correct
; tag.  THIS IS ONLY A CONVERSION FUNCTION and has no idea if the
; pointer actually points to anything sane.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %Exp
@nil_primitive2Exp(%nil_primitive* %prim)
{
        ; FIXME: what if %prim is null?  This is almost certainly the wrong
        ; behavior but what is the correct lisp semantics?
        ; need to be careful about the precise meaning of nil in lisp.
        ; For now, assert that it isn't so it can't silently do The Wrong
        ; Thing
        %notNull = icmp ne %nil_primitive* %prim, null
        assert(%notNull)

        #ifndef NDEBUG
        ; Also it obviously must be aligned
        %voidPtr = bitcast %nil_primitive* %prim to i8*
        %aligned = call NILCC i1 @Aligned(i8* %voidPtr)
        assert(%aligned)
        #endif

    %untaggedExp = ptrtoint %nil_primitive* %prim to %Exp
    %exp = call NILCC %Exp @AddTag(%Exp %untaggedExp, %Tag PRIMITIVE_TAG)

    ret %Exp %exp
}

;**********************************************************************
; Exp2nil_primitive
;
; Converts an Expression to a cell pointer.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %nil_primitive*
@Exp2nil_primitive(%Exp %exp)
{
        #ifndef NDEBUG
        %isPrimitive = call NILCC i1 @IsPrimitive(%Exp %exp)
        assert(%isPrimitive)
        #endif

    %untaggedExp = call NILCC %Exp @ClearTag(%Exp %exp)
    %prim = inttoptr %Exp %untaggedExp to %nil_primitive*

    ret %nil_primitive* %prim
}

;**********************************************************************
; Exception2Exp
;
; Converts an exception code to an Expression with the correct tag.
;
;**********************************************************************

#ifndef NDEBUG
@except_guard = private global i1 1
#endif

define NILCC %Exp
@Exception2Exp(%Word %code)
{
        #ifndef NDEBUG
        ; Detect overflow
        %maxCode = call NILCC %Word @ShiftOutTag(%Exp -1)
        %inBounds = icmp ule %Word %code, %maxCode
        assert(%inBounds)
        #endif

    %untaggedExp = call NILCC %Exp @ShiftInTag(%Word %code)
    %exp = call NILCC %Exp @AddTag(%Exp %untaggedExp, %Tag EXCEPTION_TAG)

        #ifndef NDEBUG
        %checkConversion = load i1* @except_guard
        br i1 %checkConversion, label %Check, label %NoCheck
        Check:
        store i1 0, i1* @except_guard
        %newCode = call NILCC %Word @Exp2Exception(%Exp %exp)
        store i1 1, i1* @except_guard
        %equal = icmp eq %Word %code, %newCode
        assert(%equal)
        br label %NoCheck
        NoCheck:
        #endif

    ret %Exp %exp
}

;**********************************************************************
; Exp2Exception
;
; Extracts an exception code from an exception expression.
;
; FIXME: should obviously be inlined along with the above.
;
;**********************************************************************

define NILCC %Word
@Exp2Exception(%Exp %exp)
{
    %result = call NILCC %Word @ShiftOutTag(%Exp %exp)

        #ifndef NDEBUG
        %checkConversion = load i1* @except_guard
        br i1 %checkConversion, label %Check, label %NoCheck
        Check:
        store i1 0, i1* @except_guard
        %newExp = call NILCC %Exp @Exception2Exp(%Word %result)
        store i1 1, i1* @except_guard
        %equal = icmp eq %Exp %exp, %newExp
        assert(%equal)
        br label %NoCheck
        NoCheck:
        #endif

    ret %Word %result
}

;**********************************************************************
; The Seven Operators
;
; These are supposed to be a minimal set of primitive lisp operators
; for an implementation of lisp *in lisp*.  Many will be implemented
; in terms of another form more useful internally.
;
;**********************************************************************

; #2 -- atom

; Internal form
define NILCC i1
@IsAtom(%Exp %exp)
{
    ; Implemented in a way that allows expansion to other types of
    ; atoms besides symbols
    %atomp = call NILCC i1 @TagIsNot(%Exp %exp, %Tag CELL_TAG)

    ret i1 %atomp
}

; #3 -- eq

; Internal form
define NILCC i1
@Eq(%Exp %lhs, %Exp %rhs)
{
    ; Is this Graham's eq?  It will return t for lists that point to the
    ; same cell, and that doesn't fit his description.  OTOH this is
    ; extremely fast, which is one reason we wanted unique strings.  My
    ; impression is that some of these properties actually were
    ; implementation-driven, and this is the fastest implementation.  There
    ; are also hints in "The Art of the Interpreter" that I'm right, and
    ; in my Common Lisp book (where they call it EQL)
    %areEq = icmp eq %Exp %lhs, %rhs

    ret i1 %areEq
}

define NILCC i1
@NotEq(%Exp %lhs, %Exp %rhs)
{
    %areEq = icmp ne %Exp %lhs, %rhs
    ret i1 %areEq
}

; #4 -- car
define NILCC %Exp
@Car(%Exp %exp)
{
        #ifndef NDEBUG
        %cellp = call NILCC i1 @IsCell(%Exp %exp)
        assert(%cellp)
        #endif

    %cellPtr = call NILCC %nil_cell* @Exp2nil_cell(%Exp %exp)
    %carPtr = getelementptr %nil_cell* %cellPtr, i32 0, i32 0
    %car = load %Exp* %carPtr

    ret %Exp %car
}

; #5 -- cdr
define NILCC %Exp
@Cdr(%Exp %exp)
{
        #ifndef NDEBUG
        %cellp = call NILCC i1 @IsCell(%Exp %exp)
        assert(%cellp)
        #endif

    %cellPtr = call NILCC %nil_cell* @Exp2nil_cell(%Exp %exp)
    %cdrPtr = getelementptr %nil_cell* %cellPtr, i32 0, i32 1
    %cdr = load %Exp* %cdrPtr

    ret %Exp %cdr
}

; #6 -- cons
define NILCC %Exp
@Cons(%Exp %car, %Exp %cdr)
{
    %newCell = call NILCC %nil_cell* @NewCell()

    ; Set the car
    %carPtr = getelementptr %nil_cell* %newCell, i32 0, i32 0
    store %Exp %car, %Exp* %carPtr

    ; Set the cdr
    %cdrPtr = getelementptr %nil_cell* %newCell, i32 0, i32 1
    store %Exp %cdr, %Exp* %cdrPtr

    %newExp = call NILCC %Exp @nil_cell2Exp(%nil_cell* %newCell)

    ret %Exp %newExp
}

;**********************************************************************
; IsSymbol
;
; Returns true iff the expression is a (possibly nil) symbol.
;
;**********************************************************************

define NILCC i1
@IsSymbol(%Exp %exp)
{
    %symbolp = call NILCC i1 @TagIs(%Exp %exp, %Tag SYMBOL_TAG)

    ret i1 %symbolp
}

;**********************************************************************
; IsCell
;
; Returns true iff the expression is a (non-nil) cell.
;
;**********************************************************************

define NILCC i1
@IsCell(%Exp %exp)
{
    %cellp = call NILCC i1 @TagIs(%Exp %exp, %Tag CELL_TAG)

    ret i1 %cellp
}

;**********************************************************************
; IsList
;
; Returns true iff the expression is a cell or nil.
;
; FIXME: Are there places where having this test earlier would have
; simplified the code?
;
;**********************************************************************

define NILCC i1
@IsList(%Exp %exp)
{
    %cellp = call NILCC i1 @IsCell(%Exp %exp)
    br i1 %cellp, label %True, label %NotCell

NotCell:
    %isNill = call NILCC i1 @IsNil(%Exp %exp)
    br i1 %isNill, label %True, label %False

False:
    ret i1 false

True:
    ret i1 true
}

;**********************************************************************
; IsPrimitive
;
; Returns true iff the expression is a primitive.
;
;**********************************************************************

define NILCC i1
@IsPrimitive(%Exp %exp)
{
    %primitivep = call NILCC i1 @TagIs(%Exp %exp, %Tag PRIMITIVE_TAG)

    ret i1 %primitivep
}

;**********************************************************************
; IsException
;
; Returns true iff the expression is an exception.
;
;**********************************************************************

define NILCC i1
@IsException(%Exp %exp)
{
    %exceptionp = call NILCC i1 @TagIs(%Exp %exp, %Tag EXCEPTION_TAG)

    ret i1 %exceptionp
}

;**********************************************************************
; NotException
;
; Returns false iff the expression is an exception.
;
;**********************************************************************

define NILCC i1
@NotException(%Exp %exp)
{
    %exceptionp = call NILCC i1 @TagIsNot(%Exp %exp, %Tag EXCEPTION_TAG)

    ret i1 %exceptionp
}

;**********************************************************************
; IsNil
;
; Returns true iff the expression is nil.
;
;**********************************************************************

define NILCC i1
@IsNil(%Exp %exp)
{
    %isNull = call NILCC i1 @Eq(%Exp %exp, %Exp NIL_VALUE)

    ret i1 %isNull
}

;**********************************************************************
; NotNil
;
; Returns true iff the expression is not nil.
;
;**********************************************************************

define NILCC i1
@NotNil(%Exp %exp)
{
    %notNull = call NILCC i1 @NotEq(%Exp %exp, %Exp NIL_VALUE)

    ret i1 %notNull
}

;**********************************************************************
; NewSymbol
;
; Returns a symbol whose name is the value of the given string.
;
;**********************************************************************

define NILCC %Exp
@NewSymbol(%c_char* %name)
{
        #ifndef NDEBUG
        ; Check to see that the string is at least one character long
        ; (The empty string is a valid string but *not* a valid symbol
        ; name!)
        %len = call ccc %c_size_t @strlen(%c_char* %name)
        %positive = icmp ugt %c_size_t %len, 0
        assert(%positive)
        #endif

    ; Get a pointer to a uniqueified string with the same value
    %string = call NILCC %c_char* @UniqueString(%c_char* %name)

    %exp = call NILCC %Exp @str2Exp(%c_char* %string)

    ret %Exp %exp
}

;**********************************************************************
; NewCell
;
; Returns a newly allocated cell.  Its fields must be set before use.
; This really isn't intended to be called directly--use Cons.
;
;**********************************************************************

define NILCC %nil_cell*
@NewCell()
{
    ; Compute sizeof(nil_cell)
    ; FIXME: this shouldn't be done at run-time
    %sizeAddr = getelementptr %nil_cell* null, i64 1
    %size = ptrtoint %nil_cell* %sizeAddr to %c_size_t

    ; Get a new cell
    %newMem = call NILCC i8* @NewMemory(%c_size_t %size)
    %newCell = bitcast i8* %newMem to %nil_cell*

    ret %nil_cell* %newCell
}

;**********************************************************************
; NewPrimitive
;
; Constructs a new primitive.
;
;**********************************************************************

define NILCC %Exp
@NewPrimitive(%PrimFn* %fnPtr, %Word %argCount, %c_char* %printForm,
              i1 %magic)
{
        #ifndef NDEBUG
        ; Better not be a null function pointer
        %notNull = icmp ne %PrimFn* %fnPtr, null
        assert(%notNull)

        ; Must either have a non-negative argument count or NIL_ARGS_ANY
        ; for "any"
        %argCountNonNeg = icmp sge %Word %argCount, 0
        %argCountAny = icmp eq %Word %argCount, NIL_ARGS_ANY
        %argCountOK = or i1 %argCountNonNeg, %argCountAny
        assert(%argCountOK)

        ; Check to see that the string is at least one character long
        ; (The empty string is *not* a valid primitive name!)
        %len = call ccc %c_size_t @strlen(%c_char* %printForm)
        %positive = icmp ugt %c_size_t %len, 0
        assert(%positive)
        #endif

    ; Compute sizeof(nil_primitive)
    ; FIXME: this shouldn't be done at run-time
    %sizeAddr = getelementptr %nil_primitive* null, i64 1
    %size = ptrtoint %nil_primitive* %sizeAddr to %c_size_t

    %newMem = call NILCC i8* @NewMemory(%c_size_t %size)
    %newPrim = bitcast i8* %newMem to %nil_primitive*

    ; Set function pointer
    %fnFieldPtr = getelementptr %nil_primitive* %newPrim, i64 0, i32 0
    store %PrimFn* %fnPtr, %PrimFn** %fnFieldPtr

    ; Set the argument count
    %argCountField = getelementptr %nil_primitive* %newPrim, i64 0, i32 1
    store %Word %argCount, %Word* %argCountField

    ; Set the print form
    ; Note that we don't uniqueify the print form--it's not accessible
    ; from the language (though it could be), and could be a string
    ; constant.
    %printFormField = getelementptr %nil_primitive* %newPrim, i64 0, i32 2
    store %c_char* %printForm, %c_char** %printFormField

    ; Set the magic bit
    %magicField = getelementptr %nil_primitive* %newPrim, i64 0, i32 3
    store i1 %magic, i1* %magicField

    %exp = call NILCC %Exp @nil_primitive2Exp(%nil_primitive* %newPrim)

    ret %Exp %exp
}

;**********************************************************************
; LenImp
;
; Implementation for Len--written this way for tail recursion
;
;**********************************************************************

define NILCC %Word
@LenImp(%Exp %list, %Word %count)
{
    %isNil = call NILCC i1 @IsNil(%Exp %list)
    br i1 %isNil, label %IsNil, label %NotNil

IsNil:
    ret %Word %count

NotNil:
        #ifndef NDEBUG
        %isCell = call NILCC i1 @IsCell(%Exp %list)
        assert(%isCell)
        #endif

    %rest = call NILCC %Exp @Cdr(%Exp %list)
    %restCount = add %Word %count, 1
    %len = call NILCC %Word @LenImp(%Exp %rest, %Word %restCount)
    ret %Word %len
}

;**********************************************************************
; Len
;
;**********************************************************************

define NILCC %Word
@Len(%Exp %list)
{
    %len = call NILCC %Word @LenImp(%Exp %list, %Word 0)
    ret %Word %len
}

;**********************************************************************
; ExceptionMsg
;
;**********************************************************************

    %UnknownSymbolType = type [15 x %c_char]
    @unknownSymbolArray = internal constant %UnknownSymbolType
        c"unknown symbol\00"

    %DotPairType = type [29 x %c_char]
    @dotPairArray = internal constant %DotPairType
        c"can't evaluate a dotted pair\00"

    %CannotApplyType = type [22 x %c_char]
    @cannotApplyArray = internal constant %CannotApplyType
        c"cannot apply operator\00"

    %ExpectedListType = type [14 x %c_char]
    @expectedListArray = internal constant %ExpectedListType
        c"expected list\00"

    %BadArgNumType = type [26 x %c_char]
    @badArgNumArray = internal constant %BadArgNumType
        c"mismatched argument count\00"

    %MalformedArgsType = type [15 x %c_char]
    @malformedArgsArray = internal constant %MalformedArgsType
        c"malformed args\00"

    #define EXCEPTIONMSGS_NUM 6
    %ExceptionMsgsType = type [EXCEPTIONMSGS_NUM x %c_char*]
    @exceptionMsgs = internal constant %ExceptionMsgsType [
        %c_char* getelementptr (%UnknownSymbolType* @unknownSymbolArray,
                                i64 0, i64 0 ),
        %c_char* getelementptr (%DotPairType* @dotPairArray,
                                i64 0, i64 0 ),
        %c_char* getelementptr (%CannotApplyType* @cannotApplyArray,
                                i64 0, i64 0 ),
        %c_char* getelementptr (%ExpectedListType* @expectedListArray,
                                i64 0, i64 0 ),
        %c_char* getelementptr (%BadArgNumType* @badArgNumArray,
                                i64 0, i64 0),
        %c_char* getelementptr (%MalformedArgsType* @malformedArgsArray,
                                i64 0, i64 0)
    ]

define NILCC %c_char*
@ExceptionMsg(%Word %code)
{
        #ifndef NDEBUG
        %nonNeg = icmp sge %Word %code, 0
        assert(%nonNeg)
        %smallEnough = icmp slt %Word %code, EXCEPTIONMSGS_NUM
        assert(%smallEnough)
        #endif

    %msgPtr = getelementptr %ExceptionMsgsType* @exceptionMsgs, i64 0, %Word %code
    %msg = load %c_char** %msgPtr
    ret %c_char* %msg
}

;**********************************************************************
; PrintExp
;
;**********************************************************************

define NILCC void
@PrintExp(%Exp %exp)
{
    %isAtom = call NILCC i1 @IsAtom(%Exp %exp)
    br i1 %isAtom, label %IsAtom, label %IsCell

IsAtom:
    call NILCC void @PrintAtom(%Exp %exp)
    ret void

IsCell:
    call ccc %c_int @putchar(%c_int ASCII_LPAREN)
    %car = call NILCC %Exp @Car(%Exp %exp)
    call NILCC void @PrintExp(%Exp %car)
    %cdr = call NILCC %Exp @Cdr(%Exp %exp)
    call NILCC void @PrintCDR(%Exp %cdr)
    call ccc %c_int @putchar(%c_int ASCII_RPAREN)
    ret void
}

;**********************************************************************
; PrintAtom
;
; Helper function for PrintExp.
;
;**********************************************************************

#define PRIMITIVEFORMAT_LEN 16
@primitiveFormat = internal constant [PRIMITIVEFORMAT_LEN x %c_char]
        c"#primitive: %s#\00"
%primitiveFormatType = type [PRIMITIVEFORMAT_LEN x %c_char]

#define EXCEPTIONFORMAT_LEN 20
@exceptionFormat = internal constant [EXCEPTIONFORMAT_LEN x %c_char]
        c"#exception %ld: %s#\00"
%exceptionFormatType = type [EXCEPTIONFORMAT_LEN x %c_char]

define NILCC void
@PrintAtom(%Exp %exp)
{
    %tag = call NILCC %Tag @GetTag(%Exp %exp)

    switch %Tag %tag, label %CantHappen [

        %Tag    SYMBOL_TAG, label %SymbolTag
        %Tag      CELL_TAG, label %CantHappen
        %Tag PRIMITIVE_TAG, label %IsPrimitive
        %Tag EXCEPTION_TAG, label %IsException
    ]

CantHappen:
    cant_happen()
    br label %CantHappen

SymbolTag:
    %isNil = call NILCC i1 @IsNil(%Exp %exp)
    br i1 %isNil, label %IsNil, label %IsSymbol

IsSymbol:
    %str = call NILCC %c_char* @Exp2str(%Exp %exp)
    call ccc %c_int @putstring(%c_char* %str)
    ret void

IsNil:
    call ccc %c_int @putchar(%c_int ASCII_LPAREN)
    call ccc %c_int @putchar(%c_int ASCII_RPAREN)
    ret void

IsPrimitive:
    %prim = call NILCC %nil_primitive* @Exp2nil_primitive(%Exp %exp)
    %printFormField = getelementptr %nil_primitive* %prim, i64 0, i32 2
    %printForm = load %c_char** %printFormField

    %primitiveString = getelementptr %primitiveFormatType*
                                 @primitiveFormat, i64 0, i64 0
    call ccc %c_int (%c_char*, ...)*
                     @printf(%c_char* %primitiveString,
                             %c_char* %printForm)
    ret void

IsException:
    %code = call NILCC %Word @Exp2Exception(%Exp %exp)
    %msg = call NILCC %c_char* @ExceptionMsg(%Word %code)

    %exceptionFormatStr = getelementptr %exceptionFormatType*
                                 @exceptionFormat, i64 0, i64 0
    call ccc %c_int (%c_char*, ...)*
                     @printf(%c_char* %exceptionFormatStr,
                             %Word %code, %c_char* %msg)
    ret void
}

;**********************************************************************
; PrintCDR
;
; Helper function for PrintExp, nothing else should call.
;
;**********************************************************************

define NILCC void
@PrintCDR(%Exp %exp)
{
    %notNil = call NILCC i1 @NotNil(%Exp %exp)
    br i1 %notNil, label %NotNil, label %IsNil

IsNil:
    ; End of list, nothing to do (which is why we handle this case
    ; specially instead of passing it along to PrintAtom)
    ret void

NotNil:
    %isAtom = call NILCC i1 @IsAtom(%Exp %exp)
    br i1 %isAtom, label %IsAtom, label %IsCell

IsAtom:
    ; the CDR is an atom, so we have a dotted pair
    call ccc %c_int @putchar(%c_int ASCII_PERIOD)
    call NILCC void @PrintAtom(%Exp %exp)
    ret void

IsCell:
    ; Another cell, so we need a separator
    call ccc %c_int @putchar(%c_int ASCII_SPACE)
    %car = call NILCC %Exp @Car(%Exp %exp)
    call NILCC void @PrintExp(%Exp %car)
    %cdr = call NILCC %Exp @Cdr(%Exp %exp)
    call NILCC void @PrintCDR(%Exp %cdr)
    ret void
}