Merge branch 'master' of http://matthias.benkard.de/code/mulklisp

18 files changed, 940 insertions, 110 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 4af0e66..22398e9 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -27,18 +27,19 @@ BUNDLE_NAME = Test
 
 ADDITIONAL_OBJCFLAGS = -Wall
 
-ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBinding.m			\
-                       MLKDoubleFloat.m MLKDynamicContext.m			\
-                       MLKEnvironment.m MLKFloat.m MLKInteger.m			\
-                       MLKInterpretedClosure.m MLKInterpreter.m			\
-                       MLKLinkedList.m MLKLexicalContext.m			\
-                       MLKLexicalEnvironment.m MLKLispValue.m			\
-                       MLKNumber.m MLKPackage.m MLKParenReader.m		\
-                       MLKQuoteReader.m MLKRatio.m MLKReader.m			\
-                       MLKReadtable.m MLKReaderError.m MLKRoot.m		\
-                       MLKSemicolonReader.m MLKSingleFloat.m MLKStream.m	\
-                       MLKStringInputStream.m MLKStringOutputStream.m		\
-                       MLKStringReader.m MLKSymbol.m MLKThrowException.m	\
+ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBackquoteReader.m	\
+                       MLKBinding.m MLKCommaReader.m MLKDoubleFloat.m	\
+                       MLKDynamicContext.m MLKEnvironment.m MLKFloat.m	\
+                       MLKInteger.m MLKInterpretedClosure.m		\
+                       MLKInterpreter.m MLKLinkedList.m			\
+                       MLKLexicalContext.m MLKLexicalEnvironment.m	\
+                       MLKLispValue.m MLKNumber.m MLKPackage.m		\
+                       MLKParenReader.m MLKQuoteReader.m MLKRatio.m	\
+                       MLKReader.m MLKReadtable.m MLKReaderError.m	\
+                       MLKRoot.m MLKSemicolonReader.m MLKSingleFloat.m	\
+                       MLKStream.m MLKStringInputStream.m		\
+                       MLKStringOutputStream.m MLKStringReader.m	\
+                       MLKSymbol.m MLKThrowException.m			\
                        NSObject-MLKPrinting.m NSString-MLKPrinting.m
 ToiletKit_LDFLAGS = -lgmp
 #LIBRARIES_DEPEND_UPON
diff --git a/MLKBackquoteReader.h b/MLKBackquoteReader.h
new file mode 100644
index 0000000..1c35bfa
--- /dev/null
+++ b/MLKBackquoteReader.h
@@ -0,0 +1,27 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKFuncallable.h"
+#import "MLKLispValue.h"
+
+#import <Foundation/NSArray.h>
+
+
+@interface MLKBackquoteReader : MLKLispValue <MLKFuncallable>
+-(NSArray *) applyToArray:(NSArray *)arguments;
+@end
diff --git a/MLKBackquoteReader.m b/MLKBackquoteReader.m
new file mode 100644
index 0000000..47989ab
--- /dev/null
+++ b/MLKBackquoteReader.m
@@ -0,0 +1,62 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKBackquoteReader.h"
+
+#import "MLKCons.h"
+#import "MLKDynamicContext.h"
+#import "MLKReader.h"
+#import "MLKReadtable.h"
+#import "MLKPackage.h"
+#import "MLKStream.h"
+#import "runtime-compatibility.h"
+#import "util.h"
+
+
+@implementation MLKBackquoteReader
+-(NSArray *) applyToArray:(NSArray *)arguments
+{
+  MLKStream *stream;
+  MLKReadtable *readtable;
+  MLKPackage *cl, *sys;
+  unichar ch;
+  id quoted_form;
+
+  cl = [MLKPackage findPackage:@"COMMON-LISP"];
+  sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+  stream = [arguments objectAtIndex:0];
+  readtable = [[MLKDynamicContext currentContext]
+                valueForSymbol:[cl intern:@"*READTABLE*"]];
+
+  while ([readtable isWhitespaceCharacter:(ch = [stream readChar])]);
+
+  [stream unreadChar:ch];
+
+  quoted_form = [MLKReader readFromStream:stream
+                           eofError:YES
+                           eofValue:nil
+                           recursive:YES
+                           preserveWhitespace:NO];
+
+  return [NSArray arrayWithObject:
+                    [MLKCons cons:[sys intern:@"QUASIQUOTE"]
+                             with:[MLKCons cons:nullify(quoted_form)
+                                           with:nil]]];
+}
+@end
diff --git a/MLKCommaReader.h b/MLKCommaReader.h
new file mode 100644
index 0000000..5f5d11e
--- /dev/null
+++ b/MLKCommaReader.h
@@ -0,0 +1,27 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKFuncallable.h"
+#import "MLKLispValue.h"
+
+#import <Foundation/NSArray.h>
+
+
+@interface MLKCommaReader : MLKLispValue <MLKFuncallable>
+-(NSArray *) applyToArray:(NSArray *)arguments;
+@end
diff --git a/MLKCommaReader.m b/MLKCommaReader.m
new file mode 100644
index 0000000..3a0115b
--- /dev/null
+++ b/MLKCommaReader.m
@@ -0,0 +1,73 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKCommaReader.h"
+
+#import "MLKCons.h"
+#import "MLKDynamicContext.h"
+#import "MLKReader.h"
+#import "MLKReadtable.h"
+#import "MLKPackage.h"
+#import "MLKStream.h"
+#import "runtime-compatibility.h"
+#import "util.h"
+
+
+@implementation MLKCommaReader
+-(NSArray *) applyToArray:(NSArray *)arguments
+{
+  MLKStream *stream;
+  MLKReadtable *readtable;
+  MLKPackage *cl, *sys;
+  MLKSymbol *marker;
+  unichar ch;
+  id quoted_form;
+
+  cl = [MLKPackage findPackage:@"COMMON-LISP"];
+  sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+  stream = [arguments objectAtIndex:0];
+  readtable = [[MLKDynamicContext currentContext]
+                valueForSymbol:[cl intern:@"*READTABLE*"]];
+
+  if ((ch = [stream readChar]) == '@')
+    {
+      marker = [sys intern:@"UNQUOTE-SPLICING"];
+    }
+  else
+    {
+      marker = [sys intern:@"UNQUOTE"];
+      [stream unreadChar:ch];
+    }
+
+  while ([readtable isWhitespaceCharacter:(ch = [stream readChar])]);
+
+  [stream unreadChar:ch];
+
+  quoted_form = [MLKReader readFromStream:stream
+                           eofError:YES
+                           eofValue:nil
+                           recursive:YES
+                           preserveWhitespace:NO];
+
+  return [NSArray arrayWithObject:
+                    [MLKCons cons:marker
+                             with:[MLKCons cons:nullify(quoted_form)
+                                           with:nil]]];
+}
+@end
diff --git a/MLKCons.m b/MLKCons.m
index 5bc761a..8b3084b 100644
--- a/MLKCons.m
+++ b/MLKCons.m
@@ -113,10 +113,18 @@
 
 -(NSString *)descriptionForLisp
 {
-  if ([_cdr isKindOfClass:[MLKCons class]]
-      && _car == [[MLKPackage findPackage:@"COMMON-LISP"] intern:@"QUOTE"])
-    return [NSString stringWithFormat:@"'%@", [_cdr bareDescriptionForLisp]];
-  else
+  if ([_cdr isKindOfClass:[MLKCons class]])
+    {
+      if (_car == [[MLKPackage findPackage:@"COMMON-LISP"] intern:@"QUOTE"])
+        return [NSString stringWithFormat:@"'%@", [_cdr bareDescriptionForLisp]];
+      else if (_car == [[MLKPackage findPackage:@"TOILET-SYSTEM"] intern:@"QUASIQUOTE"])
+        return [NSString stringWithFormat:@"`%@", [_cdr bareDescriptionForLisp]];
+      else if (_car == [[MLKPackage findPackage:@"TOILET-SYSTEM"] intern:@"UNQUOTE"])
+        return [NSString stringWithFormat:@",%@", [_cdr bareDescriptionForLisp]];
+      else if (_car == [[MLKPackage findPackage:@"TOILET-SYSTEM"] intern:@"UNQUOTE-SPLICING"])
+        return [NSString stringWithFormat:@",@%@", [_cdr bareDescriptionForLisp]];
+    }
+
     return [NSString stringWithFormat:@"(%@)", [self bareDescriptionForLisp]];
 }
 
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 593f4a7..1b8725b 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -24,6 +24,8 @@
 #import <Foundation/NSString.h>
 #import <Foundation/NSThread.h>
 
