APDL Public Domain 1/APDL_PD1A.iso/program/language/grs/g/DataBase

Text File | 1991-05-14 | 5.5 KB | 196 lines

(* generic database written in GRS *)
(* shows off most of the capabilities of the language *)
(* Guy Verbist April 1991 *)


write("Enter the attributes of object:\n");
write("Enter 'end' to end.\n");

let listof string attribs := [];
let listof string attribtypes := [];

let string attrib := "";
let string attribtype := "";

loop
   write("Enter attribute name:\n");
   read(attrib);
   exiton(attrib = "end");
   write("Enter attribute type:\n");
   read(attribtype);
   attribs := attrib::attribs;
   attribtypes := attribtype::attribtypes;
endloop;

let listof string attribs_copy := attribs;
let listof string attribtypes_copy := attribtypes;

let listof string main_attribs := attribs;
let listof string main_types := attribtypes;



(* now create the class *)

instanceof class data;

let string tempstring :=
       "data := class.new(\"data\",[{null function hello(){write(\"Hello\n\");};} " ;

(*add in methods*)

let string methodstring := "";

loop
   exiton(attribs_copy = []);
   methodstring := methodstring + ",{null function set_"+head(attribs_copy)+
                                  "("+head(attribtypes_copy)+ " param){"+
                                  "assume "+head(attribtypes_copy)
                                      +" "+head(attribs_copy)+" in "
                                  +head(attribs_copy)+":= param;};}" ;
   attribs_copy := tail(attribs_copy);
   attribtypes_copy := tail(attribtypes_copy);
endloop;


methodstring := methodstring + "],[{";

(*add in slots*)

let string slotstring := "";

loop
   exiton (attribs = []);
   slotstring := slotstring + head(attribtypes) + " " + head(attribs)+ ";";
   attribtypes := tail(attribtypes);
   attribs := tail(attribs);
endloop;

slotstring := slotstring+"}]);";

exec(compile(tempstring+methodstring+slotstring));

(*now add show method for each attribute*)

attribs_copy := main_attribs;
attribtypes_copy := main_types;

loop
   exiton(attribs_copy = []);
   methodstring := "null function show_" + head(attribs_copy)
                   + "(){assume " + head(attribtypes_copy) + " "
                   + head(attribs_copy) + " in write(\""
                   + head(attribs_copy) + " is \"," + head(attribs_copy)
                   + ",\"\n\");};" ;

   let (null) expression new_method := compile(methodstring);


   exec(compile("data.add_method(new_method);"));


   attribs_copy := tail(attribs_copy);
   attribtypes_copy := tail(attribtypes_copy);
endloop;

write("Type 'db();' to access the database.\n");


null function db()
{
   integer function menu(listof string menu)
   {
      let integer options := 0;

      write("\n");
      loop
         exiton(menu = []);
         options := options +1;
         write(options,") ",head(menu),"\n");
         menu := tail(menu);
      endloop;
      write("\n");

      integer selection;

      loop
         write("Select an option between 1 and ",options," :");
         read(selection);
         exiton( (selection > 0) and (selection <= options));
      endloop;
      write("\n");
      return selection;
   };

   integer choice;
   string entry_name, attrib_name, attrib_val;

   loop
      choice := menu(["add an entry", "delete an entry", "modify entry",
                      "show an entry", "show all entries",
                      "show all attributes", "quit"]);
      exiton(choice=7);

      if (choice=1) then
         write("Please enter name of entry : ");
         read(entry_name);
         exec(compile("#data "+entry_name+";"));
      endif;

      (* these are declared locally to the db() function so cannot be
         accessed from the command line, and will not conflict with anything
         else *)

      if (choice=2) then
         write("Please enter name of entry : ");
         read(entry_name);
         exec(compile("sys_delete_object("+entry_name+",true);"));
      endif;

      if (choice=3) then
         (*modify*)
         write("Please enter name of entry : ");
         read(entry_name);
         write("Please enter name of attribute to change : ");
         read(attrib_name);
         write("and the new value for that attribute : ");
         read(attrib_val);
         exec(compile(entry_name+".set_"+attrib_name+"("+attrib_val+");"));
      endif;
      if (choice=4) then
         (*show*)
         write("Please enter name of entry : ");
         read(entry_name);
         attribs_copy := main_attribs;
         string meth_str;
         exec(compile("loop exiton(attribs_copy = []);" +
                      "meth_str := \".show_\" + head(attribs_copy)+\"();\";"
                      + "exec(compile(entry_name + meth_str));"
                      + "attribs_copy := tail(attribs_copy);"
                      + "endloop;" ));
      endif;
      if (choice=5) then
         (*show*)
         exec(compile("foreach inst in data.get_instances() do {"
                      + "attribs_copy := main_attribs;"
                      + "loop exiton(attribs_copy = []);" +
                      "meth_str := \"show_\" + head(attribs_copy)+\"();\";"
                      + "exec(compile(\"inst.\"+ meth_str));"
                      + "attribs_copy := tail(attribs_copy);"
                      + "endloop;};" ));
      endif;

      if (choice=6) then
         listof string slts;
         let integer sltcount := 0;
         foreach slt in data.get_slots() do
         {
            sltcount := sltcount +1;
            write("Attribute ",sltcount," is ",slt,".\n");
         };
      endif;

   endloop;
};