raw
adalisp_genesis         1 -- Basic LispM evaluator, based on the following rules:
adalisp_genesis         2 --
adalisp_genesis         3 -- - LispM constants, i.e. booleans, numbers, characters, builtins and
adalisp_genesis         4 --  closures are returned as they are.
adalisp_genesis         5 --
adalisp_genesis         6 -- - Symbols have their values looked up in the current (lexical) Env
adalisp_genesis         7 --  or, if not found, in the (dynamic) Global_Env; the first value found
adalisp_genesis         8 --  is returned; if no bindings are found, an error message is returned.
adalisp_genesis         9 --
adalisp_genesis        10 -- - Cons objects are interpreted as function applications, i.e. for any
adalisp_genesis        11 --  list L, car(L) is evaluated and applied upon cdr(L); if car(L) is
adalisp_genesis        12 --  not a closure or a builtin, then an error message is returned.
adalisp_genesis        13 --
adalisp_genesis        14 -- A large subset of this module is dedicated to the implementation of
adalisp_genesis        15 --  builtin functions and keywords. An explicit distinction between
adalisp_genesis        16 --  keywords and functions is not made at this point, i.e. the
adalisp_genesis        17 --  distinction is implicit in e.g. the way arguments are evaluated.
adalisp_genesis        18 
adalisp_genesis        19 with LispM; use LispM;
adalisp_genesis        20 
adalisp_genesis        21 package Evaler is
adalisp_genesis        22    
adalisp_genesis        23    -- Arithmetic and logic functions
adalisp_genesis        24    type ALUFunc is (ALU_Add, ALU_Sub, ALU_Mul, ALU_Div);
adalisp_genesis        25    -- Unary predicates
adalisp_genesis        26    type UPred is (UPred_Pair, UPred_Bool, UPred_Num, UPred_Sym,
adalisp_genesis        27                   UPred_Nil, UPred_List);
adalisp_genesis        28    -- And/or conditional forms
adalisp_genesis        29    type AndOr is (AndOr_And, AndOr_Or);
adalisp_genesis        30    
adalisp_genesis        31    -- Application routines for builtin functions. These should be
adalisp_genesis        32    --  self-explanatory.
adalisp_genesis        33    procedure Apply_ALU_Func(Func : in ALUFunc;
adalisp_genesis        34                             Args : in MemPtr;
adalisp_genesis        35                             Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        36    procedure Apply_UPred(Pred : in UPred;
adalisp_genesis        37                          Args : in MemPtr;
adalisp_genesis        38                          Env : in MemPtr;
adalisp_genesis        39                          OutP : out MemPtr);
adalisp_genesis        40    procedure Apply_AndOr(Cond : in AndOr;
adalisp_genesis        41                          Args : in MemPtr;
adalisp_genesis        42                          Env : in MemPtr;
adalisp_genesis        43                          OutP : out MemPtr);
adalisp_genesis        44 
adalisp_genesis        45    procedure Apply_QuoteB(Args : in MemPtr; OutP : out MemPtr);
adalisp_genesis        46    procedure Apply_EvalB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        47    procedure Apply_IfB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        48    procedure Apply_ConsB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        49    procedure Apply_CarB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        50    procedure Apply_CdrB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        51    procedure Apply_ListB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        52    procedure Apply_ApplyB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        53    procedure Apply_DefineB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        54    procedure Apply_SetB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        55    procedure Apply_EqnB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        56    procedure Apply_EqB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        57    procedure Apply_EqvB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        58    procedure Apply_NotB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        59    procedure Apply_LambdaB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        60    procedure Apply_LetB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        61    procedure Apply_ReverseB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        62    procedure Apply_AppendB(Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        63    
adalisp_genesis        64    -- Application routine for closures
adalisp_genesis        65    procedure Apply_Closure(Op, Args, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        66    
adalisp_genesis        67    -- Apply function with name identified by Op, on Args.
adalisp_genesis        68    procedure Apply_Func(Op, Args, Env : in MemPtr;
adalisp_genesis        69                         Meta : in Boolean;
adalisp_genesis        70                         OutP : out MemPtr);
adalisp_genesis        71    
adalisp_genesis        72    -- Evaluate a list element by element.
adalisp_genesis        73    procedure Eval_List(List, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        74    
adalisp_genesis        75    -- Eval S-expression
adalisp_genesis        76    procedure Eval(InP, Env : in MemPtr; OutP : out MemPtr);
adalisp_genesis        77    
adalisp_genesis        78    -- Other usefuls: reverse append, reverse in place, boolean
adalisp_genesis        79    --  value. XXX: move these somewhere else.
adalisp_genesis        80    procedure Rev_Append(A, B : in MemPtr; OutP : out MemPtr);   
adalisp_genesis        81    procedure Rev_In_Place(List, Default : in MemPtr; OutP : out MemPtr);
adalisp_genesis        82    function Boolean_Value(P : MemPtr) return Boolean;
adalisp_genesis        83 end Evaler;