+#import "MLKBackquoteReader.h"
+#import "MLKCommaReader.h"
 #import "MLKCons.h"
 #import "MLKDynamicContext.h"
 #import "MLKEnvironment.h"
@@ -147,8 +149,6 @@ static MLKDynamicContext *global_context;
   [readtable setSyntaxType:MULTI_ESCAPE forCharacter:'|'];
 
   //  [readtable setSyntaxType:NONTERMINATING_MACRO forCharacter:'#'];
-  //  [readtable setSyntaxType:TERMINATING_MACRO forCharacter:'`'];
-  //  [readtable setSyntaxType:TERMINATING_MACRO forCharacter:','];
 
   [readtable setSyntaxType:SINGLE_ESCAPE forCharacter:'\\'];
   
@@ -164,6 +164,14 @@ static MLKDynamicContext *global_context;
   [readtable setSyntaxType:TERMINATING_MACRO forCharacter:'\''];
   [readtable setMacroFunction:AUTORELEASE([[MLKQuoteReader alloc] init])
              forCharacter:'\''];
+  
+  [readtable setSyntaxType:TERMINATING_MACRO forCharacter:'`'];
+  [readtable setMacroFunction:AUTORELEASE([[MLKBackquoteReader alloc] init])
+             forCharacter:'`'];
+  
+  [readtable setSyntaxType:TERMINATING_MACRO forCharacter:','];
+  [readtable setMacroFunction:AUTORELEASE([[MLKCommaReader alloc] init])
+             forCharacter:','];
 
   [readtable setSyntaxType:TERMINATING_MACRO forCharacter:';'];
   [readtable setMacroFunction:AUTORELEASE([[MLKSemicolonReader alloc] init])
diff --git a/MLKInterpreter.h b/MLKInterpreter.h
index 788dfe1..8ff119f 100644
--- a/MLKInterpreter.h
+++ b/MLKInterpreter.h
@@ -31,5 +31,10 @@
             inLexicalContext:(MLKLexicalContext *)context
             withEnvironment:(MLKLexicalEnvironment *)lexenv;
 
++(NSArray*) eval:(id)program
+            inLexicalContext:(MLKLexicalContext *)context
+            withEnvironment:(MLKLexicalEnvironment *)lexenv
+            expandOnly:(BOOL)expandOnly;
+  
 +(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print;
 @end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index c2d7ba4..3d55f33 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -102,9 +102,25 @@ static MLKSymbol *_LAMBDA;
             inLexicalContext:(MLKLexicalContext *)context
             withEnvironment:(MLKLexicalEnvironment *)lexenv
 {
+  return (NSArray *)[self eval:program
+                          inLexicalContext:context
+                          withEnvironment:lexenv
+                          expandOnly:NO];
+}
+
+
+#define RETURN_VALUE(thing)                     \
+  { return [NSArray arrayWithObject:nullify(thing)]; }
+
+
++(NSArray*) eval:(id)program
+            inLexicalContext:(MLKLexicalContext *)context
+            withEnvironment:(MLKLexicalEnvironment *)lexenv
+            expandOnly:(BOOL)expandOnly
+{
   MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
 
-  //NSLog (@"eval: %@", [program descriptionForLisp]);
+  //  NSLog (@"eval: %@", [program descriptionForLisp]);
 
   if (!program || [program isKindOfClass:[MLKSymbol class]])
     {
@@ -117,27 +133,34 @@ static MLKSymbol *_LAMBDA;
                                                 program, context, nil]];
           return [self eval:expansion
                        inLexicalContext:context
-                       withEnvironment:lexenv];
+                       withEnvironment:lexenv
+                       expandOnly:expandOnly];
         }
       else if ([context variableIsLexical:program])
         {
           //NSLog (@"Processing lexical variable %@.", [program descriptionForLisp]);
           //NSLog (@"Lexical environment: %@.", lexenv);
           //NSLog (@"Lexical variable value: %@.", [lexenv valueForSymbol:program]);
-          return [NSArray arrayWithObject:nullify([lexenv valueForSymbol:program])];
+          if (expandOnly)
+            RETURN_VALUE (program);
+
+          RETURN_VALUE ([lexenv valueForSymbol:program]);
         }
       else
         {
           //NSLog (@"Processing special variable %@.", [program descriptionForLisp]);
           //NSLog (@"Dynamic context: %@.", dynamicContext);
           //NSLog (@"Special variable value: %@.", [dynamicContext valueForSymbol:program]);
-          return [NSArray arrayWithObject:nullify([dynamicContext valueForSymbol:program])];
+          if (expandOnly)
+            RETURN_VALUE (program);
+
+          RETURN_VALUE ([dynamicContext valueForSymbol:program]);
         }
     }
   else if (![program isKindOfClass:[MLKCons class]])
     {
       // Everything that is not a list or a symbol evaluates to itself.
-      return [NSArray arrayWithObject:nullify(program)];
+      RETURN_VALUE (program);
     }
   else
     {
@@ -149,14 +172,22 @@ static MLKSymbol *_LAMBDA;
             {
               MLKCons *rest = denullify([[self eval:[[[program cdr] cdr] car]
                                                inLexicalContext:context
-                                               withEnvironment:lexenv]
+                                               withEnvironment:lexenv
+                                               expandOnly:expandOnly]
                                           objectAtIndex:0]);
 
               id function = denullify([[self eval:[[program cdr] car]
                                              inLexicalContext:context
-                                             withEnvironment:lexenv]
+                                             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];
 
@@ -174,21 +205,33 @@ static MLKSymbol *_LAMBDA;
                 {
                   catchTag = [[self eval:[[program cdr] car]
                                     inLexicalContext:context
-                                    withEnvironment:lexenv]
+                                    withEnvironment:lexenv
+                                    expandOnly:expandOnly]
                                objectAtIndex:0];
-
-                  newctx = [[MLKDynamicContext alloc]
-                             initWithParent:dynamicContext
-                             variables:nil
-                             handlers:nil
-                             restarts:nil
-                             catchTags:[NSSet setWithObject:catchTag]
-                             activeHandlerEnvironment:nil];
-                  [newctx pushContext];
+                  
+                  if (!expandOnly)
+                    {
+                      newctx = [[MLKDynamicContext alloc]
+                                 initWithParent:dynamicContext
+                                 variables:nil
+                                 handlers:nil
+                                 restarts:nil
+                                 catchTags:[NSSet setWithObject:catchTag]
+                                 activeHandlerEnvironment:nil];
+                      [newctx pushContext];
+                    }
 
                   values = [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]]
                                  inLexicalContext:context
-                                 withEnvironment:lexenv];
+                                 withEnvironment:lexenv
+                                 expandOnly:expandOnly];
+
+                  if (expandOnly)
+                    NS_VALUERETURN ([NSArray arrayWithObject:
+                                               [MLKCons cons:CATCH
+                                                        with:[MLKCons cons:catchTag
+                                                                      with:values]]],
+                                    NSArray *);
 
                   [MLKDynamicContext popContext];
                   RELEASE (newctx);
