TinyScheme

[JRS]

I think I figured out how to solve my problem. The optional 3rd parameter should be a SB pre-dimensioned string. If not passed, an internal buffer default of 16K will be used. This allows accessing the SB buffer variable in its raw or RTRIM() form.

Code: [Select]

a = STRING(5," ")
b = TS_Cmd(scm, "(+ 2 2)", a)

a = "4    "
b = "4"

[JRS]

My idea was dumb. 

It's still creating the 16K buffer no matter if I pass a SB string to use in its place. I'm leaving it the way it is. If I want a fast Mandelbrot iterator, I'll use my SDL gfx C version of it.

Use the right tool for the job.

The Script BASIC TinyScheme extension module source and examples can be found on the C BASIC Bitbucket site.

[RobbeK]

Hi John,

I'll try to make some time for it this week ,     

"Use the right tool for the job."   --  yep, if all you have is a hammer, everything looks like a nail ...     

The Scheme should  be there, to analyze complex structures, run binary trees , very high level abstractions etc ...


best , Rob

[JRS]

The Scheme should  be there, to analyze complex structures, run binary trees , very high level abstractions etc ...

Yeah, what you said.   

[JRS]

I was finally able to get the Windows 32 bit Script BASIC TinyScheme extension module working. I also had to use a different set of functions for RTRIM. LTRIM and TRIM. I will use these new functions in the Linux ext. modules as well. I'll get this up to the C BASIC Bitbucket site soon. My next adventure is added SDL_gfx as a foreign library function in TS. This will eliminate having to pass result strings back to SB to process.

Code: [Select]

' Character Mandelbrot

IMPORT ts.inc

sc = TS_New()
TS_Cmd sc, "(load \"init.scm\")"
mbrot = """
(newline)
(newline)
(display "Ascii Mandelbrot TinyScheme") (newline)
(display "---------------------------") (newline)

(define sq
   (lambda (x) (* x x)))

(define (1+ x) (+ x 1))
(define (1- x) (- x 1))

(define level
  (lambda (i x y rc ic it orb)
   (if (or (= i it) (> orb 4)) i
    (level (1+ i) (+ rc (- (sq x) (sq y))) (+ ic (* 2 x y)) rc ic it (+ (sq x) (sq y))))))

(define mlevel
   (lambda (L)
     (level 0 (cadr L) (car L) (cadr L) (car L) 11 0)))

(define (main)
   (let ((cnt 0) (lvl 0) (xo -1.7) (yo -2.3) (dz 0.1) )
     (do ((i 0 (1+ i)))
         ((= i 30))
        (do ((j 0 (1+ j)))
            ((= 30 j))
              (set! lvl (mlevel (list (+ xo (* i dz)) (+ yo (* j dz)) )))
              (if (< lvl 10)
                   (begin (display lvl) (display " "))
                   (display lvl))
              (set! cnt (1+ cnt))
              (when (= 30 cnt)
                 (set! cnt 0)
                 (newline))
))))
   
(main)
"""   
PRINT TS_Cmd(sc, mbrot),"\n"
TS_Close sc

Output


C:\SB22\TS>ptime scriba mbrot.sb

ptime 1.0 for Win32, Freeware - http://www.pc-tools.net/
Copyright(C) 2002, Jem Berkes <jberkes@pc-tools.net>

=== scriba mbrot.sb ===
Ascii Mandelbrot TinyScheme
---------------------------
1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2
1 1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2
1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3
1 1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3
1 1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3
1 1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3
1 1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4
1 1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4
1 1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4
1 1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4
1 1 1 1111111111111111111111111111111111111111111111117 5 4
1 1 1 1 4 4 6 6 7 1111111111111111111111111111111111118 5 4
1 1 1 1 4 4 4 5 5 6 8 11111111111111111111111111111111115 4
1 1 1 1 3 4 4 4 5 5 7 111111119 1111111111111111111111116 4
1 1 1 1 3 3 3 3 4 5 7 7 7 7 7 7 11111111111111111111119 5 4
1 1 1 1 2 3 3 3 3 3 4 5 5 5 5 6 8 111111111111111111117 5 3
1 1 1 1 2 3 3 3 3 3 3 3 4 4 5 5 6 11111111111111111111114 3
1 1 1 1 1 2 3 3 3 3 3 3 3 4 4 4 5 7 8 8 101111119 6 6 5 4 3
1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 8 1111116 5 5 4 3 3
1 1 1 1 1 1 2 3 3 3 3 3 3 3 3 4 4 4 4 5 6 9 118 5 4 4 3 3 3
1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 5 7 9 114 4 3 3 2 2
1 1 1 1 1 1 1 2 2 2 3 3 3 3 3 3 3 3 4 4 4 115 4 4 3 3 2 2 2
1 1 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2


