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

Groups > comp.lang.forth > #58742

Re: excercise from Robert L, please comment

Show all headers | View raw

On 5/6/2017 15:44, Andreas Klimas wrote:
> I forgot to clearify the exercise
> 
> "I have a string e.g. 'C6 H12 O6' that I wish to split up to give 2 strings
> 'C H O' and '6 12 6'."

OK, thanks.

So the first thing I would do is break the task down, as you've done, 
but perhaps in a slightly different way. $SEEK is rather complex, what 
with its EXECUTE for either a number or a character.

Here's my solution. (I've written BL-SKIP, but your Forth may support 
SKIP. It's commonly available but not a standard word. As is APPEND 
+PLACE for ADD-CHAR.) It switches output strings based on the input 
character.


create char-string 256 allot \ counted buffer for characters
create num-string  256 allot \ counted buffer for numbers

variable target-string  \ pointer to the target string

: init-strings ( -- ) \ zero the output strings
     0 char-string c!
     0 num-string  c!
     char-string target-string ! ;

: add-char ( char string -- ) \ add char to a counted string
     dup c@ 1+ dup >r over c!  \ increment the length
     r> + c! ;                 \ store the char

: add-target ( char -- )
     target-string @ add-char ;

: bl-skip ( addr len -- addr' len' ) \ skip blanks
     dup if
       begin over c@ bl = over and
       while
         1 /string
       repeat
     then ;

: splitem ( addr len -- ) \ given a string, split them
     init-strings
     begin bl-skip dup     \ skip blanks
     while                 \ keep going while something left
       over c@             \ get character
       dup '0' '9' 1+ within if  \ select the output string
         num-string
       else
         char-string
       then
       dup target-string @ <> if \ if target changed
         bl add-target   \ add a blank
         target-string ! \ switch strings
       else drop then
       add-target         \ add the char
       1 /string          \ move up
     repeat 2drop ;

s" C6 H12 O6" splitem
cr char-string count type
cr num-string  count type


outputs

C H O
6 12 6
  ok





>> here ," CX16 HXY12 O6" constant formular
>>
>> align
>> create l1 128 allot \ Buffer
>> create l2 128 allot
>> create >l1 l1 ,     \ Buffer-Seek-Pointer
>> create >l2 l2 ,
>>
>> : ,l1 ( c--) >l1 @ ! 1 >l1 +! ;
>> : ,l2 ( c--) >l2 @ ! 1 >l2 +! ;
>>
>> : digit? ( c--bool) [char] 0 [char] 9 1+ within ;
>> : $seek ( c-addr u xt) ( xt: c-addr u c--bool) \ subsequent iterate 
>> until bool becomes false
>>    >r
>>    begin
>>       dup while ( c-addr u)
>>          over c@ r@ execute ( c-addr u bool)
>>          0= if r> drop exit then ( c-addr' u') \ "xt execute" answered 
>> false
>>          1 /string
>>    repeat
>>    r> drop
>> ;
>> : get-char ( c--bool)  \ called by $seek
>>    dup digit? if drop false else dup ,l1 then ;
>> : get-number ( c--bool)  \ called by $seek
>>    dup digit? if dup ,l2 else drop false then ;
>> : get-chars   ( c-addr u -- c-addr2 u2) ['] get-char $seek ;
>> : get-numbers ( c-addr u -- c-addr2 u2) ['] get-number $seek ;
>>
>> : foo
>>    formular count ( c-addr u)
>>
>>    begin
>>       bl skip (  c-addr u) \ remove leading white spaces
>>
>>       get-chars
>>       bl ,l1  \ Seperate output
>>       bl skip \ remove white spaces
>>       get-numbers
>>       bl ,l2 \ Seperate output
>>
>>       dup 0= ( c-addr u)
>>    until \ until ( c-addr 0)
>>    2 drop
>>    cr
>>    ." l1:" l1  >l1 @ l1 - type
>>    cr
>>    ." l2:" l2  >l1 @ l1 - type
>>    cr
>> ;
> 
> 


-- 
Alex

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

excercise from Robert L, please comment Andreas Klimas <klimas@w3group.de> - 2017-05-06 13:14 +0200
  Re: excercise from Robert L, please comment Alex <alex@rivadpm.com> - 2017-05-06 13:14 +0100
  Re: excercise from Robert L, please comment Andreas Klimas <klimas@w3group.de> - 2017-05-06 16:44 +0200
    Re: excercise from Robert L, please comment Alex <alex@rivadpm.com> - 2017-05-06 19:55 +0100
      Re: excercise from Robert L, please comment Alex <alex@rivadpm.com> - 2017-05-06 20:26 +0100
        Re: excercise from Robert L, please comment Andreas Klimas <klimas@w3group.de> - 2017-05-07 23:08 +0200
    Re: excercise from Robert L, please comment Ron Aaron <rambamist@gmail.com> - 2017-05-07 07:46 +0300
      Re: excercise from Robert L, please comment Ron Aaron <rambamist@gmail.com> - 2017-05-07 07:54 +0300
    Re: excercise from Robert L, please comment hughaguilar96@gmail.com - 2017-05-07 09:15 -0700
  Re: excercise from Robert L, please comment humptydumpty <ouatubi@gmail.com> - 2017-05-08 11:00 -0700
  Re: excercise from Robert L, please comment humptydumpty <ouatubi@gmail.com> - 2017-05-08 11:52 -0700
    Re: excercise from Robert L, please comment "HAA" <someone@microsoft.com> - 2017-05-09 13:20 +1000
      Re: excercise from Robert L, please comment humptydumpty <ouatubi@gmail.com> - 2017-05-10 00:26 -0700
        Re: excercise from Robert L, please comment "HAA" <someone@microsoft.com> - 2017-05-11 17:07 +1000
          Re: excercise from Robert L, please comment humptydumpty <ouatubi@gmail.com> - 2017-05-11 00:25 -0700
  Re: excercise from Robert L, please comment Julian Fondren <julian.fondren@gmail.com> - 2017-05-08 21:40 -0700
    Re: excercise from Robert L, please comment Julian Fondren <julian.fondren@gmail.com> - 2017-05-08 21:46 -0700

csiph-web