@@ -227,21 +270,49 @@ static MLKSymbol *_LAMBDA;
 
               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]
+                                          withEnvironment:lexenv
+                                          expandOnly:expandOnly]
                                      objectAtIndex:0]);
 
               [context addMacro:function forSymbol:name];
 
-              return [NSArray arrayWithObject:nullify(name)];
+              RETURN_VALUE (name);
             }
           else if (car == EVAL)
             {
-              return [self eval:denullify([[self eval:[program cdr]
-                                                 inLexicalContext:context
-                                                 withEnvironment:lexenv]
-                                            objectAtIndex:0])
+              NSArray *evaluand = denullify([[self eval:[program cdr]
+                                                   inLexicalContext:context
+                                                   withEnvironment:lexenv
+                                                   expandOnly:expandOnly]
+                                              objectAtIndex:0]);
+
+              if (expandOnly)
+                RETURN_VALUE ([MLKCons cons:EVAL with:[MLKCons cons:evaluand with:nil]]);
+
+              return [self eval:evaluand
                            inLexicalContext:[MLKLexicalContext globalContext]
                            withEnvironment:[MLKLexicalEnvironment
                                              globalEnvironment]];
@@ -253,20 +324,50 @@ static MLKSymbol *_LAMBDA;
               // Incidentally works for the two-clause case:
               id alternative = [[[[program cdr] cdr] cdr] car];
 
-              NSArray *values = [self eval:condition
-                                      inLexicalContext:context
-                                      withEnvironment:lexenv];
-              if ([values objectAtIndex:0] == [NSNull null])
+              id condition_value = denullify([[self eval:condition
+                                                    inLexicalContext:context
+                                                    withEnvironment:lexenv
+                                                    expandOnly:expandOnly]
+                                               objectAtIndex:0]);
+
+              if (expandOnly)
+                {
+                  id conseq_expansion = denullify([[self eval:consequent
+                                                         inLexicalContext:context
+                                                         withEnvironment:lexenv
+                                                         expandOnly:expandOnly]
+                                                    objectAtIndex:0]);
+                  id alt_expansion = denullify([[self eval:alternative
+                                                      inLexicalContext:context
+                                                      withEnvironment:lexenv
+                                                      expandOnly:expandOnly]
+                                                 objectAtIndex:0]);
+                  RETURN_VALUE ([MLKCons
+                                  cons:IF
+                                  with:[MLKCons
+                                         cons:condition_value
+                                         with:[MLKCons
+                                                cons:conseq_expansion
+                                                with:[MLKCons cons:alt_expansion
+                                                              with:nil]]]]);
+                }
+
+              if (!condition_value)
                 return [self eval:alternative
                              inLexicalContext:context
-                             withEnvironment:lexenv];
+                             withEnvironment:lexenv
+                             expandOnly:expandOnly];
               else
                 return [self eval:consequent
                              inLexicalContext:context
-                             withEnvironment:lexenv];                
+                             withEnvironment:lexenv
+                             expandOnly:expandOnly];                
             }
           else if (car == IN_PACKAGE)
             {
+              if (expandOnly)
+                RETURN_VALUE (program);
+
               id cadr = [[program cdr] car];
               id package = [MLKPackage findPackage:stringify(cadr)];
 
@@ -275,7 +376,7 @@ static MLKSymbol *_LAMBDA;
                 forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
                             intern:@"*PACKAGE*"]];
 
