Lisp in Basic

[RobbeK]

Mike,

neither (silent) nor (speak) / (talk) is standard  ..  (as many things in NewLisp -- it's Lisp , but it mixes some Common Lisp and Scheme --  and adds some things --  p.e.  (eval-string    )  is very interesting imho (for embedding p.e.)  ).

PicoLisp goes even further away from any standard .. Mr Alexander Burger calls next a gem  -- definition of (mutual?) recursion :

:

(de recur recurse
   (run (cdr recurse)) )

the "de" stands for define/defun


best Rob   

[Mike Lobanovsky]

John,

Thanks for the information. You may pass over my response to Mr Nunes-Harwitt in its verbatim form.

QUOTE

There is absolutely no functionality whatsoever implemented in this QB 4.5 code that would allow the *QB program stack* to be restored in case Lisp-in-Basic hits an error while one of its many recursive GoSub's is in deep recursion into itself, its siblings and children, and its parent such as LispPrint or especially LispEval into the bargain.

All that the HandleError: trap actually does is unwind the Lisp code pointer *bsd* to zero in order to preclude any further execution and then point the program flow into a new round of looping within the main program loop LispReadEvalPrintLoop:.

This policy simply ignores the fact that the *QB program stack* near exhausted by previous deep recursion is left absolutely unattended. *(gc)* has nothing to do with the unwinding of *QB program stack* and cannot cure the situation by definition.

QB 4.5 has no mechanisms to reset an exhausted program stack. Standalone or inlined assembly could have stored the initial state of program stack pointer and reset it to the thus stored value whenever a Lisp exception was raised while in deep recursion. But this couldn't be mimiced in QB 4.5 at the time. TurboBasic (may BZ rest in peace) could do it but not its QB counterpart.

That said, the *only* feasible way to resolve this stalemate in QB 4.5 is to set up a global exception flag in the error trap and make all the recursive GoSub's bail out of recursion early. They should be moving up and up the recursion levels clearing their stack frames in a natural manner until the very first nested recrsion level surfaces in the main program loop LispReadEvalPrintLoop: where the exception flag may be safely cleared.

This is exactly how the current SB/FBSL/O2 code behaves thus being incongruously more safe, stack-wise, than its early QB 4.5 prototype.

UNQUOTE


Now John, my nightly recursive GoSub nightmare has turned into a nightmare by day. Almost every other GoSub yet left in LispEval is not only self recursive but it also recurses into pieces of itself. The work is very meticulous and bug prone. So I'm going completely off the air until I'm through.



I hope you won't be feeling overly lonely while I'm away.

[Mike Lobanovsky]

OK then Rob,

What does standard Scheme do while a program is loading from a disk file?

I do not want to invent my own syntax and vocabulary at this stage. I want to be able to run standard Scheme program solutions e.g. such as those found in the Scheme category on the RosettaCode site.

Once this is done, we can continue to amuse ourselves with making our XBLisp better and/or more versatile than standard Scheme.

So how does Scheme behave when loading files? (I simply don't have time enough for personal exploration of unknown territories... )

[JRS]

I hope you won't be feeling overly lonely while I'm away.

I'll keep the light on while you're away. 

I will send your message to Arthur and CC you on the e-mail.

[RobbeK]

Hi Mike,

BigLoo Scheme and CL identical , just the definition names (attached  -- loaded what I posted here today  the pr.scm file ).
In case of an error, both will give more detail where it goes wrong.

.. and if I may , something the true Lisper (the religious type) may not tell you -- those variadic and typeless  - while fantastic and glorious abstractions - have a flip-side :::   speed.  (which is completely logical) 

I did a test now  (attached)
JuliaN  : highest compiler optim. ,   variadic and typeless
Julia    : turned off above  ...     this means I have to declare my variables and things like (+ a b c) do not work any more , it's just (+ a b)   .. finito.. 

best Rob
hoping you see any difference on a faster computer than mine  (that means probably almost every computer    )


 
 

.

[JRS]

@Rob

Why are those .exe files so large? Is there stored user data in those files?

Why is GCL / CL (common lisp) and the word HUGE synonymous while doing my discovery?

Back to SBLisp. Can this Ackermann Scheme example be convert to run in the home team Lisp? (SBLisp, FBLisp and maybe O2Lisp)

Code: [Select]

(define (A m n)
    (cond
        ((= m 0) (+ n 1))
        ((= n 0) (A (- m 1) 1))
        (else (A (- m 1) (A m (- n 1))))))


It may not be immediately obvious that the evaluation of A(m, n) always terminates. However, the recursion is bounded because in each recursive application either m decreases, or m remains the same and n decreases. Each time that n reaches zero, m decreases, so m eventually reaches zero as well. (Expressed more technically, in each case the pair (m, n) decreases in the lexicographic order on pairs, which is a well-ordering, just like the ordering of single non-negative integers; this means one cannot go down in the ordering infinitely many times in succession.) However, when m decreases there is no upper bound on how much n can increase — and it will often increase greatly.

Here is a C BASIC Ackermann example.

Code: [Select]

#include <stdio.h>
#include "cbasic.h"

FUNCTION int ackermann(int m, int n)
BEGIN_FUNCTION
  IF (NOT m) THEN_DO RETURN_FUNCTION(n + 1);
  IF (NOT n) THEN_DO RETURN_FUNCTION(ackermann(m - 1, 1));
  RETURN_FUNCTION(ackermann(m - 1, ackermann(m, n - 1)));
END_FUNCTION

MAIN
BEGIN_FUNCTION
  DIM AS int m, n;
  DEF_FOR (m = 0 TO m <= 4 STEP INCR m)
  BEGIN_FOR
    DEF_FOR (n = 0 TO n < 6 - m STEP INCR n)
    BEGIN_FOR
      PRINT ("A(%d, %d) = %d\n", m, n, ackermann(m, n));
    NEXT
  NEXT
  RETURN_FUNCTION(0);
END_FUNCTION

jrs@laptop:~/C_BASIC/sblisp$ time ./ackermann
A(0, 0) = 1
A(0, 1) = 2
A(0, 2) = 3
A(0, 3) = 4
A(0, 4) = 5
A(0, 5) = 6
A(1, 0) = 2
A(1, 1) = 3
A(1, 2) = 4
A(1, 3) = 5
A(1, 4) = 6
A(2, 0) = 3
A(2, 1) = 5
A(2, 2) = 7
A(2, 3) = 9
A(3, 0) = 5
A(3, 1) = 13
A(3, 2) = 29
A(4, 0) = 13
A(4, 1) = 65533

real   0m3.090s
user   0m3.084s
sys   0m0.000s
jrs@laptop:~/C_BASIC/sblisp$

Caching Hack

Code: [Select]

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
 
int m_bits, n_bits;
int *cache;
 
int ackermann(int m, int n)
{
        int idx, res;
        if (!m) return n + 1;
 
        if (n >= 1<<n_bits) {
                printf("%d, %d\n", m, n);
                idx = 0;
        } else {
                idx = (m << n_bits) + n;
                if (cache[idx]) return cache[idx];
        }
 
        if (!n) res = ackermann(m - 1, 1);
        else    res = ackermann(m - 1, ackermann(m, n - 1));
 
        if (idx) cache[idx] = res;
        return res;
}
int main()
{
        int m, n;
 
        m_bits = 3;
        n_bits = 20;  /* can save n values up to 2**20 - 1, that's 1 meg */
        cache = malloc(sizeof(int) * (1 << (m_bits + n_bits)));
        memset(cache, 0, sizeof(int) * (1 << (m_bits + n_bits)));
 
        for (m = 0; m <= 4; m++)
                for (n = 0; n < 6 - m; n++)
                        printf("A(%d, %d) = %d\n", m, n, ackermann(m, n));
 
        return 0;
}

jrs@laptop:~/C_BASIC/sblisp$ time ./anor
A(0, 0) = 1
A(0, 1) = 2
A(0, 2) = 3
A(0, 3) = 4
A(0, 4) = 5
A(0, 5) = 6
A(1, 0) = 2
A(1, 1) = 3
A(1, 2) = 4
A(1, 3) = 5
A(1, 4) = 6
A(2, 0) = 3
A(2, 1) = 5
A(2, 2) = 7
A(2, 3) = 9
A(3, 0) = 5
A(3, 1) = 13
A(3, 2) = 29
A(4, 0) = 13
A(4, 1) = 65533

real   0m0.035s
user   0m0.000s
sys   0m0.036s
jrs@laptop:~/C_BASIC/sblisp$
       

[JRS]

Charles,

I was trying to convert the caching hack version of the Ackermann example using your shifts() function. If I can get this to work I'll use the C extension module version of shifts() you wrote.

Code: [Select]

' Script BASIC Ackermann

function shifts(v,p,ar)
  local bp,ba,co,cq,bi,x,y,d
  bp=1
  x=0xffffffff and v
  for co=0 to 31
    ba[co]=0
  next
  for co=0 to 31
    bi=x and bp
    cq=co+p
    if (bi<>0) then
      if ((cq>=0)and(cq<32)) then
        ba[cq]=1
      end if
    end if
    bp = bp + bp
  next
  bp=1
  y=0
  '
  ' SUPPORT FOR ARITHMETIC RIGHT SHIFTS
  '
  d=100
  if (ar) then
    if (x and 0x80000000) then 
      d=31+p
    end if
  end if
  '
  for co=0 to 31
   if ((ba[co]<>0)or(co>=d)) then
      y=y or bp
    end if
    bp = bp + bp
  next
  shifts=y
end function


' PRINT shifts(0x80000000,2),"\n"
' PRINT shifts(-32,-2,1),"\n"
' PRINT shifts(8,-2),"\n"


FUNCTION ackermann(m, n)
  IF NOT m THEN ackermann = n + 1
  IF n >= shifts(1, -n_bits) THEN
    idx = 0
  ELSE
    idx = shifts(m, n_bits) + n
    IF cache[idx] THEN ackermann = cache[idx]
  END IF
  IF NOT n THEN
    res = ackermann(m - 1, 1)
  ELSE
    res = ackermann(m - 1, ackermann(m, n - 1))
  END IF
  IF cache[idx] = res THEN ackermann = res
END FUNCTION

m_bits = 3
n_bits = 20

SPLITA STRING(1048576,"") BY "" TO cache
FOR m = 0 TO 1
  FOR n = 0 TO 3 - m
    PRINT "A(",m," , ",n,") = ", ackermann(m, n),"\n"
  NEXT
NEXT


[Charles Pegge]

Hi John,

The non-recursive Ackermann seems an ugly beast. Is there any benefit in porting it?

Oxygen and Lispish Recursive: (untested!)

Code: [Select]

'http://en.wikipedia.org/wiki/Ackermann_function
'
function Ack(sys m,n) as sys
sys t
if m>0 then
  if n>0 then
    t=Ack(m,n-1)
    return Ack(m-1,t) 
  else
    return Ack(m-1,1)
  end if
else
  return n+1
end if
end function

/*

( let ack " m n
  (if (> m 0 )
    (if (> n 0)
      (eval
        (decr m)
        (decr n)
        (let t (ack n 1))
        (ack m t)
      )
      ;else n=0
      (eval
        (decr m)
        (ack m 1)
      )
    )
    ;else m=0
    (+ n 1)
  ) ;end if m>0
")

*/


[JRS]

The non-recursive Ackermann seems an ugly beast. Is there any benefit in porting it?

It seems fast but not sure about the results.  Thanks Charles for the help & code!

FYI   Ack(4,1) gives me a seg. fault.

Code: [Select]

' Ackermann

FUNCTION Ack(m, n)
  IF m > 0 THEN
    IF n > 0 THEN
      t = Ack(m, n - 1)
      Ack = Ack(m - 1, t)
    ELSE
      Ack = Ack(m - 1, 1)
    END IF
  ELSE
    Ack = n + 1
  END IF
END FUNCTION

FOR m = 0 TO 3
  FOR n = 0 TO 3
    PRINT "A(",m,",",n,") = ",Ack(m, n),"\n"
  NEXT
NEXT

jrs@laptop:~/sb/sb22/sblisp$ time scriba ack.sb
A(0,0) = 1
A(0,1) = 2
A(0,2) = 3
A(0,3) = 4
A(1,0) = 2
A(1,1) = 3
A(1,2) = 4
A(1,3) = 5
A(2,0) = 3
A(2,1) = 5
A(2,2) = 7
A(2,3) = 9
A(3,0) = 5
A(3,1) = 13
A(3,2) = 29
A(3,3) = 61

real   0m0.013s
user   0m0.012s
sys   0m0.004s
jrs@laptop:~/sb/sb22/sblisp$

[Mike Lobanovsky]

Hi John,

I can soothe you a little. An attempt to calc (4,1) on any indie interpreter, BASIC or otherwise, will lead to a memory access exception (segfault in Linux lingo) due to the interpreter's process stack exhaustion caused by very deep recursion. The same happens also in FBSL, for that matter. This isn't a specific deficiency in SB but rather a common mischief. One will have to recompile one's interpreter with much larger settings of stack reserve and stack commit options in one's compiler/linker than their usual default values. Interpreters are too stack hungry for their own personal needs.

Secondly, both of your programs are recursive. There's no difference in their Ackermann algo implementation. The only difference between them is a cache used in the native C program to store intermediate calculation results. Each recursion will not go any deeper if the cache already contains the results calculated earlier for particular combinations of m and n values. Avoiding re-recursion would speed up the program significantly. You can see it in your own benchmarks. But this isn't an algorithmic solution, that's simply a hack.

Finally, here's my XBLisp solution using Rob's iterators. It is perhaps clumsy and naive but it calcs up to (3, 2) = 29 in less than a second. An attempt to calc (4,1) will lead to an Out of memory exception in about 15 minutes:

Code: [Select]

;;; Rob's macros

(define make-listx
     (lambda (i x L)
      (if (= i x) L
          (make-listx (+ i 1) x (cons i L)))))

(define range
  (lambda (x)
    (reverse (make-listx 0 x '() ))))

(define iterate
  (lambda (op it)
    (map (eval op) (range it))
  T ))



;;; ======= My LISP program ======

;; Define iterators
(define m 0)
(define n 0)

;; John's recursive Ackermann algo redefined
(define A
  (lambda (x y)
    (cond
      ((= x 0) (+ y 1))
      ((= y 0) (A (- x 1) 1))
      (else
        (A (- x 1) (A x (- y 1)))
      )
    )
  )
)

;; My Ackermann call
(define Ackermann
  (lambda ()
    (print '"A(") (print m)
      (print '", ") (print n)
        (print '") = ") (print (A m n))
    (newline)
    (set! n (+ n 1))
  )
)

(define for-inner
  (lambda ()
    (set! n 0)
    (iterate 'ackermann (- 6 m))
    (set! m (+ m 1))
  )
)

(define for-outer
  (lambda ()
    (iterate 'for-inner 4)
  )
)

(define main
  (lambda ()
    (iterate 'newline 10)
    (print  '========================== ) (newline)
    (print '"My First XBLisp Program :)") (newline)
    (print  '========================== ) (newline) (newline)
    (for-outer)
  )
)

(main)
(quit)

;;; ==== THAT'S ALL FOLKS! ====


Enjoy!

.

[Charles Pegge]

Ackermann 4,1 also exhausts the stack on o2 code!

[JRS]

Damn you're good!

Thanks for the explanation about common stack exhaustion.

Did you know that SB allows GOSUB/GOTO within a FUNCTION/SUB? I know this isn't going to help in the final C based implementation but is a way I could get SBLisp into a MODULE and call it from BASIC.

[Mike Lobanovsky]

Hi Charles,

It may be an FB problem, not yours.

[Mike Lobanovsky]

Isn't it a bit extravagant to meet a person with the word "damn"? But "you're good" sure sweetens the pill!

Yes John, I'm aware of that and in fact, the old version of SBLisp that's currently in the repo contains a lot of such GoSub's left in SUB LispEval(). I'm still fighting to remove them completely and ensure rock solid bailout of recursion in XBLisp error cases.

[JRS]

Code: [Select]

jrs@laptop:~/sb/sb22/sblisp$ time scriba lisp.sb ackermann.scm
SBLisp - Scheme BASIC Lisp

(define make-listx
     (lambda (i x L)
      (if (= i x) L
          (make-listx (+ i 1) x (cons i L)))))
MAKE-LISTX
(define range
  (lambda (x)
    (reverse (make-listx 0 x '() ))))
RANGE
(define iterate
  (lambda (op it)
    (map (eval op) (range it))
  T ))
ITERATE
(define m 0)
M
(define n 0)
N
(define A
  (lambda (x y)
    (cond
      ((= x 0) (+ y 1))
      ((= y 0) (A (- x 1) 1))
      (else
        (A (- x 1) (A x (- y 1)))
      )
    )
  )
)
A
(define Ackermann
  (lambda ()
    (print '"A(") (print m)
      (print '", ") (print n)
        (print '") = ") (print (A m n))
    (newline)
    (set! n (+ n 1))
  )
)
ACKERMANN
(define for-inner
  (lambda ()
    (set! n 0)
    (iterate 'ackermann (- 6 m))
    (set! m (+ m 1))
  )
)
FOR-INNER
(define for-outer
  (lambda ()
    (iterate 'for-inner 4)
  )
)
FOR-OUTER
(define main
  (lambda ()
    (iterate 'newline 4)
    (print  '=================== ) (newline)
    (print  '"Ackermann - SBLisp") (newline)
    (print  '=================== ) (newline) (newline)
    (for-outer)
  )
)
MAIN
(main)




===================
ACKERMANN - SBLISP
===================

A(0, 0) = 1
A(0, 1) = 2
A(0, 2) = 3
A(0, 3) = 4
A(0, 4) = 5
A(0, 5) = 6
A(1, 0) = 2
A(1, 1) = 3
A(1, 2) = 4
A(1, 3) = 5
A(1, 4) = 6
A(2, 0) = 3
A(2, 1) = 5
A(2, 2) = 7
A(2, 3) = 9
A(3, 0) = 5
A(3, 1) = 13
A(3, 2) = 29
T
(quit)

real 0m1.133s
user 0m1.116s
sys 0m0.012s
jrs@laptop:~/sb/sb22/sblisp$

Thank You  !!!