-- Basic lisp machine memory and data representation. The basic memory
--  unit of lisp machines is a cell of the form [ tag | data ]. Lisp
--  memory is an array of such cells, with cell index 0 being reserved
--  for the special value NIL.
package LispM is
   -- 8MCells should be enough for everyone
   Mem_Size : constant := 2**23;
   
   -- Machine words
   type MWord is mod 2 ** 64;
   for MWord'Size use 64;
   
   -- Cell tags.
   type Tag is (Free, Builtin, Cons, Bool, Fixnum, Char, Symbol, Closure);
   type MemPtr is range 0 .. Mem_Size;
   
   -- Built-in functions are tied in to a conceptual arithmetic-logic
   --  unit that provides the building blocks for evaluation.
   type BuiltinID is (AddB, SubB, MulB, DivB, QuoteB, EvalB, IfB,
                      ConsB, CarB, CdrB, ListB, ApplyB, DefineB, SetB,
                      EqnB, EqB, EqvB, PairPB, BooleanPB, NumberPB, SymbolPB,
                      NullPB, ListPB, AndB, OrB, NotB, LambdaB, LetB,
                      ReverseB, AppendB);

   -- Cell data type. The first part of any cell is a tag. The second
   --  part is a tag-dependent machine word.
   --
   -- Machine words are defined by tag, as follows:
   --
   -- [ free | 0 ]
   --
   -- [ builtin | bid ] where bid is a number corresponding uniquely to
   --  a BuiltinID.
   --
   -- [ cons | car, cdr ] where car and cdr are each half of an MWord.
   --
   -- [ bool | b ] where b is a truth value (0 is false, 1 is true). XXX
   --  bool values should be hardcoded symbols (or something similar).
   --
   -- [ fixnum | n ] where n is a signed integer of MWord size / 2, the
   --  first bit being a sign bit.
   --
   -- [ char | c ] where c is the ASCII code of a character.
   --
   -- [ symbol | ptr ] where ptr points to a list of characters uniquely
   --  determining the symbol's name.
   --
   -- [ closure | code, env ] where code points to a list of the form
   --  (args e1 e2 ... en) (where args is a list of symbols) and env
   --  points to a symbol-value alist.
   type Cell is record
      T : Tag;
      Data : MWord;
   end record;

   -- This puts it all together.
   type Mem is array (MemPtr range 1 .. Mem_Size) of Cell;

   -- Pointer to heap end. This is incremented on memory
   --  allocations. Don't worry about deallocations for now, since we
   --  don't have a GC (yet).
   Heap_End : MemPtr := 0;
   
   -- Pointer to interned symbol list.
   Sym_Table : MemPtr := 0;
   -- Pointer to interned symbol representing the "quote" keyword. This
   --  is used by the parser to transform ' tokens into (quote ...).
   Quote_Sym : MemPtr := 0;
   
   -- Pointer to environment: the environment is a list of symbol-value
   --  associations; a symbol may have more than one associations at a
   --  given point in time, in which case the most recent association
   --  will be considered.
   Global_Env : MemPtr := 0;

   -- A statically-allocated memory.
   AMem : Mem := (others => (T => Free, Data => 0));
   
   -- Cell manipulation primitives.
   function Get_Builtin(C : Cell) return BuiltinID;
   function Get_Car(C : Cell) return MemPtr;
   function Get_Cdr(C : Cell) return MemPtr;
   function Get_Bool(C : Cell) return Boolean;
   function Get_Fixnum(C : Cell) return Long_Integer;
   function Get_Char(C : Cell) return Character;
   function Get_Symbol(C : Cell) return MemPtr;
   function Get_Closure_Code(C : Cell) return MemPtr;
   function Get_Closure_Env(C : Cell) return MemPtr;
   procedure Set_Builtin(C : in out Cell; B : in BuiltinID);
   procedure Set_Car(C : in out Cell; Car : in MemPtr);
   procedure Set_Cdr(C : in out Cell; Cdr : in MemPtr);
   procedure Set_Bool(C : in out Cell; Value : in Boolean);
   procedure Set_Fixnum(C : in out Cell; Value : in Long_Integer);
   procedure Set_Char(C : in out Cell; Value : in Character);
   procedure Set_Symbol(C : in out Cell; Name : in MemPtr);
   procedure Set_Closure_Code(C : in out Cell; Code : in MemPtr);
   procedure Set_Closure_Env(C : in out Cell; Env : in MemPtr);
   
   -- Memory management primitives.

   -- Allocate cell in AMem.
   procedure Alloc_Cell(C : in Cell; P : out MemPtr);
   -- Higher-level allocation primitives
   procedure Alloc_Builtin(B : BuiltinID; P : out MemPtr);
   procedure Alloc_Cons(Car, Cdr : in MemPtr; P : out MemPtr);
   procedure Alloc_Bool(Value : in Boolean; P : out MemPtr);
   procedure Alloc_Fixnum(Value : in Long_Integer; P : out MemPtr);
   procedure Alloc_Char(Value : in Character; P : out MemPtr);
   procedure Alloc_Symbol(Name : in MemPtr; P : out MemPtr);
   procedure Alloc_Closure(Code, Env : in MemPtr; P : out MemPtr);
   
   -- I/O: output primitives. XXX these should be placed in a separate
   --  module.
   
   -- Dump cell to standard output.
   procedure Dump_Cell(P : in MemPtr);
   
   -- Recursively dump a cons cell, doing sugary processing.
   procedure Dump_Cons(P : in MemPtr);
   
   -- Dump a long integer
   procedure Dump_Longint(N : in Long_Integer);
   
   -- Dump the name of a builtin id
   procedure Dump_BuiltinID(BID : in BuiltinID);
   
   -- Dump a sequence of chars represented as a list.
   procedure Dump_String(P : in MemPtr);
   
   -- Init symbol table to a list of known symbols and add their
   --  bindings to builtins to the global environment.
   procedure Init_Builtin_Bindings;
   
   -- Check whether two symbol names are equal.
   function Name_EqualP(Sym1, Sym2 : MemPtr) return Boolean;
   
   -- Lookup symbol in symbol table. Return a pointer to a the unique
   --  symbol object representing it if found, NIL otherwise.
   procedure Lookup_Symbol(Name : in MemPtr; Sym : out MemPtr);
   
   -- Similar to Lookup_Symbol, only if the name does not exist, we
   --  create and add a new symbol object to the symbol table, and we
   --  return it.
   procedure Lookup_Or_Create_Symbol(Name : in MemPtr;
                                     Sym : out MemPtr);
   
   -- Lookup a binding for Sym in Env. Returns a symbol-value pair if it
   --  exists, NIL otherwise.
   procedure Lookup_Env(Sym, Env : in MemPtr; Binding : out MemPtr);
   -- Similar to Lookup_Env, only also try Global_Env
   procedure Lookup_Env_Or_Global(Sym, Env : in MemPtr;
                                  Binding : out MemPtr);

   -- Add a Sym-Value binding in Env. Returns the new binding.
   procedure Bind_Env(Sym, Value : in MemPtr;
                      Env : in out MemPtr; Binding : out MemPtr);
end LispM;