-              return [NSArray arrayWithObject:nullify(package)];
+              RETURN_VALUE (package);
             }
           else if (car == _LAMBDA)
             {
@@ -286,6 +387,21 @@ static MLKSymbol *_LAMBDA;
               id body = [[program cdr] cdr];
               MLKInterpretedClosure *closure;
 
+              if (expandOnly)
+                {
+                  id body_expansion = denullify([[self eval:[MLKCons cons:PROGN
+                                                                     with:body]
+                                                       inLexicalContext:context
+                                                       withEnvironment:lexenv
+                                                       expandOnly:expandOnly]
+                                                  objectAtIndex:0]);
+                  RETURN_VALUE ([MLKCons
+                                  cons:_LAMBDA
+                                  with:[MLKCons cons:lambdaList
+                                                with:[MLKCons cons:body_expansion
+                                                              with:nil]]]);
+                }
+
               closure = AUTORELEASE ([[MLKInterpretedClosure alloc]
                                        initWithBodyForms:body
                                        lambdaListName:lambdaList
@@ -315,6 +431,24 @@ static MLKSymbol *_LAMBDA;
                   declarations = nil;
                 }
 
+              if (expandOnly)
+                {
+                  id body_expansion = denullify([[self eval:[MLKCons cons:PROGN
+                                                                     with:body]
+                                                       inLexicalContext:context
+                                                       withEnvironment:lexenv
+                                                       expandOnly:expandOnly]
+                                                  objectAtIndex:0]);
+                  RETURN_VALUE ([MLKCons
+                                  cons:LET
+                                  with:[MLKCons
+                                         cons:[[program cdr] car]
+                                         with:[MLKCons
+                                                cons:declarations
+                                                with:[MLKCons cons:body_expansion
+                                                              with:nil]]]]);
+                }
+
               env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
                                    initWithParent:lexenv
                                    variables:nil
@@ -400,34 +534,47 @@ static MLKSymbol *_LAMBDA;
             {
               id result = nil;
               id rest = program;
+              NSMutableArray *results = [NSMutableArray array];
               while ((rest = [rest cdr]))
                 {
                   result = [self eval:[rest car]
                                  inLexicalContext:context
-                                 withEnvironment:lexenv];
+                                 withEnvironment:lexenv
+                                 expandOnly:expandOnly];
+                  if (expandOnly)
+                    [results addObjectsFromArray:result];
                 }
 
-              return result;
+              if (expandOnly)
+                {
+                  RETURN_VALUE ([MLKCons cons:PROGN
+                                         with:[MLKCons listWithArray:results]]);
+                }
+              else
+                return result;
             }
           else if (car == QUOTE)
             {
-              return [NSArray arrayWithObject:nullify([[program cdr] car])];
+              if (expandOnly)
+                RETURN_VALUE (program);
+              RETURN_VALUE ([[program cdr] car]);
             }
           else if (car == SETQ)
             {
               id symbol = [[program cdr] car];
               id value = [[self eval:[[[program cdr] cdr] car]
                                 inLexicalContext:context
-                                withEnvironment:lexenv]
+                                withEnvironment:lexenv
+                                expandOnly:expandOnly]
                            objectAtIndex:0];
               id rest = [[[program cdr] cdr] cdr];
 
               if (![program cdr])
-                return [NSArray arrayWithObject:[NSNull null]];
+                RETURN_VALUE (nil);
 
               if ([context symbolNamesSymbolMacro:symbol])
                 {
-                  id macrofun = [context macroForSymbol:program];
+                  id macrofun = [context symbolMacroForSymbol:symbol];
                   id expansion = [macrofun applyToArray:
                                              [NSArray arrayWithObjects:
                                                         program, context, nil]];
@@ -438,7 +585,25 @@ static MLKSymbol *_LAMBDA;
                                                      with:
                                                        [[program cdr] cdr]]]
                                inLexicalContext:context
-                               withEnvironment:lexenv];
+                               withEnvironment:lexenv
+                               expandOnly:expandOnly];
+                }
+
+              if (expandOnly)
+                {
+                  RETURN_VALUE ([MLKCons
+                                  cons:SETQ
+                                  with:[MLKCons
+                                         cons:symbol
+                                         with:[MLKCons
+                                                cons:value
+                                                with:denullify([[self eval:
+                                                                        [MLKCons cons:SETQ
+                                                                                 with:rest]
+                                                                      inLexicalContext:context
+                                                                      withEnvironment:lexenv
+                                                                      expandOnly:expandOnly]
+                                                                 objectAtIndex:0])]]]);
                 }
 
               if ([context variableIsLexical:symbol])
@@ -456,19 +621,27 @@ static MLKSymbol *_LAMBDA;
                              inLexicalContext:context
                              withEnvironment:lexenv];
               else
-                return [NSArray arrayWithObject:value];
+                RETURN_VALUE (value);
             }
           else if (car == SET)
             {
               id symbol = [[self eval:[[program cdr] car]
                                  inLexicalContext:context
-                                 withEnvironment:lexenv]
+                                 withEnvironment:lexenv
+                                 expandOnly:expandOnly]
                            objectAtIndex:0];
               id value = [[self eval:[[[program cdr] cdr] car]
                                 inLexicalContext:context
-                                withEnvironment:lexenv]
+                                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
@@ -482,13 +655,21 @@ static MLKSymbol *_LAMBDA;
               // Like SET, but for the function cell.
               id symbol = [[self eval:[[program cdr] car]
                                  inLexicalContext:context
-                                 withEnvironment:lexenv]
+                                 withEnvironment:lexenv
+                                 expandOnly:expandOnly]
                             objectAtIndex:0];
               id value = [[self eval:[[[program cdr] cdr] car]
                                 inLexicalContext:context
-                                withEnvironment:lexenv]
+                                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];
@@ -507,12 +688,20 @@ static MLKSymbol *_LAMBDA;
 
               catchTag = [[self eval:[[program cdr] car]
                                 inLexicalContext:context
-                                withEnvironment:lexenv]
+                                withEnvironment:lexenv
+                                expandOnly:expandOnly]
                            objectAtIndex:0];
 
               values = [self eval:[[[program cdr] cdr] car]
                              inLexicalContext:context
-                             withEnvironment:lexenv];
+                             withEnvironment:lexenv
+                             expandOnly:expandOnly];
+
+              if (expandOnly)
+                RETURN_VALUE ([MLKCons cons:THROW
+                                       with:[MLKCons cons:denullify(catchTag)
+                                                     with:[MLKCons cons:denullify([values objectAtIndex:0])
+                                                                   with:nil]]]);
 
               userInfo = [NSDictionary dictionaryWithObjectsAndKeys:
                                          catchTag, @"THROWN TAG",
@@ -541,6 +730,23 @@ static MLKSymbol *_LAMBDA;
             {
               NSArray *results;
 
+              if (expandOnly)
+                {
+                  id protectee = [self eval:[[program cdr] car]
+                                       inLexicalContext:context
+                                       withEnvironment:lexenv
+                                       expandOnly:expandOnly];
+                  id protection = [self eval:[MLKCons cons:PROGN
+                                                      with:[[program cdr] cdr]]
+                                        inLexicalContext:context
+                                        withEnvironment:lexenv
+                                        expandOnly:expandOnly];
+                  RETURN_VALUE ([MLKCons cons:UNWIND_PROTECT
+                                         with:[MLKCons cons:protectee
+                                                       with:[MLKCons cons:protection
+                                                                     with:nil]]]);
+                }
+
               NS_DURING
                 {
                   results = [self eval:[[program cdr] car]
@@ -551,7 +757,8 @@ static MLKSymbol *_LAMBDA;
                 {
                   [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]]
                         inLexicalContext:context
-                        withEnvironment:lexenv];
+                        withEnvironment:lexenv
+                        expandOnly:expandOnly];
 
                   [localException raise];
                 }
@@ -573,17 +780,21 @@ static MLKSymbol *_LAMBDA;
                   [results addObject:
                              [[self eval:[rest car]
                                     inLexicalContext:context
-                                    withEnvironment:lexenv]
+                                    withEnvironment:lexenv
+                                    expandOnly:expandOnly]
                                objectAtIndex:0]];
                 }
 