Execution time: 1.027 s

C:\SB22\TS>

[JRS]

TinyScheme Windows 32 Download

Attached is the Script BASIC ts.dll TinyScheme extension module, libtinyscheme.dll library, scheme.exe console interpreter and a couple examples.

.

[JRS]

Rob,

Is there a way you could generate the pixel Mandelbrot points in a TinyScheme list with any delimiter your chose? I would then be able to SPLITA the string to a SB array and generate the Mandelbrot graphic in SDL_gfx.

FYI: I only need the top half of this. I'll memorize the bottom half in Script BASIC. (iterationless) 

Code: [Select]

' ScriptBasic GFX - Mandelbrot

IMPORT gfx.inc

s = gfx::Window(640,480,"ScriptBasic GFX Mandelbrot")
ts = gfx::Time()
FOR y = 0 TO 479
  FOR x = 0 TO 639
    cx = (x - 320) / 120
    cy = (y - 240) / 120
    rit = gfx::Mandelbrot(cx, cy, 510)
    gfx::PixelRGBA s, x, y, rit * 12, rit * 8, rit * 4, 255
  NEXT
NEXT
te = gfx::Time()
gfx::stringColor s, 20, 15, "Time: " & FORMAT("%.4f",(te-ts)/1000) & " Seconds." & CHR(0), 0x000000ff
gfx::Update
WHILE gfx::KeyName(1) <> "+escape"
WEND
gfx::Close

interface.c (SB GFX ext. module)

Code: [Select]

besFUNCTION(gfx_Mandelbrot)
  DIM AS double cx, cy, zx, zy, tp;
  DIM AS int iter;
  besARGUMENTS("rri")
    AT cx, AT cy, AT iter
  besARGEND
  DEF_WHILE (zx * zx + zy * zy < 4 AND iter > 0)
  BEGIN_WHILE
    tp = zx * zx - zy * zy + cx;
    zy = 2 * zx * zy + cy;
    zx = tp;
    iter = iter - 1;
  WEND
  besRETURN_LONG(iter);
besEND


Critical orbits of complex numbers

Graphically speaking, a function of the form f (x) = x2 + c (where c is a complex number) is a special function under iteration.  If you plot the results of the iterations (starting at x = 0) in the complex plane, you obtain what is called the critical orbits of c.  If these critical orbits repeat (where the same point in the complex plane repeats), the complex number is in the Mandelbrot set.  If the critical orbits simply move further and further away from the origin, the complex numbers are not in the Mandelbrot set.

[JRS]

If your running on Linux 64 bit, attached is your Script BASIC TinyScheme 64 bit treat.

.

[JRS]

I was able to get a MySQL extension module for TinyScheme working which is helpful for creating the SDL_gfx extension module. Attached is the TinyScheme MySQL library I built if you want to give it a try.

tsx_mysql(1) API Reference tsx_mysql(1)
NAME
 tsx_mysql.so <-> a mysql extension for tiny scheme
SYNOPSIS
 (load-extension "tsx_mysql")
 Load the MySQL extension into the tiny scheme environment.
 (mysql-connect hostname username password database)
 Connect to a MySQL database. This function takes four string
 arguments: hostname, username, password, database.
 (mysql-disconnect)
 Disconnect from a MySQL database.
 (mysql-query sql)
 Query a MySQL database. This function takes a string containing
 SQL statements. The query results will be returned as a list of
 strings.
 (mysql-error)
 Returns the current MySQL error string.
FILES
 tsx_mysql.so
AUTHOR
 A. Carl Douglas (carl.douglas@gmail.com)
tsx_mysql.so 11 July 2011 tsx_mysql(1)

