add source from 2024.4 release

This commit is contained in:
crc 2024-05-23 20:02:11 +02:00
parent b0b315622c
commit c299bdac8c
2 changed files with 2725 additions and 1486 deletions

View file

@ -1,463 +0,0 @@
================================================================
,dPYb, ,dPYb,
IP'`Yb IP'`Yb
I8 8I gg I8 8I
I8 8bgg, "" I8 8'
I8 dP" "8 ,ggggg, ,ggg,,ggg, gg I8 dP ,ggggg,
I8d8bggP" dP" "Y8 ,8" "8P" "8, 88 I8dP dP" "Y8
I8P' "Yb, i8' ,8I d8 8I 8I 88 I8P i8' ,8I
,d8 `Yb,,d8, ,d8P8P 8I Yb,_,88,_,d8b,_ ,d8, ,d8'
88P Y8P"Y8888P" 8I `Y88P""Y88P'"Y88P"Y8888P"
================================================================
This file provides the high level extensions to the Konilo
system.
Stack comments are made by the `(` sigil. I define this first,
as they are useful to have.
~~~
&sigil:( #40 sigil:set
:) ;
~~~
Next is a `$` sigil, to return the character from a string. I'll
use this to setup other sigils without needing to hard code the
ASCII constants.
~~~
:sigil:$ #0 s:fetch process-data ;
&sigil:$ #36 sigil:set
~~~
For accessing variables, the `@` (fetch) and `!` (store) sigils
are defined.
~~~
:sigil:@
d:lookup d:address fetch
compiling? [ &internal:lit comma comma &fetch comma ]
&fetch choose ;
:sigil:!
d:lookup d:address fetch
compiling? [ &internal:lit comma comma &store comma ]
&store choose ;
&sigil:@ $@ sigil:set
&sigil:! $! sigil:set
~~~
The last sigil is `\`, which creates a header pointing to an
address. You can use this to name quotes:
[ ... ] \name
or to make an alias:
&drop \sigil:(
~~~
:sigil:\ d:create @Dictionary d:address store ;
&sigil:\ $\ sigil:set
~~~
I/O device 7 pushes the depth of the data and address stacks to
the data stack. (Excluding the pushed values). I define words to
access these should the need arise. (Mostly, I just use the
`depth/data` to make sure the data stack has the right number
of elements)
~~~
:depths (-nn) #7 io ; (data,_then_address_depth)
:depth/data (-n) depths drop ;
:depth/address (-n) depths nip ;
~~~
Scope words. I've used these for over a decade now. It lets me
hide factors from the main dictionary. This isn't realy crucial,
just a quality of life helper.
~~~
:{{ @Dictionary dup &sys:buffers/scope store-next store ;
:---reveal---
'_ d:create @Dictionary &sys:buffers/scope n:inc store ;
:}} &sys:buffers/scope fetch-next swap fetch d:link store ;
~~~
Variables. Ones made without an initial value are set to zero.
Use the & sigil when using them.
~~~
:var-n (ns-) d:create comma ;
:var (s-) d:create #0 comma ;
~~~
~~~
:rot (abc-bca) &swap dip swap ;
:n:between? (nlu-f) rot [ rot rot n:limit ] sip eq? ;
~~~
The words in `compile:` are intended to help in writing compiler
extensions for generating ilo code words. I use them to implement
`curry`, which binds a value and function together into a new
function.
E.g.,
#678 &n:put curry \display:678
~~~
:compile:lit (n-) #1 comma comma ;
:compile:call (a-) compile:lit #8 comma ;
:compile:jump (a-) compile:lit #7 comma ;
:curry (vq-q) here [ swap compile:lit compile:jump ] dip ;
~~~
Arrays are important, being the data structure used for strings
and a variety of other things. This is a very simple way to
create them.
~~~
:a:make (...n-a) here [ dup comma &comma times ] dip ;
:a:make/temp (...n-a) [ a:make a:temp ] gc ;
~~~
`a:reduce` will iterate over an array and value, applying a
function to reduce the array down to a single value. For instance,
to sum an array:
&array #0 &n:add a:reduce
~~~
:a:reduce (anq-n) &swap dip a:for-each ;
~~~
To map a function to each value in an array, I provide `a:map`.
This modifies the original array, not a copy of it.
~~~
:a:map (aq-a)
swap [ fetch-next [ [ fetch over call ] sip
&store sip n:inc ] times
drop-pair ] sip ;
&a:map \s:map
~~~
The next couple of words allow for extracting portions of an
array into a new array. The subsets will be stored in the
temporary buffers.
~~~
:a:middle (afl-a)
here [ dup comma [ n:inc n:add ] dip
here swap copy ] dip dup &Free store s:temp ;
:a:left (an-a) #0 swap a:middle ;
:a:right (an-a) over s:length over n:sub swap a:middle ;
&a:left \s:left (sn-s)
&a:right \s:right (sn-s)
&a:middle \s:middle (sfl-s)
~~~
Input tokens are whitespace delimited. This presents an issue
for strings: how to add spaces?
The solution used here is to replace (via `s:map`) underscores
with spaces. I've been doing this now for many years, and it's
not proven to be a problem. The `sigil:'` will use the latest
`s:rewrite` it can find, so you can redefine this to make other
changes if you need to.
~~~
:s:rewrite (s-) [ dup $_ eq? [ drop #32 ] if ] s:map ;
~~~
`a:indices` returns an array with the locations of a value that
matches the passed value. `a:index` returns the first location
that matches.
~~~
{{
'Count var
:prepare #0 &Count store ;
:reserve swap #0 comma ;
:patch here over n:sub n:dec over store ;
:cleanup dup s:temp swap &Free store ;
:record &Count fetch comma ;
:iterate [ (match? over eq? ) &record if
&Count v:inc ] a:for-each ;
---reveal---
:a:indices (av-a)
prepare here [ reserve iterate drop ] dip patch cleanup ;
}}
:a:index (av-n) [ a:indices #0 a:fetch ] gc ;
&a:index \s:index/c
~~~
`a:contains?` returns a flag indicating whether or not an array
contains a given value.
~~~
:a:contains? (an-f)
swap #0 swap [ swap [ over eq? ] dip or ] a:for-each nip ;
&a:contains? \s:contains? (sc-f)
~~~
`a:filter` runs a quote against each value in an array. The quote
needs to consume the value and return a single flag. If true, the
value is added to a new array.
~~~
:a:filter (aq-)
[ [ over &call dip swap &comma &drop choose ] curry
here [ over fetch comma a:for-each ] dip
here over n:sub n:dec over store a:temp ] gc ;
&a:filter \s:filter (sq-)
~~~
~~~
:c:lowercase? (c-f) $a $z n:between? ;
:c:uppercase? (c-f) $A $Z n:between? ;
:c:to-upper (c-c) dup c:lowercase? [ #32 n:sub ] if ;
:c:to-lower (c-c) dup c:uppercase? [ #32 n:add ] if ;
:c:to-s (c-s) '_ s:temp tuck #0 s:store ;
:s:to-upper (s-s) [ s:dup &c:to-upper s:map s:temp ] gc ;
:s:to-lower (s-s) [ s:dup &c:to-lower s:map s:temp ] gc ;
~~~
~~~
{{
'Current var
:get-index &sys:buffers/loops @Current n:add ;
:prepare &Current v:inc #0 get-index store ;
:cleanup &Current v:dec ;
:inner:indexed-times
swap [ dup &call dip (next get-index v:inc ) ] dip n:dec
tuck n:-zero? &inner:indexed-times ?jump drop-pair ;
---reveal---
:I (-n) get-index fetch ;
:J (-n) get-index #1 n:sub fetch ;
:K (-n) get-index #2 n:sub fetch ;
:indexed-times (nq-) prepare inner:indexed-times cleanup ;
}}
:bi (xqq-) &sip dip call ;
:bi* (xyqq-) &dip dip call ;
:bi@ (xyq-) dup bi* ;
:tri (xqqq-) [ &sip dip sip ] dip call ;
:tri* (xyzqqq-) [ [ swap &dip dip ] dip dip ] dip call ;
:tri@ (xyzq-) dup dup tri* ;
:a:eq? (aa-f) &a:hash bi@ eq? ;
&a:eq? \s:eq? (ss-f)
:a:-eq? (aa-a) a:eq? not ;
&a:-eq? \s:-eq? (ss-f)
:a:chop (a-a) a:temp &v:dec sip ;
&a:chop \s:chop (s-s)
:a:behead (a-a)
a:chop [ [ n:inc dup n:inc swap ]
&a:length bi copy ] sip ;
&a:behead \s:behead (s-s)
:a:first (a-n) #0 a:fetch ;
:a:last (a-n) dup a:length n:dec a:fetch ;
&a:first \s:first (s-c)
&a:last \s:last (s-c)
~~~
The `s:trim` words remove leading, or trailing (or both)
whitespace from a string. These aren't mirrored in the `a:`
namespace.
~~~
:s:trim-right (s-s)
s:temp [ dup v:dec [ s:last #32 lteq? ] sip swap ] while
dup v:inc ;
{{
'Start var
'End var
'Len var
:find-end dup s:length dup !Len over n:add n:inc !End n:inc ;
:new-size @Start over swap n:sub @Len swap n:sub ;
---reveal---
:s:trim-left (s-s)
s:dup dup #0 s:fetch #32 eq?
[ dup !Start find-end
[ fetch-next #32 -eq? over @End -eq? and ] while
new-size (patch over store ) ] if ;
}}
:s:trim (s-s) s:trim-left s:trim-right ;
~~~
`n:get` reads a number from the input device.
~~~
:n:get (-n) s:get/token s:temp s:to-n ;
~~~
================================================================
The block editor is an important piece of the Konilo system.
It's how code is entered, managed, and run.
~~~
:block:buffer (-a) &sys:buffers/block ;
#16 'Blocks var-n (number_of_blocks_available)
#0 'Block var-n (current_block_number)
~~~
~~~
:e:to-line (n-a) #64 n:mul block:buffer n:add ;
:e:line (n-) e:to-line #64 [ fetch-next c:put ] times drop nl ;
{{
:sep sp sp sp #6 [ '+----5---- s:put ] times '+--- s:put nl ;
:l/n I dup #10 lt? &sp if n:put sp ;
:line l/n I e:line ;
:lines #16 &line indexed-times ;
:info 'sys:info d:lookup dup n:-zero?
[ d:address fetch call ] &drop choose ;
---reveal---
:list* (-) nl #16 [ I e:line ] indexed-times ;
:list# (-) nl lines ;
:list (-) nl sep lines sep info ;
}}
&list 'e:Display var-n
{{
:reset #1024 block:buffer n:dec store ;
:constrain @Block #0 @Blocks n:dec n:limit !Block ;
---reveal---
:set (n-) !Block constrain ;
:save (-) @Block block:buffer block:save ;
:load (-) @Block block:buffer block:load reset ;
:next (-) &Block v:inc constrain load ;
:prev (-) &Block v:dec constrain load ;
:new (-) #32 block:buffer #1024 fill reset ;
:edit (n-) set load @e:Display call ;
:run (-) reset block:buffer n:dec s:evaluate ;
:use (block) set load run ;
:using (first,last) over n:sub swap use [ next run ] times ;
}}
{{
:handle dup #8 eq? over #127 eq? or
[ drop #-1 allot ] &comma choose ;
:process dup #10 eq? [ drop #-1 ] [ handle #0 ] choose ;
---reveal---
:s:get/line (-s)
here [ #0 comma [ c:get process ] until ] sip
here over n:sub n:dec over !Free swap store drop
here s:temp ;
}}
:e:erase/line (n-) e:to-line #32 swap #64 fill ;
:e:replace (sn-) n:inc swap e:to-line over n:dec s:length copy ;
:e:replace-at (snn-) [ &e:to-line dip n:add ] dip
[ over store n:inc ] s:for-each drop ;
:e:insert (n"-) dup e:erase/line s:get/line e:replace ;
:e:insert-at (nn"-) s:get/line e:replace-at ;
:0 ("-) #0 e:insert ; :1 ("-) #1 e:insert ;
:2 ("-) #2 e:insert ; :3 ("-) #3 e:insert ;
:4 ("-) #4 e:insert ; :5 ("-) #5 e:insert ;
:6 ("-) #6 e:insert ; :7 ("-) #7 e:insert ;
:8 ("-) #8 e:insert ; :9 ("-) #9 e:insert ;
:10 ("-) #10 e:insert ; :11 ("-) #11 e:insert ;
:12 ("-) #12 e:insert ; :13 ("-) #13 e:insert ;
:14 ("-) #14 e:insert ; :15 ("-) #15 e:insert ;
~~~
~~~
:. ("-) #62 [ c:get drop ] times ;
~~~
The basic `use` and `using` words aren't very convienient as you
need to keep track of the exact blocks to load. `needs` allows
you to use the first part of a block title line (typically a
comment for code blocks) instead. It'll scan through the block
set, running any blocks that match the provided text. E.g., to
load a block set named "(pali)":
'(pali) needs
Blocks are loaded in order from 0 to N, where N is the value in
`Blocks`. This can be very slow if you have a large block set or
are loading multiple sets of blocks. You may want to consider
keeping blocks towards the low end of the block set and limiting
`Blocks` before running this.
~~~
{{
'Len var
:buffer (-a) &sys:buffers/needs ;
:check (-f) block:buffer buffer @Len compare ;
:setup (s-) dup s:length !Len n:inc buffer @Len copy ;
---reveal---
:needs (s-)
setup @Block [
@Blocks [ I set load check &run if ] indexed-times
] dip !Block load ;
}}
~~~
For generating an index of the blocks, `titles` is provided.
This shows the block number and index line for any block with
a title line.
~~~
:titles (-)
@Block @Blocks
[ I set load block:buffer fetch #32 -eq?
[ I n:put sp #64 block:buffer n:dec &store &s:put bi nl ] if
] indexed-times !Block load ;
~~~
`sys:info` is called by the editor. It displays a status line below
the editor output. You can write a new `sys:info`, and the the code
will use the most recent one.
~~~
:sys:info (-)
'___B: s:put @Block n:put $/ c:put @Blocks n:dec n:put
'___S: s:put depth/data n:put $/ c:put #32 n:put
'___M: s:put here n:put $/ c:put #59999 n:put nl ;
~~~
================================================================
The last couple of things are just to save the image and set a
startup word. The default startup word runs the code in blocks
1 and 2, then starts the editor on block 0.
~~~
{{
:process (n-f) set load block:buffer fetch $( eq? &run if ;
---reveal---
:prelude (-) #1 process #2 process ;
:startup (-) prelude ;
}}
:rom:save (-) #4 io ;
rom:save bye
~~~

File diff suppressed because it is too large Load diff