
    <<AssertingImpl.Mesa>>
    <<Copyright Š1984 Xerox Corporation.  All rights reserved.>>
<<Last Edited by: Spreitzer, September 3, 1984 1:43:32 pm PDT>>

    DIRECTORY Asserting, Rope;

    AssertingImpl: CEDAR PROGRAM
        IMPORTS Rope
        EXPORTS Asserting =

        {OPEN Asserting;

        Error: PUBLIC ERROR [a: Assertion] = CODE;

        Warning: PUBLIC SIGNAL [a: Assertion] = CODE;


        ROPE: TYPE = Rope.ROPE;
        Bool: TYPE = REF BOOL;
        Int: TYPE = REF INT;
        Reel: TYPE = REF REAL;


        Assert: PUBLIC PROC [reln: Term, args: Composite, inAdditionTo: Assertions] RETURNS [allTogetherNow: Assertions] =
            {allTogetherNow _ CONS[CONS[reln, args], inAdditionTo]};

        AssertionsAbout: PUBLIC PROC [reln: Term, from: Assertions] RETURNS [filtered: Assertions] = {
            filtered _ NIL;
            FOR from _ from, from.rest WHILE from # NIL DO
                IF Equal[from.first.first, reln] THEN filtered _ CONS[from.first, filtered];
                ENDLOOP;
            filtered _ filtered --so we can break at exit--};

        EnumerateAssertionsAbout: PUBLIC PROC [reln: Term, from: Assertions, to: AssertionConsumer] = {
            FOR from _ from, from.rest WHILE from # NIL DO
                IF Equal[from.first.first, reln] THEN to[from.first];
                ENDLOOP;
            };

        AssertFn: PUBLIC PROC [fn: Term, args: Composite, inAdditionTo: Assertions] RETURNS [allTogetherNow: Assertions] = {
            FOR al: Assertions _ inAdditionTo, al.rest WHILE al # NIL DO
                IF Equal[al.first.first, fn] THEN
                    {al.first.rest _ args; RETURN [inAdditionTo]};
                ENDLOOP;
            allTogetherNow _ CONS[CONS[fn, args], inAdditionTo]};

        AssertFn1: PUBLIC PROC [fn, arg: Term, inAdditionTo: Assertions] RETURNS [allTogetherNow: Assertions] = {
            FOR al: Assertions _ inAdditionTo, al.rest WHILE al # NIL DO
                IF Equal[al.first.first, fn] THEN
                    {al.first.rest _ LIST[arg]; RETURN [inAdditionTo]};
                ENDLOOP;
            allTogetherNow _ CONS[LIST[fn, arg], inAdditionTo]};

        FnVals: PUBLIC PROC [fn: Term, from: Assertions] RETURNS [vals: Composite] = {
            FOR from _ from, from.rest WHILE from # NIL DO
                IF Equal[from.first.first, fn] THEN RETURN [from.first.rest];
                ENDLOOP;
            vals _ NIL};

        FnVal: PUBLIC PROC [fn: Term, from: Assertions] RETURNS [val: Term] = {
            FOR from _ from, from.rest WHILE from # NIL DO
                IF Equal[from.first.first, fn] THEN {
                    IF from.first.rest.rest # NIL THEN ERROR Error[LIST[$MultipleValued, from.first]];
                    RETURN [from.first.rest.first]};
                ENDLOOP;
            val _ NIL};

        CheckFn: PUBLIC PROC [fn: Term, in: Assertions] = {
            found: INT _ 0;
            FOR al: Assertions _ in, al.rest WHILE al # NIL DO
                IF Equal[al.first.first, fn] THEN found _ found + 1;
                ENDLOOP;
            IF found # 1 THEN ERROR Error[LIST[$NotFunctional, fn, in, NEW [INT _ found]]]};

        Union: PUBLIC PROC [a, b: Assertions] RETURNS [c: Assertions] = {
            c _ b;
            WHILE a # NIL DO
                c _ CONS[a.first, c];
                a _ a.rest;
                ENDLOOP;
            c _ c};

        Equal: PUBLIC PROC [a, b: Term] RETURNS [BOOL] = {
            IF (a = NIL) # (b = NIL) THEN RETURN [FALSE];
            IF a = NIL THEN RETURN [TRUE];
            WITH a SELECT FROM
                aa: ATOM => RETURN [a = b];
                ra: ROPE => RETURN [ISTYPE[b, ROPE] AND ra.Equal[NARROW[b]]];
                ba: Bool => RETURN [ISTYPE[b, Bool] AND ba^ = NARROW[b, Bool]^];
                ia: Int => RETURN [ISTYPE[b, Int] AND ia^ = NARROW[b, Int]^];
                ra: Reel => RETURN [ISTYPE[b, Reel] AND ra^ = NARROW[b, Reel]^];
                ca: Composite => IF ISTYPE[b, Composite] THEN {
                    cb: Composite _ NARROW[b];
                    WHILE (ca # NIL) AND (cb # NIL) DO
                        IF NOT Equal[ca.first, cb.first] THEN RETURN [FALSE];
                        ca _ ca.rest;
                        cb _ cb.rest;
                        ENDLOOP;
                    RETURN [(ca = NIL) = (cb = NIL)];
                    } ELSE RETURN [FALSE];
                ENDCASE => RETURN [a = b];
            };

        }.