Lisp in Basic

[Mike Lobanovsky]

If I wasn't a software developer, I would be a click & touch person as well.

Wait wait...

Would you elaborate a little more on the logical accents implicit in that quotation of yours, sir?

Should I understand it such that since I am a click & touch person, I can not be regarded as a software developer? Should I go now from where I don't belong quietly closing the door behind me so as not to distract you from your creative thought processes, John?

Or does my English just slip me here and I'm seeing things that aren't there?

[Mike Lobanovsky]

Thanks again, Rob, for your clarifications and the abundance of visuals to satisfy my poor unenlightened click & touch lamer soul...

[JRS]

We all have our own way of defining comfortable.

I use the same OS's and tools everyone else uses with varying levels of success and desire to continue along certain paths. The computing industry is too unstable right now to be circling wagons looking for protection and relief.

 

[Ed Davis]

Hehe, can we write a console Tetris or Space Invaders in this XBlisp thingy and (re)register at that retro-BASIC serpentarium on account of the underlying BASIC?

Don't forget console Star Trek there is even a Lisp version!
http://www.dunnington.u-net.com/public/startrek/
http://www.takeoka.org/~take/trek/trek-man-e.html

(links provided by one of the retro-BASIC serpentarium's)

(who also freely admits to preferring the command line on Windows/Linux and before that on VMS/MVS/CMS)   

[JRS]

Another round of code restructuring, combining and dead code removal. Before any more of this is attempted, a clear understanding of why changing what is remaining in GOSUB form could be better optimized in another other form.

Current source is on Bitbucket.

Visual changes:

• When an expression returns a false, it now prints a F rather than ().
  
• SBLisp will return to the console prompt after a (quit) without saying Bye!.
  
• The code is now more readable and a foundation for better error reporting in place.

It seems to be working. PLEASE TEST !!!

[Mike Lobanovsky]

http://www.takeoka.org/~take/trek/trek-man-e.html
(... preferring the command line on Windows ...)

Hi Ed,

Thanks for the links!

Once our XPLisp is capable of running this ASCII art LISP Star Treck code, I'll consider my LISP mission complete. I also promise to present you with a Gold Edition Console Special then.

PLEASE TEST !!!

Hi John,

PLEASE HELP !!! all ye who enter here. (c)

Would you accept help from humble point & click lamer nobodies trespassing the sacred lands of Holy Mother Console and Divine Almighty Terminal?

[JRS]

Would you accept help from humble point & click lamer nobodies trespassing the sacred lands of Holy Mother Console and Divine Allmighty Terminal?

You did send that check or is the mail just a little slow? 

[Mike Lobanovsky]

Is F compliant with LISP syntax?

(Just downloaded. Need time to test.)

[JRS]

Is F compliant with LISP syntax?

That's how it works if CL and ECL.

Scheme vs. Common Lisp

initdr.scm

Code: [Select]

; initdr.scm              Gordon S. Novak Jr.               31 Aug 00

; Definitions to add to Dr. Scheme: add the following to your file:
; (load "initdr.scm")

(define pi 3.1415926535)
(define (1+ n) (+ n 1))
(define (1- n) (- n 1))

; While-Do macro: (while c s1 ... sn)
; Example:  (let ((n 0)) (while (< n 3) (write n) (newline) (set! n (1+ n))))
(define-macro while (lambda (c . s)
  (list 'do '() (list (list 'not c)) (cons 'begin s))))

; dotimes as in Common Lisp
; Example: (dotimes (j 3) (write j) (newline))
(define-macro dotimes (lambda (args . s)
  (let ((maxvar (gensym 'dotimes-count)))
    (list 'do
          (list (list (car args) 0 (list '+ 1 (car args)))
                (list maxvar (cadr args)))
          (list (list '>= (car args) maxvar)
                (if (null? (cddr args)) #f (caddr args)))
          (cons 'begin s)) ) ))

; dolist as in Common Lisp
(define-macro dolist (lambda (args . s)
  (let ((lstvar (gensym 'dolist-ptr)))
    (list 'do
          (list (list lstvar (cadr args) (list 'cdr lstvar))
                (list (car args) #f) )
          (list (list 'null? lstvar)
                (if (null? (cddr args)) #f (caddr args)))
          (cons 'begin (cons (list 'set! (car args) (list 'car lstvar))
                             s)) ) )))

; Versions of standard Lisp functions in Scheme

(define (copy-list l)
  (if (pair? l)
      (cons (car l) (copy-list (cdr l)))
      l))

(define (copy-tree x)
  (if (pair? x)
      (cons (copy-tree (car x))
            (copy-tree (cdr x)))
      x))

; Simple subst similar to copy-tree
(define (subst new old tree)
  (if (pair? tree)
      (cons (subst new old (car tree))
            (subst new old (cdr tree)))
      (if (eqv? old tree)
          new
          tree)))

; More efficient subst
(define (subst new old tree)
  (if (pair? tree)
      (let ((left (subst new old (car tree)))
            (right (subst new old (cdr tree))))
        (if (and (eq? left (car tree))
                 (eq? right (cdr tree)))
            tree
            (cons left right)))
      (if (eqv? old tree)
          new
          tree)))

; Simple sublis similar to copy-tree
(define (sublis alist tree)
  (if (pair? tree)
      (cons (sublis alist (car tree))
            (sublis alist (cdr tree)))
      (if (assv tree alist)
          (cdr (assv tree alist))
          tree)))

; More efficient sublis
(define (sublis alist tree)
  (if (pair? tree)
      (let ((left (sublis alist (car tree)))
            (right (sublis alist (cdr tree))))
        (if (and (eq? left (car tree))
                 (eq? right (cdr tree)))
            tree
            (cons left right)))
      (let ((new (assv tree alist)))
        (if new
            (cdr new)
            tree) ) ) )

(define (intersection x y)
  (if (pair? x)
      (if (memv (car x) y)
          (cons (car x) (intersection (cdr x) y))
          (intersection (cdr x) y))
      '()))

(define (union x y)
  (if (pair? x)
      (if (memv (car x) y)
          (union (cdr x) y)
          (cons (car x) (union (cdr x) y)))
      y))

(define (set-difference x y)
  (if (pair? x)
      (if (memv (car x) y)
          (set-difference (cdr x) y)
          (cons (car x) (set-difference (cdr x) y)))
      '()))

(define (subset pred lst)
  (if (pair? lst)
      (if (pred (car lst))
  (cons (car lst)
(subset pred (cdr lst)))
  (subset pred (cdr lst)))
      '() ) )

(define (subset? x l)
  (if (pair? x)
      (and (memv (car x) l)
   (subset? (cdr x) l))
      (null? x)) )

(define (every pred lst)
  (if (pair? lst)
      (if (pred (car lst))
  (every pred (cdr lst))
  #f)
      #t) )

(define (some pred lst)
  (if (pair? lst)
      (or (pred (car lst))
  (some pred (cdr lst)))
      #f))

(define (nconc x y)
  (define (nconc2 x y)
    (if (pair? (cdr x))
        (nconc2 (cdr x) y)
        (set-cdr! x y)))
  (if (pair? x)
      (begin (nconc2 x y) x)
      y) )

(define (nreverse x)
  (let ((last '()) (tmp '()))
    (while (pair? x)
      (set! tmp (cdr x))
      (set-cdr! x last)
      (set! last x)
      (set! x tmp))
    last))

; Time the execution of the specified form.
(define-macro time (lambda (form)
  (let ((var (gensym 'time-var)))
    (list 'let (list (list var '(current-seconds)))
  form
  (list '- '(current-seconds) var)) )))

; Convert a floating-point number to a string of sign and at most 4 characters.
; Rounds the number so that 1.999 will come out as 2.00 , very small as 0.0 .
; numstring is written assuming that num is not too large or too small,
; i.e. num must be printable in 4 digits.
(define (numstring num)
  (let* ((numc (abs num)) (sign (if (< num 0) -1 1)) (exponent 0))
    (if (< numc 1.0e-6)
"0.0"
(begin
  (if (< numc 1.0)
      (begin (while (< numc 100)
    (set! numc (* numc 10))
    (set! exponent (1- exponent)))
     (set! numc (* (round numc) (expt 10 exponent))) )
      (set! numc (* numc 1.0001)))
  (if (< sign 0)
      (string-append "-"
     (substring (number->string numc) 0
       (min 4 (string-length (number->string numc)))))
      (substring (number->string numc) 0
(min 4 (string-length (number->string numc))))) ) ) ))

; additions thanks to Michael Bogomolny:
(define (test-expression expr)
  (display "> ") (write expr) (newline)
  (write (eval expr)) (newline) (newline) 'ok)

(define (turnin lst)
  (if (null? lst)
      'done
      (begin
         (test-expression (car lst))
         (turnin (cdr lst)))))

(define some? some)
(define every? every)
(print-vector-length #f)

(require-library "trace.ss")

; was drgraphics.scm       Gordon S. Novak Jr.              24 Aug 00

; Some graphics routines for DrScheme:

; The following is for DrScheme version 102:
(require-library "graphics.ss" "graphics")

; These routines are compatible with MacGambit and use the
; following conventions:
;    (0,0) is at the center of the window
;    +y is upward.
; You can change the size of the drawing window by changing
; the parameters *hsize* and *vsize* below before starting.

; Thanks to Dustin Friesenhahn for adding color.

; (clear-graphics)           ; erase the drawing window
; (position-pen x y)         ; move the pen to (x,y) without drawing
; (draw-line-to x y)         ; draw from current pen position to (x,y)
; (graphics-text string x y) ; draw the string in the window at (x,y)
;    e.g. (graphics-text "Hi, Mom!" 0 0)

; DrScheme specific function
; (graphics-string-size str) ; returns list (width height) of str
;                            ; in integer units of pixels

(define *hsize* 409)         ; horizontal size of drawing viewport
(define *vsize* 428)         ; vertical size of drawing viewport
(define *xoffset* 200)       ; x offset of coordinates
(define *yoffset* 200)       ; y offset of coordinates
(define *vp* #f)             ; viewport
(define *lastpt* #f)         ; last point
(define *color* (make-rgb 0 0 0))  ; init to black

; Use the viewport *vp* or open one if needed
(define (viewport)
  (or *vp*
      (begin
(open-graphics)
(set! *vp* (open-viewport "CS 307" *hsize* *vsize*))
(clear-graphics)
*vp*)))

(define (clear-graphics)
  ((clear-viewport (viewport)))
   (position-pen 0 0) )

; fix a number to be an exact integer
(define (fix x)
  (if (and (integer? x)
   (exact? x))
      x
      (if (exact? x)
  (round x)
  (inexact->exact (round x)))))

; convert from upward y to downward y as used by DrScheme
; MacGambit uses center of window as (0,0)
(define (yconvert y) (fix (- *yoffset* y)))
(define (xconvert x) (fix (+ *xoffset* x)))

; position the pen to specified point
(define (position-pen x y)
  (or *vp* (viewport))
  (set! *lastpt* (make-posn (xconvert x) (yconvert y))))

; draw a line from last point to specified point
(define (draw-line-to x y)
  (let ((newpt (make-posn (xconvert x) (yconvert y))))
    (begin
      ((draw-line (viewport)) *lastpt* newpt *color*)
      (set! *lastpt* newpt))))

; draw a string beginning at specified (x, y)
(define (graphics-text string x y)
  ((draw-string (viewport))
     (make-posn (xconvert x) (yconvert y))
     string *color*))

; DrScheme specific graphics-string-size
; returns list (width height) of a string in pixels
; Michael Bogomolny - spring 2001
(define (graphics-string-size str)
  (let ((temp ((get-string-size (viewport)) str)))
    (list (fix (car temp))
          (fix (cadr temp)))))

; set color to be used in drawing
; Each color value must be between 0 and 1.
(define (set-color! red green blue)
  (if (and (number? red) (>= red 0) (<= red 1)
   (number? green) (>= green 0) (<= green 1)
   (number? blue) (>= blue 0) (<= blue 1))
      (set! *color* (make-rgb red green blue)) ) )


[JRS]

(Just downloaded. Need time to test.)

Thank You !

[Mike Lobanovsky]

Seems running just fine here. No mem leaks or uptime regression detected.

BTW sblisp.exe in the repo seems not updated -- still prints Bye!.

Thanks for good work, John!

[JRS]

BTW sblisp.exe in the repo seems not updated -- still prints Bye!.

Code: [Select]

jrs@laptop:~/sb/sb22/sblisp$ cd ~/repos/sblisp
jrs@laptop:~/repos/sblisp$ git add SBLisp_exe.zip
jrs@laptop:~/repos/sblisp$ git commit -m "Updaded Windows 32 standalone SBLisp.exe"
[master bc32b87] Updaded Windows 32 standalone SBLisp.exe
 1 file changed, 0 insertions(+), 0 deletions(-)
 rewrite SBLisp_exe.zip (96%)
jrs@laptop:~/repos/sblisp$ git push
Password for 'https://ScriptBasic@bitbucket.org':
To https://ScriptBasic@bitbucket.org/ScriptBasic/sblisp.git
   619c627..bc32b87  master -> master
jrs@laptop:~/repos/sblisp$



.

[Mike Lobanovsky]

Thanks for the update, John.

Seems like we are having a little uptime regression here. SB's (fibonacci 20) now runs some 11.7 seconds against 10.7 seconds for the former pre-Sub versions. Perhaps that will be the penalty for better structured code.

I haven't yet updated FBLisp with your Subs. I'll see if my uptime increases too as soon as I do. I'll inform you here when I'm through.

Go have a rest.

[JRS]

Go have a rest.

Just trying to find Scheme examples that work to post. I hope others do the same.

[Mike Lobanovsky]

John,

I think I should put OxyLISP aside for the time being. It still takes too much of my effort. I'd rather spend more time on trying to enrich the structure and vocabulary of the two versions that are currently functioning. What do you think?

hope others do the same.

Others are enjoying Sunday morning while someone else is still stuck in Saturday night.