summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MLKCons.m4
-rw-r--r--MLKForm.h32
-rw-r--r--MLKForm.m143
-rw-r--r--MLKInterpreter.m132
-rw-r--r--MLKLLVMCompiler.h2
-rw-r--r--MLKLLVMCompiler.mm286
-rw-r--r--MLKLexicalContext-MLKLLVMCompilation.h2
-rw-r--r--MLKLexicalContext-MLKLLVMCompilation.mm12
-rw-r--r--MLKLexicalContext.h7
-rw-r--r--MLKLexicalContext.m41
-rw-r--r--MLKLexicalEnvironment.m32
-rw-r--r--MLKPackage.m6
-rw-r--r--MLKReadEvalPrintLoop.m15
-rw-r--r--MLKRoot.m64
-rw-r--r--functions.h3
-rw-r--r--functions.m28
-rw-r--r--special-symbols.h8
-rw-r--r--util.lisp14
18 files changed, 535 insertions, 296 deletions
diff --git a/MLKCons.m b/MLKCons.m
index bee917f..9e49d45 100644
--- a/MLKCons.m
+++ b/MLKCons.m
@@ -146,7 +146,7 @@
if (!_cdr)
return [NSString stringWithFormat:@"%@",
MLKPrintToString(_car)];
- else if ([_cdr isKindOfClass:[MLKCons class]])
+ else if (MLKInstanceP (_cdr) && [_cdr isKindOfClass:[MLKCons class]])
return [NSString stringWithFormat:@"%@ %@",
MLKPrintToString(_car),
[_cdr bareDescriptionForLisp]];
@@ -158,7 +158,7 @@
-(NSString *)descriptionForLisp
{
- if ([_cdr isKindOfClass:[MLKCons class]])
+ if (MLKInstanceP (_cdr) && [_cdr isKindOfClass:[MLKCons class]])
{
if (_car == [[MLKPackage findPackage:@"COMMON-LISP"] intern:@"QUOTE"])
return [NSString stringWithFormat:@"'%@", [_cdr bareDescriptionForLisp]];
diff --git a/MLKForm.h b/MLKForm.h
index 29483ef..5263dbd 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -91,6 +91,7 @@
{
id _body;
NSArray *_bodyForms;
+ id _bodyContext;
}
-(void) splitDeclarationsAndBody:(id)object;
@@ -133,14 +134,6 @@
@end
-@interface MLKSimpleDefmacroForm : MLKDeclaringForm
-{
- MLKSymbol *_lambdaListName;
- MLKSymbol *_name;
-}
-@end
-
-
@interface MLKEvalWhenForm : MLKBodyForm
{
BOOL _compileToplevel;
@@ -281,22 +274,6 @@
@end
-@interface MLKSetForm : MLKCompoundForm
-{
- MLKForm *_variableForm;
- MLKForm *_valueForm;
-}
-@end
-
-
-@interface MLKFSetForm : MLKCompoundForm
-{
- MLKForm *_functionNameForm;
- MLKForm *_valueForm;
-}
-@end
-
-
@interface MLKThrowForm : MLKCompoundForm
{
MLKForm *_tagForm;
@@ -319,6 +296,10 @@
}
+(Class) dispatchClassForObject:(id)object;
+
+-(id) name;
+-(id) lambdaListName;
+-(id) bodyForms;
@end
@@ -329,6 +310,9 @@
}
+(Class) dispatchClassForObject:(id)object;
+
+-(id) name;
+-(id) valueForm;
@end
diff --git a/MLKForm.m b/MLKForm.m
index a5bebe5..c8a5416 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -43,9 +43,10 @@
inContext:(MLKLexicalContext *)context
forCompiler:(id)compiler
{
- _form = object;
- _context = context;
- _compiler = compiler;
+ self = [super init];
+ LASSIGN (_form, object);
+ LASSIGN (_context, context);
+ LASSIGN (_compiler, compiler);
return [self complete];
}
@@ -56,7 +57,7 @@
+(Class) dispatchClassForObject:(id)object
{
- if ([object isKindOfClass:[MLKCons class]])
+ if (MLKInstanceP (object) && [object isKindOfClass:[MLKCons class]])
return [MLKCompoundForm class];
else
return [MLKAtomicForm class];
@@ -89,7 +90,7 @@
@implementation MLKAtomicForm
+(Class) dispatchClassForObject:(id)object
{
- if ([object isKindOfClass:[MLKSymbol class]])
+ if (MLKInstanceP (object) && [object isKindOfClass:[MLKSymbol class]])
return [MLKSymbolForm class];
else
return [MLKSelfEvaluatingForm class];
@@ -128,9 +129,7 @@
{
id car = [object car];
- if (car == APPLY) return [MLKFunctionCallForm class];
- else if (car == CATCH) return [MLKCatchForm class];
- else if (car == _DEFMACRO) return [MLKSimpleDefmacroForm class];
+ if (car == CATCH) return [MLKCatchForm class];
else if (car == EVAL) return [MLKFunctionCallForm class];
else if (car == EVAL_WHEN) return [MLKEvalWhenForm class];
else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class];
@@ -148,8 +147,6 @@
else if (car == QUOTE) return [MLKQuoteForm class];
else if (car == SETQ) return [MLKSetQForm class];
else if (car == _FSETQ) return [MLKFSetQForm class];
- else if (car == SET) return [MLKSetForm class];
- else if (car == _FSET) return [MLKFSetForm class];
else if (car == THROW) return [MLKThrowForm class];
else if (car == UNWIND_PROTECT) return [MLKUnwindProtectForm class];
else return [MLKSimpleCompoundForm class];
@@ -173,24 +170,24 @@
else if ([_head isKindOfClass:[MLKCons class]])
{
LRELEASE (self);
- return [MLKForm formWithObject:[MLKCons cons:FUNCALL
- with:object]
- inContext:context
- forCompiler:compiler];
+ return LRETAIN ([MLKForm formWithObject:[MLKCons cons:FUNCALL
+ with:object]
+ inContext:context
+ forCompiler:compiler]);
}
else if ([context symbolNamesMacro:_head])
{
LRELEASE (self);
- return [MLKMacroCallForm formWithObject:object
- inContext:context
- forCompiler:compiler];
+ return LRETAIN ([MLKMacroCallForm formWithObject:object
+ inContext:context
+ forCompiler:compiler]);
}
else
{
LRELEASE (self);
- return [MLKFunctionCallForm formWithObject:object
- inContext:context
- forCompiler:compiler];
+ return LRETAIN ([MLKFunctionCallForm formWithObject:object
+ inContext:context
+ forCompiler:compiler]);
}
}
@@ -212,15 +209,16 @@
forCompiler:compiler];
id <MLKFuncallable> macrofun = [context macroForSymbol:_head];
+ //NSLog (@"Expanding: %@", MLKPrintToString (_form));
id expansion = denullify ([[macrofun
applyToArray:
[NSArray arrayWithObjects:
_form, context, nil]]
objectAtIndex:0]);
- return [MLKForm formWithObject:expansion
- inContext:context
- forCompiler:compiler];
+ return LRETAIN ([MLKForm formWithObject:expansion
+ inContext:context
+ forCompiler:compiler]);
}
@end
@@ -228,7 +226,7 @@
@implementation MLKBodyForm
-(void) splitDeclarationsAndBody:(id)object
{
- _body = object;
+ LASSIGN (_body, object);
}
-(void) processBody:(id)object inContext:(MLKLexicalContext *)context
@@ -246,6 +244,7 @@
rest = [rest cdr];
}
+ LASSIGN (_bodyContext, context);
LASSIGN (_bodyForms, bodyForms);
}
@@ -333,31 +332,6 @@
@end
-@implementation MLKSimpleDefmacroForm
--(id) complete
-{
- MLKLexicalContext *newContext;
-
- self = [super complete];
-
- LASSIGN (_name, [_tail car]);
- LASSIGN (_lambdaListName, [[_tail cdr] car]);
- newContext = [MLKLexicalContext contextWithParent:_context
- variables:[NSSet setWithObject:_lambdaListName]
- functions:nil
- goTags:nil
- macros:nil
- compilerMacros:nil
- symbolMacros:nil
- declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
-
- [self processBody:[[_tail cdr] cdr]
- inContext:newContext];
- return self;
-}
-@end
-
-
@implementation MLKEvalWhenForm
-(id) complete
{
@@ -550,7 +524,7 @@
inContext:newContext
forCompiler:_compiler];
LRELEASE (self); //?FIXME
- return newForm;
+ return LRETAIN (newForm);
}
@end
@@ -733,16 +707,17 @@
@implementation MLKSetQForm
-(id) complete
{
- id rest = _tail;
+ id rest;
NSMutableArray *variables, *valueForms;
self = [super complete];
+ rest = _tail;
variables = [NSMutableArray array];
valueForms = [NSMutableArray array];
while (rest)
{
- [variables addObject:[rest car]];
+ [variables addObject:nullify([rest car])];
[valueForms addObject:MAKE_FORM([[rest cdr] car])];
rest = [[rest cdr] cdr];
}
@@ -762,16 +737,17 @@
@implementation MLKFSetQForm
-(id) complete
{
- id rest = _tail;
+ id rest;
NSMutableArray *functionNames, *valueForms;
self = [super complete];
+ rest = _tail;
functionNames = [NSMutableArray array];
valueForms = [NSMutableArray array];
while (rest)
{
- [functionNames addObject:[rest car]];
+ [functionNames addObject:nullify([rest car])];
[valueForms addObject:MAKE_FORM([[rest cdr] car])];
rest = [[rest cdr] cdr];
}
@@ -788,40 +764,6 @@
@end
-@implementation MLKSetForm
--(id) complete
-{
- self = [super complete];
- LASSIGN (_variableForm, MAKE_FORM ([_tail car]));
- LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
- return self;
-}
-
--(NSArray *) subforms
-{
- return [[[super subforms] arrayByAddingObject:_variableForm]
- arrayByAddingObject:_valueForm];
-}
-@end
-
-
-@implementation MLKFSetForm
--(id) complete
-{
- self = [super complete];
- LASSIGN (_functionNameForm, MAKE_FORM ([_tail car]));
- LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
- return self;
-}
-
--(NSArray *) subforms
-{
- return [[[super subforms] arrayByAddingObject:_functionNameForm]
- arrayByAddingObject:_valueForm];
-}
-@end
-
-
@implementation MLKThrowForm
-(id) complete
{
@@ -883,6 +825,21 @@
inContext:newContext];
return self;
}
+
+-(id) name
+{
+ return _name;
+}
+
+-(id) lambdaListName
+{
+ return _lambdaListName;
+}
+
+-(id) bodyForms
+{
+ return _bodyForms;
+}
@end
@@ -914,6 +871,16 @@
{
return [[super subforms] arrayByAddingObject:_valueForm];
}
+
+-(id) name
+{
+ return _name;
+}
+
+-(id) valueForm
+{
+ return _valueForm;
+}
@end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 693c742..0cdf904 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -29,6 +29,7 @@
#import "MLKInterpreter.h"
#import "MLKLexicalContext.h"
#import "MLKLexicalEnvironment.h"
+#import "MLKLLVMCompiler.h"
#import "MLKPackage.h"
#import "MLKReader.h"
#import "MLKRoot.h"
@@ -192,34 +193,7 @@
}
}
- if (car == APPLY)
- {
- MLKCons *rest = denullify([[self eval:[[[program cdr] cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0]);
-
- id function = denullify([[self eval:[[program cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0]);
-
- if (expandOnly)
- RETURN_VALUE ([MLKCons cons:APPLY
- with:[MLKCons cons:function
- with:[MLKCons cons:rest
- with:nil]]]);
-
- if ([function isKindOfClass:[MLKSymbol class]])
- function = [lexenv functionForSymbol:function];
-
- return [function applyToArray:(rest
- ? (id)[rest array]
- : (id)[NSArray array])];
- }
- else if (car == CATCH)
+ if (car == CATCH)
{
id catchTag;
NSArray *values;
@@ -289,46 +263,6 @@
return nil;
}
- else if (car == _DEFMACRO)
- {
- // No real lambda lists here. This SYS::%DEFMACRO is
- // really as low-level as it gets.
- id name = [[program cdr] car];
- id lambdaListAndBody = [[program cdr] cdr];
-
- id <MLKFuncallable> function;
-
- if (expandOnly)
- {
- id lambdaList = [lambdaListAndBody car];
- id body = [lambdaListAndBody cdr];
- id body_expansion =
- denullify([[self eval:[MLKCons cons:PROGN with:body]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0]);
- RETURN_VALUE ([MLKCons
- cons:_DEFMACRO
- with:[MLKCons
- cons:name
- with:[MLKCons
- cons:lambdaList
- with:[MLKCons
- cons:body_expansion
- with:nil]]]]);
- }
-
- function = denullify([[self eval:[MLKCons cons:_LAMBDA with:lambdaListAndBody]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0]);
-
- [context addMacro:function forSymbol:name];
-
- RETURN_VALUE (name);
- }
else if (car == EVAL)
{
NSArray *evaluand = denullify([[self eval:[[program cdr] car]
@@ -1059,59 +993,6 @@
else
RETURN_VALUE (value);
}
- else if (car == SET)
- {
- id symbol = [[self eval:[[program cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0];
- id value = [[self eval:[[[program cdr] cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0];
-
- if (expandOnly)
- RETURN_VALUE ([MLKCons cons:SET
- with:[MLKCons cons:symbol
- with:[MLKCons cons:value
- with:nil]]]);
-
- if ([dynamicContext bindingForSymbol:symbol])
- [dynamicContext setValue:value forSymbol:symbol];
- else
- [[MLKDynamicContext globalContext] addValue:value
- forSymbol:symbol];
-
- return [NSArray arrayWithObject:symbol];
- }
- else if (car == _FSET)
- {
- // Like SET, but for the function cell.
- id symbol = [[self eval:[[program cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0];
- id value = [[self eval:[[[program cdr] cdr] car]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0];
-
- if (expandOnly)
- RETURN_VALUE ([MLKCons cons:_FSET
- with:[MLKCons cons:symbol
- with:[MLKCons cons:value
- with:nil]]]);
-
- [[MLKLexicalContext globalContext] addFunction:symbol];
- [[MLKLexicalEnvironment globalEnvironment] addFunction:value
- forSymbol:symbol];
-
- return [NSArray arrayWithObject:symbol];
- }
else if (car == THROW)
{
id catchTag;
@@ -1335,7 +1216,8 @@
if (code == eofValue)
break;
- if ([code isKindOfClass:[MLKCons class]] && [code cdr])
+ if (MLKInstanceP(code)
+ && [code isKindOfClass:[MLKCons class]] && [code cdr])
formdesc = [NSString stringWithFormat:@"(%@ %@ ...)",
MLKPrintToString([code car]),
MLKPrintToString([[code cdr] car])];
@@ -1347,6 +1229,11 @@
for (i = 0; i < level; i++)
fprintf (stderr, "| ");
fprintf (stderr, "LOAD: %s\n", [formdesc UTF8String]);
+
+#ifdef USE_LLVM
+ expansion = code;
+ result = [MLKLLVMCompiler eval:code];
+#else // !USE_LLVM
expansion = denullify([[MLKInterpreter
eval:code
inLexicalContext:[MLKLexicalContext
@@ -1370,6 +1257,7 @@
withEnvironment:[MLKLexicalEnvironment globalEnvironment]
expandOnly:NO];
//NSLog (@"; LOAD: Top-level form evaluated.");
+#endif //!USE_LLVM
LRELEASE (pool);
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 379d791..cf2823b 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -37,6 +37,8 @@ using namespace llvm;
+(id) compile:(id)object
inContext:(MLKLexicalContext *)context;
++(id) eval:(id)object;
+
+(void) processTopLevelForm:(id)object;
+(void) processTopLevelForm:(id)object
inMode:(enum MLKProcessingMode)mode;
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 4313ac9..aa0ab79 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -16,10 +16,14 @@
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
+#import "MLKDynamicContext.h"
#import "MLKLLVMCompiler.h"
+#import "MLKPackage.h"
#import "globals.h"
+#import "util.h"
#import <Foundation/NSArray.h>
+#import <Foundation/NSAutoreleasePool.h>
#import <Foundation/NSEnumerator.h>
#import <Foundation/NSString.h>
@@ -100,6 +104,9 @@ static Constant
+(id) compile:(id)object
inContext:(MLKLexicalContext *)context
{
+ NSAutoreleasePool *pool;
+ pool = [[NSAutoreleasePool alloc] init];
+
Value *v = NULL;
BasicBlock *block;
std::vector<const Type*> noargs (0, Type::VoidTy);
@@ -112,27 +119,33 @@ static Constant
module);
id lambdaForm;
id (*fn)();
+ MLKForm *form = [MLKForm formWithObject:object
+ inContext:context
+ forCompiler:self];
block = BasicBlock::Create ("entry", function);
builder.SetInsertPoint (block);
- v = [self processForm:[MLKForm formWithObject:object
- inContext:context
- forCompiler:self]];
+ v = [self processForm:form];
builder.CreateRet (v);
verifyFunction (*function);
fpm->run (*function);
+ //function->dump();
+
// JIT-compile.
fn = (id (*)()) execution_engine->getPointerToFunction (function);
- module->dump();
- NSLog (@"%p", fn);
+ //module->dump();
+ //NSLog (@"%p", fn);
+
+ [pool release];
+ //NSLog (@"Code compiled.");
// Execute.
lambdaForm = fn();
- NSLog (@"Closure built.");
+ //NSLog (@"Closure built.");
return lambdaForm;
}
@@ -150,7 +163,12 @@ static Constant
//FIXME
// If PROGN, do this... If EVAL-WHEN, do that...
-
+}
+
++(id) eval:(id)object
+{
+ return [self compile:object
+ inContext:[MLKLexicalContext globalContext]];
}
+(Value *) processForm:(MLKForm *)form
@@ -314,10 +332,7 @@ static Constant
{
NSEnumerator *e = [_bodyForms objectEnumerator];
MLKForm *form;
- Value *value = NULL;
-
- if ([_bodyForms count] == 0)
- value = ConstantPointerNull::get (PointerTy);
+ Value *value = ConstantPointerNull::get (PointerTy);
while ((form = [e nextObject]))
{
@@ -364,9 +379,31 @@ static Constant
{
Value *value;
- if ([_context variableHeapAllocationForSymbol:_form])
+ //NSLog (@"Symbol: %@", MLKPrintToString (_form));
+ //[_compiler insertTrace:[NSString stringWithFormat:@"Symbol: %@", _form]];
+
+ if (![_context variableIsLexical:_form])
{
- Value *binding = builder.CreateLoad ([_context bindingValueForSymbol:_form]);
+ //[_compiler insertTrace:@"Dynamic."];
+ Value *mlkdynamiccontext = [_compiler insertClassLookup:@"MLKCons"];
+ Value *dynctx = [_compiler insertMethodCall:@"currentContext"
+ onObject:mlkdynamiccontext];
+
+ LRETAIN (_form); // FIXME: release
+ Value *symbolV = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)_form,
+ false),
+ PointerTy);
+
+ std::vector<Value *> args (1, symbolV);
+ value = [_compiler insertMethodCall:@"valueForSymbol:"
+ onObject:dynctx
+ withArgumentVector:&args];
+ }
+ else if ([_context variableHeapAllocationForSymbol:_form])
+ {
+ //[_compiler insertTrace:@"Global."];
+ Value *binding = builder.CreateLoad (builder.Insert ([_context bindingCellValueForSymbol:_form]));
value = [_compiler insertMethodCall:@"value" onObject:binding];
}
else
@@ -383,28 +420,67 @@ static Constant
@implementation MLKFunctionCallForm (MLKLLVMCompilation)
-(Value *) processForLLVM
{
+ static MLKPackage *sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+ BOOL special_dispatch = NO;
+ Value *functionCell;
+ Value *functionPtr;
+ Value *closureDataCell;
+ Value *closureDataPtr;
+ std::vector<Value *> args;
+
if (![_context symbolNamesFunction:_head])
{
- NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
- // XXX Issue a style warning.
+ if (_head && [_head homePackage] == sys)
+ {
+ special_dispatch = YES;
+ }
+ else
+ {
+ NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
+ // XXX Issue a style warning.
+ }
}
- Value *functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
- Value *functionPtr = builder.CreateLoad (functionCell);
- Value *closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
- Value *closureDataPtr = builder.CreateLoad (closureDataCell);
+ if (!special_dispatch)
+ {
+ functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
+ functionPtr = builder.CreateLoad (functionCell);
+ closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
+ closureDataPtr = builder.CreateLoad (closureDataCell);
+
+ args.push_back (closureDataPtr);
+ }
+ else
+ {
+ std::vector<const Type *> argtypes (1, PointerTy);
+ functionPtr = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)MLKDispatchRootFunction,
+ false),
+ PointerType::get (FunctionType::get (PointerTy,
+ argtypes,
+ true),
+ 0));
+ LRETAIN (_head); // FIXME: release sometime? On the other hand,
+ // these symbols will probably never be
+ // deallocated anyway.
+ args.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)_head,
+ false),
+ PointerTy));
+ }
NSEnumerator *e = [_argumentForms objectEnumerator];
MLKForm *form;
- std::vector<Value *> args;
- args.push_back (closureDataPtr);
-
while ((form = [e nextObject]))
{
args.push_back ([form processForLLVM]);
}
+ //GlobalVariable *endmarker = module->getGlobalVariable ("MLKEndOfArgumentsMarker", false);
+ //endmarker->setConstant (true);
+ //GlobalVariable *endmarker = new GlobalVariable (PointerTy, true, GlobalValue::ExternalWeakLinkage);
Value *endmarker = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
(uint64_t)MLKEndOfArgumentsMarker,
false),
@@ -534,7 +610,7 @@ static Constant
builder.CreateRet (value);
- function->dump();
+ //function->dump();
//NSLog (@"Verify...");
verifyFunction (*function);
//NSLog (@"Optimise...");
@@ -544,7 +620,7 @@ static Constant
// the function.
execution_engine->getPointerToFunction (function);
//NSLog (@"Done.");
- function->dump();
+ //function->dump();
//NSLog (@"Function built.");
builder.SetInsertPoint (outerBlock);
@@ -569,3 +645,165 @@ static Constant
return closure;
}
@end
+
+
+@implementation MLKLetForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ NSEnumerator *e = [_variableBindingForms objectEnumerator];
+ Value *value = ConstantPointerNull::get (PointerTy);
+ MLKForm *form;
+ MLKVariableBindingForm *binding_form;
+
+ while ((binding_form = [e nextObject]))
+ {
+ // FIXME: Handle heap allocation.
+ Value *binding_value = [[binding_form valueForm] processForLLVM];
+ Value *binding_variable = builder.CreateAlloca (PointerTy,
+ NULL,
+ [(MLKPrintToString([binding_form name]))
+ UTF8String]);
+ builder.CreateStore (binding_value, binding_variable);
+ [_bodyContext setValueValue:binding_variable
+ forSymbol:[binding_form name]];
+ }
+
+ e = [_bodyForms objectEnumerator];
+ while ((form = [e nextObject]))
+ {
+ value = [form processForLLVM];
+ }
+
+ return value;
+}
+@end
+
+
+@implementation MLKQuoteForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ // FIXME: When to release _quotedData? At the same time the code is
+ // released, probably...
+ LRETAIN (_quotedData);
+ return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)_quotedData,
+ false),
+ PointerTy);
+}
+@end
+
+
+@implementation MLKSelfEvaluatingForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ // FIXME: When to release _form? At the same time the code is
+ // released, probably...
+ LRETAIN (_form);
+ return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)_form,
+ false),
+ PointerTy);
+}
+@end
+
+
+@implementation MLKIfForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ Function *function = builder.GetInsertBlock()->getParent();
+ BasicBlock *thenBlock = BasicBlock::Create ("if_then", function);
+ BasicBlock *elseBlock = BasicBlock::Create ("if_else");
+ BasicBlock *joinBlock = BasicBlock::Create ("if_join");
+
+ Value *test = builder.CreateICmpNE ([_conditionForm processForLLVM],
+ ConstantPointerNull::get (PointerTy));
+ Value *value = builder.CreateAlloca (PointerTy, NULL, "if_result");
+ builder.CreateCondBr (test, thenBlock, elseBlock);
+
+ builder.SetInsertPoint (thenBlock);
+ builder.CreateStore ([_consequentForm processForLLVM], value);
+ builder.CreateBr (joinBlock);
+
+ builder.SetInsertPoint (elseBlock);
+ function->getBasicBlockList().push_back (elseBlock);
+ builder.CreateStore ([_alternativeForm processForLLVM], value);
+ builder.CreateBr (joinBlock);
+
+ builder.SetInsertPoint (joinBlock);
+ function->getBasicBlockList().push_back (joinBlock);
+
+ return builder.CreateLoad (value);
+}
+@end
+
+
+@implementation MLKSetQForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ NSEnumerator *var_e, *value_e;
+ MLKForm *valueForm;
+ Value *value = ConstantPointerNull::get (PointerTy);
+ id variable;
+
+ var_e = [_variables objectEnumerator];
+ value_e = [_valueForms objectEnumerator];
+ while ((valueForm = [value_e nextObject]))
+ {
+ variable = [var_e nextObject];
+ value = [valueForm processForLLVM];
+ if (![_context variableIsLexical:variable])
+ {
+ Value *mlkdynamiccontext = [_compiler insertClassLookup:@"MLKCons"];
+ Value *dynctx = [_compiler insertMethodCall:@"currentContext"
+ onObject:mlkdynamiccontext];
+
+ LRETAIN (variable); // FIXME: release
+ Value *symbolV = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)variable,
+ false),
+ PointerTy);
+
+ std::vector<Value *> args;
+ args.push_back (value);
+ args.push_back (symbolV);
+ [_compiler insertMethodCall:@"setValue:forSymbol:"
+ onObject:dynctx
+ withArgumentVector:&args];
+ }
+ else if ([_context variableHeapAllocationForSymbol:variable])
+ {
+ Value *binding = builder.CreateLoad (builder.Insert ([_context
+ bindingCellValueForSymbol:variable]));
+ std::vector<Value *> args (1, value);
+
+ [_compiler insertVoidMethodCall:@"setValue:"
+ onObject:binding
+ withArgumentVector:&args];
+ }
+ else
+ {
+ builder.CreateStore (value, [_context valueValueForSymbol:variable]);
+ }
+ }
+
+ return value;
+}
+@end
+
+
+@implementation MLKInPackageForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+ id package = [MLKPackage findPackage:stringify(_packageDesignator)];
+
+ [[MLKDynamicContext currentContext]
+ setValue:package
+ forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]];
+
+ return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+ (uint64_t)package,
+ false),
+ PointerTy);
+}
+@end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
index d42140e..d791765 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.h
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -37,7 +37,7 @@ using namespace llvm;
-(BOOL) variableHeapAllocationForSymbol:(id)name;
-(Instruction *) functionCellValueForSymbol:(id)name;
-(Instruction *) closureDataPointerValueForSymbol:(id)name;
--(Value *) bindingValueForSymbol:(id)name;
+-(Instruction *) bindingCellValueForSymbol:(id)name;
-(Value *) valueValueForSymbol:(id)name;
//-(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name;
//-(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name;
diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm
index 744351a..22d211d 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.mm
+++ b/MLKLexicalContext-MLKLLVMCompilation.mm
@@ -45,7 +45,11 @@ using namespace std;
id flag = [self deepPropertyForVariable:name
key:@"LLVM.heap-flag"];
- return (flag && [flag boolValue]);
+ if (flag)
+ return [flag boolValue];
+ else
+ return (![self contextForVariable:name]
+ || [self contextForVariable:name] == [MLKLexicalContext globalContext]);
}
-(Instruction *) functionCellValueForSymbol:(id)name
@@ -70,12 +74,12 @@ using namespace std;
PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
}
--(Value *) bindingValueForSymbol:(id)name
+-(Instruction *) bindingCellValueForSymbol:(id)name
{
return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
- (uint64_t)[self bindingForSymbol:name],
+ (uint64_t)[self bindingCellForSymbol:name],
false),
- PointerType::get(Type::Int8Ty, 0)));
+ PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
}
-(Value *) valueValueForSymbol:(id)name
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index fc2abc3..e350b63 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -86,9 +86,8 @@
-(id) declarations;
-(void) addDeclaration:(id)declaration;
-// FIXME?
-//-(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables
-// functions:(NSDictionary *)functions;
+-(id) contextForVariable:(MLKSymbol *)symbol;
+-(id) contextForFunction:(MLKSymbol *)symbol;
-(void) addVariable:(MLKSymbol *)symbol;
-(void) addFunction:(MLKSymbol *)symbol;
@@ -107,7 +106,7 @@
-(void *) functionCellForSymbol:(id)name;
-(void *) closureDataPointerForSymbol:(id)name;
--(id) bindingForSymbol:(id)name;
+-(id *) bindingCellForSymbol:(id)name;
-(void) dealloc;
@end
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index 1eaa51c..3f820a8 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -37,6 +37,8 @@
#import "runtime-compatibility.h"
#import "util.h"
+#include <stdlib.h>
+
#define MAKE_ENVIRONMENT(variable, parent, parent_member) \
[[MLKEnvironment alloc] \
@@ -196,9 +198,29 @@ static MLKSymbol *LEXICAL;
with:_declarations]);
}
+-(id) contextForVariable:(MLKSymbol *)symbol
+{
+ if ([_variables containsObject:nullify(symbol)])
+ return self;
+ else if (_parent)
+ return [_parent contextForVariable:symbol];
+ else
+ return nil;
+}
+
+-(id) contextForFunction:(MLKSymbol *)symbol
+{
+ if ([_functions containsObject:nullify(symbol)])
+ return self;
+ else if (_parent)
+ return [_parent contextForFunction:symbol];
+ else
+ return nil;
+}
+
-(BOOL) symbolNamesFunction:(MLKSymbol *)symbol
{
- symbol = symbol ? (id)symbol : (id)[NSNull null];
+ symbol = nullify (symbol);
if ([_functions containsObject:symbol])
return YES;
else if ([_knownMacros containsObject:symbol])
@@ -209,7 +231,7 @@ static MLKSymbol *LEXICAL;
-(BOOL) symbolNamesMacro:(MLKSymbol *)symbol
{
- symbol = symbol ? (id)symbol : (id)[NSNull null];
+ symbol = nullify (symbol);
if ([_functions containsObject:symbol])
return NO;
else if ([_knownMacros containsObject:symbol])
@@ -220,7 +242,7 @@ static MLKSymbol *LEXICAL;
-(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol
{
- symbol = symbol ? (id)symbol : (id)[NSNull null];
+ symbol = nullify (symbol);
if ([_variables containsObject:symbol])
return NO;
else if ([_knownSymbolMacros containsObject:symbol])
@@ -399,20 +421,25 @@ static MLKSymbol *LEXICAL;
}
}
--(id) bindingForSymbol:(id)name
+-(id *) bindingCellForSymbol:(id)name
{
id prop = [self deepPropertyForVariable:name
key:@"LEXCTX.variable-binding"];
if (!prop)
{
- prop = [MLKBinding binding];
+ id *cell = malloc (sizeof(id));
+ *cell = [[MLKBinding alloc] init];
+ prop = [NSValue valueWithPointer:cell];
[self setDeepProperty:prop
forVariable:name
key:@"LEXCTX.variable-binding"];
+ return cell;
+ }
+ else
+ {
+ return [prop pointerValue];
}
-
- return prop;
}
-(void) dealloc
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index ca6b4a9..723c955 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -107,17 +107,43 @@ static MLKLexicalEnvironment *global_environment;
-(id) valueForSymbol:(MLKSymbol *)symbol
{
- return [_variables valueForSymbol:symbol];
+ if (![_variables environmentForSymbol:symbol]
+ || [_variables environmentForSymbol:symbol] == global_environment->_variables)
+ {
+ id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+ return [*cell value];
+ }
+ else
+ {
+ return [_variables valueForSymbol:symbol];
+ }
}
-(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol
{
- [_variables setValue:value forSymbol:symbol];
+ if (![_variables environmentForSymbol:symbol]
+ || [_variables environmentForSymbol:symbol] == global_environment->_variables)
+ {
+ id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+ [*cell setValue:value forSymbol:symbol];
+ }
+ else
+ {
+ [_variables setValue:value forSymbol:symbol];
+ }
}
-(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
{
- [_variables addValue:value forSymbol:symbol];
+ if (self == global_environment)
+ {
+ id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+ [*cell setValue:value forSymbol:symbol];
+ }
+ else
+ {
+ [_variables addValue:value forSymbol:symbol];
+ }
}
-(void) addBindingForSymbol:(MLKSymbol *)symbol
diff --git a/MLKPackage.m b/MLKPackage.m
index acaf6db..6d97652 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -92,7 +92,6 @@ static NSMutableDictionary *packages = nil;
[cl export:[cl intern:@"FUNCALL"]];
[cl export:[cl intern:@"FUNCTION"]];
[cl export:[cl intern:@"PROGN"]];
- [cl export:[cl intern:@"APPLY"]];
[cl export:[cl intern:@"PROGV"]];
[cl export:[cl intern:@"SETQ"]];
[cl export:[cl intern:@"SETF"]];
@@ -101,15 +100,14 @@ static NSMutableDictionary *packages = nil;
[cl export:[cl intern:@"VALUES"]];
[cl export:[cl intern:@"EVAL"]];
[cl export:[cl intern:@"SPECIAL"]];
- [cl export:[cl intern:@"SET"]];
[cl export:[cl intern:@"UNWIND-PROTECT"]];
[cl export:[cl intern:@"MULTIPLE-VALUE-CALL"]];
[cl export:[cl intern:@"EVAL-WHEN"]];
- [sys export:[sys intern:@"%DEFMACRO"]];
[sys export:[sys intern:@"%LAMBDA"]];
[sys export:[sys intern:@"%FSET"]];
[sys export:[sys intern:@"%FSETQ"]];
+ [sys export:[sys intern:@"%MACROSET"]];
[sys export:[sys intern:@"%LOOP"]];
[sys export:[sys intern:@"%FLET"]];
[sys export:[sys intern:@"%MACROLET"]];
@@ -155,6 +153,8 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"DECLARATIONS-AND-DOC-AND-FORMS"]];
[sys export:[sys intern:@"DECLARATIONS-AND-FORMS"]];
[sys export:[sys intern:@"COMPILE"]];
+ [sys export:[sys intern:@"SET"]];
+ [sys export:[sys intern:@"APPLY"]];
[sys export:[sys intern:@"OBJC-CLASS-OF"]];
[sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m
index 2ddc5d7..fc0d8ef 100644
--- a/MLKReadEvalPrintLoop.m
+++ b/MLKReadEvalPrintLoop.m
@@ -31,7 +31,12 @@
#import <Foundation/NSNull.h>
#import <Foundation/NSString.h>
-#import <histedit.h>
+#ifdef GNUSTEP
+#import <Foundation/NSDebug.h>
+#endif
+
+#include <histedit.h>
+#include <string.h>
static int _argc;
@@ -132,7 +137,13 @@ static const char *prompt (EditLine *e) {
if (strcmp (line, ":q\n") == 0 || strncmp (line, ":q ", 3) == 0)
break;
+#if 1
NS_DURING
+#else
+ GSDebugAllocationActive (YES);
+ [NSObject enableDoubleReleaseCheck:YES];
+ NSZombieEnabled = YES;
+#endif
{
int i;
@@ -150,6 +161,7 @@ static const char *prompt (EditLine *e) {
printf ("%s\n", [MLKPrintToString (denullify (result)) UTF8String]);
}
}
+#if 1
NS_HANDLER
{
printf ("Caught an unhandled exception.\nName: %s\nReason: %s\n",
@@ -157,6 +169,7 @@ static const char *prompt (EditLine *e) {
[[localException reason] UTF8String]);
}
NS_ENDHANDLER;
+#endif
LRELEASE (pool);
}
diff --git a/MLKRoot.m b/MLKRoot.m
index b051dd3..0db7483 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -99,6 +99,10 @@ static id truify (BOOL value)
withString:@"_"
options:NSLiteralSearch
range:NSMakeRange(0, [methodName length])];
+ [methodName replaceOccurrencesOfString:@"%"
+ withString:@""
+ options:NSLiteralSearch
+ range:NSMakeRange(0, [methodName length])];
[methodName appendString:@":"];
selector = NSSelectorFromString (methodName);
@@ -707,12 +711,66 @@ as provided by method %@ of object %@",
#ifdef USE_LLVM
+(NSArray *) compile:(NSArray *)args
{
- NSLog (@"Compiling lambda form.");
+ //NSLog (@"Compiling lambda form.");
id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0])
inContext:[MLKLexicalContext globalContext]];
- NSLog (@"Compilation done.");
- NSLog (@"Compiled: %@", thing);
+ //NSLog (@"Compilation done.");
+ //NSLog (@"Compiled: %@", thing);
RETURN_VALUE (thing);
}
#endif
+
++(NSArray *) fset:(NSArray *)args
+{
+ id symbol = denullify ([args objectAtIndex:0]);
+ id value = denullify ([args objectAtIndex:1]);
+
+ [[MLKLexicalContext globalContext] addFunction:symbol];
+ [[MLKLexicalEnvironment globalEnvironment] addFunction:value
+ forSymbol:symbol];
+
+ RETURN_VALUE (value);
+}
+
++(NSArray *) set:(NSArray *)args
+{
+ id symbol = denullify ([args objectAtIndex:0]);
+ id value = denullify ([args objectAtIndex:1]);
+ MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
+
+ if ([dynamicContext bindingForSymbol:symbol])
+ [dynamicContext setValue:value forSymbol:symbol];
+ else
+ [[MLKDynamicContext globalContext] addValue:value
+ forSymbol:symbol];
+
+ RETURN_VALUE (value);
+}
+
++(NSArray *) macroset:(NSArray *)args
+{
+ id symbol = denullify ([args objectAtIndex:0]);
+ id value = denullify ([args objectAtIndex:1]);
+
+ [[MLKLexicalContext globalContext] addMacro:value
+ forSymbol:symbol];
+
+ RETURN_VALUE (value);
+}
+
++(NSArray *) apply:(NSArray *)args
+{
+ id function = denullify ([args objectAtIndex:0]);
+ id arglist = denullify ([args objectAtIndex:1]);
+
+ if (!function || [function isKindOfClass:[MLKSymbol class]])
+ {
+ function = [[MLKLexicalEnvironment globalEnvironment]
+ functionForSymbol:function];
+ }
+
+ return [function applyToArray:(arglist
+ ? (id)[arglist array]
+ : (id)[NSArray array])];
+}
@end
diff --git a/functions.h b/functions.h
index 8f3e70e..4ea8261 100644
--- a/functions.h
+++ b/functions.h
@@ -17,6 +17,7 @@
*/
#import "MLKInteger.h"
+#import "MLKSymbol.h"
#import <Foundation/NSString.h>
#include <stdint.h>
@@ -82,7 +83,7 @@ void MLKSetForeignValueWithLispValue (void *destination, id value, MLKForeignTyp
id MLKLispValueWithForeignValue (void *source, MLKForeignType type);
id MLKInterpretedFunctionTrampoline (void *target, ...);
-
+id MLKDispatchRootFunction (MLKSymbol *name, ...);
#ifdef __cplusplus
}
diff --git a/functions.m b/functions.m
index 7caea41..20cde07 100644
--- a/functions.m
+++ b/functions.m
@@ -25,7 +25,9 @@
#import "MLKInterpretedClosure.h"
#import "MLKPackage.h"
#import "MLKSymbol.h"
+#import "MLKRoot.h"
+#import <Foundation/NSArray.h>
#import <Foundation/NSException.h>
#import <Foundation/NSString.h>
@@ -405,7 +407,31 @@ id MLKInterpretedFunctionTrampoline (void *target, ...)
values = [closure applyToArray:arguments];
if ([values count] > 0)
- return [values objectAtIndex:0];
+ return denullify ([values objectAtIndex:0]);
+ else
+ return nil;
+}
+
+id MLKDispatchRootFunction (MLKSymbol *name, ...)
+{
+ NSArray *values;
+ NSMutableArray *arguments;
+ id arg;
+ va_list ap;
+
+ arguments = [NSMutableArray array];
+
+ va_start (ap, name);
+ while ((arg = va_arg (ap, id)) != MLKEndOfArgumentsMarker)
+ {
+ [arguments addObject:nullify(arg)];
+ }
+ va_end (ap);
+
+ values = [MLKRoot dispatch:name withArguments:arguments];
+
+ if ([values count] > 0)
+ return denullify ([values objectAtIndex:0]);
else
return nil;
}
diff --git a/special-symbols.h b/special-symbols.h
index fa68ba7..d7e7351 100644
--- a/special-symbols.h
+++ b/special-symbols.h
@@ -36,7 +36,6 @@ static MLKSymbol *_MACROLET;
static MLKSymbol *LAMBDA;
static MLKSymbol *LET;
static MLKSymbol *LOCALLY;
-static MLKSymbol *APPLY;
static MLKSymbol *FUNCALL;
static MLKSymbol *FUNCTION;
static MLKSymbol *EVAL;
@@ -44,14 +43,11 @@ static MLKSymbol *EVAL_WHEN;
static MLKSymbol *QUOTE;
static MLKSymbol *SETQ;
static MLKSymbol *SETF;
-static MLKSymbol *SET;
static MLKSymbol *_FSETQ;
-static MLKSymbol *_FSET;
static MLKSymbol *SYMBOL_MACROLET;
static MLKSymbol *PROGV;
static MLKSymbol *UNWIND_PROTECT;
static MLKSymbol *VALUES;
-static MLKSymbol *_DEFMACRO;
static MLKSymbol *_FOREIGN_LAMBDA;
static MLKSymbol *_LAMBDA;
static MLKSymbol *_LOOP;
@@ -87,7 +83,6 @@ ensure_symbols ()
_FLET = [sys intern:@"%FLET"];
_MACROLET = [sys intern:@"%MACROLET"];
_LOOP = [sys intern:@"%LOOP"];
- APPLY = [cl intern:@"APPLY"];
EVAL = [cl intern:@"EVAL"];
EVAL_WHEN = [cl intern:@"EVAL-WHEN"];
FUNCALL = [cl intern:@"FUNCALL"];
@@ -95,14 +90,11 @@ ensure_symbols ()
QUOTE = [cl intern:@"QUOTE"];
SETQ = [cl intern:@"SETQ"];
SETF = [cl intern:@"SETF"];
- SET = [cl intern:@"SET"];
_FSETQ = [sys intern:@"%FSETQ"];
- _FSET = [sys intern:@"%FSET"];
SYMBOL_MACROLET = [cl intern:@"SYMBOL-MACROLET"];
PROGV = [cl intern:@"PROGV"];
VALUES = [cl intern:@"VALUES"];
UNWIND_PROTECT = [cl intern:@"UNWIND-PROTECT"];
- _DEFMACRO = [sys intern:@"%DEFMACRO"];
_FOREIGN_LAMBDA = [sys intern:@"%FOREIGN-LAMBDA"];
_LAMBDA = [sys intern:@"%LAMBDA"];
V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
diff --git a/util.lisp b/util.lisp
index 412b23d..b9601e4 100644
--- a/util.lisp
+++ b/util.lisp
@@ -22,6 +22,20 @@
otherwise unless when eq boundp))
+(setq t 't)
+(setq nil ())
+
+(%macroset '%defmacro
+ (%lambda args
+ (let ((form (car args)))
+ (let ((name (car (cdr form)))
+ (lambda-list-name (car (cdr (cdr form))))
+ (body (cdr (cdr (cdr form)))))
+ (list '%macroset
+ (list 'quote name)
+ (cons '%lambda
+ (cons lambda-list-name body)))))))
+
(%defmacro %defun args
(list '%fset
(list 'quote (car (cdr (car args))))