jrs@laptop:~/tinyscheme/tinyscheme-1.41$ ./scheme
TinyScheme 1.41
ts> (load "init.scm")
Loading init.scm
#<EOF>
ts> (load-extension "tsx_mysql")

(display "Mysql extension test.")(newline)

(define queries (list
                  "SELECT VERSION(), CURRENT_DATE"
                  "SHOW DATABASES"
                  "SELECT  table_name, table_type, engine FROM information_schema.tables"))

(define run-query
  (lambda (sql)
    (let ((result (mysql-query sql)))
      (if result
        (display result)
        (display (mysql-error))))
    (newline)))

(if (mysql-connect "" "" "" "")
    (for-each run-query queries)
    (display (mysql-error)))

(mysql-disconnect)
(newline)
#t
ts> Mysql extension test.#t
ts>
#t
ts> queries
ts> run-query
ts> #((5.5.38-0ubuntu0.12.04.1 2014-08-31))
#((information_schema) (test))
#((CHARACTER_SETS SYSTEM VIEW MEMORY) (COLLATIONS SYSTEM VIEW MEMORY) (COLLATION_CHARACTER_SET_APPLICABILITY SYSTEM VIEW MEMORY) (COLUMNS SYSTEM VIEW MyISAM) (COLUMN_PRIVILEGES SYSTEM VIEW MEMORY) (ENGINES SYSTEM VIEW MEMORY) (EVENTS SYSTEM VIEW MyISAM) (FILES SYSTEM VIEW MEMORY) (GLOBAL_STATUS SYSTEM VIEW MEMORY) (GLOBAL_VARIABLES SYSTEM VIEW MEMORY) (KEY_COLUMN_USAGE SYSTEM VIEW MEMORY) (PARAMETERS SYSTEM VIEW MyISAM) (PARTITIONS SYSTEM VIEW MyISAM) (PLUGINS SYSTEM VIEW MyISAM) (PROCESSLIST SYSTEM VIEW MyISAM) (PROFILING SYSTEM VIEW MEMORY) (REFERENTIAL_CONSTRAINTS SYSTEM VIEW MEMORY) (ROUTINES SYSTEM VIEW MyISAM) (SCHEMATA SYSTEM VIEW MEMORY) (SCHEMA_PRIVILEGES SYSTEM VIEW MEMORY) (SESSION_STATUS SYSTEM VIEW MEMORY) (SESSION_VARIABLES SYSTEM VIEW MEMORY) (STATISTICS SYSTEM VIEW MEMORY) (TABLES SYSTEM VIEW MEMORY) (TABLESPACES SYSTEM VIEW MEMORY) (TABLE_CONSTRAINTS SYSTEM VIEW MEMORY) (TABLE_PRIVILEGES SYSTEM VIEW MEMORY) (TRIGGERS SYSTEM VIEW MyISAM) (USER_PRIVILEGES SYSTEM VIEW MEMORY) (VIEWS SYSTEM VIEW MyISAM) (INNODB_BUFFER_PAGE SYSTEM VIEW MEMORY) (INNODB_TRX SYSTEM VIEW MEMORY) (INNODB_BUFFER_POOL_STATS SYSTEM VIEW MEMORY) (INNODB_LOCK_WAITS SYSTEM VIEW MEMORY) (INNODB_CMPMEM SYSTEM VIEW MEMORY) (INNODB_CMP SYSTEM VIEW MEMORY) (INNODB_LOCKS SYSTEM VIEW MEMORY) (INNODB_CMPMEM_RESET SYSTEM VIEW MEMORY) (INNODB_CMP_RESET SYSTEM VIEW MEMORY) (INNODB_BUFFER_PAGE_LRU SYSTEM VIEW MEMORY))
(#t #t)
ts> #t
ts>
#t
ts>



.

[JRS]

I took a peek at the code for the MySQL extension module for TinyScheme and it is similar to the Script BASIC extension module API.

I would like to try the idea of creating pixel / position color value in a TS list and passing it to SB for processing as a first step.
 
@Rob - It doesn't seem that Lisp in BASIC has attracted much interest from anyone other than you and Mike. You have tons of Lisp options from interpreters to compilers to chose from so this reality isn't a surprise. I'm happy where things are currently with the SB TS ext. module (Linux & Windows) and I don't think putting more effort into it would do anything to make it more attractive to anyone other than you. I would be happy to try any suggestions you might have for the SB TS interface but Lisp isn't my main focus.

[JRS]

Rob,

I found a github repository for TinyScheme (fork) that has fixed some issues and included the RE (regular expression) and TSX (TinySchmeme Extensions) extension modules. I couldn't get RE to work so it isn't included in the attached zip. If you could give this a test, that would be great. The tinyscheme.exe was compiled with VS2008 (VC9) and the schme.exe and the libtinyscheme.dll were compiled with TDM-GCC-32. The Script BASIC TinyScheme extension module for Windows 32 seems to work fine with the new libtinyscheme.dll.

• based on TinyScheme 1.41
• build with MS Visual C++ on Windows
• continuations support without using 'SCHEME STACK' (#undef USE_SCHEME_STACK)
• embedding 'init.scm' into tinyscheme.exe (or tinyscheme.lib)
• fixed crash in GC after getting read-char 'EOF'
• implement 'string->uninterned-symbol' and 'gensym' gets new uninterned-symbol
• include TinyScheme Extensions (TSX)
• include TinyScheme RE extension

Code: [Select]

ts> (load-extension "tsx")
#t
ts> (time)
(114 8 1 17 59 44)
ts> (gettimeofday)
(1409619622 865397)
ts> (file-size "init.scm")
24511
ts> (system "ls -l init.scm")
-rw-rw-r-- 1 jrs jrs 24511 Sep  1 16:45 init.scm
0
ts>


TinyScheme Extensions (TSX) 1.1  [September, 2002]
(c) 2002 Manuel Heras-Gilsanz (manuel@heras-gilsanz.com)

This software is subject to the license terms contained in the
LICENSE file.


TSX FUNCTIONS

TSX incorporates the following functions:

*Sockets (included if HAVE_SOCKETS is defined in tsx.h)

(make-client-socket host port)
        host: string (IP address or host name)
        port: integer number

        Returns a socket which is already connected to the
        specified host and port, or #f if the connection could
        not be performed.

(make-server-socket port)
        port: integer number

        Returns a socket which is bound to the specified port on
        the local machine, and ready to accept connections. If the
        socket could not be created (e.g., because the port is
        already in use, or it is a privileged port and the user has
        no permissions on it), #f is returned.

(recv! sock buff)
        sock: socket obtained with make-client-socket or accept
        buff: string

        Waits for received data through the specified socket, and
        stores it on the buffer. The return value indicates the
        number of received bytes. This call blocks until some data
        is received, but does not guarantee that buff gets
        completely filled. If an error occurs (e.g., the other
        peer disconnects) then #f is returned.

(recv-new-string sock)
        sock: socket obtained with make-client-socket or accept

        Waits for received data through the specified socket, and
        returns it in a new string. This call blocks until some
        data is received. If an error occurs, then #f is returned.

(send sock buff)
        sock: socket obtained with make-client-socket or accept
        buff: string

        Sends the data contained in the string through the socket.
        It returns the number of transmitted bytes (could be
        different than the size of the string!), or #f if an error
        occured (e.g., the other peer disconnected).

(accept server-sock)
        server-sock: socket obtained with make-server-socket

        Waits until a connection is received on the specified
        server socket, and returns the connected socket. If an
        error occurs (e.g., the network interface shuts down), it
        returns #f instead.

(close-socket sock)
        sock: socket obtained with make-server-socket,
              make-client-socket or accept

   The socket is closed. No further calls should be performed
        on this socket.

(sock-is-data-ready? sock)
        sock: socket obtained with make-server-socket,
              make-client-socket or accept

   This function allows non-blocking operation with sockets.
   It returns #t if data is available for reception on this
   socket, and #f if no data has been received.

(sock-peek sock)
        sock: socket obtained with make-server-socket,
              make-client-socket or accept

   This function returns (as a newly created string) the
   data received in this socket. The information is not
   removed from the input queue.

*File system (included if HAVE_FILESYSTEM is defined in tsx.h)

Scheme already defines functions to read and write files. These
functions allow access to the filesystem to check if a certain
file exists, to get its size, etc.

(file-size filename)
        filename: string

        This function returns the size (in bytes) of the
        indicated file, or #f if the file does not exists or
        is not accessible to the requesting user.

(file-exists? filename)
        filename: string

        This function returns #t if the indicated file exists, and
        #f if it does not exists or it is not accessible to the
        requesting user.

(delete-file filename)
        filename: string

        Removes the specified file. It returns #t if the operation
        succeeds, or #f otherwise (e.g., because the file is
        read-only, or because the file does not exist).

(open-dir-stream path)
        path: string

        Opens a "directory stream" on the provided directory path.
        This stream will provide all the files within the directory,
        using the function read-dir-entry. The stream should be closed
        at the end with close-dir-stream.

(read-dir-entry dirstream)
        dirstream: directory stream, obtained with open-dir-stream.

        It returns the name of the following directory entry, or eof
        if all the entries were provided. Check the return value with
        with eof-object?.

(close-dir-stream dirstream)
        dirstream: directory stream, obtained with open-dir-stream.

        Close directory stream. No further calls to read-dir-entry should
        be performed.


*Time (available if HAVE_TIME is defined in tsx.h)

(time)
        Returns the current local time, as a list of integer
        containing:
          (year month day-of-month hour min sec millisec)
        The year is expressed as an offsett from 1900.

(gettimeofday)
        Returns a list containing the number of seconds from
        the beginning of the day, and microseconds within the
        current second.

(usleep microsec)
        microsec: integer

        Suspends execution of the calling thread during the
        specified number of microseconds.


*Miscellaneous functions (available if HAVE_MISC is defined)

(getenv varname)
        varname: string

        Returns a string with the content of the specified
        environment variable, or #f if the variable is not
        defined.

(system command)
        command: string

        Executes a command on the /bin/sh shell. Returns #f if
        it is unable to run /bin/sh or another error occurs,
        or an integer return code which is the value returned
        by the command to the shell.



.

[RobbeK]

Hi John,

I'll have a look at it probably tomorrow, have to finish a (small) job first ...


best Rob

[JRS]

Thanks Rob.

[RobbeK]

Hi John,

In the mean time -- from a few days ago , should work also in TinyScheme (with minor modifications) , code finds a number exact ! solutions of the Riemann Zeta function , it's based on recognizing number patterns.   ( I hope it's correct , otherwise I'll get a number of mathematicians against me     -- should be an excellent benchmark

--------------------------------------------

(define zeta (λ (lim n acc)
  (if (zero? lim) acc
      (zeta (- lim 1) n (+ acc (/ 1.0 (expt lim n)))))))


(define pi-list (λ  (n L)
  (if (zero? n) L
      (pi-list (- n 1) (cons (expt pi n) L)))))

(define almost (λ (x )
  (let (( tst (round x)))
    (if  (< (abs (- x tst)) 0.00001) (round x) 0)
  )))

(define not-zero? (λ (i max L)
  (if (or (= i (- max 1) ) (> (car L) 0)) (list i (car L))
      (not-zero? (+ i 1) max (cdr L)))))

(define iter
   (let (( piL (pi-list 20 '())) (res '()) (solution 0) )
    {λ  (start end)
      (if (= start end) (display "finished")
          (begin
            (let (( x (zeta 1000000 start 0 )))
      (set! res (map (lambda (y) (/ y x)) piL))
      (set! res (map almost res))
      (set! solution (not-zero? 0 (length res) res))
      (when (> (cadr solution) 0)
       (display "Zeta(")
       (display start) (display ") = expt pi ")
       (display (+ 1 (car solution)))
       (display " / ")
       (displayln (cadr solution)) ))
            (iter (+ 1 start) end  )))}))
         


(define   main  (λ ()
  (displayln "Zeta solutions")
  (displayln "--------------")
  (displayln " ")
  (iter 2 12)))

(main)

---------------- you will have to replace the λ  by lambda and define   (define (displayln s) (display s) (newline))

You can compare the speed with compiled (bytecode and GNU Lightning JIT) pro attachment

best Rob
(I wrote the code in a way it is compatible with BL too --   begin replaced with sequence and display to be replaced with print...
)

sorry , lisp ..  means big executables.....  pi should be defined in TS I think ?   

.

[JRS]

Rob,

Please post a version of this that runs on TinyScheme. I not a good enough Lisp programmer to understand your instructions.