Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #55926 > unrolled thread

Tiny SPRINTF

Back to article view | Back to comp.lang.forth

Contents

  Tiny SPRINTF Hans Bezemer <the.beez.speaks@gmail.com> - 2017-03-19 17:16 +0100
    Re: Tiny SPRINTF albert@cherry.spenarnc.xs4all.nl (Albert van der Horst) - 2017-03-19 20:48 +0100
      Re: Tiny SPRINTF foxaudioresearch@gmail.com - 2017-03-19 13:51 -0700
        Re: Tiny SPRINTF Hans Bezemer <the.beez.speaks@gmail.com> - 2017-03-19 22:18 +0100
    Re: Tiny SPRINTF Julian Fondren <julian.fondren@gmail.com> - 2017-03-19 20:51 -0700
    Re: Tiny SPRINTF minforth@arcor.de - 2017-03-20 02:20 -0700
      Re: Tiny SPRINTF hughaguilar96@gmail.com - 2017-03-23 18:19 -0700
    Re: Tiny SPRINTF "HAA" <someone@microsoft.com> - 2017-03-24 11:51 +1100
    Re: Tiny SPRINTF Lars Brinkhoff <lars.spam@nocrew.org> - 2017-04-05 20:29 +0200

#55926 — Tiny SPRINTF

With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
post some code in the hope it will be useful to someone.

Hans Bezemer

---8<---
defer    (pad)                         \ right or left aligned
variable (width)                       \ width of field
variable (cursor)                      \ current position
variable (origin)                      \ origin of buffer
-1 1 rshift constant max-n             \ largest signed integer

: lfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
  >r rot tuck max rot swap r> -rot 2dup 2>r rot >r
  >r over r> swap - 2dup chars + r> swap >r fill r> swap cmove 2r>
;

: rfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
  >r >r over >r dup >r swap cmove r> r> r> over max swap >r
  2dup r@ - r> swap >r chars + r> r> fill
;

: lpad bl lfill ; : rpad bl rfill ;    ( a1 n1 a2 n2 -- a2 n1|n2)
: chop 1- swap char+ swap ;
                                       ( c --)
: (cursor1+!) (cursor) tuck @ c! 1 swap +! ;
: (cursor+!) (cursor) dup >r @ (width) @ (pad) r> +! drop ;
                                       ( a n --)
: (format)                             ( a1 n1 -- a2 n2)
  dup 0> if                            \ return on null string
    over swap 2>r c@ >r                \ save format and character
    r@ [char] % = if [char] % (cursor1+!) then
    r@ [char] d = if s>d <# #s #> (cursor+!) then 
    r@ [char] c = if (cursor1+!) then
    r@ [char] s = if (cursor+!) then
    r> [char] * = if (width) ! 2r> chop recurse else 2r> then
  then                                 \ recurse if width on command line
;