+              if (expandOnly)
+                RETURN_VALUE ([MLKCons cons:VALUES
+                                       with:[MLKCons listWithArray:results]]);
               return results;
             }
           else
             {
               if ([context symbolNamesFunction:car])
                 {
-                  id function = [lexenv functionForSymbol:car];
+                  id function;
                   MLKCons *rest = [program cdr];
                   NSMutableArray *args = [NSMutableArray array];
                   
@@ -591,13 +802,23 @@ static MLKSymbol *_LAMBDA;
                     {
                       id result = [[self eval:[rest car]
                                          inLexicalContext:context
-                                         withEnvironment:lexenv]
+                                         withEnvironment:lexenv
+                                         expandOnly:expandOnly]
                                     objectAtIndex:0];
                       [args addObject:result];
                       rest = [rest cdr];
                     }
-                  
-                  return [function applyToArray:args];
+
+                  if (expandOnly)
+                    {
+                      RETURN_VALUE ([MLKCons cons:[program car]
+                                             with:[MLKCons listWithArray:args]]);
+                    }
+                  else
+                    {
+                      function = [lexenv functionForSymbol:car];
+                      return [function applyToArray:args];
+                    }
                 }
               else if ([context symbolNamesMacro:car])
                 {
@@ -610,7 +831,8 @@ static MLKSymbol *_LAMBDA;
 
                   return [self eval:expansion
                                inLexicalContext:context
-                               withEnvironment:lexenv];
+                               withEnvironment:lexenv
+                               expandOnly:expandOnly];
                 }
               else
                 {
@@ -622,12 +844,19 @@ static MLKSymbol *_LAMBDA;
                     {
                       id result = [[self eval:[rest car]
                                          inLexicalContext:context
-                                         withEnvironment:lexenv]
+                                         withEnvironment:lexenv
+                                         expandOnly:expandOnly]
                                     objectAtIndex:0];
                       [args addObject:result];
                       rest = [rest cdr];
                     }
 
+                  if (expandOnly)
+                    {
+                      RETURN_VALUE ([MLKCons cons:[program car]
+                                             with:[MLKCons listWithArray:args]]);
+                    }
+
                   results = [MLKRoot dispatch:car withArguments:args];
 
                   if (results)
@@ -648,7 +877,8 @@ static MLKSymbol *_LAMBDA;
         {
           return [self eval:[MLKCons cons:FUNCALL with:program]
                        inLexicalContext:context
-                       withEnvironment:lexenv];
+                       withEnvironment:lexenv
+                       expandOnly:expandOnly];
         }
       else
         {
@@ -668,6 +898,7 @@ static MLKSymbol *_LAMBDA;
   while (YES)
     {
       id result;
+      id expansion;
       //NSLog (@"; LOAD: Reding a form.");
       id code = [MLKReader readFromStream:stream
                            eofError:NO
@@ -692,12 +923,29 @@ static MLKSymbol *_LAMBDA;
       else
         formdesc = [code descriptionForLisp];
 
-      fprintf (stderr, "; LOAD: %s\n",
-               [formdesc UTF8String]);
+      fprintf (stderr, "; COMPILE-MINIMALLY: %s\n", [formdesc UTF8String]);
+      expansion = denullify([[MLKInterpreter
+                               eval:code
+                               inLexicalContext:[MLKLexicalContext
+                                                  globalContext]
+                               withEnvironment:[MLKLexicalEnvironment
+                                                 globalEnvironment]
+                               expandOnly:YES]
+                              objectAtIndex:0]);
+
+      if ([code isKindOfClass:[MLKCons class]] && [code cdr])
+        formdesc = [NSString stringWithFormat:@"(%@ %@ ...)",
+                               [[expansion car] descriptionForLisp],
+                               [[[expansion cdr] car] descriptionForLisp]];
+      else
+        formdesc = [expansion descriptionForLisp];
+
+      fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]);
       result = [MLKInterpreter
-                 eval:code
+                 eval:expansion
                  inLexicalContext:[MLKLexicalContext globalContext]
-                 withEnvironment:[MLKLexicalEnvironment globalEnvironment]];
+                 withEnvironment:[MLKLexicalEnvironment globalEnvironment]
+                 expandOnly:NO];
       //NSLog (@"; LOAD: Top-level form evaluated.");
 
       if (print)
diff --git a/MLKPackage.m b/MLKPackage.m
index cae3416..039596a 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -115,6 +115,10 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"MAKE-SYMBOL"]];
   [sys export:[sys intern:@"IMPORT"]];
   [sys export:[sys intern:@"INTERN"]];
