Linux Cubed Series 3: Developer Tools/Linux Cubed Series 3 - Developer Tools.iso/devel/lang/eiffel/smalleif.97/se.t/SmallEiffel/lib_std/general.e

Text File | 1996-05-02 | 14.4 KB | 572 lines

-- Part of SmallEiffel -- Read DISCLAIMER file -- Copyright (C)
-- Dominique COLNET and Suzanne COLLIN -- [e-mail]
--
class GENERAL
--
-- Platform-independent universal properties.
-- This class is an ancestor to all developer-written classes.
--

feature -- Access :

   generating_type: STRING is
     -- Name of current object's generating type (type of
     -- which it is a direct instance).
      external "CSE"
      end;

   generator: STRING is
     -- Name of current object's generating class (base class
     -- of the type of witch it is a direct instance).
      external "CSE"
      end;

   id_object(id: INTEGER): ANY is
     -- Object for wich `object_id' has returened `id'.
     -- Void if none.
      require
     id /= 0;
      do
     c_inline_c("R=((T0 *)a1);");
      end;

   object_id: INTEGER is
     -- Value identifying current reference object.
      require
     not is_expanded_type
      do
     c_inline_c("R=((int)C);")
      end;

   stripped(other: GENERAL): like other is
     -- New created object with fields copied from current object, but
     -- limited to attributes of type of `other'.
      require
     conformance: conforms_to(other);
      do
     not_yet_implemented;
      ensure
     stripped_to_other: Result.same_type(other);
      end;

feature -- Status report :

   frozen conforms_to(other: GENERAL): BOOLEAN is
     -- Does type of current object conform to type of other
     -- (as per Eiffel: The Language, chapter 13) ?
      require
     other_not_void: other /= Void;
      do
     not_yet_implemented;
      end;

   frozen same_type(other: GENERAL): BOOLEAN is
     -- Is type of current object identical to type of other.
      require
     other_not_void: other /= Void;
      do
     if is_expanded_type then
     else
        c_inline_c("R=((C->id)==(a1->id));");
     end;
      ensure
--     definition: Result = (conforms_to(other) and
--                   other.conforms_to(Current));
      end;

   frozen new_same_type(other: GENERAL): BOOLEAN is
     -- Is type of current object identical to type of other.
      require
     other_not_void: other /= Void;
      do
     if is_expanded_type then
        -- *** Could write not is_expanded !!
     else
        c_inline_c("R=(C->id)==(a1->id);");
     end;
      ensure
     definition: Result = (conforms_to(other) and
                   other.conforms_to(Current));
      end;

feature -- Comparison :

   frozen deep_equal(some: GENERAL; other: like some): BOOLEAN is
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     elseif standard_equal(some,other) then
        Result := true;
     else
        not_yet_implemented;
     end;
      ensure
     shallow_implies_deep: standard_equal(some,other)
                   implies Result;
     same_type: Result implies some.same_type(other);
     symmetric: Result implies deep_equal(other,some);
      end;

   frozen equal(some: ANY; other: like some): BOOLEAN is
     -- Are `some' and `other' both Void or attached to
     -- objects considered equal ?
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     else
        Result := some.is_equal(other);
     end;
      ensure
     definition: Result = (some = Void and other = Void) or else
             ((some /= Void and other /= Void) and then
              some.is_equal(other));
      end;

   is_equal(other: like Current): BOOLEAN is
     -- Is `other' attached to an object considered equal to
     -- current object ?
      require
     other_not_void: other /= Void
      do
     Result := standard_is_equal(other);
      ensure
     consistent: standard_is_equal(other) implies Result;
-- ***     same_type: Result implies same_type(other);
-- ELKS problem for expanded target.
     symmetric: Result implies other.is_equal(Current);
      end;

   frozen standard_equal(some: ANY; other: like some): BOOLEAN is
     -- Are `some' and `other' both Void or attached to
     -- field-by-field objects of the same type ?
     -- Always use the default object comparison criterion.
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     elseif some.same_type(other) then
        Result := some.standard_is_equal(other);
     end;
      ensure
     definition: Result = (some = Void and other = Void) or else
             ((some /= Void and other /= Void) and then
              some.standard_is_equal(other));
      end;

   frozen standard_is_equal(other: like Current): BOOLEAN is
     -- Are Current and `other' field-by-field identical?
      require
     other /= Void
      do
     if is_expanded_type then
        Result := other = Current;
     elseif other = Current then
        Result := true;
     else
        c_inline_c("R=!memcmp(C,a1,s[C->id]);");
     end;
      ensure
     same_type: Result implies same_type(other);
     symmetric: Result implies other.standard_is_equal(Current);
      end;

feature -- Duplication :

   frozen clone(other: ANY): like other is
     -- Void if `other' is Void; otherwise new object
     -- equal to `other'.
      do
     if other /= Void then
        c_inline_c("R=(T0 *)new(a1->id);");
        c_inline_c("AF_1");
        Result.copy(other);
        c_inline_c("AF_0");
     end;
      ensure
     equal: equal(Result,other);
      end;

   copy(other: like Current) is
     -- Update current object using fields of object attached
     -- to `other', so as to yield equal objects.
      require
     other_not_void: other /= Void;
     type_identity: same_type(other);
      do
     if is_expanded_type then
        c_inline_c("C=a1;");
     else
        c_inline_c("memcpy(C,a1,s[C->id]);");
     end;
      ensure
     is_equal: is_equal(other)
      end;

   frozen deep_clone(other: GENERAL): like other is
     -- Void if `other' is Void: otherwise, new object structure
     -- recursively duplicated from the one attached to other.
      do
     not_yet_implemented;
      ensure
     deep_equal: deep_equal(other,Result);
      end;

   frozen standard_clone(other: ANY): like other is
     -- Void if `other' is Void; otherwise new object
     -- field-by-field identical to `other'.
     -- Always use the default copying semantics.
      do
     if other /= Void then
        c_inline_c("R=(T0 *)new(a1->id);%N%
               %memcpy(R,a1,s[a1->id]);");
     end;
      ensure
     equal: standard_equal(Result,other);
      end;

    frozen standard_copy(other: like Current) is
     -- Copy every field of `other' onto corresponding
     -- field of curent object.
      require
     other_not_void: other /= Void;
     type_identity: same_type(other);
      do
     c_inline_c("memcpy(C,a1,s[a1->id]);");
      ensure
     is_standard_equal: standard_is_equal(other);
      end;