: (.field)                             ( x | - a1 n1 -- a2 n2)
  0 (width) ! ['] lpad is (pad)        \ start with a zero width
  2dup chop if c@ [char] - = if ['] rpad is (pad) chop then else drop then
  begin                                \ get alignment
    chop dup                           \ get width
  while                                \ is there any format string left?
    over c@ [char] 0 - dup max-n and 10 <
    if (width) @ 10 * + (width) ! else drop (format) exit then
  repeat                               \ get width or print format
;
                                       ( a n -- a n)
: (%?) over c@ [char] % = if (.field) else over c@ (cursor1+!) then ;

: sprintf                              ( x1 .. xi a1 n1 a2 -- a2 n3)
  dup (cursor) ! (origin) ! begin dup 0> while (%?) chop repeat 2drop
  (origin) @ (cursor) @ over -
;

create buffer 80 chars allot

23 4 s" Hello" char !
s" This is %%char%c%%, string '%-6s' and number%*d" buffer sprintf cr type
---8<---

[toc] | [next] | [standalone]

#55940

In article <58ceaecb$0$767$e4fe514c@news.xs4all.nl>,
Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
>With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
>post some code in the hope it will be useful to someone.

Code is never useful if you don't know what it does.

<SNIP>

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#55943

On Sunday, March 19, 2017 at 3:48:19 PM UTC-4, Albert van der Horst wrote:
> In article <58ceaecb$0$767$e4fe514c@news.xs4all.nl>,
> Hans Bezemer  <the.beez.speaks@gmail.com> wrote:
> >With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
> >post some code in the hope it will be useful to someone.
> 
> Code is never useful if you don't know what it does.
> 
> <SNIP>
> 
> Groetjes Albert
> -- 
> Albert van der Horst, UTRECHT,THE NETHERLANDS
> Economic growth -- being exponential -- ultimately falters.
> albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

I am going to way out on a limb here and guess it does something like this
but in Forth:

http://www.cplusplus.com/reference/cstdio/sprintf/

How does it differ Hans?


B

[toc] | [prev] | [next] | [standalone]

#55945

foxaudioresearch@gmail.com wrote:
> I am going to way out on a limb here and guess it does something like this
> but in Forth:
> 
> http://www.cplusplus.com/reference/cstdio/sprintf/
> 
> How does it differ Hans?
- It only supports specifiers d, c, s, %
- It only supports flag -
- Full support of width
- No support for precision or length

http://www.cplusplus.com/reference/cstdio/printf/

See example for typical use:

        create buffer 80 chars allot

        23 4 s" Hello" char !
        s" This is %%char%c%%, string '%-6s' and number%*d" buffer sprintf cr type

Hans Bezemer

[toc] | [prev] | [next] | [standalone]

#55956

On Sunday, March 19, 2017 at 11:16:42 AM UTC-5, The Beez wrote:
> With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
> post some code in the hope it will be useful to someone.
> 
> Hans Bezemer

> : chop 1- swap char+ swap ;

I recognize this as

  : chop  1 /STRING ;

>     r@ [char] d = if s>d <# #s #> (cursor+!) then 

This would permit the display of negative numbers:

  dup 0< swap abs 0 <# #s rot sign #>


In general it seems like you could have simpler code if you wrote
printf instead, and assumed that for sprintf's sake the host Forth had
some way to redirect normal I/O to a string. Which is true of gforth
(strings.fs), SwiftForth (buffio.f), and VFX (Genio/Buffer.fth), and
any Forth with vectored EMIT and TYPE

In this case padding f.e. mainly becomes a selection between SPACES
TYPE and -ROT TYPE SPACES

[toc] | [prev] | [next] | [standalone]

#55961

Am Sonntag, 19. März 2017 17:16:42 UTC+1 schrieb The Beez:
> With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
> post some code in the hope it will be useful to someone.
> 
> Hans Bezemer
> 
> ---8<---
> defer    (pad)                         \ right or left aligned
> variable (width)                       \ width of field
> variable (cursor)                      \ current position
> variable (origin)                      \ origin of buffer
> -1 1 rshift constant max-n             \ largest signed integer
> 
> : lfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
>   >r rot tuck max rot swap r> -rot 2dup 2>r rot >r
>   >r over r> swap - 2dup chars + r> swap >r fill r> swap cmove 2r>
> ;
> 
> : rfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
>   >r >r over >r dup >r swap cmove r> r> r> over max swap >r
>   2dup r@ - r> swap >r chars + r> r> fill
> ;
> 
> : lpad bl lfill ; : rpad bl rfill ;    ( a1 n1 a2 n2 -- a2 n1|n2)
> : chop 1- swap char+ swap ;
>                                        ( c --)
> : (cursor1+!) (cursor) tuck @ c! 1 swap +! ;
> : (cursor+!) (cursor) dup >r @ (width) @ (pad) r> +! drop ;
>                                        ( a n --)
> : (format)                             ( a1 n1 -- a2 n2)
>   dup 0> if                            \ return on null string
>     over swap 2>r c@ >r                \ save format and character
>     r@ [char] % = if [char] % (cursor1+!) then
>     r@ [char] d = if s>d <# #s #> (cursor+!) then 
>     r@ [char] c = if (cursor1+!) then
>     r@ [char] s = if (cursor+!) then
>     r> [char] * = if (width) ! 2r> chop recurse else 2r> then
>   then                                 \ recurse if width on command line
> ;
> 
> : (.field)                             ( x | - a1 n1 -- a2 n2)
>   0 (width) ! ['] lpad is (pad)        \ start with a zero width
>   2dup chop if c@ [char] - = if ['] rpad is (pad) chop then else drop then
>   begin                                \ get alignment
>     chop dup                           \ get width
>   while                                \ is there any format string left?
>     over c@ [char] 0 - dup max-n and 10 <
>     if (width) @ 10 * + (width) ! else drop (format) exit then
>   repeat                               \ get width or print format
> ;
>                                        ( a n -- a n)
> : (%?) over c@ [char] % = if (.field) else over c@ (cursor1+!) then ;
> 
> : sprintf                              ( x1 .. xi a1 n1 a2 -- a2 n3)
>   dup (cursor) ! (origin) ! begin dup 0> while (%?) chop repeat 2drop
>   (origin) @ (cursor) @ over -
> ;
> 
> create buffer 80 chars allot
> 
> 23 4 s" Hello" char !
> s" This is %%char%c%%, string '%-6s' and number%*d" buffer sprintf cr type
> ---8<---

Thank you for posting this!
I have no time to experiment with it, but I already like its compactness, and it is certainly an improvement over <# .. #> et al.

[toc] | [prev] | [next] | [standalone]

#56212

On Monday, March 20, 2017 at 2:21:01 AM UTC-7, minf...@arcor.de wrote:
> Am Sonntag, 19. März 2017 17:16:42 UTC+1 schrieb The Beez:
> > With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
> > post some code in the hope it will be useful to someone.
> > 
> > Hans Bezemer
> > 
> > ---8<---
> > defer    (pad)                         \ right or left aligned
> > variable (width)                       \ width of field
> > variable (cursor)                      \ current position
> > variable (origin)                      \ origin of buffer
> > -1 1 rshift constant max-n             \ largest signed integer
> > 
> > : lfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
> >   >r rot tuck max rot swap r> -rot 2dup 2>r rot >r
> >   >r over r> swap - 2dup chars + r> swap >r fill r> swap cmove 2r>
> > ;
> > 
> > : rfill                                ( a1 n1 a2 n2 c -- a2 n1|n2)
> >   >r >r over >r dup >r swap cmove r> r> r> over max swap >r
> >   2dup r@ - r> swap >r chars + r> r> fill
> > ;
> > 
> > : lpad bl lfill ; : rpad bl rfill ;    ( a1 n1 a2 n2 -- a2 n1|n2)
> > : chop 1- swap char+ swap ;
> >                                        ( c --)
> > : (cursor1+!) (cursor) tuck @ c! 1 swap +! ;
> > : (cursor+!) (cursor) dup >r @ (width) @ (pad) r> +! drop ;
> >                                        ( a n --)
> > : (format)                             ( a1 n1 -- a2 n2)
> >   dup 0> if                            \ return on null string
> >     over swap 2>r c@ >r                \ save format and character
> >     r@ [char] % = if [char] % (cursor1+!) then
> >     r@ [char] d = if s>d <# #s #> (cursor+!) then 
> >     r@ [char] c = if (cursor1+!) then
> >     r@ [char] s = if (cursor+!) then
> >     r> [char] * = if (width) ! 2r> chop recurse else 2r> then
> >   then                                 \ recurse if width on command line
> > ;
> > 
> > : (.field)                             ( x | - a1 n1 -- a2 n2)
> >   0 (width) ! ['] lpad is (pad)        \ start with a zero width
> >   2dup chop if c@ [char] - = if ['] rpad is (pad) chop then else drop then
> >   begin                                \ get alignment
> >     chop dup                           \ get width
> >   while                                \ is there any format string left?
> >     over c@ [char] 0 - dup max-n and 10 <
> >     if (width) @ 10 * + (width) ! else drop (format) exit then
> >   repeat                               \ get width or print format
> > ;
> >                                        ( a n -- a n)
> > : (%?) over c@ [char] % = if (.field) else over c@ (cursor1+!) then ;
> > 
> > : sprintf                              ( x1 .. xi a1 n1 a2 -- a2 n3)
> >   dup (cursor) ! (origin) ! begin dup 0> while (%?) chop repeat 2drop
> >   (origin) @ (cursor) @ over -
> > ;
> > 
> > create buffer 80 chars allot
> > 
> > 23 4 s" Hello" char !
> > s" This is %%char%c%%, string '%-6s' and number%*d" buffer sprintf cr type
> > ---8<---
> 
> Thank you for posting this!
> I have no time to experiment with it, but I already like its compactness, and it is certainly an improvement over <# .. #> et al.

I'm not much interested in this. I always considered PRINTF and SPRINTF to be one of the worst features of C (actually of the standard library). 

The C programmers used to often criticize Forth for being interpreted. This isn't really true. The Forth source-code isn't being interpreted at run-time. The irony here is that in C PRINTF and SPRINTF are interpreting source-code at run-time (the pattern-string is effectively source-code for a mini-language).

I might write SPRINTF and put it in STRING-STACK.4TH --- there might be occasions when it is useful, and C programmers would like it.

[toc] | [prev] | [next] | [standalone]

#56209

Hans Bezemer wrote:
> With terror in my heart I'm doing the most dangerous thing here in c.l.f. I
> post some code in the hope it will be useful to someone.
>
> Hans Bezemer

That's a walk in the park :)  Terror would be posting to comp.lang.c !!!

As a non-C user, no Pavlovian response is triggered however fans
may wish to check out 'sprintf.f' that comes with SwiftForth.

[toc] | [prev] | [next] | [standalone]

#56756

Hans Bezemer <the.beez.speaks@gmail.com> writes:
> With terror in my heart I'm doing the most dangerous thing here in
> c.l.f. I post some code in the hope it will be useful to someone.

My version is here:

https://github.com/larsbrinkhoff/fmacs/blob/master/src/format.fth

A cute and/or horrible trick is to use a wordlist as the dispatch table
for % characters.

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.forth

csiph-web