+  [sys export:[sys intern:@"OBJC-CLASS-OF"]];
+  [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
+  [sys export:[sys intern:@"FIND-OBJC-CLASS"]];
+  [sys export:[sys intern:@"NS-LOG"]];
 
   [cl export:[cl intern:@"*BREAK-ON-SIGNALS*"]];
   [cl export:[cl intern:@"*COMPILE-FILE-PATHNAME*"]];
diff --git a/MLKParenReader.m b/MLKParenReader.m
index 9287ce9..b61a332 100644
--- a/MLKParenReader.m
+++ b/MLKParenReader.m
@@ -59,6 +59,7 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
   while ((nextChar = slurpWhitespaceAndPeek(stream, readtable)) != ')')
     {
       id item;
+      id dotMarker = [[NSObject alloc] init];
 
       // FIXME: What to do about dots?  Maybe add a new
       // singleDotAllowed:(BOOL)dotp argument to readFromStream:...?
@@ -66,8 +67,35 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
                         eofError:YES
                         eofValue:nil
                         recursive:YES
-                        preserveWhitespace:NO];
-      
+                        preserveWhitespace:NO
+                        singleDotMarker:dotMarker];
+
+      if (item == dotMarker)
+        {
+          id nextItem;
+
+          RELEASE (dotMarker);
+
+          nextItem = [MLKReader readFromStream:stream
+                                eofError:YES
+                                eofValue:nil
+                                recursive:YES
+                                preserveWhitespace:NO
+                                singleDotMarker:nil];
+          [tail setCdr:nextItem];
+
+          if ((nextChar = slurpWhitespaceAndPeek (stream, readtable)) == ')')
+            {
+              [stream readChar];
+              return [NSArray arrayWithObject:cons];
+            }
+          else
+            {
+              [NSException raise:@"MLKReaderError"
+                           format:@"Unexpectedly read a single dot."];
+            }
+        }
+
       if (!tail)
         {
           cons = tail = [MLKCons cons:item with:nil];
@@ -77,6 +105,8 @@ static unichar slurpWhitespaceAndPeek (MLKStream *stream, MLKReadtable *readtabl
           [tail setCdr:[MLKCons cons:item with:nil]];
           tail = [tail cdr];
         }
+
+      RELEASE (dotMarker);
     }
 
   [stream readChar];
diff --git a/MLKReader.h b/MLKReader.h
index 9a49ef9..60954f1 100644
--- a/MLKReader.h
+++ b/MLKReader.h
@@ -26,6 +26,13 @@
             eofError:(BOOL)eofError
             eofValue:(id)eofValue
            recursive:(BOOL)recursive
+  preserveWhitespace:(BOOL)preserveWhitespace
+     singleDotMarker:(id)dotMarker;
+
++(id) readFromStream:(MLKStream *)stream
+            eofError:(BOOL)eofError
+            eofValue:(id)eofValue
+           recursive:(BOOL)recursive
   preserveWhitespace:(BOOL)preserveWhitespace;
 
 +(id) readFromString:(NSString *)string;
diff --git a/MLKReader.m b/MLKReader.m
index 7343c64..7db9670 100644
--- a/MLKReader.m
+++ b/MLKReader.m
@@ -45,6 +45,21 @@
            recursive:(BOOL)recursive
   preserveWhitespace:(BOOL)preserveWhitespace
 {
+  return [self readFromStream:stream
+               eofError:eofError
+               eofValue:eofValue
+               recursive:recursive
+               preserveWhitespace:preserveWhitespace
+               singleDotMarker:nil];
+}
+
++(id) readFromStream:(MLKStream *)stream
+            eofError:(BOOL)eofError
+            eofValue:(id)eofValue
+           recursive:(BOOL)recursive
+  preserveWhitespace:(BOOL)preserveWhitespace
+     singleDotMarker:(id)dotMarker
+{
   unichar ch;
   NSMutableString *token;
   MLKReadtable *readtable;
@@ -169,6 +184,16 @@
     }
 
   //NSLog (@"--> Interpret token: %@", token);
+
+  if ([token isEqualToString:@"."])
+    {
+      if (dotMarker)
+        return dotMarker;
+      else
+        [NSException raise:@"MLKReaderError"
+                     format:@"Unexpectedly read a single dot."];
+    }
+
   return [self interpretToken:token
                readtable:readtable
                escaped:ever_escaped];
