File: takl.sc

package info (click to toggle)
stalin 0.11-6
  • links: PTS
  • area: main
  • in suites: bullseye, buster, stretch
  • size: 110,396 kB
  • ctags: 163,122
  • sloc: ansic: 1,757,574; lisp: 88,332; sh: 1,514; makefile: 229; sed: 100; csh: 30
file content (37 lines) | stat: -rw-r--r-- 1,229 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File:         takl.sc
;;; Description:  TAKL benchmark from the Gabriel tests
;;; Author:       Richard Gabriel
;;; Created:      12-Apr-85
;;; Modified:     12-Apr-85 10:07:00 (Bob Shaw)
;;;               22-Jul-87 (Will Clinger)
;;;               21-Mar-94 (Qobi)
;;;               31-Mar-98 (Qobi)
;;; Language:     Scheme
;;; Status:       Public Domain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; TAKL -- The TAKeuchi function using lists as counters.

(define (listn n)
 (if (not (= 0 n))			;Qobi: avoid temptation to optimize
     (cons n (listn (- n 1)))		;Qobi: avoid temptation to optimize
     '()))				;Qobi

(define *18l* (listn 18))		;Qobi
(define *12l* (listn 12))		;Qobi
(define  *6l* (listn 6))		;Qobi

(define (mas x y z)
 (if (not (shorterp y x))
     z
     (mas (mas (cdr x) y z) (mas (cdr y) z x) (mas (cdr z) x y))))

(define (shorterp x y)
 (and (not (null? y))			;Qobi: used to depend on () being false
      (or (null? x) (shorterp (cdr x) (cdr y)))))

;;; note: The LISTN is not done multiple times.
(do ((i 0 (+ i 1))) ((= i 1000))
 (write (mas *18l* *12l* *6l*))
 (newline))