Learn Try Scheme - nomssi/abap_scheme GitHub Wiki

Code from various sources that works directly with the interpreter:

Data Types

Boolean

The standard objects are

    #f for false
    #t for true

but in logical expressions (if, cond, and, or, when, unless, do), all values except #f are treated as true.

Symbols

A symbol is like an ABAP global field-symbols of type ANY

    (define pi 3.1415926535897932384626433832795)
    ;; alternative definition of pi: (define pi (* 4 (atan 1)))

    (define a 1)
    (define b 2)

Evaluate a symbol

 a
 => 1
 x
 => Eval: Symbol x is unbound

There are fewer restrictions on a symbol's name

(define ! not)
=> !
(! #f)
=> #t

; multiple dots as an identifier
(define ... "three dots")
=> ...
...
=> "three dots"

Assignment

    (define game-over #f)
    (set! game-over #t)

Characters and Strings

A single character can be specified as

#\a

A string is a group of characters enclosed in double quotation marks.

    ;; valid string: "I am a string"
    (display "Hello World")
    => Hello World

Numbers

Numerical Types

Numbers are arranged into a tower of subtypes in which each level is a subset of the level above it:

  • number
  • complex number 0+4i, 20.0-0.0i with a real part and an imaginary part, where i is the square root of -1.
  • real number 3.141492, -1.344e+23, #inf.0, +nan.0 1.6f0
  • rational number 4/5, -1/3, 0.25, 1/1
  • integer 1, 1.0, 1e10 For example, 3 is an integer. Therefore 3 is also a rational, a real, and a complex number.
Exactness

Scheme number is exact if it was written as an exact constant or was derived from exact numbers using only exact operations. A number is inexact if it was written as an inexact constant, if it was derived using inexact ingredients, or if it was derived using inexact operations. Thus inexactness is a contagious property of a number. An exact complex number has an exact real part and an exact imaginary part; all other complex numbers are inexact complex numbers.

Syntax of numerical constants

Note that case is not signi cant in numerical constants. A number can be written in binary, octal, decimal, or hexadecimal by the use of a radix pre fix. The radix prefi xes are #b (binary), #o (octal), #d (decimal), and #x (hexadecimal). With no radix prefi x, a number is assumed to be expressed in decimal.

A numerical constant can be specifi ed to be either exact by prefix #e or to be inexact by prefix #i. An exactness prefi x can appear before or after any radix prefi x that is used. If the written representation of a number has no exactness pre fix, the constant is inexact if it contains a decimal point or an exponent. Otherwise, it is exact.

The exponent marker is e, but can be replaced by s, f, d or l (short, single, double, long) for compatibility with other Schemes, although the indicated precision is not used.

Numerical Operations

LISP uses prefix notation. The ABAP expression a * ( b + c ) / d will be written as (/ (* a (+ b c) ) d)

(+ 1 2)
=> 3
(+ 1 'foo)
=> Eval: foo is not a number in [+]

; Rational  
(+ 2/5 10/6)
=> 31/15

; infix notation is (60 * 9 / 5) + 32
(+ (* (/ 9 5) 60) 32)
=> 140

; infix 2 * cos( 0 ) * ( 4 + 6 )
(* 2 (cos 0) (+ 4 6))
=> 20

(+ 3 (* 4 5))
=> 23

List

; assumes we have defined a and b as symbols above
(list a b)
=> ( 1 2 )

Examples from the Racket Guide:

    (length (list "hop" "skip" "jump"))        ; count the elements
    ==> 3

    (list-ref (list "hop" "skip" "jump") 0)    ; extract by position. Index starts with 0
    ==> "hop"

    (list-ref (list "hop" "skip" "jump") 1)
    ==> "skip"

    (append (list "hop" "skip") (list "jump")) ; combine lists
    ==> ("hop" "skip" "jump")

    (reverse (list "hop" "skip" "jump"))       ; reverse order
    ==> '("jump" "skip" "hop")

    (member "fall" (list "hop" "skip" "jump")) ; check for an element
    ==> #f

Circular List

    (define c '(1 2 3 4))
    => c
    (set-cdr! (cddr c) c)
    => '()
    c
    => #0 = ( 1 2 3 . #0# )

Vector

(vector 'a 'b)
=> #( a b )

lambda / function definition

;; Functions
;; (define (function_name arguments)
;;           ... function body ... )
;; ... body ... )
(define (f n)
          (+ n 10) )
=> f 
(f 5)
=> 15 

;; the quote function - the argument is NOT evaluated
;; it is kept as a LIST of argument
(quote (+ 3 (* 4 5)) )
=> (+ 3 (* 4 5))

;; the single quotation mark = quote function
'(+ 3 (* 4 5))
 => (+ 3 (* 4 5))

Syntax Special Forms

and begin case cond define do if else lambda let let* letrec or quote set!

Predicates

Functions that return #t or #f. The convention is to use ? as the last character in the name, e.g.

; atom?
(define (atom? x)
    (not (or (pair? x) (null? x) (vector? x))))

Comparison

(define x 3)
=> x
;; x greater or equal to 5?
(<= 5 x )
=> #f
;; x less or equal to 16?
(<= x 16 )
=> #t
;; x between 2 and 16 ?
(<= 2 x 16 )
=> #t
;; alternative
(and (<= 2 x ) (<= x 16))

Locals

(let (declarations)
 ... body.. )

surround the entire list of declarations with matching parentheses or brackets

Variables

(let ((a 5)
      (b 6))
  (+ a b))
=> 11

(let ((x 5))
    (let ((x 2)
          (y x))
      (list y x)))
=> ( 5 2 )

Nested declarations with dependencies

(let ((x 2))
 (let ((x 3) (y x))
  y))
=> 2

let* binds in sequence, referencing previously bound local variables

(let ((x 2))
 (let* ((x 3) (y x))
  y))
=> 3

(let* ((a 5)
       (b (+ a 2)))
  b)
=> 7

Conversion Celsius -> Fahrenheit

;; https://see.stanford.edu/materials/icsppcs107/30-Scheme-Functions.pdf
;; Function: celsius->fahrenheit
;; -----------------------------
;; Simple conversion function to bring a Celsius
;; degree amount into Fahrenheit.
;;
(define (celsius->fahrenheit celsius)
(+ (* 1.8 celsius) 32))

Lap year check

;; https://see.stanford.edu/materials/icsppcs107/30-Scheme-Functions.pdf
;; Predicate function: _leap-year?_
;; ------------------------------
;; Illustrates the use of the 'or, 'and, and 'not special forms. The question mark after the
;; function name isn't required, it's just customary to include a question mark at the end 
;; of a function that returns a true or false.
;;
;; A year is a leap year if it's divisible by 400, or if it's divisible by 4 but not by 100.
;;
(define (leap-year? year)
(or (and (zero? (remainder year 4))
(not (zero? (remainder year 100))))
(zero? (remainder year 400))))

Absolute value

;; abs
(define (abs x)
        ( (if (< x 0)
              -
              + ) x ))

Static Scoping

(define x 1)
(define (f x) (g 2))
(define (g y) (+ x y))
(f 5)
=> 3 ; not 7

Factorial

(define (factorial n)
  (if (zero? n)
    1
    (* n (factorial (- n 1)))))

or

(define factorial
  (lambda (n)
    (if (= n 0)
        1
        (* n (factorial (- n 1))))))

or

(define (factorial n)
  (apply * (iota n 1)))

Square

;; Square
(define (square x) (* x x)) 
(square 11)
=> 121

Average

;; Average
(define (average x y)
  (/ (+ x y) 2))
(average 23 35)
=> 29

Internal definitions

(let ((x 5)) 
  (define foo (lambda (y) (bar x y)))
  (define bar (lambda (a b) (+ (* a b) a)))
   (foo (+ x 3)))
=> 45

Reverse List

;; reverse list
(define reverse
  (lambda (ls)
    (let rev ((ls ls) (new '()))
      (if (null? ls)
          new
          (rev (cdr ls) (cons (car ls) new))))))

Flatten

(define (atom? x) (not (or (pair? x) (null? x) (vector? x))))
(define (flatten x)  
  (letrec    
    ((f (lambda (x r)
           (cond ((null? x) r)
                    ((atom? x) (cons x r))
                    (else (f (car x)  
                             (f (cdr x) r)))))))    
    (f x ())))


(flatten '((a) (b (c)) (d (e (f)))))
=> ( a b c d e f )

Sample Code

FizzBuzz

  (define nums (iota 100 1))
  
  (define transformed
    (map (lambda (n)
          (cond ((= (remainder n 15) 0) "FizzBuzz")
                ((= (remainder n 5) 0) "Buzz")
                ((= (remainder n 3) 0) "Fizz")
                (else n)))
        nums))
  
  (for-each (lambda (n) (display n) (newline))
            transformed)

Primes

;
; primes
; By Ozan Yigit
;
(define  (interval-list m n)
  (if (> m n)
      '()
      (cons m (interval-list (+ 1 m) n))))

(define (sieve l)
  (define (remove-multiples n l)
   (if (null? l)
      '()
     (if  (= (modulo (car l) n) 0)      ; division test
         (remove-multiples n (cdr l))
         (cons (car l)
            (remove-multiples n (cdr l))))))

   (if (null? l)
      '()
      (cons (car l)
    (sieve (remove-multiples (car l) (cdr l))))))

(define (primes<= n)
  (sieve (interval-list 2 n)))

Now execute (primes<= 300)

Numerical Approximation

;; Square Root
;; https://mitpress.mit.edu/sicp/chapter1/node9.html
(define (sqrt x)
  (sqrt-iter 1.0 x))
(define (sqrt-iter guess x)
  (if (good-enough? guess x)
      guess
      (sqrt-iter (improve guess x) x)))
(define (good-enough? guess x)
  (< (abs (- (square guess) x)) 0.001))
(define (improve guess x)
  (average guess (/ x guess)))

Roots of a Quadratic Polynomial

 (define (quadratic-formula a b c)
;; find the roots x of a quadratic equation a x**2 + b * x + c = 0
     (let ([minusb (- 0 b)]
           [radical (sqrt (- (* b b) (* 4 (* a c))))]
           [divisor (* 2 a)])
       (let ([root1 (/ (+ minusb radical) divisor)]
             [root2 (/ (- minusb radical) divisor)])
; create a pair with both solutions
         (cons root1 root2))))

now test

(quadratic-formula 2 -4 -6)
=> ( 3 . -1 )

if you have been using the sqrt approximation above, you will get something like

=> ( 3.001286994470244717463540664936568 . -1.001286994470244717463540664936566 )

instead.

Guess my Number

;----------------------------------------------------------
;; guess my number between 1 and 100
 
(define *big* 100)
(define *small* 1)
 
(define (guess) (round (/ (+ *big* *small*) 2)) )
(define (larger) (set! *small* (+ 1 (guess))) (guess))
(define (smaller) (set! *big* (- (guess) 1)) (guess))
 
(define (restart) (set! *big* 100) (set! *small* 1) (guess))

; my number is 16 - the logic needs 7 steps
(restart)   ; 51
(smaller) ; 26
(smaller) ; 13
(larger)  ; 20
(smaller) ; 17
(smaller) ; 15
(larger)  ; 16

;--------- now your number
(restart) ; 51

Sample IO

IO test © 1996 by A. Aaby

The purpose of the following function is to help balance a checkbook. The function prompts the user for an initial balance. Then it enters the loop in which it requests a number from the user, subtracts it from the current balance, and keeps track of the new balance. Deposits are entered by inputting a negative number. Entering zero (0) causes the procedure to terminate and print the final balance.

(define checkbook (lambda ()

; This check book balancing program was written to illustrate
; i/o in Scheme. It uses the purely functional part of Scheme.

        ; These definitions are local to checkbook
        (letrec

            ; These strings are used as prompts

          ((IB "Enter initial balance: ")
            (AT "Enter transaction (- for withdrawal): ")
            (FB "Your final balance is: ")

            ; This function displays a prompt then returns a value read.

            (prompt-read (lambda (Prompt)

                  (display Prompt)
                  (read)))


            ; This function recursively computes the new balance given 
            ; an initial balance init and a new value t. 
            ; Termination occurs when the new value is 0.

            (newbal (lambda (Init t)
                  (if (= t 0)
                      (list FB Init)
                      (transaction (+ Init t)))))

            ; This function prompts for and reads the next
            ; transaction and passes the information to newbal
 
            (transaction (lambda (Init)
                      (newbal Init (prompt-read AT)))))

; This is the body of checkbook;  it prompts for the starting balance

  (transaction (prompt-read IB)))))

Now call (checkbook)

Self replicating program

A Quine

((lambda (x)
   (list x (list (quote quote) x)))
   (quote (lambda (x)
           (list x (list (quote quote) x)))))

String Matcher

;; http://www.brics.dk/RS/03/20/BRICS-RS-03-20.pdf
;; A staged quadratic-time string matcher
(define (main pattern text)
(match pattern text 0 0))
(define (match pattern text j k)
(if (= (string-length pattern) j)
    (- k j)
    (if (= (string-length text) k)
        -1
        (compare pattern text j k))))

;; Backtracking also using one character of negative information
(define (compare pattern text j k)
  (if (equal? (string-ref text k)
              (string-ref pattern j))
      (match pattern text (+ j 1) (+ k 1))
      (let ([s (rematch-neg pattern j)])
         (if (= s -1)
            (match pattern text 0 (+ k 1))
            (compare pattern text s k)))))

(define (rematch-neg pattern i)
  (if (= i 0)
  -1
  (let ([j (rematch pattern i)])
    (if (equal? (string-ref pattern j)
                (string-ref pattern i))
        (rematch-neg pattern j)
        j))))

;    (define (compare pattern text j k)
;    (if (equal? (string-ref pattern j) (string-ref text k))
;        (match pattern text (+ j 1) (+ k 1))
;        (let ([s (rematch pattern j)])
;            (if (= s -1)
;                (match pattern text 0 (+ k 1))
;                (compare pattern text s k)))))

;; Compositional backtracking suitable for fast partial evaluation
(define (rematch pattern i)
(if (= i 0)
    -1
    (letrec ([try-subproblem
        (lambda (j)
            (if (= j -1)
                0
            (if (equal? (string-ref pattern j)
                        (string-ref pattern (- i 1)))
                (+ j 1)
                (try-subproblem (rematch pattern j)))))])
        (try-subproblem (rematch pattern (- i 1))))))

More Examples from https://github.com/hmgle/yascm

More Sample Code

Scheme Sorting Examples

https://cs.gmu.edu/~white/CS363/Scheme/SchemeSamples.html

Scheme Test Suite

https://github.com/hmgle/yascm/blob/master/tests/tests.scm