impls/ada/types.ads

   1 -- This started out as a simple public variant record.
   2 -- Then smart pointers were added.  They were part of the Mal_Type and
   3 -- were required to be public because of the dependencies and
   4 -- how the variant record was public.  Not very Ada-like.
   5 -- The third version bites the bullet and delares Mal_Type as tagged.
   6 -- Smart pointers are an OO version in a separate package.
   7 -- The Doubly_Linked_Lists have been replaced with a tree-like list instead...
   8 -- The tree-like list has been replaced with a singly linked list. Sigh.
   9
  10 -- WARNING!  This code contains:
  11 -- Recursive data structures.
  12 -- Object-based smart pointers.
  13 -- Object-oriented code.
  14 -- And strong-typing!
  15
  16 -- Chris M Moore 25/03/2015
  17
  18 with Ada.Strings.Unbounded;
  19 with Smart_Pointers;
  20 with Envs;
  21
  22 package Types is
  23
  24    -- Some simple types.  Not supposed to use the standard types directly.
  25
  26    subtype Mal_Float is Float;
  27    subtype Mal_Integer is Integer;
  28    subtype Mal_String is String;
  29
  30    -- Start off with the top-level abstract type.
  31
  32    subtype Mal_Handle is Smart_Pointers.Smart_Pointer;
  33
  34    function "=" (A, B : Mal_Handle) return Mal_Handle;
  35
  36    function "=" (A, B : Mal_Handle) return Boolean;
  37
  38    type Sym_Types is (Nil, Bool, Int, Floating, Str, Sym, Atom, Node,
  39                       List, Func, Lambda, Error);
  40
  41    type Mal_Type is abstract new Smart_Pointers.Base_Class with private;
  42
  43    function Sym_Type (T : Mal_Type) return Sym_Types is abstract;
  44
  45    function Get_Meta (T : Mal_Type) return Mal_Handle;
  46
  47    procedure Set_Meta (T : in out Mal_Type'Class; SP : Mal_Handle);
  48
  49    function Copy (M : Mal_Handle) return Mal_Handle;
  50
  51    function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True)
  52    return Mal_String;
  53
  54    function Is_Macro_Call (T : Mal_Type'Class; Env : Envs.Env_Handle) return Boolean;
  55
  56    type Mal_Ptr is access all Mal_Type'Class;
  57
  58    -- A helper function that just view converts the smart pointer to
  59    -- a Mal_Type'Class pointer.
  60    function Deref (S : Mal_Handle) return Mal_Ptr;
  61
  62    -- A helper function to detect null smart pointers.
  63    function Is_Null (S : Mal_Handle) return Boolean;
  64
  65    -- Derived types.  All boilerplate from here.
  66
  67    type Nil_Mal_Type is new Mal_Type with private;
  68
  69    function New_Nil_Mal_Type return Mal_Handle;
  70
  71    overriding function Sym_Type (T : Nil_Mal_Type) return Sym_Types;
  72
  73
  74    type Int_Mal_Type is new Mal_Type with private;
  75
  76    function New_Int_Mal_Type (Int : Mal_Integer) return Mal_Handle;
  77
  78    overriding function Sym_Type (T : Int_Mal_Type) return Sym_Types;
  79
  80    function Get_Int_Val (T : Int_Mal_Type) return Mal_Integer;
  81
  82    type Int_Ptr is access all Int_Mal_Type;
  83
  84    function Deref_Int (SP : Mal_Handle) return Int_Ptr;
  85
  86
  87    type Float_Mal_Type is new Mal_Type with private;
  88
  89    function New_Float_Mal_Type (Floating : Mal_Float) return Mal_Handle;
  90
  91    overriding function Sym_Type (T : Float_Mal_Type) return Sym_Types;
  92
  93    function Get_Float_Val (T : Float_Mal_Type) return Mal_Float;
  94
  95    type Float_Ptr is access all Float_Mal_Type;
  96
  97    function Deref_Float (SP : Mal_Handle) return Float_Ptr;
  98
  99
 100    type Bool_Mal_Type is new Mal_Type with private;
 101
 102    function New_Bool_Mal_Type (Bool : Boolean) return Mal_Handle;
 103
 104    overriding function Sym_Type (T : Bool_Mal_Type) return Sym_Types;
 105
 106    function Get_Bool (T : Bool_Mal_Type) return Boolean;
 107
 108    type Bool_Ptr is access all Bool_Mal_Type;
 109
 110    function Deref_Bool (SP : Mal_Handle) return Bool_Ptr;
 111
 112
 113    type String_Mal_Type is new Mal_Type with private;
 114
 115    function New_String_Mal_Type (Str : Mal_String) return Mal_Handle;
 116
 117    overriding function Sym_Type (T : String_Mal_Type) return Sym_Types;
 118
 119    function Get_String (T : String_Mal_Type) return Mal_String;
 120
 121    type String_Ptr is access all String_Mal_Type;
 122
 123    function Deref_String (SP : Mal_Handle) return String_Ptr;
 124
 125
 126    type Symbol_Mal_Type is new Mal_Type with private;
 127
 128    function New_Symbol_Mal_Type (Str : Mal_String) return Mal_Handle;
 129
 130    overriding function Sym_Type (T : Symbol_Mal_Type) return Sym_Types;
 131
 132    function Get_Sym (T : Symbol_Mal_Type) return Mal_String;
 133
 134    type Sym_Ptr is access all Symbol_Mal_Type;
 135
 136    function Deref_Sym (S : Mal_Handle) return Sym_Ptr;
 137
 138
 139
 140    type Atom_Mal_Type is new Mal_Type with private;
 141
 142    function New_Atom_Mal_Type (MH : Mal_Handle) return Mal_Handle;
 143
 144    overriding function Sym_Type (T : Atom_Mal_Type) return Sym_Types;
 145
 146    function Get_Atom (T : Atom_Mal_Type) return Mal_Handle;
 147
 148    procedure Set_Atom (T : in out Atom_Mal_Type; New_Val : Mal_Handle);
 149
 150    type Atom_Ptr is access all Atom_Mal_Type;
 151
 152    function Deref_Atom (S : Mal_Handle) return Atom_Ptr;
 153
 154
 155
 156    type Error_Mal_Type is new Mal_Type with private;
 157
 158    function New_Error_Mal_Type (Str : Mal_String) return Mal_Handle;
 159
 160    overriding function Sym_Type (T : Error_Mal_Type) return Sym_Types;
 161
 162
 163    -- Lists.
 164
 165    type List_Types is (List_List, Vector_List, Hashed_List);
 166    function Opening (LT : List_Types) return Character;
 167    function Closing (LT : List_Types) return Character;
 168
 169    type List_Mal_Type is new Mal_Type with private;
 170
 171    function "=" (A, B : List_Mal_Type) return Boolean;
 172
 173    function New_List_Mal_Type
 174      (List_Type : List_Types;
 175       The_First_Node : Mal_Handle := Smart_Pointers.Null_Smart_Pointer)
 176    return Mal_Handle;
 177
 178    function New_List_Mal_Type
 179      (The_List : List_Mal_Type)
 180    return Mal_Handle;
 181
 182    type Handle_Lists is array (Positive range <>) of Mal_Handle;
 183
 184    -- Make a new list of the form: (Handle_List(1), Handle_List(2)...)
 185    function Make_New_List (Handle_List : Handle_Lists) return Mal_Handle;
 186
 187    overriding function Sym_Type (T : List_Mal_Type) return Sym_Types;
 188
 189    function Get_List_Type (L : List_Mal_Type) return List_Types;
 190
 191    function Prepend (Op : Mal_Handle; To_List : List_Mal_Type)
 192    return Mal_Handle;
 193
 194    procedure Append (To_List : in out List_Mal_Type; Op : Mal_Handle);
 195
 196    function Length (L : List_Mal_Type) return Natural;
 197
 198    function Nth (L : List_Mal_Type; N : Natural) return Mal_Handle;
 199
 200    procedure Add_Defs (Defs : List_Mal_Type; Env : Envs.Env_Handle);
 201
 202    -- Get the first item in the list:
 203    function Car (L : List_Mal_Type) return Mal_Handle;
 204
 205    -- Get the rest of the list (second item onwards)
 206    function Cdr (L : List_Mal_Type) return Mal_Handle;
 207
 208    type Func_Access is access
 209      function (Elem : Mal_Handle)
 210      return Mal_Handle;
 211
 212    function Map
 213      (Func_Ptr : Func_Access;
 214       L : List_Mal_Type)
 215    return Mal_Handle;
 216
 217    type Binary_Func_Access is access
 218      function (A, B : Mal_Handle)
 219      return Mal_Handle;
 220
 221    function Reduce
 222      (Func_Ptr : Binary_Func_Access;
 223       L : List_Mal_Type)
 224    return Mal_Handle;
 225
 226    function Is_Null (L : List_Mal_Type) return Boolean;
 227
 228    function Null_List (L : List_Types) return List_Mal_Type;
 229
 230    function Pr_Str (T : List_Mal_Type; Print_Readably : Boolean := True)
 231    return Mal_String;
 232
 233    function Cat_Str (T : List_Mal_Type; Print_Readably : Boolean := True)
 234    return Mal_String;
 235
 236    function Concat (Rest_Handle : List_Mal_Type)
 237    return Types.Mal_Handle;  -- a new list
 238
 239    -- Duplicate copies the list (logically).  This is to allow concatenation,
 240    -- The result is always a List_List.
 241    function Duplicate (The_List : List_Mal_Type) return Mal_Handle;
 242
 243    type List_Ptr is access all List_Mal_Type;
 244
 245    function Deref_List (SP : Mal_Handle) return List_Ptr;
 246
 247    type List_Class_Ptr is access all List_Mal_Type'Class;
 248
 249    function Deref_List_Class (SP : Mal_Handle) return List_Class_Ptr;
 250
 251
 252    type Func_Mal_Type is new Mal_Type with private;
 253
 254    type Builtin_Func is access
 255       function (MH : Mal_Handle) return Mal_Handle;
 256
 257    function New_Func_Mal_Type (Str : Mal_String; F : Builtin_Func)
 258    return Mal_Handle;
 259
 260    overriding function Sym_Type (T : Func_Mal_Type) return Sym_Types;
 261
 262    function Get_Func_Name (T : Func_Mal_Type) return Mal_String;
 263
 264    function Call_Func
 265      (FMT : Func_Mal_Type; Rest_List : Mal_Handle)
 266    return Mal_Handle;
 267
 268    type Func_Ptr is access all Func_Mal_Type;
 269
 270    function Deref_Func (S : Mal_Handle) return Func_Ptr;
 271
 272
 273
 274    type Lambda_Mal_Type is new Mal_Type with private;
 275
 276    function New_Lambda_Mal_Type
 277      (Params : Mal_Handle; Expr : Mal_Handle; Env : Envs.Env_Handle)
 278    return Mal_Handle;
 279
 280    overriding function Sym_Type (T : Lambda_Mal_Type) return Sym_Types;
 281
 282    function Get_Env (L : Lambda_Mal_Type) return Envs.Env_Handle;
 283
 284    procedure Set_Env (L : in out Lambda_Mal_Type; Env : Envs.Env_Handle);
 285
 286    function Get_Params (L : Lambda_Mal_Type) return Mal_Handle;
 287
 288    function Get_Expr (L : Lambda_Mal_Type) return Mal_Handle;
 289
 290    function Get_Is_Macro (L : Lambda_Mal_Type) return Boolean;
 291
 292    procedure Set_Is_Macro (L : in out Lambda_Mal_Type; B : Boolean);
 293
 294    function Apply
 295      (L : Lambda_Mal_Type;
 296       Param_List : Mal_Handle) return Mal_Handle;
 297
 298    type Lambda_Ptr is access all Lambda_Mal_Type;
 299
 300    function Get_Macro (T : Mal_Handle; Env : Envs.Env_Handle) return Lambda_Ptr;
 301
 302    function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr;
 303
 304    generic
 305       with function Int_Op (A, B : Mal_Integer) return Mal_Integer;
 306       with function Float_Op (A, B : Mal_Float) return Mal_Float;
 307    function Arith_Op (A, B : Mal_Handle) return Mal_Handle;
 308
 309    generic
 310       with function Int_Rel_Op (A, B : Mal_Integer) return Boolean;
 311       with function Float_Rel_Op (A, B : Mal_Float) return Boolean;
 312    function Rel_Op (A, B : Mal_Handle) return Mal_Handle;
 313
 314    Runtime_Exception : exception;
 315
 316    Mal_Exception : exception;  -- So tempting to call this Mal_Function but...
 317
 318    Mal_Exception_Value : Mal_Handle;  -- Used by mal's throw command
 319
 320 private
 321
 322    type Mal_Type is abstract new Smart_Pointers.Base_Class with record
 323       Meta : Mal_Handle;
 324    end record;
 325
 326    -- Not allowed to be abstract and private.  RM 3.9.3(10)
 327    -- So if you call this it'll just raise an exception.
 328    function To_Str (T : Mal_Type; Print_Readably : Boolean := True)
 329    return Mal_String;
 330
 331    type Nil_Mal_Type is new Mal_Type with null record;
 332
 333    overriding function To_Str (T : Nil_Mal_Type; Print_Readably : Boolean := True)
 334    return Mal_String;
 335
 336    type Int_Mal_Type is new Mal_Type with record
 337       Int_Val : Mal_Integer;
 338    end record;
 339
 340    overriding function To_Str (T : Int_Mal_Type; Print_Readably : Boolean := True)
 341    return Mal_String;
 342
 343    type Float_Mal_Type is new Mal_Type with record
 344       Float_Val : Mal_Float;
 345    end record;
 346
 347    overriding function To_Str (T : Float_Mal_Type; Print_Readably : Boolean := True)
 348    return Mal_String;
 349
 350    type Bool_Mal_Type is new Mal_Type with record
 351       Bool_Val : Boolean;
 352    end record;
 353
 354    overriding function To_Str (T : Bool_Mal_Type; Print_Readably : Boolean := True)
 355    return Mal_String;
 356
 357    type String_Mal_Type is new Mal_Type with record
 358       The_String : Ada.Strings.Unbounded.Unbounded_String;
 359    end record;
 360
 361    overriding function To_Str (T : String_Mal_Type; Print_Readably : Boolean := True)
 362    return Mal_String;
 363
 364    type Symbol_Mal_Type is new Mal_Type with record
 365       The_Symbol : Ada.Strings.Unbounded.Unbounded_String;
 366    end record;
 367
 368    overriding function To_Str (T : Symbol_Mal_Type; Print_Readably : Boolean := True)
 369    return Mal_String;
 370
 371    type Atom_Mal_Type is new Mal_Type with record
 372       The_Atom : Mal_Handle;
 373    end record;
 374
 375    overriding function To_Str (T : Atom_Mal_Type; Print_Readably : Boolean := True)
 376    return Mal_String;
 377
 378    type Func_Mal_Type is new Mal_Type with record
 379       Func_Name : Ada.Strings.Unbounded.Unbounded_String;
 380       Func_P : Builtin_Func;
 381    end record;
 382
 383    overriding function To_Str (T : Func_Mal_Type; Print_Readably : Boolean := True)
 384    return Mal_String;
 385
 386    type Error_Mal_Type is new Mal_Type with record
 387       Error_Msg : Ada.Strings.Unbounded.Unbounded_String;
 388    end record;
 389
 390    overriding function To_Str (T : Error_Mal_Type; Print_Readably : Boolean := True)
 391    return Mal_String;
 392
 393
 394    -- Nodes have to be a differnt type from a List;
 395    -- otherwise how do you represent a list within a list?
 396    type Node_Mal_Type is new Mal_Type with record
 397       Data : Mal_Handle;
 398       Next : Mal_Handle;  -- This is always a Node_Mal_Type handle
 399    end record;
 400
 401    function New_Node_Mal_Type
 402      (Data : Mal_Handle;
 403       Next : Mal_Handle := Smart_Pointers.Null_Smart_Pointer)
 404    return Mal_Handle;
 405
 406    overriding function Sym_Type (T : Node_Mal_Type) return Sym_Types;
 407
 408    overriding function To_Str
 409      (T : Node_Mal_Type; Print_Readably : Boolean := True)
 410    return Mal_String;
 411
 412    type Node_Ptr is access all Node_Mal_Type;
 413
 414    function Deref_Node (SP : Mal_Handle) return Node_Ptr;
 415
 416
 417    type List_Mal_Type is new Mal_Type with record
 418       List_Type : List_Types;
 419       The_List : Mal_Handle;
 420       Last_Elem : Mal_Handle;
 421    end record;
 422
 423    overriding function To_Str
 424      (T : List_Mal_Type; Print_Readably : Boolean := True)
 425    return Mal_String;
 426
 427    type Container_Cursor is tagged record
 428       The_Node : Node_Ptr := null;
 429    end record;
 430
 431    type Lambda_Mal_Type is new Mal_Type with record
 432       Params, Expr : Mal_Handle;
 433       Env : Envs.Env_Handle;
 434       Is_Macro : Boolean;
 435    end record;
 436
 437    overriding function To_Str
 438      (T : Lambda_Mal_Type; Print_Readably : Boolean := True)
 439    return Mal_String;
 440
 441
 442 end Types;