Path: ...!news.mixmin.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Krishna Myneni <krishna.myneni@ccreweb.org>
Newsgroups: comp.lang.forth
Subject: Re: Juggling system-compilation items
Date: Sat, 10 Aug 2024 22:29:14 -0500
Organization: A noiseless patient Spider
Lines: 82
Message-ID: <v99b6a$154bp$1@dont-email.me>
References: <v957nr$jq4q$2@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 8bit
Injection-Date: Sun, 11 Aug 2024 05:29:15 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="b66a7ec4db50da8a6e67c3f578c1db3b";
	logging-data="1216889"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19PZY2HhwNUQLSvw4eaA5PO"
User-Agent: Mozilla Thunderbird
Cancel-Lock: sha1:zQEyIYOYiZz02t08Vy5NkH8k2IA=
In-Reply-To: <v957nr$jq4q$2@dont-email.me>
Content-Language: en-US
Bytes: 3250

On 8/9/24 09:05, Ruvim wrote:
> Do you know a Forth system in which the following definition for "const" 
> is compiled but does not work as expected?
> 
> 
> : const ( x "<spaces>name" -- )
>    depth >r          ( x )                   ( R: n.depth )
>    :                 ( x colon-sys )         ( R: n.depth )
>    depth r> -        ( x colon-sys n.size )  ( R: )
>    n>r               ( x )                   ( R: i*x n.size )
>    postpone literal  (   )                   ( R: i*x n.size )
>    nr>               ( colon-sys n.size )    ( R: )
>    drop              ( colon-sys )
>    postpone ;        (   )
> ;
> 
> 
> t{ 123 const foo -> }t
> t{ foo -> 3 }t
> 
> 
> Note 3.1.5.1 System-compilation types 
> <https://forth-standard.org/standard/usage#subsubsection.3.1.5.1>
> 
> 
> -- 
> Ruvim
> 

In kForth, for the code above, foo returns 123 which is what I expect.

--
Krishna


=== begin code ===

: N>R           \ xn .. x1 N -- ; R: -- x1 .. xn n
\ Transfer N items and count to the return stack.
   dup                   \ xn .. x1 N N --
   begin
     dup
   while
     rot r> swap >r >r   \ xn .. N N -- ; R: .. x1 --
     1-                  \ xn .. N 'N -- ; R: .. x1 --
   repeat
   drop                  \ N -- ; R: x1 .. xn --
   r> swap >r >r
;

: NR>           \ -- xn .. x1 N ; R: x1 .. xn N --
\ Pull N items and count off the return stack.
   r> r> swap >r dup
   begin
     dup
   while
     r> r> swap >r -rot
     1-
   repeat
   drop
;


: const ( x "<spaces>name" -- )
   depth >r          ( x )                   ( R: n.depth )
   :                 ( x colon-sys )         ( R: n.depth )
   depth r> -        ( x colon-sys n.size )  ( R: )
   n>r               ( x )                   ( R: i*x n.size )
   postpone literal  (   )                   ( R: i*x n.size )
   nr>               ( colon-sys n.size )    ( R: )
   drop              ( colon-sys )
   postpone ;        (   )
;
=== end code ===

=== begin test ===
123 const foo
  ok
foo .
123  ok
=== end test ===