feature -- Basic operations :

   frozen default: like Current is
     -- Default value of current type.
      do
      end;

   frozen default_pointer: POINTER is
     -- Default value of type POINTER (avoid the need to
      -- write p.default for some `p' of type POINTER).
      do
      ensure
     Result = Result.default;
      end;

   default_rescue is
     -- Handle exception if no Rescue clause (default do
     -- nothing).
      do
      end;

   frozen do_nothing is
     -- Execute a null action.
      do
      end;

   frozen Void: NONE is
      -- Void reference.
      external "CSE"
      end;

feature -- Output :

   frozen io: STD_INPUT_OUTPUT is
     -- Handle to standard file setup.
     -- To use the standard input/output file.
      once
     !!Result.make;
      ensure
     Result /= Void;
      end;

   frozen std_input: STD_INPUT is
     -- To use the standard input file.
      once
     !!Result.make;
      end;

   frozen std_output: STD_OUTPUT is
     -- To use the standard output file.
      once
     !!Result.make;
      end;

   frozen std_error: STD_ERROR is
     -- To use the standard error file.
      once
     !!Result.make;
      end;

   out: STRING is
     -- New string containing terse printable representation
     -- of current object;
      do
     not_yet_implemented;
      end;

   frozen print(some: GENERAL) is
     -- Write terse external representation of `some' on
     -- `standard_output'. This routine is called to print
     -- the stack when a `crash' occurs. Thus, user can redefine
     -- `print_on' or `print_attributes_on' to adapt printing
     -- of run time stack.
      do
     if some = Void then
        std_output.put_string("Void");
     else
        some.print_on(std_output);
     end;
      end;

   print_on(file: STD_FILE_WRITE) is
     -- Default printing for reference target.
     --
     -- Note : this routine is used to print stack when `crash'.
      do
     file.put_string(generating_type);
     file.put_character('#');
     file.put_integer(object_id);
     file.put_character('[');
     print_attributes_on(file);
     file.put_character(']');
      end;

   print_attributes_on(file: STD_FILE_WRITE) is
      do
           tagged_out_memory.clear;
     fill_tagged_out_memory;
     file.put_string(tagged_out_memory);
      end;

   frozen tagged_out: STRING is
     -- New string containing printable representation of current
     -- object, each field preceded by its attribute name, a
     -- colon and a space.
      do
     tagged_out_memory.clear;
     fill_tagged_out_memory;
     Result := clone(tagged_out_memory);
      end;

   frozen tagged_out_memory: STRING is
      once
     !!Result.make(1024);
      end;

   fill_tagged_out_memory is
      external "CSE"
      end;

feature -- Named file handling :

   file_exists(path: STRING): BOOLEAN is
      require
     path /= Void;
      do
     path.extend('%U');
     c_inline_c(
         "{FILE *f=fopen(((T7 *)a1)->_storage,%"r%");%N%
     %R=(f != NULL);%N%
     %fclose(f);}");
     path.remove_last(1);
      end;

   remove_file(path: STRING) is
      require
     path /= Void;
      do
     path.extend('%U');
     c_inline_c("remove(((T7 *)a1)->_storage);");
     path.remove_last(1);
      end;

   rename_file(old_path, new_path: STRING) is
      require
     old_path /= Void;
     new_path /= Void;
      do
     old_path.extend('%U');
     new_path.extend('%U');
     c_inline_c("rename(((T7 *)a1)->_storage,((T7 *)a2)->_storage);");
     old_path.remove_last(1);
     new_path.remove_last(1);
      end;

feature -- Access to command-line arguments :

   argument_count: INTEGER is
     -- Number of arguments given to command that started
     -- system execution (command name does not count).
      external "CSE"
      ensure
     Result >= 0;
      end;

   argument(i: INTEGER): STRING is
     -- `i' th argument of command that started system execution
     -- Gives the command name if `i' is 0.
      require
     i >= 0;
     i <= argument_count;
      external "CSE"
      ensure
     Result /= Void
      end;

   get_environment_variable(name: STRING): STRING is
     -- To get the value of a system environment variable
     -- (like "PATH" on Unix for example).
     -- Gives Void when system variable `name' is undefined.
      require
     name /= Void
      do
     name.extend('%U');
     c_inline_c("R=((T0 *)getenv(((T7 *)a1)->_storage));%N%
            %if (R) R=((T0 *)e2s((char *)R));")
     name.remove_last(1);
      ensure
     Result /= Void implies not Result.empty
      end;

feature -- System calls and crashing :

   system(cmd: STRING) is
     -- To execute a `cmd' at system level.
     -- For example, "ls -l" on UNIX.
      do
     cmd.extend('%U');
     c_inline_c("system(((T7 *)a1)->_storage);");
     cmd.remove_last(1);
      end;

   crash is
     -- Print Run Time Stack (unless "-boost" mode)
     -- and then exit with `exit_failure_code'.
     -- See also `print'.
      do
     c_inline_c("rsp();");
     die_with_code(exit_failure_code);
      end;

   die_with_code(code:INTEGER) is
     -- Terminate execution with exit status code `code'.
     -- Do not print any message.
      require
     code = exit_success_code or else
     code = exit_failure_code;
      do
     c_inline_c("exit(a1);");
      end;

   exit_success_code: INTEGER is 0;

   exit_failure_code: INTEGER is 1;

feature -- Maths constants :

   Pi: DOUBLE is 3.1415926535897932384626;

   Evalue: DOUBLE is  2.71828182845904523536;

   Deg: DOUBLE is 57.295780; -- Deg/Radian.

   Phi: DOUBLE is 1.618034; -- Golden Ratio.

feature -- Character names :

   Ctrl_a: CHARACTER is '%/1/';
   Ctrl_b: CHARACTER is '%/2/';
   Ctrl_c: CHARACTER is '%/3/';
   Ctrl_d: CHARACTER is '%/4/';
   Ctrl_e: CHARACTER is '%/5/';
   Ctrl_f: CHARACTER is '%/6/';
   Ctrl_g: CHARACTER is '%/7/';
   Ch_del: CHARACTER is '%/8/';
   Ch_tab: CHARACTER is '%/9/';
   Ctrl_j: CHARACTER is '%/10/';
   Ctrl_k: CHARACTER is '%/11/';
   Ctrl_l: CHARACTER is '%/12/';
   Ctrl_m: CHARACTER is '%/13/';
   Ctrl_n: CHARACTER is '%/14/';
   Ctrl_o: CHARACTER is '%/15/';
   Ctrl_p: CHARACTER is '%/16/';
   Ctrl_q: CHARACTER is '%/17/';
   Ctrl_r: CHARACTER is '%/18/';
   Ctrl_s: CHARACTER is '%/19/';
   Ctrl_t: CHARACTER is '%/20/';
   Ctrl_u: CHARACTER is '%/21/';
   Ctrl_v: CHARACTER is '%/22/';
   Ctrl_w: CHARACTER is '%/23/';
   Ctrl_x: CHARACTER is '%/24/';
   Ctrl_y: CHARACTER is '%/25/';
   Ctrl_z: CHARACTER is '%/26/';

feature -- Hashing :

   hash_code: INTEGER is
      external "CSE"
      ensure
     non_negative: Result >= 0
      end;

feature -- Should not exist :

   not_yet_implemented is
      do
     std_error.put_string(
      "Sorry, Some Feature is Not Yet Implemented.%N%
       %Please, if you can write it by yourself and if you send me%N%
       %the corresponding tested Eiffel code, I may put it in the%N%
       %standard library!%N%
       %Many Thanks in advance.%N%
       %D.Colnet e-mail: [e-mail]%N");
     crash;
       end;

feature {ANY} -- WARNING: For SmallEiffel Users's only.
   -- Using following features could makes your Eiffel code not
   -- portable on other Eiffel compilers.

   frozen is_expanded_type: BOOLEAN is
     -- Statically computed by SmallEiffel.
     -- Result is true if target static type is an expanded type.
     -- Target is not evaluated.
     -- Usefull for formal generic type.
      external "CSE"
      end;

   object_size: INTEGER is
     -- Gives the size of the current object at first level
     -- only (pointed sub-object are not concerned).
     -- The result is the C sizeof of the corresponding
     -- struct or basic object.
      do
     if is_expanded_type then
        c_inline_c("R=sizeof(C);")
     else
        c_inline_c("R=s[C->id];")
     end;
      end;

feature {NONE} -- WARNING: For SmallEiffel Gurus's only.
   -- Using following features makes your Eiffel code not
   -- portable on other Eiffel compilers.

   c_inline_h(c_code: STRING) is
     -- Target must be Current and `c_code' must be a manifest
     -- string. Write `c_code' in the heading C file.
      external "CSE"
      end;

   c_inline_c(c_code: STRING) is
     -- Target must be Current and `c_code' must be a manifest
     -- string. Write `c_code' in the stream at current position.
      external "CSE"
      end;

end -- GENERAL