home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / compiler.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  14KB  |  588 lines
  1. /* compiler.c -- UMB Scheme, compiles Scheme expressions to abstract graphs.
  2.  
  3. UMB Scheme Interpreter                  $Revision: 2.12 $
  4. Copyright (C) 1988, 1991 William R Campbell
  5.  
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with this program; if not, write to the Free Software
  18. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. UMB Scheme was written by Bill Campbell with help from Karl Berry,
  21. Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
  22. Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni and Thang Quoc Tran.
  23.  
  24. For additional information about UMB Scheme, contact the author:
  25.  
  26.     Bill Campbell
  27.     Department of Mathematics and Computer Science
  28.     University of Massachusetts at Boston
  29.     Harbor Campus
  30.     Boston, MA 02125
  31.  
  32.     Telephone: 617-287-6449        Internet: bill@cs.umb.edu
  33.  
  34. */
  35.  
  36.  
  37. #include    "portable.h"
  38. #include    "eval.h"
  39. #include    "object.h"
  40. #include    "architecture.h"
  41. #include    "compiler.h"
  42. #include     "steering.h"
  43. #include     "debug.h"
  44.  
  45. /*
  46.  
  47. In general, the compilation routines take their input expressions from atop
  48. the stack and leave the target graphs in the Value_Register.
  49.  
  50. */
  51.  
  52. #define Extend_Compiler_Environment( frame ) \
  53.     {    Get_Environment_Frame_Previous(frame) = Environment_Register;\
  54.         Environment_Register = frame; }
  55.  
  56. #define Restore_Compiler_Environment() \
  57.         Environment_Register = \
  58.             Get_Environment_Frame_Previous(Environment_Register);
  59.  
  60. Private void    Compile_Arguments();
  61. Private    void    Lookup_Address();
  62. Private Object    Scanned_Internal_Defns();
  63.  
  64.     
  65.  
  66. Public void Self_Compile()
  67. {
  68.     Value_Register = Top( 1 ) ;
  69.     Pop( 1 ) ;
  70. }
  71.  
  72.  
  73. Public void Compile_The_Empty_Object()
  74. {
  75.     Error( "Unquoted ()" );
  76. }
  77.  
  78.  
  79. Public void Compile_Form()
  80. {
  81.     /* The expression to be compiled is a list of the form
  82.  
  83.         (operator ...)
  84.     */
  85.  
  86.     Object    form = Top( 1 ) ;
  87.     Object    operator = First( form ) ;
  88.  
  89.     if ( Is_Symbol( operator ) )
  90.     {
  91.         if ( operator == QUOTE_Symbol )
  92.         {
  93.             /* form = (quote expr) */
  94.  
  95.             if ( Length( form ) != 2 )
  96.             {
  97.                 Display_Error("Bad syntax to quote in: ", form);
  98.             }
  99.  
  100.             Value_Register = Second( form ) ;
  101.         }
  102.         else if ( operator == DEFINE_Symbol )
  103.         {
  104.             Object name ;
  105.  
  106.             /* form = (define name expr) */
  107.  
  108.             if ( Length( form ) <  2 )
  109.             {
  110.             Display_Error("Bad syntax to define in: ", form);
  111.             }
  112.  
  113.             name = Second( form );
  114.  
  115.             if ( Is_Pair( name ) )
  116.             {
  117.             Object formals = Rest( name );
  118.  
  119.             /* Transform: (define (name . formals) . body)
  120.                 => (define name (lambda formals . body))
  121.             */
  122.  
  123.             name = First( name );
  124.  
  125.             Push( DEFINE_Symbol );
  126.             Push( name );
  127.             Push( LAMBDA_Symbol );
  128.             Push( formals );
  129.             Push( Rest( Rest( form )));
  130.  
  131.             Make_Pair();
  132.             Push( Value_Register );    /* (formals . body ) */
  133.             Make_Pair();
  134.             Push( Value_Register );    /* (lambda formals . body) */
  135.             Push( Nil );
  136.             Make_Pair();
  137.             Push( Value_Register );    /* ((lambda formals .body)) */
  138.             Make_Pair();
  139.             Push( Value_Register );    /* (name (lambda ...)) */
  140.             Make_Pair();
  141.             Push( Value_Register );    /* (define name (lambda...)) */
  142.  
  143.             Compile_Object( Top(1) ); /* Now, compile THAT! */
  144.             }
  145.             else
  146.             {
  147.             /* Basic form: (define name expr) */
  148.  
  149.             Object    expr ; 
  150.  
  151.             if ( Length( form ) != 3 )
  152.             {
  153.                 Display_Error("Bad syntax to define in: ", form);
  154.             }
  155.  
  156.             expr = Third( form );
  157.  
  158.             if ( !Is_Symbol( name ) )
  159.             {
  160.                 Display_Error("Bad syntax to define in: ", form);
  161.             }
  162.  
  163.             if (Get_Global_Binding(name) == The_Syntactic_Keyword)
  164.             {
  165.                 Error1( "`%s' cannot be used as a variable.",
  166.                     Get_Symbol_Name(name) );
  167.             }
  168.  
  169.             if ( Debugging && 
  170.                  Environment_Register ==     
  171.                 Get_State_Frame_Environment( State_Debugged ) )
  172.             {
  173.                 Lookup_Address( name , The_Global_Environment );
  174.             }
  175.             else
  176.             {
  177.                 Lookup_Address( name , Environment_Register );
  178.                 if ( Is_Local_Variable( Value_Register ) )
  179.                 {
  180.                 if (Get_Variable_Frame_Number(Value_Register)!=0)
  181.                     Display_Error( "Bad internal definition: ",
  182.                         form );
  183.                 }
  184.                 else if ((Environment_Register!=
  185.                         The_Global_Environment))
  186.                 {
  187.                     Display_Error( "Bad internal definition: ",form);
  188.                 }
  189.             }
  190.  
  191.             Push( Value_Register );
  192.  
  193.             Push( expr );
  194.             Compile_Object( Top( 1 ));
  195.             Push( Value_Register );
  196.  
  197.             Make_Definition();
  198.             }
  199.         }
  200.         else if ( operator == SET_Symbol )
  201.         {
  202.             /* form = (set! name expr) */
  203.  
  204.             if ( Length( form ) != 3 || !Is_Symbol(Second(form)) )
  205.             {
  206.                 Display_Error("Bad syntax to set! in: ", form);
  207.             }
  208.  
  209.             if (Get_Global_Binding(Second(form)) ==
  210.                 The_Syntactic_Keyword)
  211.             {
  212.                 Error1( "`%s' cannot be used as a variable.",
  213.                     Get_Symbol_Name(Second(form)) );
  214.             }
  215.  
  216.  
  217.             Lookup_Address( Second( form ) , Environment_Register );
  218.             Push( Value_Register );
  219.  
  220.             Push( Third( Top( 2 ) ) ); /* expr */
  221.             Compile_Object( Top( 1 ));
  222.             Push( Value_Register ); 
  223.  
  224.             Make_Assignment();
  225.         }
  226.         else if ( operator == IF_Symbol )
  227.         {
  228.             /* form = (if test consequent alternative)
  229.                  or   (if test consequent)
  230.             */
  231.  
  232.             if ( Length( form ) < 3 || Length( form ) > 4 )
  233.             {
  234.                 Display_Error("Bad syntax to if in: ", form);
  235.             }
  236.  
  237.             Push( Second( form )); /* form now = Top(2) */
  238.             Compile_Object( Top( 1 ));
  239.             Push( Value_Register );    /* test on stack */
  240.  
  241.             Push( Third( Top(2)) ); /* form now = Top(3) */
  242.             Compile_Object( Top( 1 ));
  243.             Push( Value_Register );    /* consequent on stack */
  244.  
  245.             if (Length( Top(3) ) == 4) 
  246.             {
  247.                 /* alternative supplied in form */
  248.  
  249.                 Push( Fourth( Top(3) )); 
  250.                 Compile_Object( Top( 1 ));
  251.                 Push( Value_Register );
  252.             }
  253.             else
  254.             {
  255.                 /* no alternative in form; use () instead */
  256.  
  257.                 Push( Nil );
  258.             }            /* alternative on stack */
  259.  
  260.             Make_Conditional();
  261.         }
  262.         else if ( operator == MACRO_Symbol )
  263.         {
  264.             /* form = (macro keyword transformer) */
  265.  
  266.             if ( Length( form ) != 3 || !Is_Symbol(Second(form)) )
  267.             {
  268.                 Display_Error("Bad syntax to macro in: ", form);
  269.             }
  270.  
  271.             Make_Global_Variable(Second(form));/* defined keyword */
  272.             Push( Value_Register );
  273.  
  274.             /* The Macro Object */
  275.  
  276.             form = Top( 2 );
  277.             Push( Second( form ) );    /* keyword on stack */
  278.             Push( Third( form ) );
  279.             Compile_Object( Top( 1 ));
  280.             Push( Value_Register );    /* transformer on stack */
  281.             Make_Macro();
  282.  
  283.             Push( Value_Register );        /* the macro */
  284.             Make_Definition();
  285.         }
  286.         else if ( operator == BEGIN_Symbol )
  287.         {
  288.             /* form = (begin . expr-sequence) */
  289.  
  290.             Push( Rest( form ));
  291.             Compile_Arguments();
  292.             Push( Value_Register );    /* expr-sequence on stack */
  293.             Make_Sequence(TRUE);
  294.         }
  295.         else if ( operator == DELAY_Symbol )
  296.         {
  297.             /* form = (delay expr) */
  298.  
  299.             if ( Length( form ) != 2 )
  300.             {
  301.                 Display_Error("Bad syntax to delay in: ", form);
  302.             }
  303.  
  304.             Push( Second( form ));
  305.             Compile_Object( Top( 1 ));
  306.             Push( Value_Register ); /* expr on stack */
  307.             Make_Delay();
  308.         }
  309.         else if ( operator == LAMBDA_Symbol )
  310.         {
  311.             /* form = (lambda formals . body ) */
  312.  
  313.             Object     formals = Second( form );
  314.             Object    formal_check;
  315.             Boolean    internal_definitions = FALSE;
  316.                         
  317.                         formal_check = formals;
  318.                         while (Is_Pair(formal_check))
  319.                         {
  320.                            if (! Is_Symbol(First(formal_check)))
  321.                            {
  322.                 Display_Error("Formals must be symbols", 
  323.                                         First(formal_check));
  324.                            }
  325.                else if ( Member( First(formal_check),
  326.                          Rest(formal_check) ))
  327.                {
  328.                 Display_Error( "Name duplicated in formals: ",
  329.                         First( formal_check ) );
  330.                }
  331.                formal_check = Rest( formal_check );
  332.  
  333.             }
  334.                         if (! Is_Symbol(formal_check) && formal_check != Nil)
  335.                         {
  336.                            Display_Error("Bad syntax for formal arguments",
  337.