diff --git a/MLKRoot.m b/MLKRoot.m
index f6ee730..d007173 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -225,10 +225,12 @@ static id truify (BOOL value)
 +(NSArray *) macroexpand_1:(NSArray *)args
 {
   id form = [args objectAtIndex:0];
-  id env = [args count] > 1 ? [args objectAtIndex:1] : nil;
+  id env = [args count] > 1 ? denullify([args objectAtIndex:1]) : nil;
   MLKLexicalContext *context = env ? (id)env : (id)[MLKLexicalContext globalContext];
 
-  if ([context symbolNamesMacro:[form car]])
+  if ([form isKindOfClass:[MLKCons class]]
+      && (![form car] || [[form car] isKindOfClass:[MLKSymbol class]])
+      && [context symbolNamesMacro:[form car]])
     {
       id <MLKFuncallable> macrofun = [context macroForSymbol:[form car]];
       form = denullify ([[macrofun applyToArray:
@@ -409,4 +411,27 @@ static id truify (BOOL value)
 
   RETURN_VALUE ([cl intern:@"T"]);
 }
+
++(NSArray *) objc_class_of:(NSArray *)args
+{
+  RETURN_VALUE ([[args objectAtIndex:0] class]);
+}
+
++(NSArray *) objc_subclassp:(NSArray *)args
+{
+  RETURN_VALUE (truify ([[args objectAtIndex:0] isSubclassOfClass:
+                                                  [args objectAtIndex:1]]));
+}
+
++(NSArray *) find_objc_class:(NSArray *)args
+{
+  RETURN_VALUE (NSClassFromString ([args objectAtIndex:0]));
+}
+
++(NSArray *) ns_log:(NSArray *)args
+{
+  NSString *description = [[args objectAtIndex:0] descriptionForLisp];
+  NSLog (@"%@", description);
+  RETURN_VALUE ([args objectAtIndex:0]);
+}
 @end
diff --git a/cond.lisp b/cond.lisp
deleted file mode 100644
index 7b3d1cc..0000000
--- a/cond.lisp
+++ /dev/null
@@ -1,29 +0,0 @@
-(%defun list* args
-  (if (null (cdr args))
-      (car args)
-      (cons (car args)
-            (apply 'list* (cdr args)))))
-
-(%defmacro let* args
-  (let ((form (car args)))
-    (let ((bindings (car (cdr form)))
-          (body (cdr (cdr form))))
-      (if (null bindings)
-          (list* 'let nil body)
-          (let ((first-binding (car bindings))
-                (rest (cdr bindings)))
-            (list 'let
-                  (list first-binding)
-                  (list* 'let* rest body)))))))
-
-(%defmacro cond args
-  (let* ((form (car args))
-         (clauses (cdr form))
-         (clause (car clauses))
-         (rest (cdr clauses)))
-    (if (null clauses)
-        nil
-        (list 'if
-              (car clause)
-              (cons 'progn (cdr clause))
-              (cons 'cond rest)))))
diff --git a/destructuring-bind.lisp b/destructuring-bind.lisp
new file mode 100644
index 0000000..161390d
--- /dev/null
+++ b/destructuring-bind.lisp
@@ -0,0 +1,114 @@
+(setq lambda-list-keywords
+      '(&allow-other-keys &aux &body &environment &key &optional &rest &whole))
+
+(%defmacro* d-b (lambda-list environment whole-sym expression . body)
+  ;; (ns-log lambda-list)
+  `(let* ,(unless whole-sym
+            (let ((real-expression expression))
+              (setq whole-sym (gensym "WHOLE")
+                    expression (gensym "EXPRESSION"))
+              `((,expression ,real-expression)
+                (,whole-sym ,expression))))
+     ,(cond ((consp lambda-list)
+             (case (car lambda-list)
+               (&environment
+                `(let ((,(cadr lambda-list) ,environment))
+                   (d-b ,(cddr lambda-list) ,environment ,whole-sym ,expression
+                     ,@body)))
+               (&aux
+                (if (or (endp (cdr lambda-list))
+                        (member (cadr lambda-list) lambda-list-keywords))
+                    `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression
+                       ,@body)
+                    `(let (,(cadr lambda-list))
+                       (d-b (&aux ,@(cddr lambda-list)) ,environment ,whole-sym ,expression
+                         ,@body))))
+               (&optional
+                (if (or (endp (cdr lambda-list))
+                        (member (cadr lambda-list) lambda-list-keywords))
+                    `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression
+                       ,@body)
+                    (let ((sym (gensym))
+                          (head (car lambda-list)))
+                      `(let* ((,sym ,expression)
+                              ,@(cond ((atom head)
+                                       `((,head (cadr ,sym))))
+                                      ((null (cdr head))
+                                       `((,(car head) (cadr ,sym))))
+                                      ((null (cddr head))
+                                       `((,(car head) (if (null ,sym)
+                                                          ,(cadr head)
+                                                          (cadr ,sym)))))
+                                      (t
+                                       `((,(car head) (if (null ,sym)
+                                                          ,(cadr head)
+                                                          (cadr ,sym)))
+                                         (,(caddr head) (not (null ,sym)))))))
+                         (d-b (&optional ,@(cddr lambda-list)) ,environment ,whole-sym (cdr ,sym)
+                           ,@body)))))
+               ((&rest &body)
+                (if (member (cadr lambda-list) lambda-list-keywords)
+                    `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression
+                       ,@body)
+                    (let ((sym (gensym)))
+                      `(let* ((,sym ,expression)
+                              (,(cadr lambda-list) ,sym))
+                         (d-b ,(cddr lambda-list) ,environment ,whole-sym ,sym
+                           ,@body)))))
+               (&whole
+                `(let ((,(cadr lambda-list) ,whole-sym))
+                   (d-b ,(cddr lambda-list) ,environment ,whole-sym ,expression
+                     ,@body)))
+               (&allow-other-keys
+                `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression
+                   ,@body))
+               (&key
+                (if (or (endp (cdr lambda-list))
+                        (member (cadr lambda-list) lambda-list-keywords))
+                    `(d-b ,(cdr lambda-list) ,environment ,whole-sym ,expression
+                       ,@body)
+                    (let* ((sym (gensym))
+                           (value-sym (gensym))
+                           (missing (gensym "MISSING"))
+                           (head (cadr lambda-list))
+                           (var (if (consp head)
+                                    (if (consp (car head))
+                                        (cadar head)
+                                        (car head))
+                                    head))
+                           (keyword-name
+                            (if (and (consp head) (consp (car head)))
+                                (caar head)
+                                (intern (symbol-name var) '#:keyword))))
+                      `(let* ((,sym ,expression)
+                              (,value-sym (getf ,sym ,keyword-name ',missing))
+                              ,@(cond ((atom head)
+                                       `((,var ,value-sym)))
+                                      ((null (cdr head))
+                                       `((,var ,value-sym)))
+                                      ((null (cddr head))
+                                       `((,var (if (eq ,value-sym ',missing)
+                                                   ,(cadr head)
+                                                   ,value-sym))))
+                                      (t
+                                       `((,var (if (eq ,value-sym ',missing)
+                                                   ,(cadr head)
+                                                   ,value-sym))
+                                         (,(caddr head) (not (eq ,value-sym ',missing)))))))
+                         (d-b (&key ,@(cddr lambda-list)) ,environment ,whole-sym ,sym
+                           ,@body)))))
+               (otherwise
+                (let ((sym (gensym)))
+                  `(let ((,sym ,expression))
+                     (d-b ,(car lambda-list) ,environment ,whole-sym (car ,sym)
+                       (d-b ,(cdr lambda-list) ,environment ,whole-sym (cdr ,sym)
+                         ,@body)))))))
+            ((null lambda-list)
+             `(progn ,@body))
+            (t `(let ((,lambda-list ,expression))
+                  ,@body)))))
+
+
+(export '(destructuring-bind lambda-list-keywords
+          &allow-other-keys &aux &body &environment &key &optional &rest
+          &whole))
diff --git a/init.lisp b/init.lisp
index 4c4f5f0..9a51e6b 100644
--- a/init.lisp
+++ b/init.lisp
@@ -1,5 +1,5 @@
 (in-package :common-lisp)
 (load "util.lisp")
-(load "cond.lisp")
 (load "list-functions.lisp")
+(load "destructuring-bind.lisp")
 (in-package :common-lisp-user)
diff --git a/util.lisp b/util.lisp
index ed4c3a0..08c7d1c 100644
--- a/util.lisp
+++ b/util.lisp
@@ -2,3 +2,198 @@
   (list '%fset
         (list 'quote (car (cdr (car args))))
         (cons '%lambda (cdr (cdr (car args))))))
+
+(%defun list* args
+  (if (null (cdr args))
+      (car args)
+      (cons (car args)
+            (apply 'list* (cdr args)))))
+
+(%defmacro let* args
+  (let ((form (car args)))
+    (let ((bindings (car (cdr form)))
+          (body (cdr (cdr form))))
+      (if (null bindings)
+          (list* 'let nil body)
+          (let ((first-binding (car bindings))
+                (rest (cdr bindings)))
+            (list 'let
+                  (list first-binding)
+                  (list* 'let* rest body)))))))
+
+(%defmacro cond args
+  (let* ((form (car args))
+         (clauses (cdr form))
+         (clause (car clauses))
+         (rest (cdr clauses)))
+    (if (null clauses)
+        nil
+        (list 'if
+              (car clause)
+              (cons 'progn (cdr clause))
+              (cons 'cond rest)))))
+
+(%defun not args
+  (if (null (car args)) t nil))
+
+(%defun make-%defmacro*-body args
+  (let ((lambda-list (car args))
+        (lambda-list-name (car (cdr args)))
+        (body (car (cdr (cdr args)))))
+    (cond ((null lambda-list) body)
+          ((not (listp lambda-list))
+           (list
+            (list* 'let
+                   (list (list lambda-list lambda-list-name))
+                   body)))
+          (t (let ((lambda-symbol (car lambda-list))
+                   (rest-lambda-list (cdr lambda-list))
+                   (rest-name (gensym)))
+               (list
+                (list* 'let
+                       (list (list lambda-symbol
+                                   (list 'car lambda-list-name))
+                             (list rest-name
+                                   (list 'cdr lambda-list-name)))
+                       (make-%defmacro*-body (cdr lambda-list)
+                                             rest-name
+                                             body))))))))
+
+(%defmacro %defmacro* args
+  (let* ((form (car args))
+         (real-args (cdr form)))
+    (let ((name (car real-args))
+          (lambda-list (car (cdr real-args)))
+          (body (cdr (cdr real-args)))
+          (macro-lambda-list-name (gensym))
+          (lambda-list-name (gensym)))
+      (list '%defmacro
+            name
+            macro-lambda-list-name
+            (list* 'let
+                   (list (list lambda-list-name
+                               (list 'cdr
+                                     (list 'car macro-lambda-list-name))))
+                   (make-%defmacro*-body lambda-list lambda-list-name body))))))
+
+(%defmacro %defun* args
+  (let* ((form (car args))
+         (real-args (cdr form)))
+    (let ((name (car real-args))
+          (lambda-list (car (cdr real-args)))
+          (body (cdr (cdr real-args)))
+          (lambda-list-name (gensym)))
+      (list* '%defun
+             name
+             lambda-list-name
+             (make-%defmacro*-body lambda-list lambda-list-name body)))))
+
+(%defmacro* and expressions
+  (cond ((null expressions) t)
+        ((null (cdr expressions)) (car expressions))
+        (t (list 'if
+                 (car expressions)
+                 (cons 'and (cdr expressions))
+                 nil))))
+
+(%defmacro* or expressions
+  (cond ((null expressions) nil)
+        ((null (cdr expressions)) (car expressions))
+        (t (let ((expr-sym (gensym)))
+             (list 'let
+                   (list (list expr-sym (car expressions)))
+                   (list 'if
+                         expr-sym
+                         expr-sym
+                         (cons 'or (cdr expressions))))))))
+
+(%defun* %reverse-helper (list stack)
+  (if (null list)
+      stack
+      (%reverse-helper (cdr list) (cons (car list) stack))))
+
+(%defun* reverse (list)
+  (%reverse-helper list nil))
+
+(%defun* %append-helper (reversed-list1 list2)
+  (if (null reversed-list1)
+      list2
+      (%append-helper (cdr reversed-list1) (cons (car reversed-list1) list2))))
+
+(%defun* %append-two-lists (list1 list2)
+  (%append-helper (reverse list1) list2))
+
+(%defun* %append (lists)
+  (if (null (cdr lists))
+      (car lists)
+      (let ((first-list (car lists))
+            (second-list (car (cdr lists)))
+            (rest (cdr (cdr lists))))
+        (%append (list* (%append-two-lists first-list second-list) rest)))))
+
+(%defun append lists
+  (%append lists))
+
+(%defmacro* sys::quasiquote (object)
+  (if (not (consp object))
+      (list 'quote object)
+      (cond ((eq 'sys::unquote (car object)) (car (cdr object)))
+            ((eq 'sys::quasiquote (car object)) (list 'quote object))
+            ((and (consp (car object))
+                  (eq 'sys::unquote-splicing (car (car object))))
+             (list 'append
+                   (car (cdr (car object)))
+                   (list 'sys::quasiquote (cdr object))))
+            (t (list 'cons
+                     (list 'sys::quasiquote (car object))
+                     (list 'sys::quasiquote (cdr object)))))))
+
+(%defun* %member (item list)
+  (and list
+       (or (and (eq item (car list)) list)
+           (%member item (cdr list)))))
+
+(%defmacro* case (object . clauses)
+  (let ((this-clause (car clauses))
+        (rest (cdr clauses))
+        (object-sym (gensym)))
+    (if (null clauses)
+        nil
+        (if (and (null rest)
+                 (or (eq (car this-clause) t)
+                     (eq (car this-clause) 'otherwise)))
+            `(progn ,@(cdr this-clause))
+            `(let ((,object-sym ,object))
+               (if ,(if (listp (car this-clause))
+                        `(%member ,object-sym
+                                  (quote ,(car this-clause)))
+                        `(eq ,object-sym
+                             (quote ,(car this-clause))))
+                   (progn ,@(cdr this-clause))
+                   (case ,object-sym ,@rest)))))))
+
+(%defun* list-eqp (list1 list2)
+  "Not really EQUALP (only works on trees of symbols)."
+  (if (and (consp list1) (consp list2))
+      (and (list-eqp (car list1) (car list2))
+           (list-eqp (cdr list1) (cdr list2)))
+      (eq list1 list2)))
+
+(%defun* macroexpand (object . rest)
+  (let* ((env (if rest (car rest) nil))
+         (expansion-1 (macroexpand-1 object env))
+         (expansion-2 (macroexpand-1 expansion-1 env)))
+    (if (list-eqp expansion-1 expansion-2)
+        expansion-1
+        (macroexpand expansion-2))))
+
+(%defun* macroexpand-all (object . rest)
+  (let* ((env (if rest (car rest) nil)))
+    (if (consp object)
+        (let ((expansion (macroexpand object env)))
+          (cons (macroexpand-all (car expansion))
+                (macroexpand-all (cdr expansion))))
+        object)))
+
+(%defmacro* unless (test . body)
+  `(if (not ,test) (progn ,@body) nil))