<commit_before>; minimal set of Scheme (with Ol subset)
(define-library (scheme core)
   (version 2.0)
   (license MIT/LGPL3)
   (keywords (scheme core ol))
   (description "
      Core Otus-Lisp Scheme library.")

   (import
      (src vm) ;; Codes and primitives of the Otus Lisp Virtual Machine that
               ;;  do not need to be exported by libraries.
               ;
               ; object creation/modification:
               ;   vm:new vm:make vm:makeb vm:cast
               ;   cons car cdr ref type size set-ref set-ref! eq? less?
               ; basic math primitives:
               ;   integer:
               ;     vm:add vm:sub vm:mul vm:div vm:shr vm:shl
               ;   floating-point (if built with OLVM_INEXACTS)
               ;     vm:fp1 (xFE: fsin, xFF: fcos),
               ;     vm:fp2 (xD9: <, xC1: +, xE9: -, xC9: *, xF9: /)
               ;   binary:
               ;     vm:and vm:or vm:xor
               ; special:
               ;   vm:pin, vm:unpin, vm:deref
               ;   clock, syscall
               ; vm info:
               ;   vm:version vm:maxvalue vm:valuewidth vm:features
               ; associative arrays support:
               ;   ff:red ff:black ff:toggle ff:red? ff:right?
               ; execution flow:
               ;   ff-apply tuple-apply
               ;
               ; exported functions:
               ;   apply apply/cc arity-error
               ;   call-with-current-continuation
               ;
               ;; special forms: (declared in lang/env.scm)
               ;
               ; quote values lambda setq
               ; letq ifeq either values-apply
               ;

      (scheme srfi-16)   ; case-lambda
      (scheme srfi-87)   ; <= in cases
      (scheme srfi-71))  ; (let* ((a b (values..

   ; -----------------------------------------------------------------
   ; internal staff
   (begin
      ; internal: (-1 obj), (+1 obj)
      ; note: todo: add theoretically impossible case:
      ;       (if carry (runtime-error "Too long list to fit in fixnum"))

      (setq |-1| (lambda (n) ; * internal
         (values-apply (vm:sub n 1) (lambda (n carry) n))))
      (setq |+1| (lambda (n) ; * internal
         (values-apply (vm:add n 1) (lambda (n carry) n))))
      (setq |0.0| (vm:fp2 #xC9 42 0)) ; * internal

      ; * ol specific: (runtime-error reason info)
      (setq runtime-error (lambda (reason info)
         (call-with-current-continuation (lambda (resume) (vm:sys resume 5 reason info)))))

      ; * temporary, allows basic assert implementation
      (setq equal? (lambda (a b)
         (ifeq a b #true #false)))

      ; * internal automation testing staff
      ; note: please be careful!
      ;       this is simplified 'assert' that uses 'eq?' before real 'equal?' be implemented in chapter 6
      (define-syntax assert
         (syntax-rules (===>)
            ((assert expression ===> expectation)
               (ifeq (equal? ((lambda (x) x) expression) (quote expectation)) #true
                  #true
                  (runtime-error "assertion error:" (cons (quote expression) (cons "must be" (cons (quote expectation) #null))))))))
   )

   ; =================================================================
   ; Scheme
   ;
   ; Revised(7) Report on the Algorithmic Language Scheme
   ;                  Dedicated to the Memory of ALGOL 60
   ;
   (begin

      ; =================================================================
      ; Programming languages should be designed not by piling feature on
      ; top of feature, but by removing the weaknesses and restrictions
      ; that make additional features appear necessary. Scheme demonstrates
      ; that a very small number of rules for forming expressions, with no
      ; restrictions on how they are composed, suffice to form a practical
      ; and efficient programming language that is flexible enough to support
      ; most of the major programming paradigms in use today.
      ;
      ;
      ;                      DESCRIPTION OF THE LANGUAGE
      ;
      ;;; ---------------------------------------------------------------
      ;;; Chapter 1
      ;;; Overview of Scheme

      ; 1.1  Semantics
      ;
      ; Scheme is a statically scoped programming language. Each
      ; use of a variable is associated with a lexically apparent
      ; binding of that variable.
      ;
      ; Scheme is a dynamically typed language. Types are asso-
      ; ciated with values (also called objects) rather than with
      ; variables. Statically typed languages, by contrast, asso-
      ; ciate types with variables and expressions as well as with
      ; values.
      ;
      ; Scheme has latent ..................
      ; ......

      ; 1.2  Syntax
      ;
      ; Scheme, like most dialects of Lisp, employs .....
      ; ......

      ; 1.3  Notation and terminology
      ;
      ; 1.3.1  Primitive, library, and optional features
      ;
      ; It is required that every implementation of Scheme support
      ; all features that are not marked as being optional. ......
      ; ...

      ; 1.3.2  Error situations and unspecified behavior
      ;
      ; When speaking of an error situation, this report .......
      ; ....

      ; 4.3.3. Signaling errors in macro transformers
      ;
      (define-syntax syntax-error
         (syntax-rules (runtime-error)
            ((syntax-error . staff)
               (runtime-error "syntax error: " (quote staff)))))

      ; * ol specific
      (setq error runtime-error) ; [yc] is it required?

      ; * ol some warnings
      (setq error:please-import-langintern (lambda ()
         (runtime-error "Please, import (lang intern) to get the function.")))

      ; 1.3.3  Entry format
      ;
      ; Chapters 4 and 6 are organized into entries. Each ....
      ; ........

      ; 1.3.4  Evaluation examples
      ;
      ; The symbol "==>" used in program examples should be
      ; read "evaluates to." ...
      ; ....

      ; 1.3.5  Naming conventions
      ;
      ; By convention, the names of procedures that always return
      ; a boolean value usually end in “?”. Such procedures are
      ; called predicates.
      ;
      ; By convention, the names of procedures that store values
      ; into previously allocated locations (see section 3.4) usually
      ; end in "!". Such procedures are called mutation procedures.
      ; By convention, the value returned by a mutation
      ; procedure is unspecified.
      ;
      ; By convention, "->"" appears within the names of procedures
      ; that take an object of one type and return an analogous
      ; object of another type. For example, list->vector
      ; takes a list and returns a vector whose elements are the
      ; same as those of the list.


      ;;; ---------------------------------------------------------------
      ;;; Chapter 2
      ;;; Lexical conventions
      ;
      ; This section gives an informal account of some of the lexical
      ; conventions used in writing Scheme programs. For a formal
      ; syntax of Scheme, see section 7.1.
      ;
      ; 2.1  Identifiers
      ;
      ; Most identifiers allowed by other .......
      ; ....
      ;
      ; Here are some examples of identifiers:
      ;
      ; lambda        q
      ; list->vector  soup
      ; +             V17a
      ; <=?           a34kTMNs
      ; the-word-recursion-has-many-meanings
      ;
      ; All implementations of Scheme must support the following
      ; extended identifier characters:
      ;
      ; ! $ % & * + - . / : < = > ? @ ^ _ ~
      ;
      ; Alternatively, an identifier can be represented by a se-
      ; quence of zero or more characters enclosed within vertical
      ; lines (|), analogous to string literals.
      ;
      ; ...................................

      ; 2.2  Whitespace and comments
      ;
      ; Whitespace characters are spaces and newlines. .........
      ; ..........

      ; 2.3  Other notations
      ;
      ; For a description of ........
      ; ..........


      ;;; ---------------------------------------------------------------
      ;;; Chapter 3
      ;;; Basic concepts

      ; 3.1  Variables, syntactic keywords, and regions
      ;
      ; An identifier may name a type of syntax, or ...
      ; ..

      ; 3.2  Disjointness of types
      ;
      ; No object satisfies more than one ...
      ; ..

      ; 3.3  External representations
      ;
      ; An important concept in Scheme (and Lisp) is that ...
      ; ..

      ; 3.4  Storage model
      ; Variables and objects such as pairs, vectors, and ...
      ; .........

      ; 3.5  Proper tail recursion
      ; Implementations of Scheme are required to be ...
      ; ...............


      ;;; ---------------------------------------------------------------
      ;;; Chapter 4
      ;;; Expressions
      ;
      ; Expression types are categorized as primitive or derived.
      ; Primitive expression types include variables and procedure
      ; calls. Derived expression types are not semantically primitive,
      ; but can instead be defined as macros. With the exception
      ; of quasiquote, whose macro definition is complex,
      ; the derived expressions are classified as library features.
      ; Suitable definitions are given in section 7.3.

      ; 4.1  Primitive expression types

      ; 4.1.1  Variable references
      ;
      ; syntax:  <variable>
      ;
      ; An expression consisting of a variable (section 3.1) is a
      ; variable reference. The value of the variable reference is
      ; the value stored in the location to which the variable is
      ; bound. It is an error to reference an unbound variable.

      ; 4.1.2  Literal expressions
      ;
      ; syntax:  quote <datum>                * builtin
      ; syntax:  '<datum>                     * builtin
      ; syntax:  <constant>                   * builtin

      ; 4.1.3  Procedure calls
      ;
      ; syntax:  (<operator> <operand1> ...)  * builtin

      ; 4.1.4  Procedures
      ;
      ; syntax:  (lambda <formals> <body>)    * builtin

      (define-syntax λ                  ; * ol specific
         (syntax-rules ()
            ((λ . x) (lambda . x))))

      ;(assert ((lambda x x) 3 4 5 6)                  ===>  (3 4 5 6))
      ;(assert ((lambda (x y . z) z) 3 4 5 6)          ===>  (5 6))

      ; 4.1.5  Conditionals
      ;
      ; syntax:  if <test> <consequent> <alternate>
      ; syntax:  if <test> <consequent>
      (define-syntax if
         (syntax-rules (not eq? null? empty? zero?)
            ((if val       then)      (if val then #false))
            ((if (not val) then else) (if val else then))
            ((if (eq? a b) then else) (ifeq a b then else))
            ((if (null? t) then else) (if (eq? t #null) then else))  ; boot image size and compilation speed optimization
            ((if (a . b)   then else) (letq (x) ((a . b)) (if x then else)))
            ((if #true     then else)  then)
            ((if #false    then else)  else)
            ((if t         then else) (ifeq t #false else then))))

      (assert (if (less? 2 3) 'yes 'no)               ===>  yes)
      (assert (if (less? 3 2) 'yes 'no)               ===>  no)

      ; syntax:  unless <test> <consequent> <alternate> * ol specific
      ; syntax:  unless <test> <consequent> * ol specific
      (define-syntax unless
         (syntax-rules ()
            ((unless val then)      (if val #false then))
            ((unless val then else) (if val else then))))

      (assert (unless (less? 2 3) 'yes 'no)               ===>  no)
      (assert (unless (less? 3 2) 'yes 'no)               ===>  yes)

      ; 4.1.6  Assignments
      ;
      ; syntax: set! <variable> <expression>  * not supported
      (setq set! (lambda (variable expression)
         (runtime-error "No set! is allowed." "(sometimes you can use set-ref!, check the docs.)")))

      ; 4.2  Derived expression types
      ;
      ; The constructs in this section are hygienic, as discussed
      ; in section 4.3. For reference purposes, section 7.3 gives
      ; macro definitions that will convert most of the constructs
      ; described in this section into the primitive constructs de-
      ; scribed in the previous section.

      ; 4.2.1  Conditionals
      ;
      ; library syntax:  (cond <clause1> <clause2> ...)
      (define-syntax cond
         (syntax-rules (else =>)
            ((cond) #false)
            ((cond (else exp . rest))
               ((lambda () exp . rest)))        ; (begin ...)
            ((cond (clause => exp) . rest)
               ((lambda (fresh)
                  (if fresh
                     (exp fresh)
                     (cond . rest)))  clause))
            ((cond (clause exp . rest-exps) . rest)
               (if clause
                  ((lambda () exp . rest-exps)) ; (begin ...)
                  (cond . rest)))))

      (assert (cond ((less? 2 3) 'greater)
                    ((less? 3 2) 'less))                  ===>  greater)
      (assert (cond ((less? 3 3) 'greater)
                    ((less? 3 3) 'less)
                    (else 'equal))                        ===>  equal)
      (assert (cond ((car (cdr '((a 1) (b 2)))) => car)
                    (else #f))                            ===>  b)

      ; library syntax:  (case <key> <clause1> <clause2> ...)
      (define-syntax case
         (syntax-rules (else eqv? memv =>)
            ((case (op . args) . clauses)
               ((lambda (fresh) ; let ((fresh (op.args)))
                  (case fresh . clauses)) (op . args)))
            ((case thing) #false)
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing ((a) => exp) . clauses)
               (if (eqv? thing (quote a))
                  (exp thing)
                  (case thing . clauses)))
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing ((a ...) => exp) . clauses)
               (if (memv thing (quote (a ...)))
                  (exp thing)
                  (case thing . clauses)))
            ((case thing ((a) . body) . clauses)
               (if (eqv? thing (quote a))
                  ((lambda () . body)) ; means (begin . body)
                  (case thing . clauses)))
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing (else => func))
               (func thing))
            ((case thing (else . body))
               ((lambda () . body)))   ; means (begin . body)
            ((case thing ((a . b) . body) . clauses)
               (if (memv thing (quote (a . b)))
                  ((lambda () . body)) ; means (begin . body)
                  (case thing . clauses)))
            ((case thing (atom . then) . clauses) ;; added for (case (type foo) (type-foo thenfoo) (type-bar thenbar) ...)
               (if (eq? thing atom)
                  ((lambda () . then)) ; means (begin . body)
                  (case thing . clauses)))))

      ; library syntax:  (and <test1> ...)
      (define-syntax and
         (syntax-rules ()
            ((and) #true)
            ((and a) a)
            ((and a . b)
               (if a (and . b) #false))))

      (assert (and (eq? 2 2) (less? 1 2))                 ===> #true)
      (assert (and (eq? 2 2) (less? 2 1))                 ===> #false)
      (assert (and 1 2 '(f g) 'c)                         ===> c)
      (assert (and)                                       ===> #true)

      ; library syntax:  (or <test1> ...)
      (define-syntax or
         (syntax-rules ()
            ((or) #false)
            ((or (a . b) . c) ; additional optimization
               ((lambda (x) (or x . c))  (a . b)))
            ((or a) a)
            ((or a . b)
               (if a a (or . b)))))

      (assert (or (eq? 2 2) (less? 1 2))                  ===> #true)
      (assert (or (eq? 2 2) (less? 2 1))                  ===> #true)
      (assert (or #f #f #f)                               ===> #false)
      (assert (or #f 'c #f)                               ===> c)

      ; 4.2.2  Binding constructs
      ;
      ; The three binding constructs let, let*, and letrec give
      ; Scheme a block structure, like Algol 60. The syntax of the
      ; three constructs is identical, but they differ in the regions
      ; they establish for their variable bindings. In a let ex-
      ; pression, the initial values are computed before any of the
      ; variables become bound; in a let* expression, the bind-
      ; ings and evaluations are performed sequentially; while in a
      ; letrec expression, all the bindings are in effect while their
      ; initial values are being computed, thus allowing mutually
      ; recursive definitions.

      ; library syntax:  (letrec <bindings> <body>)
      (define-syntax letrec
         (syntax-rules ()
            ((letrec ((?var ?val) ...) ?body) (letq (?var ...) (?val ...) ?body))
            ((letrec vars body ...) (letrec vars (begin body ...)))))

      ; library syntax:  (letrec* ...) - r7rs
      ;(define-syntax letrec*
      ;   (syntax-rules ()
      ;      ((letrec () . body)
      ;         (begin . body))
      ;      ((letrec* ((var val) . rest) . body)
      ;         (letrec ((var val))
      ;            (letrec* rest . body)))))

      ; library syntax:  (let <bindings> <body>)
      ;                  (let keyword <bindings> <body>) named let, from 4.2.4 Iteration
      (define-syntax let
         (syntax-rules ()
            ((let ((var val) ...) exp . rest)
               ((lambda (var ...) exp . rest) val ...))
               ;why not (letq (var ...) (val ...) exp . rest)) ???
            ((let keyword ((var init) ...) exp . rest)
               (letrec ((keyword (lambda (var ...) exp . rest))) (keyword init ...)))))

      ; library syntax:  (let* <bindings> <body>)
      (define-syntax let*
         (syntax-rules (<=)
            ((let* (((var ...) gen) . rest) . body)
               (values-apply gen (lambda (var ...) (let* rest . body))))
            ((let* ((var val) . rest-bindings) exp . rest-exps)
               ((lambda (var) (let* rest-bindings exp . rest-exps)) val))
            ; http://srfi.schemers.org/srfi-71/srfi-71.html
            ((let* ((var ... (op . args)) . rest-bindings) exp . rest-exps)
               (values-apply (op . args)
                  (lambda (var ...)
                     (let* rest-bindings exp . rest-exps))))
            ((let* ((var ... node) . rest-bindings) exp . rest-exps)
               (tuple-apply node
                  (lambda (var ...)
                     (let* rest-bindings exp . rest-exps))))
            ((let* (((name ...) <= value) . rest) . code)
               (tuple-apply value
                  (lambda (name ...)
                     (let* rest . code))))
            ((let* ()) exp)
            ((let* () exp . rest)
               ((lambda () exp . rest)))))

      ; lets === let*, TEMP!
      (define-syntax lets
         (syntax-rules ()
            ((lets . stuff) (let* . stuff))))

      ; 4.2.3  Sequencing
      ;
      ; library syntax:  (begin <expression1> <expression2> ...)
      (define-syntax begin
         (syntax-rules (define letrec define-values let*-values letrec) ; todo: rename define-values to define*
            ((begin exp) exp)
            ((begin (define . a) (define . b) ... . rest)
               (begin 42 () (define . a) (define . b) ... . rest))
            ((begin (define-values (val ...) . body) . rest)
               (let*-values (((val ...) (begin . body))) . rest))
            ((begin 42 done (define ((op . args1) . args2) . body) . rest)
               (begin 42 done (define (op . args1) (lambda args2 . body)) . rest))
            ((begin 42 done (define (var . args) . body) . rest)
               (begin 42 done (define var (lambda args . body)) . rest))
            ((begin 42 done (define var exp1 exp2 . expn) . rest)
               (begin 42 done (define var (begin exp1 exp2 . expn)) . rest))
            ((begin 42 done (define var val) . rest)
               (begin 42 ((var val) . done) . rest))
            ((begin 42 done . exps)
               (begin 43 done () exps))
            ((begin 43 (a . b) c exps)
               (begin 43 b (a . c) exps))
            ((begin 43 () bindings exps)
               (letrec bindings (begin . exps)))
            ((begin first . rest)
               ((lambda (free) (begin . rest))  first))))

      ; 4.2.4  Iteration       * moved to (scheme r5rs iteration)

      ; 4.2.5  Delayed evaluation
      ;
      ; library syntax:  delay <expression>
      (define-syntax delay
         (syntax-rules ()
            ((delay (op . args))
               (lambda () (op . args)))
            ((delay value) value)))

      ; library syntax:  delay-force <expression>
      ; todo.

      ; library syntax:  force <expression>
      (setq force (lambda (thunk) (thunk)))

      ; (promise? obj )
      ; todo.

      ; (make-promise obj )
      ; todo.


      ; 4.2.6. Dynamic bindings
      ; * declared in (scheme dynamic-bindings)

      ; 4.2.7. Exception handling
      ; todo: * declared in (scheme exceptions)
      ; todo: guard, raise

      ; 4.2.8. Quasiquotation
      ;
      ; `(a ,(+ 1 2) ,(map abs '(4 -5 6)) b) ===> (a 3 (4 5 6) b)
      ; `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) ===> (a 3 4 5 6 b)
      (define-syntax quasiquote
         (syntax-rules (unquote quote unquote-splicing append _work _sharp_vector list->vector)
                                                   ;          ^         ^
                                                   ;          '-- mine  '-- added by the parser for #(... (a . b) ...) -> (_sharp_vector ... )
            ((quasiquote _work () (unquote exp)) exp)
            ((quasiquote _work (a . b) (unquote exp))
               (list 'unquote (quasiquote _work b exp)))
            ((quasiquote _work d (quasiquote . e))
               (list 'quasiquote
                  (quasiquote _work (() . d) . e)))
            ((quasiquote _work () ((unquote-splicing exp) . tl))
               (append exp
                  (quasiquote _work () tl)))
            ((quasiquote _work () (_sharp_vector . es))
               (list->vector
                  (quasiquote _work () es)))
            ((quasiquote _work d (a . b))
               (cons (quasiquote _work d a)
                     (quasiquote _work d b)))
            ((quasiquote _work d atom)
               (quote atom))
            ((quasiquote . stuff)
               (quasiquote _work () . stuff))))

      ; 4.2.9. Case-lambda
      ; * declared in (scheme srfi-16)

      ; 4.3  Macros
      ;
      ; Scheme programs can define and use .......
      ; ......

      ; 4.3.1  Binding constructs for syntactic keywords
      ;
      ; syntax: (let-syntax ...
      ; syntax: (letrec-syntax ...

      ; 4.3.2  Pattern language
      ;
      ; (syntax-rules


      ;;; ---------------------------------------------------------------
      ;;; Chapter 5
      ;;; Program structure

      ; 5.1  Programs
      ; A Scheme program consists of a sequence ........
      ; ........

      ; 5.2  Definitions
      ;
      ; Definitions are valid in some, but not all, contexts .......
      ; ...........

      (define-syntax define
         (syntax-rules (lambda) ;λ
            ((define ((name . args) . more) . body)
               (define (name . args) (lambda more . body)))
            ((define (name . args) . body)
               (setq name (letq (name) ((lambda args . body)) name)))
            ((define name (lambda (var ...) . body))
               (setq name (letq (name) ((lambda (var ...) . body)) name)))
            ((define name val)
               (setq name val))
            ((define name a b . c)
               (define name (begin a b . c)))))

;      ;; not defining directly because letq doesn't yet do variable arity
;      ;(define list ((lambda (x) x) (lambda x x)))
;
;      ;; fixme, should use a print-limited variant for debugging
;
       ; EXTENSION, unused!
;      (define-syntax define*
;         (syntax-rules (print list)
;            ((define* (op . args) . body)
;               (define (op . args)
;                  (print " * " (list (quote op) . args))
;                  .  body))
;            ((define* name (lambda (arg ...) . body))
;               (define* (name arg ...) . body))))

      ; EXTENSION, maybe unused!
      ; the internal one is handled by begin. this is just for toplevel.
      (define-syntax define-values
         (syntax-rules (list)
            ((define-values (val ...) . body)
               (setq (val ...)
                  (let* ((val ... (begin . body)))
                     (list val ...))))))

      ; EXTENSION, maybe r7rs!
      (define-syntax let*-values
         (syntax-rules ()
            ((let*-values (((var ...) gen) . rest) . body)
               (values-apply gen
                  (lambda (var ...) (let*-values rest . body))))
            ((let*-values () . rest)
               (begin . rest))))

      ; 5.2.1  Top level definitions
      ;
      ; At the top level of a program ........
      ; ......

      ; 5.2.2  Internal definitions
      ;
      ; Definitions may occur at the beginning .......
      ; ...........


      ; 5.3  Syntax definitions
      ;
      ; Syntax definitions are valid only at the top .......
      ; ......
      ;
      ; (define-syntax <keyword> <transformer spec>)


      ;;; ---------------------------------------------------------------
      ;;; Chapter 6
      ;;; Standard procedures
      ;
      ; This chapter describes Scheme's built-in procedures. The initial (or ``top level'') Scheme
      ; environment starts out with a number of variables bound to locations containing useful values,
      ; most of which are primitive procedures that manipulate data. For example, the variable abs is
      ; bound to (a location initially containing) a procedure of one argument that computes the
      ; absolute value of a number, and the variable + is bound to a procedure that computes sums.
      ; Built-in procedures that can easily be written in terms of other built-in procedures are
      ; identified as ``library procedures''.
      ;

      ; 6.1  Equivalence predicates
      ;
      ; A predicate is a procedure that always returns a boolean
      ; value (#t or #f). An equivalence predicate is the compu-
      ; tational analogue of a mathematical equivalence relation;
      ; it is symmetric, reflexive, and transitive. Of the equiva-
      ; lence predicates described in this section, eq? is the finest
      ; or most discriminating, equal? is the coarsest, and eqv?
      ; is slightly less discriminating than eq?.

      ; (r7rs) procedure:  (eq? obj1 obj2)   * builtin
      (define eq? eq?)

      ; (r7rs) procedure:  (eqv? obj1 obj2)
      ;
      ; The eqv? procedure defines a useful equivalence relation on
      ; objects. Briefly, it returns #t if obj 1 and obj 2 are normally
      ; regarded as the same object. This relation is left slightly
      ; open to interpretation, but the following partial specifica-
      ; tion of eqv? holds for all implementations of Scheme.
      (define (eqv? a b)
      ;  * obj 1 and obj 2 are both #t or both #f.
      ;  * obj 1 and obj 2 are both symbols and are the same sym-
      ;    bol according to the symbol=? procedure
      ;  * obj 1 and obj 2 are both characters and are the same
      ;    character according to the char=? procedure
      ;  * obj 1 and obj 2 are both the empty list
      ;  * obj 1 and obj 2 are pairs, vectors, bytevectors, records,
      ;    or strings that denote the same location in the store
      ;  * obj 1 and obj 2 are procedures whose location tags are
      ;    equal
         (if (eq? a b)
            #true
      ;  * obj 1 and obj 2 are both exact numbers and are numer-
      ;    ically equal (in the sense of =)
         (let ((typea (type a)))
         (if (or (eq? typea TINT+)
                 (eq? typea TINT-)
                 (eq? typea TRATIONAL)
                 (eq? typea TCOMPLEX))
            (and
               (eq? (type a) (type b))
               (eqv? (car a) (car b))
               (eqv? (cdr a) (cdr b)))
      ;  * obj 1 and obj 2 are both inexact numbers such that they
      ;    are numerically equal (in the sense of =) and they yield
      ;    the same results (in the sense of eqv?) when passed as
      ;    arguments to any other procedure that can be defined
      ;    as a finite composition of Scheme’s standard arith-
      ;    metic procedures, provided it does not result in a NaN
      ;    value.
         (if (eq? typea TINEXACT)
            (and
               (eq? (type a) (type b))
               (let loop ((n (|-1| (size a))))
                  (if (eq? (ref a n) (ref b n))
                     (if (eq? n 0)
                        #true
                        (loop (|-1| n))))))
         ; else
         #false)))))

      (assert (eqv? 'a 'a)                  ===> #true)
      (assert (eqv? '() '())                ===> #true)
      (assert (eqv? 2 2)                    ===> #true) ; atomic numbers
      (assert (eqv? 72057594037927936
                    72057594037927936)      ===> #true) ; not an atomic numbers
      (assert (eqv? 0.33 0.33)              ===> #true)
      (assert (eqv? 7/3 14/6)               ===> #true)
      (assert (eqv? 2+3i 2+3i)              ===> #true)
      (assert (let ((p (lambda (x) x)))
                 (eqv? p p))                ===> #true)
      (assert (let ((x '(a)))
                 (eqv? x x))                ===> #true)

      ; The eqv? procedure returns #f if:

      ;  * obj 1 and obj 2 are of different types
      (assert (eqv? 'a 12)                  ===> #false)
      (assert (eqv? #f 'nil)                ===> #false)

      ;  * one of obj 1 and obj 2 is #t but the other is #f
      (assert (eqv? #t #f)                  ===> #false)

      ;  * obj 1 and obj 2 are symbols but are not the same symbol
      ;    according to the symbol=? procedure
      (assert (eqv? 'a 'b)                  ===> #false)

      ;  * one of obj 1 and obj 2 is an exact number but the other
      ;    is an inexact number
      (assert (eqv? 2 (vm:cast 2 TINEXACT)) ===> #false)

      ;  * obj 1 and obj 2 are both exact numbers and are numer-
      ;    ically unequal
      (assert (eqv? 2 3)                    ===> #false) ; atomic number
      (assert (eqv? 72057594037927936
                    82057594037927936)      ===> #false) ; not an atomic numbers

      ;  * obj 1 and obj 2 are both inexact numbers such that ei-
      ;    ther they are numerically unequal (in the sense of =),
      ;    or they do not yield the same results (in the sense
      ;    of eqv?) when passed as arguments to any other pro-
      ;    cedure that can be defined as a finite composition of
      ;    Scheme’s standard arithmetic procedures, provided it
      ;    does not result in a NaN value. As an exception, the
      ;    behavior of eqv? is unspecified when both obj 1 and
      ;    obj 2 are NaN
      (assert (eqv? (vm:cast 2 TINEXACT)
                    (vm:cast 3 TINEXACT))   ===> #false)
           ; todo: more examples

      ;  * obj 1 and obj 2 are characters for which the char=? pro-
      ;    cedure returns #f
      (assert (eqv? #\a #\A)                ===> #false)

      ;  * one of obj 1 and obj 2 is the empty list but the other is
      ;    not
      (assert (eqv? '() '(a))               ===> #false)

      ;  * obj 1 and obj 2 are pairs, vectors, bytevectors, records,
      ;    or strings that denote distinct locations
      (assert (eqv? (cons 1 2) (cons 1 2))  ===> #false)

      ;  * obj 1 and obj 2 are procedures that would behave dif-
      ;    ferently (return different values or have different side
      ;    effects) for some arguments
      (assert (eqv? (lambda () 1)
                    (lambda () 2))          ===> #false)
      (assert (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
                       (g (lambda () (if (eqv? f g) 'g 'both))))
                 (eqv? f g))                ===> #false)

      ; The following examples illustrate cases in which the above
      ; rules do not fully specify the behavior of eqv?. All that
      ; can be said about such cases is that the value returned by
      ; eqv? must be a boolean

      ;(assert (eqv? "" "")                  ===> #false) ; * ol specific, (in r7rs unspecified)
      (assert (eqv? '#() '#())              ===> #true)  ; * ol specific, (in r7rs unspecified)
      ;assert (eqv? (lambda (x) x)
      ;             (lambda (x) x))         ===> #true)  ; * ol specific, (in r7rs unspecified), depends on (lang assemble)
      ;assert (eqv? (lambda (x) x)
      ;             (lambda (y) y))         ===> #true)  ; * ol specific, (in r7rs unspecified), depends on (lang assemble)
      ;assert (eqv? 1.0e0 1.0f0)            ===> unspecified
      (assert (eqv? +nan.0 +nan.0)          ===> #true)  ; * ol specific, (in r7rs unspecified)

      ;(assert (eqv? '(a) '(a))              ===> #false) ; * ol specific, (in r7rs unspecified)
      ;assert (eqv? "a" "a")                ===> unspecified
      ;assert (eqv? '(b) (cdr '(a b)))      ===> unspecified
      ;assert (letrec ((f (lambda () (if (eqv? f g) ’both ’f)))<commit_msg>more asserts to eqv?<commit_after>; minimal set of Scheme (with Ol subset)
(define-library (scheme core)
   (version 2.0)
   (license MIT/LGPL3)
   (keywords (scheme core ol))
   (description "
      Core Otus-Lisp Scheme library.")

   (import
      (src vm) ;; Codes and primitives of the Otus Lisp Virtual Machine that
               ;;  do not need to be exported by libraries.
               ;
               ; object creation/modification:
               ;   vm:new vm:make vm:makeb vm:cast
               ;   cons car cdr ref type size set-ref set-ref! eq? less?
               ; basic math primitives:
               ;   integer:
               ;     vm:add vm:sub vm:mul vm:div vm:shr vm:shl
               ;   floating-point (if built with OLVM_INEXACTS)
               ;     vm:fp1 (xFE: fsin, xFF: fcos),
               ;     vm:fp2 (xD9: <, xC1: +, xE9: -, xC9: *, xF9: /)
               ;   binary:
               ;     vm:and vm:or vm:xor
               ; special:
               ;   vm:pin, vm:unpin, vm:deref
               ;   clock, syscall
               ; vm info:
               ;   vm:version vm:maxvalue vm:valuewidth vm:features
               ; associative arrays support:
               ;   ff:red ff:black ff:toggle ff:red? ff:right?
               ; execution flow:
               ;   ff-apply tuple-apply
               ;
               ; exported functions:
               ;   apply apply/cc arity-error
               ;   call-with-current-continuation
               ;
               ;; special forms: (declared in lang/env.scm)
               ;
               ; quote values lambda setq
               ; letq ifeq either values-apply
               ;

      (scheme srfi-16)   ; case-lambda
      (scheme srfi-87)   ; <= in cases
      (scheme srfi-71))  ; (let* ((a b (values..

   ; -----------------------------------------------------------------
   ; internal staff
   (begin
      ; internal: (-1 obj), (+1 obj)
      ; note: todo: add theoretically impossible case:
      ;       (if carry (runtime-error "Too long list to fit in fixnum"))

      (setq |-1| (lambda (n) ; * internal
         (values-apply (vm:sub n 1) (lambda (n carry) n))))
      (setq |+1| (lambda (n) ; * internal
         (values-apply (vm:add n 1) (lambda (n carry) n))))
      (setq |0.0| (vm:fp2 #xC9 42 0)) ; * internal

      ; * ol specific: (runtime-error reason info)
      (setq runtime-error (lambda (reason info)
         (call-with-current-continuation (lambda (resume) (vm:sys resume 5 reason info)))))

      ; * temporary, allows basic assert implementation
      (setq equal? (lambda (a b)
         (ifeq a b #true #false)))

      ; * internal automation testing staff
      ; note: please be careful!
      ;       this is simplified 'assert' that uses 'eq?' before real 'equal?' be implemented in chapter 6
      (define-syntax assert
         (syntax-rules (===>)
            ((assert expression ===> expectation)
               (ifeq (equal? ((lambda (x) x) expression) (quote expectation)) #true
                  #true
                  (runtime-error "assertion error:" (cons (quote expression) (cons "must be" (cons (quote expectation) #null))))))))
   )

   ; =================================================================
   ; Scheme
   ;
   ; Revised(7) Report on the Algorithmic Language Scheme
   ;                  Dedicated to the Memory of ALGOL 60
   ;
   (begin

      ; =================================================================
      ; Programming languages should be designed not by piling feature on
      ; top of feature, but by removing the weaknesses and restrictions
      ; that make additional features appear necessary. Scheme demonstrates
      ; that a very small number of rules for forming expressions, with no
      ; restrictions on how they are composed, suffice to form a practical
      ; and efficient programming language that is flexible enough to support
      ; most of the major programming paradigms in use today.
      ;
      ;
      ;                      DESCRIPTION OF THE LANGUAGE
      ;
      ;;; ---------------------------------------------------------------
      ;;; Chapter 1
      ;;; Overview of Scheme

      ; 1.1  Semantics
      ;
      ; Scheme is a statically scoped programming language. Each
      ; use of a variable is associated with a lexically apparent
      ; binding of that variable.
      ;
      ; Scheme is a dynamically typed language. Types are asso-
      ; ciated with values (also called objects) rather than with
      ; variables. Statically typed languages, by contrast, asso-
      ; ciate types with variables and expressions as well as with
      ; values.
      ;
      ; Scheme has latent ..................
      ; ......

      ; 1.2  Syntax
      ;
      ; Scheme, like most dialects of Lisp, employs .....
      ; ......

      ; 1.3  Notation and terminology
      ;
      ; 1.3.1  Primitive, library, and optional features
      ;
      ; It is required that every implementation of Scheme support
      ; all features that are not marked as being optional. ......
      ; ...

      ; 1.3.2  Error situations and unspecified behavior
      ;
      ; When speaking of an error situation, this report .......
      ; ....

      ; 4.3.3. Signaling errors in macro transformers
      ;
      (define-syntax syntax-error
         (syntax-rules (runtime-error)
            ((syntax-error . staff)
               (runtime-error "syntax error: " (quote staff)))))

      ; * ol specific
      (setq error runtime-error) ; [yc] is it required?

      ; * ol some warnings
      (setq error:please-import-langintern (lambda ()
         (runtime-error "Please, import (lang intern) to get the function.")))

      ; 1.3.3  Entry format
      ;
      ; Chapters 4 and 6 are organized into entries. Each ....
      ; ........

      ; 1.3.4  Evaluation examples
      ;
      ; The symbol "==>" used in program examples should be
      ; read "evaluates to." ...
      ; ....

      ; 1.3.5  Naming conventions
      ;
      ; By convention, the names of procedures that always return
      ; a boolean value usually end in “?”. Such procedures are
      ; called predicates.
      ;
      ; By convention, the names of procedures that store values
      ; into previously allocated locations (see section 3.4) usually
      ; end in "!". Such procedures are called mutation procedures.
      ; By convention, the value returned by a mutation
      ; procedure is unspecified.
      ;
      ; By convention, "->"" appears within the names of procedures
      ; that take an object of one type and return an analogous
      ; object of another type. For example, list->vector
      ; takes a list and returns a vector whose elements are the
      ; same as those of the list.


      ;;; ---------------------------------------------------------------
      ;;; Chapter 2
      ;;; Lexical conventions
      ;
      ; This section gives an informal account of some of the lexical
      ; conventions used in writing Scheme programs. For a formal
      ; syntax of Scheme, see section 7.1.
      ;
      ; 2.1  Identifiers
      ;
      ; Most identifiers allowed by other .......
      ; ....
      ;
      ; Here are some examples of identifiers:
      ;
      ; lambda        q
      ; list->vector  soup
      ; +             V17a
      ; <=?           a34kTMNs
      ; the-word-recursion-has-many-meanings
      ;
      ; All implementations of Scheme must support the following
      ; extended identifier characters:
      ;
      ; ! $ % & * + - . / : < = > ? @ ^ _ ~
      ;
      ; Alternatively, an identifier can be represented by a se-
      ; quence of zero or more characters enclosed within vertical
      ; lines (|), analogous to string literals.
      ;
      ; ...................................

      ; 2.2  Whitespace and comments
      ;
      ; Whitespace characters are spaces and newlines. .........
      ; ..........

      ; 2.3  Other notations
      ;
      ; For a description of ........
      ; ..........


      ;;; ---------------------------------------------------------------
      ;;; Chapter 3
      ;;; Basic concepts

      ; 3.1  Variables, syntactic keywords, and regions
      ;
      ; An identifier may name a type of syntax, or ...
      ; ..

      ; 3.2  Disjointness of types
      ;
      ; No object satisfies more than one ...
      ; ..

      ; 3.3  External representations
      ;
      ; An important concept in Scheme (and Lisp) is that ...
      ; ..

      ; 3.4  Storage model
      ; Variables and objects such as pairs, vectors, and ...
      ; .........

      ; 3.5  Proper tail recursion
      ; Implementations of Scheme are required to be ...
      ; ...............


      ;;; ---------------------------------------------------------------
      ;;; Chapter 4
      ;;; Expressions
      ;
      ; Expression types are categorized as primitive or derived.
      ; Primitive expression types include variables and procedure
      ; calls. Derived expression types are not semantically primitive,
      ; but can instead be defined as macros. With the exception
      ; of quasiquote, whose macro definition is complex,
      ; the derived expressions are classified as library features.
      ; Suitable definitions are given in section 7.3.

      ; 4.1  Primitive expression types

      ; 4.1.1  Variable references
      ;
      ; syntax:  <variable>
      ;
      ; An expression consisting of a variable (section 3.1) is a
      ; variable reference. The value of the variable reference is
      ; the value stored in the location to which the variable is
      ; bound. It is an error to reference an unbound variable.

      ; 4.1.2  Literal expressions
      ;
      ; syntax:  quote <datum>                * builtin
      ; syntax:  '<datum>                     * builtin
      ; syntax:  <constant>                   * builtin

      ; 4.1.3  Procedure calls
      ;
      ; syntax:  (<operator> <operand1> ...)  * builtin

      ; 4.1.4  Procedures
      ;
      ; syntax:  (lambda <formals> <body>)    * builtin

      (define-syntax λ                  ; * ol specific
         (syntax-rules ()
            ((λ . x) (lambda . x))))

      ;(assert ((lambda x x) 3 4 5 6)                  ===>  (3 4 5 6))
      ;(assert ((lambda (x y . z) z) 3 4 5 6)          ===>  (5 6))

      ; 4.1.5  Conditionals
      ;
      ; syntax:  if <test> <consequent> <alternate>
      ; syntax:  if <test> <consequent>
      (define-syntax if
         (syntax-rules (not eq? null? empty? zero?)
            ((if val       then)      (if val then #false))
            ((if (not val) then else) (if val else then))
            ((if (eq? a b) then else) (ifeq a b then else))
            ((if (null? t) then else) (if (eq? t #null) then else))  ; boot image size and compilation speed optimization
            ((if (a . b)   then else) (letq (x) ((a . b)) (if x then else)))
            ((if #true     then else)  then)
            ((if #false    then else)  else)
            ((if t         then else) (ifeq t #false else then))))

      (assert (if (less? 2 3) 'yes 'no)               ===>  yes)
      (assert (if (less? 3 2) 'yes 'no)               ===>  no)

      ; syntax:  unless <test> <consequent> <alternate> * ol specific
      ; syntax:  unless <test> <consequent> * ol specific
      (define-syntax unless
         (syntax-rules ()
            ((unless val then)      (if val #false then))
            ((unless val then else) (if val else then))))

      (assert (unless (less? 2 3) 'yes 'no)               ===>  no)
      (assert (unless (less? 3 2) 'yes 'no)               ===>  yes)

      ; 4.1.6  Assignments
      ;
      ; syntax: set! <variable> <expression>  * not supported
      (setq set! (lambda (variable expression)
         (runtime-error "No set! is allowed." "(sometimes you can use set-ref!, check the docs.)")))

      ; 4.2  Derived expression types
      ;
      ; The constructs in this section are hygienic, as discussed
      ; in section 4.3. For reference purposes, section 7.3 gives
      ; macro definitions that will convert most of the constructs
      ; described in this section into the primitive constructs de-
      ; scribed in the previous section.

      ; 4.2.1  Conditionals
      ;
      ; library syntax:  (cond <clause1> <clause2> ...)
      (define-syntax cond
         (syntax-rules (else =>)
            ((cond) #false)
            ((cond (else exp . rest))
               ((lambda () exp . rest)))        ; (begin ...)
            ((cond (clause => exp) . rest)
               ((lambda (fresh)
                  (if fresh
                     (exp fresh)
                     (cond . rest)))  clause))
            ((cond (clause exp . rest-exps) . rest)
               (if clause
                  ((lambda () exp . rest-exps)) ; (begin ...)
                  (cond . rest)))))

      (assert (cond ((less? 2 3) 'greater)
                    ((less? 3 2) 'less))                  ===>  greater)
      (assert (cond ((less? 3 3) 'greater)
                    ((less? 3 3) 'less)
                    (else 'equal))                        ===>  equal)
      (assert (cond ((car (cdr '((a 1) (b 2)))) => car)
                    (else #f))                            ===>  b)

      ; library syntax:  (case <key> <clause1> <clause2> ...)
      (define-syntax case
         (syntax-rules (else eqv? memv =>)
            ((case (op . args) . clauses)
               ((lambda (fresh) ; let ((fresh (op.args)))
                  (case fresh . clauses)) (op . args)))
            ((case thing) #false)
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing ((a) => exp) . clauses)
               (if (eqv? thing (quote a))
                  (exp thing)
                  (case thing . clauses)))
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing ((a ...) => exp) . clauses)
               (if (memv thing (quote (a ...)))
                  (exp thing)
                  (case thing . clauses)))
            ((case thing ((a) . body) . clauses)
               (if (eqv? thing (quote a))
                  ((lambda () . body)) ; means (begin . body)
                  (case thing . clauses)))
            ; http://srfi.schemers.org/srfi-87/srfi-87.html
            ((case thing (else => func))
               (func thing))
            ((case thing (else . body))
               ((lambda () . body)))   ; means (begin . body)
            ((case thing ((a . b) . body) . clauses)
               (if (memv thing (quote (a . b)))
                  ((lambda () . body)) ; means (begin . body)
                  (case thing . clauses)))
            ((case thing (atom . then) . clauses) ;; added for (case (type foo) (type-foo thenfoo) (type-bar thenbar) ...)
               (if (eq? thing atom)
                  ((lambda () . then)) ; means (begin . body)
                  (case thing . clauses)))))

      ; library syntax:  (and <test1> ...)
      (define-syntax and
         (syntax-rules ()
            ((and) #true)
            ((and a) a)
            ((and a . b)
               (if a (and . b) #false))))

      (assert (and (eq? 2 2) (less? 1 2))                 ===> #true)
      (assert (and (eq? 2 2) (less? 2 1))                 ===> #false)
      (assert (and 1 2 '(f g) 'c)                         ===> c)
      (assert (and)                                       ===> #true)

      ; library syntax:  (or <test1> ...)
      (define-syntax or
         (syntax-rules ()
            ((or) #false)
            ((or (a . b) . c) ; additional optimization
               ((lambda (x) (or x . c))  (a . b)))
            ((or a) a)
            ((or a . b)
               (if a a (or . b)))))

      (assert (or (eq? 2 2) (less? 1 2))                  ===> #true)
      (assert (or (eq? 2 2) (less? 2 1))                  ===> #true)
      (assert (or #f #f #f)                               ===> #false)
      (assert (or #f 'c #f)                               ===> c)

      ; 4.2.2  Binding constructs
      ;
      ; The three binding constructs let, let*, and letrec give
      ; Scheme a block structure, like Algol 60. The syntax of the
      ; three constructs is identical, but they differ in the regions
      ; they establish for their variable bindings. In a let ex-
      ; pression, the initial values are computed before any of the
      ; variables become bound; in a let* expression, the bind-
      ; ings and evaluations are performed sequentially; while in a
      ; letrec expression, all the bindings are in effect while their
      ; initial values are being computed, thus allowing mutually
      ; recursive definitions.

      ; library syntax:  (letrec <bindings> <body>)
      (define-syntax letrec
         (syntax-rules ()
            ((letrec ((?var ?val) ...) ?body) (letq (?var ...) (?val ...) ?body))
            ((letrec vars body ...) (letrec vars (begin body ...)))))

      ; library syntax:  (letrec* ...) - r7rs
      ;(define-syntax letrec*
      ;   (syntax-rules ()
      ;      ((letrec () . body)
      ;         (begin . body))
      ;      ((letrec* ((var val) . rest) . body)
      ;         (letrec ((var val))
      ;            (letrec* rest . body)))))

      ; library syntax:  (let <bindings> <body>)
      ;                  (let keyword <bindings> <body>) named let, from 4.2.4 Iteration
      (define-syntax let
         (syntax-rules ()
            ((let ((var val) ...) exp . rest)
               ((lambda (var ...) exp . rest) val ...))
               ;why not (letq (var ...) (val ...) exp . rest)) ???
            ((let keyword ((var init) ...) exp . rest)
               (letrec ((keyword (lambda (var ...) exp . rest))) (keyword init ...)))))

      ; library syntax:  (let* <bindings> <body>)
      (define-syntax let*
         (syntax-rules (<=)
            ((let* (((var ...) gen) . rest) . body)
               (values-apply gen (lambda (var ...) (let* rest . body))))
            ((let* ((var val) . rest-bindings) exp . rest-exps)
               ((lambda (var) (let* rest-bindings exp . rest-exps)) val))
            ; http://srfi.schemers.org/srfi-71/srfi-71.html
            ((let* ((var ... (op . args)) . rest-bindings) exp . rest-exps)
               (values-apply (op . args)
                  (lambda (var ...)
                     (let* rest-bindings exp . rest-exps))))
            ((let* ((var ... node) . rest-bindings) exp . rest-exps)
               (tuple-apply node
                  (lambda (var ...)
                     (let* rest-bindings exp . rest-exps))))
            ((let* (((name ...) <= value) . rest) . code)
               (tuple-apply value
                  (lambda (name ...)
                     (let* rest . code))))
            ((let* ()) exp)
            ((let* () exp . rest)
               ((lambda () exp . rest)))))

      ; lets === let*, TEMP!
      (define-syntax lets
         (syntax-rules ()
            ((lets . stuff) (let* . stuff))))

      ; 4.2.3  Sequencing
      ;
      ; library syntax:  (begin <expression1> <expression2> ...)
      (define-syntax begin
         (syntax-rules (define letrec define-values let*-values letrec) ; todo: rename define-values to define*
            ((begin exp) exp)
            ((begin (define . a) (define . b) ... . rest)
               (begin 42 () (define . a) (define . b) ... . rest))
            ((begin (define-values (val ...) . body) . rest)
               (let*-values (((val ...) (begin . body))) . rest))
            ((begin 42 done (define ((op . args1) . args2) . body) . rest)
               (begin 42 done (define (op . args1) (lambda args2 . body)) . rest))
            ((begin 42 done (define (var . args) . body) . rest)
               (begin 42 done (define var (lambda args . body)) . rest))
            ((begin 42 done (define var exp1 exp2 . expn) . rest)
               (begin 42 done (define var (begin exp1 exp2 . expn)) . rest))
            ((begin 42 done (define var val) . rest)
               (begin 42 ((var val) . done) . rest))
            ((begin 42 done . exps)
               (begin 43 done () exps))
            ((begin 43 (a . b) c exps)
               (begin 43 b (a . c) exps))
            ((begin 43 () bindings exps)
               (letrec bindings (begin . exps)))
            ((begin first . rest)
               ((lambda (free) (begin . rest))  first))))

      ; 4.2.4  Iteration       * moved to (scheme r5rs iteration)

      ; 4.2.5  Delayed evaluation
      ;
      ; library syntax:  delay <expression>
      (define-syntax delay
         (syntax-rules ()
            ((delay (op . args))
               (lambda () (op . args)))
            ((delay value) value)))

      ; library syntax:  delay-force <expression>
      ; todo.

      ; library syntax:  force <expression>
      (setq force (lambda (thunk) (thunk)))

      ; (promise? obj )
      ; todo.

      ; (make-promise obj )
      ; todo.


      ; 4.2.6. Dynamic bindings
      ; * declared in (scheme dynamic-bindings)

      ; 4.2.7. Exception handling
      ; todo: * declared in (scheme exceptions)
      ; todo: guard, raise

      ; 4.2.8. Quasiquotation
      ;
      ; `(a ,(+ 1 2) ,(map abs '(4 -5 6)) b) ===> (a 3 (4 5 6) b)
      ; `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) ===> (a 3 4 5 6 b)
      (define-syntax quasiquote
         (syntax-rules (unquote quote unquote-splicing append _work _sharp_vector list->vector)
                                                   ;          ^         ^
                                                   ;          '-- mine  '-- added by the parser for #(... (a . b) ...) -> (_sharp_vector ... )
            ((quasiquote _work () (unquote exp)) exp)
            ((quasiquote _work (a . b) (unquote exp))
               (list 'unquote (quasiquote _work b exp)))
            ((quasiquote _work d (quasiquote . e))
               (list 'quasiquote
                  (quasiquote _work (() . d) . e)))
            ((quasiquote _work () ((unquote-splicing exp) . tl))
               (append exp
                  (quasiquote _work () tl)))
            ((quasiquote _work () (_sharp_vector . es))
               (list->vector
                  (quasiquote _work () es)))
            ((quasiquote _work d (a . b))
               (cons (quasiquote _work d a)
                     (quasiquote _work d b)))
            ((quasiquote _work d atom)
               (quote atom))
            ((quasiquote . stuff)
               (quasiquote _work () . stuff))))

      ; 4.2.9. Case-lambda
      ; * declared in (scheme srfi-16)

      ; 4.3  Macros
      ;
      ; Scheme programs can define and use .......
      ; ......

      ; 4.3.1  Binding constructs for syntactic keywords
      ;
      ; syntax: (let-syntax ...
      ; syntax: (letrec-syntax ...

      ; 4.3.2  Pattern language
      ;
      ; (syntax-rules


      ;;; ---------------------------------------------------------------
      ;;; Chapter 5
      ;;; Program structure

      ; 5.1  Programs
      ; A Scheme program consists of a sequence ........
      ; ........

      ; 5.2  Definitions
      ;
      ; Definitions are valid in some, but not all, contexts .......
      ; ...........

      (define-syntax define
         (syntax-rules (lambda) ;λ
            ((define ((name . args) . more) . body)
               (define (name . args) (lambda more . body)))
            ((define (name . args) . body)
               (setq name (letq (name) ((lambda args . body)) name)))
            ((define name (lambda (var ...) . body))
               (setq name (letq (name) ((lambda (var ...) . body)) name)))
            ((define name val)
               (setq name val))
            ((define name a b . c)
               (define name (begin a b . c)))))

;      ;; not defining directly because letq doesn't yet do variable arity
;      ;(define list ((lambda (x) x) (lambda x x)))
;
;      ;; fixme, should use a print-limited variant for debugging
;
       ; EXTENSION, unused!
;      (define-syntax define*
;         (syntax-rules (print list)
;            ((define* (op . args) . body)
;               (define (op . args)
;                  (print " * " (list (quote op) . args))
;                  .  body))
;            ((define* name (lambda (arg ...) . body))
;               (define* (name arg ...) . body))))

      ; EXTENSION, maybe unused!
      ; the internal one is handled by begin. this is just for toplevel.
      (define-syntax define-values
         (syntax-rules (list)
            ((define-values (val ...) . body)
               (setq (val ...)
                  (let* ((val ... (begin . body)))
                     (list val ...))))))

      ; EXTENSION, maybe r7rs!
      (define-syntax let*-values
         (syntax-rules ()
            ((let*-values (((var ...) gen) . rest) . body)
               (values-apply gen
                  (lambda (var ...) (let*-values rest . body))))
            ((let*-values () . rest)
               (begin . rest))))

      ; 5.2.1  Top level definitions
      ;
      ; At the top level of a program ........
      ; ......

      ; 5.2.2  Internal definitions
      ;
      ; Definitions may occur at the beginning .......
      ; ...........


      ; 5.3  Syntax definitions
      ;
      ; Syntax definitions are valid only at the top .......
      ; ......
      ;
      ; (define-syntax <keyword> <transformer spec>)


      ;;; ---------------------------------------------------------------
      ;;; Chapter 6
      ;;; Standard procedures
      ;
      ; This chapter describes Scheme's built-in procedures. The initial (or ``top level'') Scheme
      ; environment starts out with a number of variables bound to locations containing useful values,
      ; most of which are primitive procedures that manipulate data. For example, the variable abs is
      ; bound to (a location initially containing) a procedure of one argument that computes the
      ; absolute value of a number, and the variable + is bound to a procedure that computes sums.
      ; Built-in procedures that can easily be written in terms of other built-in procedures are
      ; identified as ``library procedures''.
      ;

      ; 6.1  Equivalence predicates
      ;
      ; A predicate is a procedure that always returns a boolean
      ; value (#t or #f). An equivalence predicate is the compu-
      ; tational analogue of a mathematical equivalence relation;
      ; it is symmetric, reflexive, and transitive. Of the equiva-
      ; lence predicates described in this section, eq? is the finest
      ; or most discriminating, equal? is the coarsest, and eqv?
      ; is slightly less discriminating than eq?.

      ; (r7rs) procedure:  (eq? obj1 obj2)   * builtin
      (define eq? eq?)

      ; (r7rs) procedure:  (eqv? obj1 obj2)
      ;
      ; The eqv? procedure defines a useful equivalence relation on
      ; objects. Briefly, it returns #t if obj 1 and obj 2 are normally
      ; regarded as the same object. This relation is left slightly
      ; open to interpretation, but the following partial specifica-
      ; tion of eqv? holds for all implementations of Scheme.
      (define (eqv? a b)
      ;  * obj 1 and obj 2 are both #t or both #f.
      ;  * obj 1 and obj 2 are both symbols and are the same sym-
      ;    bol according to the symbol=? procedure
      ;  * obj 1 and obj 2 are both characters and are the same
      ;    character according to the char=? procedure
      ;  * obj 1 and obj 2 are both the empty list
      ;  * obj 1 and obj 2 are pairs, vectors, bytevectors, records,
      ;    or strings that denote the same location in the store
      ;  * obj 1 and obj 2 are procedures whose location tags are
      ;    equal
         (if (eq? a b)
            #true
      ;  * obj 1 and obj 2 are both exact numbers and are numer-
      ;    ically equal (in the sense of =)
         (let ((typea (type a)))
         (if (or (eq? typea TINT+)
                 (eq? typea TINT-)
                 (eq? typea TRATIONAL)
                 (eq? typea TCOMPLEX))
            (and
               (eq? (type a) (type b))
               (eqv? (car a) (car b))
               (eqv? (cdr a) (cdr b)))
      ;  * obj 1 and obj 2 are both inexact numbers such that they
      ;    are numerically equal (in the sense of =) and they yield
      ;    the same results (in the sense of eqv?) when passed as
      ;    arguments to any other procedure that can be defined
      ;    as a finite composition of Scheme’s standard arith-
      ;    metic procedures, provided it does not result in a NaN
      ;    value.
         (if (eq? typea TINEXACT)
            (and
               (eq? (type a) (type b))
               (let loop ((n (|-1| (size a))))
                  (if (eq? (ref a n) (ref b n))
                     (if (eq? n 0)
                        #true
                        (loop (|-1| n)))))))))))

      (assert (eqv? 'a 'a)                  ===> #true) ; symbols
      (assert (eqv? '() '())                ===> #true) ; empty lists
      (assert (eqv? 2 2)                    ===> #true) ; atomic integer numbers
      (assert (eqv? 72057594037927936
                    72057594037927936)      ===> #true) ; long (not atomic) integer numbers
      (assert (eqv? 0.33 0.33)              ===> #true) ; rational numbers
      (assert (eqv? 7/3 14/6)               ===> #true) ; rational numbers
      (assert (eqv? 2+3i 2+3i)              ===> #true) ; complex numbers
      (assert (eqv? (vm:cast 2 TINEXACT)
                    (vm:cast 2 TINEXACT))   ===> #true) ; inexact numbers
      (assert (eqv? +nan.0 +nan.0)          ===> #true) ; inexact NaNs
      (assert (let ((p (lambda (x) x)))
                 (eqv? p p))                ===> #true) ; same lambda
      (assert (let ((x '(a)))
                 (eqv? x x))                ===> #true) ; same list

      ; * ol specific cases (in r7rs unspecified)
      (assert (eqv? "" "")                  ===> #false); * ol specific, (in r7rs unspecified)

      ; The eqv? procedure returns #f if:

      ;  * obj 1 and obj 2 are of different types
      (assert (eqv? 'a 12)                  ===> #false)
      (assert (eqv? #f 'nil)                ===> #false)

      ;  * one of obj 1 and obj 2 is #t but the other is #f
      (assert (eqv? #t #f)                  ===> #false)

      ;  * obj 1 and obj 2 are symbols but are not the same symbol
      ;    according to the symbol=? procedure
      (assert (eqv? 'a 'b)                  ===> #false)

      ;  * one of obj 1 and obj 2 is an exact number but the other
      ;    is an inexact number
      (assert (eqv? 2 (vm:cast 2 TINEXACT)) ===> #false)

      ;  * obj 1 and obj 2 are both exact numbers and are numer-
      ;    ically unequal
      (assert (eqv? 2 3)                    ===> #false) ; atomic number
      (assert (eqv? 72057594037927936
                    82057594037927936)      ===> #false) ; not an atomic numbers

      ;  * obj 1 and obj 2 are both inexact numbers such that ei-
      ;    ther they are numerically unequal (in the sense of =),
      ;    or they do not yield the same results (in the sense
      ;    of eqv?) when passed as arguments to any other pro-
      ;    cedure that can be defined as a finite composition of
      ;    Scheme’s standard arithmetic procedures, provided it
      ;    does not result in a NaN value. As an exception, the
      ;    behavior of eqv? is unspecified when both obj 1 and
      ;    obj 2 are NaN
      (assert (eqv? (vm:cast 2 TINEXACT)
                    (vm:cast 3 TINEXACT))   ===> #false)
           ; todo: more examples

      ;  * obj 1 and obj 2 are characters for which the char=? pro-
      ;    cedure returns #f
      (assert (eqv? #\a #\A)                ===> #false)

      ;  * one of obj 1 and obj 2 is the empty list but the other is
      ;    not
      (assert (eqv? '() '(a))               ===> #false)

      ;  * obj 1 and obj 2 are pairs, vectors, bytevectors, records,
      ;    or strings that denote distinct locations
      (assert (eqv? (cons 1 2) (cons 1 2))  ===> #false)

      ;  * obj 1 and obj 2 are procedures that would behave dif-
      ;    ferently (return different values or have different side
      ;    effects) for some arguments
      (assert (eqv? (lambda () 1)
                    (lambda () 2))          ===> #false)
      (assert (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
                       (g (lambda () (if (eqv? f g) 'g 'both))))
                 (eqv? f g))                ===> #false)

      ; The following examples illustrate cases in which the above
      ; rules do not fully specify the behavior of eqv?. All that
      ; can be said about such cases is that the value returned by
      ; eqv? must be a boolean

      (assert (eqv? #() #())              ===> #true)  ; * ol specific, (in r7rs unspecified)
      (assert (eqv? (lambda (x) x)
                    (lambda (x) x))         ===> #true)  ; * ol specific, (in r7rs unspecified), depends on (lang assemble)
      ;assert (eqv? (lambda (x) x)
      ;             (lambda (y) y))         ===> #true)  ; * ol specific, (in r7rs unspecified), depends on (lang assemble)
      ;assert (eqv? 1.0e0 1.0f0)            ===> unspecified
      (assert (eqv? +nan.0 +nan.0)          ===> #true)  ; * ol specific, (in r7rs unspecified)

      ;(assert (eqv? '(a) '(a))              ===> #false) ; * ol specific, (in r7rs unspecified)
      ;assert (eqv? "a" "a")                ===> unspecified
      ;assert (eqv? '(b) (cdr '(a b)))      ===> unspecified
      ;assert (letrec ((f (lambda () (if (eqv? f g) ’both ’f)))
{'fraction_non_alphanumeric': 0.144236787981758, 'fraction_numerical': 0.014083877313779844, 'mean_word_length': 1.4600916590284143, 'pattern_counts': {'":': 0, '<': 99, '<?xml version=': 0, '>': 223, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 26, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2851705', 'n_tokens_mistral': 20045, 'n_tokens_neox': 18438, 'n_words': 6885}