MODULE; IMPORT JunoValue, InUseRec, InUseRecSeq; IMPORT Text AS TextIntf; (* to avoid name clash with "RTVal.Text" type *) IMPORT Wr, Fmt, Stdio, Thread; <* FATAL Wr.Failure, Thread.Alerted *> VAR debug := FALSE; REVEAL Number = NumberPublic BRANDED "RTVal.Number" OBJECT link: Number END; Text = TextPublic BRANDED "RTVal.Text" OBJECT link: Text END; Pair = PairPublic BRANDED "RTVal.Pair" OBJECT link: Pair END; VAR markStack := NEW(InUseRecSeq.T).init(); numAvail, numInUse: Number := NIL; textAvail, textInUse: Text := NIL; pairAvail, pairInUse: Pair := NIL; PROCEDURE RTVal FromReal (r: Real): Number = VAR res := numAvail; BEGIN IF res = NIL THEN res := NEW(Number) ELSE numAvail := numAvail.link END; res.val := r; res.link := numInUse; numInUse := res; RETURN res END FromReal; PROCEDUREFromInt (i: INTEGER): Number = VAR res := numAvail; BEGIN IF res = NIL THEN res := NEW(Number) ELSE numAvail := numAvail.link END; res.val := FLOAT(i, Real); res.link := numInUse; numInUse := res; RETURN res END FromInt; PROCEDUREFromText (txt: TEXT): Text = VAR res := textAvail; BEGIN <* ASSERT txt # NIL *> IF res = NIL THEN res := NEW(Text) ELSE textAvail := textAvail.link END; res.val := txt; res.link := textInUse; textInUse := res; RETURN res END FromText; PROCEDUREFromPair (car, cdr: T): Pair = VAR res := pairAvail; BEGIN <* ASSERT car # NIL AND cdr # NIL *> IF res = NIL THEN res := NEW(Pair) ELSE pairAvail := pairAvail.link END; res.car := car; res.cdr := cdr; res.link := pairInUse; pairInUse := res; RETURN res END FromPair; PROCEDUREFromJV (jv: JunoValue.T): T = BEGIN TYPECASE jv OF <*NOWARN*> NULL => RETURN NIL | JunoValue.Null => RETURN nil | REF Real (r) => RETURN FromReal(r^) | TEXT (t) => RETURN FromText(t) | REF JunoValue.Pair (r) => RETURN FromJVPair(r) END END FromJV; PROCEDUREFromJVPair (pr: REF JunoValue.Pair): Pair =
Equivalent toRETURN FromPair(FromJV(pr.car), FromJV(pr.cdr))
, but uses fewer stack frames in the case thatpr
is a long list.Note: The calls to
FromPair
belowonly need to pass a valid first argument. They pass the same second argument only becauseFromPair
's arguments must be non-NIL. The boguscdr
value gets overwritten on the next iteration, or after the loop.
VAR car: T := FromJV(pr.car); res: Pair := FromPair(car, car); curr: Pair := res; BEGIN LOOP TYPECASE pr.cdr OF NULL => EXIT | REF JunoValue.Pair (newPr) => car := FromJV(newPr.car); curr.cdr := FromPair(car, car); pr := newPr; curr := curr.cdr ELSE EXIT END END; curr.cdr := FromJV(pr.cdr); RETURN res END FromJVPair; PROCEDUREToJV (v: T): JunoValue.T = BEGIN TYPECASE v OF <* NOWARN *> NULL => RETURN NIL | Null => RETURN JunoValue.Nil | Number (r) => RETURN JunoValue.RefReal(r.val) | Text (t) => RETURN t.val | Pair (p) => RETURN ToJVPair(p) END END ToJV; PROCEDUREToJVPair (pr: Pair): REF JunoValue.Pair =
Equivalent to:RETURN NEW(REF JunoValue.Pair, car := ToJV(pr.car), cdr := ToJV(pr.cdr))but uses fewer stack frames in the case thatpr
is a long list.
VAR res := NEW(REF JunoValue.Pair, car := ToJV(pr.car), cdr := NIL); curr := res; BEGIN LOOP TYPECASE pr.cdr OF NULL => EXIT | Pair (newPr) => curr.cdr := NEW(REF JunoValue.Pair, car := ToJV(newPr.car), cdr := NIL); pr := newPr; curr := curr.cdr ELSE EXIT END END; curr.cdr := ToJV(pr.cdr); RETURN res END ToJVPair; PROCEDUREEqual (v, w: T): BOOLEAN = BEGIN IF v = NIL OR w = NIL THEN RETURN FALSE END; TYPECASE v OF <*NOWARN*> Null => RETURN w = nil | Number (vv) => TYPECASE w OF Number (ww) => RETURN vv.val = ww.val ELSE RETURN FALSE END | Text (vv) => TYPECASE w OF Text (ww) => RETURN TextIntf.Equal(vv.val, ww.val) ELSE RETURN FALSE END | Pair (vv) => TYPECASE w OF Pair (ww) => RETURN EqualPair(vv, ww) ELSE RETURN FALSE END END END Equal; PROCEDUREEqualPair (p1: Pair; p2: Pair): BOOLEAN =
Equivalent toRETURN Equal(p1.car, p2.car) AND Equal(p1.cdr, p2.cdr)
, but uses fewer stack frames whenp1
andp2
are long lists.
BEGIN LOOP IF NOT Equal(p1.car, p2.car) THEN RETURN FALSE END; TYPECASE p1.cdr OF NULL => RETURN FALSE | Pair (newP1) => TYPECASE p2.cdr OF NULL => RETURN FALSE | Pair (newP2) => p1 := newP1; p2 := newP2 ELSE RETURN FALSE END ELSE EXIT END END; RETURN Equal(p1.cdr, p2.cdr) END EqualPair; PROCEDUREMark () = VAR r := InUseRec.T{numInUse, textInUse, pairInUse}; BEGIN markStack.addhi(r); numInUse := NIL; textInUse := NIL; pairInUse := NIL END Mark; PROCEDUREDispose () = VAR deletedAny := FALSE; BEGIN IF debug THEN Wr.PutText(Stdio.stderr, "RTVal.Dispose:\n"); Wr.Flush(Stdio.stderr) END; DisposeNum(deletedAny); DisposeText(deletedAny); DisposePair(deletedAny); IF markStack.size() > 0 THEN VAR r := markStack.remhi(); BEGIN numInUse := r.numInUse; textInUse := r.textInUse; pairInUse := r.pairInUse END END; IF debug THEN IF NOT deletedAny THEN Wr.PutText(Stdio.stderr, " Nothing deleted\n") END; Wr.PutChar(Stdio.stderr, '\n'); Wr.Flush(Stdio.stderr) END END Dispose; PROCEDUREDisposeNum (VAR deletedAny: BOOLEAN) = VAR l := numInUse; cnt := 1; BEGIN IF l = NIL THEN RETURN END; WHILE l.link # NIL DO l := l.link; INC(cnt) END; l.link := numAvail; numAvail := numInUse; numInUse := NIL; IF debug THEN deletedAny := TRUE; Wr.PutText(Stdio.stderr, Fmt.Pad(Fmt.Int(cnt), 7)); Wr.PutText(Stdio.stderr, " number(s)\n"); Wr.Flush(Stdio.stderr) END END DisposeNum; PROCEDUREDisposeText (VAR deletedAny: BOOLEAN) = VAR l := textInUse; cnt := 1; BEGIN IF l = NIL THEN RETURN END; WHILE l.link # NIL DO l := l.link; INC(cnt) END; l.link := textAvail; textAvail := textInUse; textInUse := NIL; IF debug THEN deletedAny := TRUE; Wr.PutText(Stdio.stderr, Fmt.Pad(Fmt.Int(cnt), 7)); Wr.PutText(Stdio.stderr, " text(s)\n"); Wr.Flush(Stdio.stderr) END END DisposeText; PROCEDUREDisposePair (VAR deletedAny: BOOLEAN) = VAR l := pairInUse; cnt := 1; BEGIN IF l = NIL THEN RETURN END; WHILE l.link # NIL DO l := l.link; INC(cnt) END; l.link := pairAvail; pairAvail := pairInUse; pairInUse := NIL; IF debug THEN deletedAny := TRUE; Wr.PutText(Stdio.stderr, Fmt.Pad(Fmt.Int(cnt), 7)); Wr.PutText(Stdio.stderr, " pair(s)\n"); Wr.Flush(Stdio.stderr) END END DisposePair; BEGIN nil := NEW(Null) END RTVal.