Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Stewart G. <sgr...@us...>]

Hi Norayr,

Sorry for the delay. I see the problem, but I'm not sure what you're 
trying to achieve. Within Resources, Discipline is an extension of 
Discipline.Discipline and it looks like most of the procedures in this 
module require the extended type. These will break if you change the 
signature of GetDisc. Why do you want to change the signature of GetDisc?

Cheers,
   Stewart

On 7/10/10 5:46 AM, Norayr Chilingaryan wrote:
> Hey,
> thank you for reply.
> ok, I see, indeed.
>
> So, here we have Resources.Mod from Ulm's Oberon LIbrary which contains:
>
>     TYPE
>        List = POINTER TO ListRec;
>        ListRec =
>       RECORD
>          resource: Resource;
>          next: List;
>       END;
>        Discipline = POINTER TO DisciplineRec;
>        DisciplineRec =
>       RECORD
>          (Disciplines.DisciplineRec)
>          state: State;           (* alive, unreferenced, or terminated *)
>          stopped: BOOLEAN;       (* may be TRUE, if alive or unreferenced *)
>          refcnt: LONGINT;        (* # of Attach - # of Detach *)
>          eventType: Events.EventType; (* may be NIL *)
>          dependants: List;       (* list of resources which depends on us *)
>          dependsOn: Resource;    (* we depend on this resource *)
>          key: Key;               (* attach key for dependsOn *)
>       END;
>
> ...
>
>     PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
>     BEGIN
>       IF ~Disciplines.Seek(resource, discID, disc) THEN
>       NEW(disc); disc.id <http://disc.id> := discID;
>       disc.state := alive; disc.refcnt := 0;
>       disc.eventType := NIL;
>       disc.dependants := NIL; disc.dependsOn := NIL;
>       Disciplines.Add(resource, disc);
>     END;
>     END GetDisc;
>
> Procedure GetDisc is called a lot of times:
> hacktar ulmoberonlib # grep GetDisc *
> Resources.Mod:   PROCEDURE GetDisc(resource: Resource; VAR disc:
> Discipline);
> Resources.Mod:   END GetDisc;
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, resourceDisc);
> Resources.Mod:      GetDisc(dependant, dependantDisc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:     GetDisc(resource, disc);
> Resources.Mod:     GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, resourceDisc);
> Resources.Mod:      GetDisc(dependant, dependantDisc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> hacktar ulmoberonlib #
>
> like this:
>
>    PROCEDURE GenEvent(resource: Resource; change: StateChange);
>        VAR
>       disc: Discipline;
>       event: Event;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.eventType # NIL THEN
>       NEW(event);
>       event.type := disc.eventType;
>       event.message := "Resources: state change notification";
>       event.change := change;
>       event.resource := resource;
>       Events.Raise(event);
>        END;
>     END GenEvent;
>
>     PROCEDURE ^ Detach(resource: Resource; key: Key);
>     PROCEDURE Unlink(dependant, resource: Resource);
>        (* undo DependsOn operation *)
>        VAR
>       dependantDisc, resourceDisc: Discipline;
>       prev, member: List;
>     BEGIN
>        GetDisc(resource, resourceDisc);
>        IF resourceDisc.state = terminated THEN
>       (* no necessity for clean up *)
>       RETURN
>        END;
>        GetDisc(dependant, dependantDisc);
>
>        prev := NIL; member := resourceDisc.dependants;
>        WHILE member.resource # dependant DO
>       prev := member; member := member.next;
>        END;
>        IF prev = NIL THEN
>       resourceDisc.dependants := member.next;
>        ELSE
>       prev.next := member.next;
>        END;
>
>        (* Detach reference from dependant to resource *)
>        Detach(dependantDisc.dependsOn, dependantDisc.key);
>        dependantDisc.dependsOn := NIL; dependantDisc.key := NIL;
>     END Unlink;
>
>
>     PROCEDURE InternalNotify(resource: Resource; change: StateChange);
>        VAR
>       disc: Discipline;
>       event: Event;
>       dependant: List;
>     BEGIN
>        GetDisc(resource, disc);
>        CASE change OF
>        | communicationResumed: disc.stopped := FALSE;
>        | communicationStopped: disc.stopped := TRUE;
>        | terminated:           disc.stopped := FALSE; disc.state :=
> terminated;
>        END;
>        GenEvent(resource, change);
>
>        (* notify all dependants *)
>        dependant := disc.dependants;
>        WHILE dependant # NIL DO
>       InternalNotify(dependant.resource, change);
>       dependant := dependant.next;
>        END;
>
>        (* remove dependency relation in case of termination, if present *)
>        IF (change = terminated) & (disc.dependsOn # NIL) THEN
>       Unlink(resource, disc.dependsOn);
>        END;
>     END InternalNotify;
>
>     (* === exported procedures
> =========================================== *)
>
>     PROCEDURE TakeInterest*(resource: Resource; VAR eventType:
> Events.EventType);
>        (* return resource specific event type for state notifications;
>       eventType is guaranteed to be # NIL even if
>       the given resource is already terminated
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.eventType = NIL THEN
>       Events.Define(disc.eventType);
>       Events.Ignore(disc.eventType);
>        END;
>        eventType := disc.eventType;
>     END TakeInterest;
>
>     PROCEDURE Attach*(resource: Resource; VAR key: Key);
>        (* mark the resource as being used until Detach gets called *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.state IN {terminated, unreferenced} THEN
>       key := NIL;
>        ELSE
>       INC(disc.refcnt); NEW(key); key.valid := TRUE;
>       key.resource := resource;
>        END;
>     END Attach;
>
>     PROCEDURE Detach*(resource: Resource; key: Key);
>        (* mark the resource as unused; the returned key of Attach must
>       be given -- this allows to check for proper balances
>       of Attach/Detach calls;
>       the last Detach operation causes a state change to unreferenced
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        IF (key # NIL) & key.valid & (key.resource = resource) THEN
>       GetDisc(resource, disc);
>       IF disc.state # terminated THEN
>          key.valid := FALSE; DEC(disc.refcnt);
>          IF disc.refcnt = 0 THEN
>             GenEvent(resource, unreferenced);
>             disc.state := unreferenced;
>             IF disc.dependsOn # NIL THEN
>            Unlink(resource, disc.dependsOn);
>             END;
>          END;
>       END;
>        END;
>     END Detach;
>
>     PROCEDURE Notify*(resource: Resource; change: StateChange);
>        (* notify all interested parties about the new state;
>       only valid state changes are accepted:
>       - Notify doesn't accept any changes after termination
>       - unreferenced is generated conditionally by Detach only
>       - communicationResumed is valid after communicationStopped only
>       valid notifications are propagated to all dependants (see below);
>        *)
>        VAR
>       disc: Discipline;
>       event: Event;
>       dependant: List;
>     BEGIN
>        IF change # unreferenced THEN
>       GetDisc(resource, disc);
>       IF (disc.state # terminated) & (disc.state # change) &
>             ((change # communicationResumed) OR disc.stopped) THEN
>          InternalNotify(resource, change);
>       END;
>        END;
>     END Notify;
>
>     PROCEDURE DependsOn*(dependant, resource: Resource);
>        (* states that `dependant' depends entirely on `resource' --
>       this is usually the case if operations on `dependant'
>       are delegated to `resource';
>       only one call of DependsOn may be given per `dependant' while
>       several DependsOn for one resource are valid;
>       DependsOn calls implicitly Attach for resource and
>       detaches if the dependant becomes unreferenced;
>       all other state changes propagate from `resource' to
>       `dependant'
>        *)
>        VAR
>       dependantDisc, resourceDisc: Discipline;
>       member: List;
>     BEGIN
>        GetDisc(resource, resourceDisc);
>        IF resourceDisc.state <= unreferenced THEN
>       (* do not create a relationship to dead or unreferenced objects
>          but propagate a termination immediately to dependant
>       *)
>       IF resourceDisc.state = terminated THEN
>          Notify(dependant, resourceDisc.state);
>       END;
>       RETURN
>        END;
>
>        GetDisc(dependant, dependantDisc);
>        IF dependantDisc.dependsOn # NIL THEN
>       (* don't accept changes *)
>       RETURN
>        END;
>        dependantDisc.dependsOn := resource;
>
>        NEW(member); member.resource := dependant;
>        member.next := resourceDisc.dependants;
>        resourceDisc.dependants := member;
>        Attach(resource, dependantDisc.key);
>     END DependsOn;
>
>     PROCEDURE Alive*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the resource is not yet terminated
>       and ready for communication (i.e. not communicationStopped)
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN ~disc.stopped & (disc.state IN {alive, unreferenced})
>     END Alive;
>
>     PROCEDURE Stopped*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the object is currently not responsive
>       and not yet terminated
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN disc.stopped
>     END Stopped;
>
>     PROCEDURE Terminated*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the resource is terminated *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN disc.state = terminated
>     END Terminated;
>
> BEGIN
>     discID := Disciplines.Unique();
> END Resources.
>
>
>
> And we have module Disciplines:
>
>
> MODULE Disciplines;
>
>     (* Disciplines allows to attach additional data structures to
>        abstract datatypes like Streams;
>        these added data structures permit to parametrize operations
>        which are provided by other modules (e.g. Read or Write for Streams)
>     *)
>
>     IMPORT Objects;
>
>     TYPE
>        Identifier* = LONGINT;
>
>        Discipline* = POINTER TO DisciplineRec;
>        DisciplineRec* =
>       RECORD
>          (Objects.ObjectRec)
>          id*: Identifier; (* should be unique for all types of
> disciplines *)
>       END;
>
>        DisciplineList = POINTER TO DisciplineListRec;
>        DisciplineListRec =
>       RECORD
>          discipline: Discipline;
>          id: Identifier; (* copied from discipline.id
> <http://discipline.id> *)
>          next: DisciplineList;
>       END;
>
>        Object* = POINTER TO ObjectRec;
>        ObjectRec* =
>       RECORD
>          (Objects.ObjectRec)
>          (* private part *)
>          list: DisciplineList; (* set of disciplines *)
>       END;
>
> ...
>
>     PROCEDURE Seek*(object: Object; id: Identifier;
>            VAR discipline: Discipline) : BOOLEAN;
>        (* returns TRUE if a discipline with the given id is found *)
>        VAR
>       dl: DisciplineList;
>     BEGIN
>        dl := object.list;
>        WHILE (dl # NIL) & (dl.id <http://dl.id> # id) DO
>       dl := dl.next;
>        END;
>        IF dl # NIL THEN
>       discipline := dl.discipline;
>        ELSE
>       discipline := NIL;
>        END;
>        RETURN discipline # NIL
>     END Seek;
>
> If I change PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
> to
> PROCEDURE GetDisc(resource: Resource; VAR disc: Disciplines.Discipline);
> Then this code:
>     IF ~Disciplines.Seek(resource, discID, (*disctmp*)disc) THEN
>       NEW(disc); disc.id <http://disc.id> := discID;
>       disc.state := alive; disc.refcnt := 0;
>       disc.eventType := NIL;
>       disc.dependants := NIL; disc.dependsOn := NIL;
>       Disciplines.Add(resource, disc);
>     END;
> will not work.
>
> If I use local tmpdisc, assign tmpdisc.id <http://tmpdisc.id> := disc.id
> <http://disc.id> and pass it instead,
> I anyway have to assign back pointer disc := tmpdisc which is not
> allowed, and this is not an optimal solution as well.
>
> Any idea?
> Thank you.
>
> On Wed, Oct 6, 2010 at 7:24 AM, Stewart Greenhill
> <sgr...@ii... <mailto:sgr...@ii...>> wrote:
>
>     Hi Norayr,
>
>     I think the restriction is correct.
>
>     This can be confusing, but think of it like this: if your parameter
>     is declared "aaa(VAR p : T1)" then it means the procedure can write
>     ANY value of type T1 to p. Sure, T2 is a subtype of T1 but there are
>     other subtypes of T1 which are not also T2. It would be an error for
>     the compiler to allow aaa(p2) because you could then assign
>     something to p2 which is not a subtype of T2. For example:
>
>
>     PROCEDURE aaa (VAR p : T1);
>     BEGIN
>       NEW(p);  (* assign new instance of T1 to p *)
>     END aaa;
>
>     Now, allowing aaa(p2) would break the type system.
>
>     Its hard to say how to best handle this without knowing some more
>     details of what you're trying to do. This sort of pattern could work:
>
>     VAR
>       p1 : T1;
>     ...
>       p1 := NEW(T2);
>       aaa(p1);
>
>     Cheers,
>       Stewart
>
>
>     On 6/10/10 1:18 AM, Norayr Chilingaryan wrote:
>      > Hello, yet another question which came out during library porting
>     work.
>      > MODULE test2;
>      >
>      > TYPE T1 = POINTER TO TRec;
>      >       TRec = RECORD
>      >       a : INTEGER
>      >       END;
>      >
>      > TYPE T2 = POINTER TO T2Rec;
>      >       T2Rec = RECORD (TRec)
>      >       b : REAL
>      >       END;
>      > VAR p1 : T1;
>      >      p2 : T2;
>      >
>      > PROCEDURE aaa (VAR p : T1);
>      > BEGIN
>      >
>      > END aaa;
>      >
>      > BEGIN
>      > p2 := NEW(T2);
>      > p1 := NEW(T1);
>      > aaa(p2);
>      >
>      > END test2.
>      >
>      > So, this won't compile unless:
>      > we change procedure to PROCEDURE aaa (p : T1); i. e. without VAR
>      > or
>      > pointer passed to the procedure is not a pointer to the extended
>     type,
>      > so aaa(p1) will work.
>      >
>      > Are that restrictions intentional?
>      > What would be an optimal (or nicer) workaround to solve this if I
>     need
>      > to compile library which have been written like this.
>      >
>      > Thank you
>      > Norayr
>     [...]
>
>
>
>
> ------------------------------------------------------------------------------
> Beautiful is writing same markup. Internet Explorer 9 supports
> standards for HTML5, CSS3, SVG 1.1,  ECMAScript5, and DOM L2&  L3.
> Spend less time writing and  rewriting code and more time creating great
> experiences on the web. Be a part of the beta today.
> http://p.sf.net/sfu/beautyoftheweb
>
>
>
> _______________________________________________
> ooc-compiler mailing list
> ooc...@li...
> https://lists.sourceforge.net/lists/listinfo/ooc-compiler