--* From SMWATT%WATSON.vnet.ibm.com@yktvmv.watson.ibm.com Wed Jun 15 21:07:27 1994 --* Received: from yktvmv-ob.watson.ibm.com by asharp.watson.ibm.com (AIX 3.2/UCB 5.64/930311) --* id AA18502; Wed, 15 Jun 1994 21:07:27 -0400 --* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3) --* with BSMTP id 0601; Wed, 15 Jun 94 21:07:27 EDT --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id --* for asbugs@watson; Wed, 15 Jun 94 21:07:27 -0400 --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id 3235; Wed, 15 Jun 1994 21:07:27 EDT --* Received: from leonardo.watson.ibm.com by yktvmv.watson.ibm.com --* (IBM VM SMTP V2R3) with TCP; Wed, 15 Jun 94 21:07:26 EDT --* Received: by leonardo.watson.ibm.com (AIX 3.2/UCB 5.64/920123) --* id AA21958; Wed, 15 Jun 1994 21:02:38 -0400 --* Date: Wed, 15 Jun 1994 21:02:38 -0400 --* From: smwatt@leonardo.watson.ibm.com (Stephen Watt) --* X-External-Networks: yes --* Message-Id: <9406160102.AA21958@leonardo.watson.ibm.com> --* To: asbugs@watson.ibm.com --* Subject: [4] Assertion failed, file "../src/genfoam.c" line 4410: foamTag(foam) == FOAM_Values [fmtout.as][v36--] --@ Fixed by: PAB Sat Aug 6 11:23:42 EDT 1994 --@ Tested by: embed.as --@ Summary: embeds in titdn #if BugHeaders LastSeenBy: Godzilla LastUpdate: 01/Jan/45 BugKeywords: unclassified Priority: Comments: Comments: SeenBy: Updates: #endif #assert modified #if modified ------------------- tail calling multiple value returning functions doesnt. -- -- fmtout.as -- -- Copyright The Numerical Algorithms Group 1994. #include "aslib" import from StandardIO; Format ==> String; SI ==> SingleInteger; OUT ==> OutPort; +++`FormattedOutput' provides functions which format their arguments +++ according to a control string. The control characters are: +++ +++ #n Put a newline. +++ ## Put a `#' character. +++ #{i}a Put the i-th argument. +++ #a Put the next argument. +++ #1,...,#9 Shorthand for `#{1}a',...,`#{9}a' FormattedOutput: with { print: (Format, on: OUT == print) -> Tuple(OUT->OUT) -> OUT; count: (Format, on: OUT == sink()) -> Tuple(OUT->OUT) -> SI; string:(Format) -> Tuple(OUT->OUT) -> String; } == add { import from SI, Character, OutPort; default fmt: Format; default i0,narg: SI; default on: OutPort; default items: Tuple(OUT->OUT); CTL ==> "#"; DONT ==> -1; CANT ==> -2; print(fmt, on: OutPort == print): Tuple(OUT->OUT) -> OUT == { (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): OUT +-> { putFormat(fmt, i0, on, items) } } count(fmt, on: OutPort == sink()): Tuple(OUT->OUT) -> SI == { n0 := #on; (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): SI +-> { putFormat(fmt, i0, on, items); #on - n0 } } string(fmt: Format): Tuple(OUT->OUT) -> String == { a: Array Character := empty(); on := a::OutPort; (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): String +-> { putFormat(fmt, i0, on, items); s := convert a; dispose! a; s } } local convert(a: Array Character): String == { s: String := empty(#a); for i in 1..#a repeat s.i := a.i; s } --`putSpan' puts characters from the format string onto the OutPort. -- The first character put is `fmt.i0', and output proceeds until a -- format control requiring an argument item, or the end of the format -- string is encountered. The result is the index of the first -- character not output, and the modified outport. local putSpan(fmt, i0, on): (SI, OUT) == { i0 < 1 => (1, on); while not end?(fmt, i0) repeat { -- Handle those formats which do not require an item. if fmt.i0 = CTL then { (i0,on,narg) := doControl(fmt,i0,on, DONT, ()); narg = CANT => break; } -- Find length of substring. i := i0; while not end?(fmt,i+1) and fmt.i ~= CTL repeat i:=i+1; -- Back up if necessary. if fmt.i = CTL then i:=i-1; -- Put the substring. (i0, on) := (i+1, put(on, fmt, i0, i)); } return (i0, on); } --`putFormat' puts the characters from the format string onto -- the OutPort, with the formatted items interspersed as desired. local putFormat(fmt, i0, on, items): OUT == { narg := 1; nitems := length items; repeat { (i0, on) := putSpan(fmt, i0, on); end?(fmt,i0) => break; fmt.i0 ~= CTL => error "Bad case in putFormat."; (i0,on,narg) := doControl(fmt,i0,on,narg,items); } return on; } --`doControl' handles the control sequences in the format. -- An input value of DONT for narg means not to handle items. -- An output value of CANT for narg means the format couldn't be done. local doControl(fmt, i0, on, narg, items): (SI, OUT, SI) == { MSG ==> "Bad format string."; i0 < 1 or fmt.i0 ~= CTL => error MSG; i0 := i0 + 1; end?(fmt, i0) => error MSG; c := lower fmt.i0; i0 := i0 + 1; -- Handle easy cases without parameter. c = CTL => (i0, put(on, c), narg); c = "n" => (i0, put(on, newline), narg); digit? c => { narg = DONT => (i0, on, CANT); doControlA(i0, on, ord c - ord "0", items); } -- Collect the numeric parameter, if there is one. parm := 0; parm? := false; if c = "{" then { parm? := true; while not end?(fmt, i0) and digit? fmt.i0 repeat { parm := 10 * parm + ord fmt.i0 - ord "0"; i0 := i0 + 1; } end?(fmt,i0) or fmt.i0 ~= "}" => error MSG; i0 := i0 + 1; end?(fmt, i0) => error MSG; c := lower fmt.i0; i0 := i0 + 1; } -- Handle cases with parameter. c = "a" => { narg = DONT => (i0, on, CANT); if parm? then narg := parm; doControlA(i0, on, narg, items); } error MSG; } local doControlA(i0, on, narg, items): (SI, OUT, SI) == { narg < 1 or narg > length items => error "Bad format string"; (i0, element(items, narg)(on), narg+1); } } #else -- original begin ------------------- tail calling multiple value returning functions doesnt. -- -- fmtout.as -- -- Copyright The Numerical Algorithms Group 1994. #include "aslib" import from StandardIO; Format ==> String; SI ==> SingleInteger; OUT ==> OutPort; +++`FormattedOutput' provides functions which format their arguments +++ according to a control string. The control characters are: +++ +++ #n Put a newline. +++ ## Put a `#' character. +++ #{i}a Put the i-th argument. +++ #a Put the next argument. +++ #1,...,#9 Shorthand for `#{1}a',...,`#{9}a' FormattedOutput: with { print: (Format, on: OUT == print) -> Tuple(OUT->OUT) -> OUT; count: (Format, on: OUT == sink()) -> Tuple(OUT->OUT) -> SI; string:(Format) -> Tuple(OUT->OUT) -> String; } == add { import from SI, Character, OutPort; default fmt: Format; default i0,narg: SI; default on: OutPort; default items: Tuple(OUT->OUT); CTL ==> "#"; DONT ==> -1; CANT ==> -2; print(fmt, on: OutPort == print): Tuple(OUT->OUT) -> OUT == { (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): OUT +-> { putFormat(fmt, i0, on, items) } } count(fmt, on: OutPort == sink()): Tuple(OUT->OUT) -> SI == { n0 := #on; (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): SI +-> { putFormat(fmt, i0, on, items); #on - n0 } } string(fmt: Format): Tuple(OUT->OUT) -> String == { a: Array Character := empty(); on := a::OutPort; (i0, on) := putSpan(fmt, 1, on); (items: Tuple(OUT->OUT)): String +-> { putFormat(fmt, i0, on, items); s := convert a; dispose! a; s } } local convert(a: Array Character): String == { s: String := empty(#a); for i in 1..#a repeat s.i := a.i; s } --`putSpan' puts characters from the format string onto the OutPort. -- The first character put is `fmt.i0', and output proceeds until a -- format control requiring an argument item, or the end of the format -- string is encountered. The result is the index of the first -- character not output, and the modified outport. local putSpan(fmt, i0, on): (SI, OUT) == { i0 < 1 => (1, on); while not end?(fmt, i0) repeat { -- Handle those formats which do not require an item. if fmt.i0 = CTL then { (i0,on,narg) := doControl(fmt,i0,on, DONT, ()); narg = CANT => break; } -- Find length of substring. i := i0; while not end?(fmt,i+1) and fmt.i ~= CTL repeat i:=i+1; -- Back up if necessary. if fmt.i = CTL then i:=i-1; -- Put the substring. (i0, on) := (i+1, put(on, fmt, i0, i)); } return (i0, on); } --`putFormat' puts the characters from the format string onto -- the OutPort, with the formatted items interspersed as desired. local putFormat(fmt, i0, on, items): OUT == { narg := 1; nitems := length items; repeat { (i0, on) := putSpan(fmt, i0, on); end?(fmt,i0) => break; fmt.i0 ~= CTL => error "Bad case in putFormat."; (i0,on,narg) := doControl(fmt,i0,on,narg,items); } return on; } --`doControl' handles the control sequences in the format. -- An input value of DONT for narg means not to handle items. -- An output value of CANT for narg means the format couldn't be done. local doControl(fmt, i0, on, narg, items): (SI, OUT, SI) == { MSG ==> "Bad format string."; i0 < 1 or fmt.i0 ~= CTL => error MSG; i0 := i0 + 1; end?(fmt, i0) => error MSG; c := lower fmt.i0; i0 := i0 + 1; -- Handle easy cases without parameter. c = CTL => (i0, put(on, c), narg); c = "n" => (i0, put(on, newline), narg); digit? c => { narg = DONT => (i0, on, CANT); doControlA(i0, on, ord c - ord "0", items); } -- Collect the numeric parameter, if there is one. parm := 0; parm? := false; if c = "{" then { parm? := true; while not end?(fmt, i0) and digit? fmt.i0 repeat { parm := 10 * parm + ord fmt.i0 - ord "0"; i0 := i0 + 1; } end?(fmt,i0) or fmt.i0 ~= "}" => error MSG; i0 := i0 + 1; end?(fmt, i0) => error MSG; c := lower fmt.i0; i0 := i0 + 1; } -- Handle cases with parameter. c = "a" => { narg = DONT => (i0, on, CANT); if parm? then narg := parm; doControlA(i0, on, narg, items); } error MSG; } local doControlA(i0, on, narg, items): (SI, OUT, SI) == { narg < 1 or narg > length items => error "Bad format string"; (i0, element(items, narg)(on), narg+1); } } #endif -- original end