#Morphir Scheme

#Overview

(define (inc x) (+ x 1))
(inc 41)
;; => 42

#Lexical syntax

#| outer #| inner |# |# #; (+ 9 9) '(1 . 2)
;; => (1 . 2)

(let ([x 1] [y 2]) (+ x y))
;; => 3

(+ 18446744073709551616 1)
;; => 18446744073709551617

(+ 1/3 1/6)
;; => 1/2

(list 0.5 1e3 (symbol? '.5))
;; => (0.5 1000.0 #t)

"say \"hi\"\tthen go"
;; => "say \"hi\"\tthen go"

(list #\a #\( #\space #\newline)
;; => (#\a #\( #\space #\newline)

(symbol->string '|two words|)
;; => "two words"

#Refused input

///|
test "the reader refuses text that ends too early" {
  for
    refusal in [
      ("(1 2", "Syntax at character 4: Unclosed list"),
      ("\"abc", "Syntax at character 4: Unclosed quoted text"),
      ("\"a\\", "Syntax at character 3: Unclosed escape"),
      ("#| open", "Syntax at character 7: Unclosed block comment"),
      ("'", "Syntax at character 1: Expected datum"),
      ("#;", "Syntax at character 2: Expected datum"),
      ("(1 .", "Syntax at character 4: Expected datum"),
      ("#\\", "Syntax at character 2: Expected character"),
    ] {
    let (source, expected) = refusal
    let message = try {
      ignore(@scheme.parse_program(source))
      ""
    } catch {
      e => @scheme.error_message(e)
    }
    assert_eq(message, expected)
  }
}

#(1 . 2)
;; error: Syntax at character 8: Invalid vector

(1 . 2 3)
;; error: Syntax at character 7: Expected closing delimiter after tail

#x10
;; error: Syntax at character 4: Unknown reader token: #x10

"a\q"
;; error: Syntax at character 4: Unsupported escape

1/0
;; error: Division by zero

1e400
;; error: Nonfinite number

#Values

///|
test "a host can return a real that is not finite" {
  let runtime = @scheme.Runtime::new()
  runtime.define_native("infinity", fn(_rt, _args) {
    @scheme.Value::Number(@scheme.Number::Real(1.0 / 0.0))
  })
  inspect(
    @scheme.value_to_string(runtime.eval("(infinity)")),
    content="Infinity.0",
  )
  let below = @scheme.Value::Number(@scheme.Number::Real(-1.0 / 0.0))
  inspect(@scheme.value_to_string(below), content="-Infinity.0")
  let nan = @scheme.Value::Number(@scheme.Number::Real(0.0 / 0.0))
  inspect(@scheme.value_to_string(nan), content="NaN.0")
  let message = try {
    ignore(runtime.eval("(+ (infinity) 1)"))
    ""
  } catch {
    e => @scheme.error_message(e)
  }
  inspect(message, content="Nonfinite arithmetic result")
}

#Truthiness

(if 0 'zero-is-true 'false)
;; => zero-is-true

#Equality

(list (equal? 1 1.0) (equal? car car) (equal? '(1 #(2)) (list 1 (vector 2))))
;; => (#t #f #t)

#Special forms

(let ((if (lambda (x) x))) (if 1))
;; error: if expects condition, consequent and alternative

#Evaluation and application

#(x (+ 1 2))
;; => #(x (+ 1 2))

(1 2)
;; error: Attempt to call a non-procedure

#define

(define (square x) (* x x))
(square 7)
;; => 49

(define answer 42)
;; => #<unit>

#set!

(define count 0)
(set! count (+ count 1))
count
;; => 1

(set! missing 1)
;; error: Unbound identifier: missing

#lambda

(define (make-adder x) (lambda (y) (+ x y)))
((make-adder 10) 32)
;; => 42

((lambda (a . rest) rest) 1 2 3)
;; => (2 3)

((lambda args args) 1 2)
;; => (1 2)

((lambda (x) x))
;; error: Procedure argument count mismatch

#if

(if (< 1 2) 'yes 'no)
;; => yes

(if #t 1)
;; error: if expects condition, consequent and alternative

#begin

(begin (define x 1) (+ x 1))
;; => 2

(begin)
;; => #<unit>

#and and or

(list (and 1 2 3) (and 1 #f 3) (or #f 'b) (and) (or))
;; => (3 #f b #t #f)

#let, let* and letrec

(let ((x 1)) (let ((x 2) (y x)) y))
;; => 1

(let* ((x 1) (x (+ x 1))) x)
;; => 2

(letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
         (odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))))
  (even? 10))
;; => #t

(letrec ((a b) (b 1)) a)
;; error: Uninitialized recursive binding: b

(let ((x 1) (x 2)) x)
;; error: Duplicate binding: x

#Named let

(let loop ((n 10000) (sum 0))
  (if (= n 0) sum (loop (- n 1) (+ sum 1))))
;; => 10000

#quote

(list '(a b . c) (quote (+ 1 2)))
;; => ((a b . c) (+ 1 2))

#Built-in procedures

#Arithmetic

(list (+ 1 2 3) (- 10 4 1) (* 2 3 4) (/ 1 3) (quotient -7 2) (remainder -7 2) (number? 1/2) (integer? 2.0))
;; => (6 5 24 1/3 -3 -1 #t #f)

(list (+ 1 0.5) (* 2 1.0) (- 5) (/ 6 4))
;; => (1.5 2.0 -5 3/2)

(/ 1 0)
;; error: Division by zero

#Comparison

(list (= 1 1.0) (< 1 2 3) (> 3 2 2) (<= 1 1 2) (>= 3 1 2) (equal? '(1 (2)) '(1 (2))))
;; => (#t #t #f #t #f #t)

(< 2 1 'x)
;; error: Expected number

#Lists

(list (cons 1 2) (car '(1 2)) (cdr '(1 2)) (list 1 2) (null? '()) (pair? '()) (list? '(1 . 2)) (length '(1 2 3)) (append '(1) '(2 3)) (reverse '(1 2 3)))
;; => ((1 . 2) 1 (2) (1 2) #t #f #f 3 (1 2 3) (3 2 1))

(list (append) (append '(1) 2))
;; => (() (1 . 2))

(car '())
;; error: Expected pair

#Higher-order

(list (map (lambda (x) (* x x)) '(1 2 3)) (fold-left - 0 '(1 2 3)) (apply + 1 '(2 3)) (procedure? car))
;; => ((1 4 9) -6 6 #t)

(map (lambda (x y) x) '(1 2) '(3 4))
;; error: map: expected 2 arguments

#Strings

(list (string-append "ab" "cd") (string=? "a" "a") (string? 'a))
;; => ("abcd" #t #f)

(string-append "a" 1)
;; error: Expected string

#Symbols and conversion

(list (symbol? 'a) (symbol->string 'abc) (string->symbol "abc") (number->string 1/3) (string->number "2.5"))
;; => (#t "abc" abc "1/3" 2.5)

(string->symbol "two words")
;; => |two words|

(string->number "ten")
;; => #f

(string->number "1/0")
;; error: Division by zero

#Records

(list (record (cons "x" 1)) (record-ref (record (cons "x" 1)) "x") (record-set (record (cons "x" 1)) "x" 2) (record-keys (record (cons "x" 1) (cons "y" 2))))
;; => (#<record x=1> 1 #<record x=2> ("x" "y"))

(define point (record (cons "x" 1)))
(define moved (record-set point "y" 2))
(list point moved)
;; => (#<record x=1> #<record x=1 y=2>)

(record-ref (record (cons "x" 1)) "y")
;; error: Missing record field

#Vectors

(list (vector 1 2) (vector-ref #(a b c) 1) (vector-length #(a b c)))
;; => (#(1 2) b 3)

(vector-ref #(a b c) 3)
;; error: Vector index out of range

#Other

(list (not 0) (boolean? #f) (unit))
;; => (#f #t #<unit>)

(error "Not found:" 'key)
;; error: "Not found:" key

#Errors

(define x 1) (car x))
;; error: Syntax at character 20: Unexpected closing delimiter

undefined-name
;; error: Unbound identifier: undefined-name

(car 1)
;; error: Expected pair

`(1 ,x)
;; error: Unsupported: Quasiquotation is not in the Morphir Scheme core

(define (deep n) (+ 1 (deep n)))
(deep 0)
;; error: Limit exceeded: evaluation depth

#Limits

(let loop () (loop))
;; error: Limit exceeded: environment frames

///|
test "limits bound a session and leave it usable" {
  let runtime = @scheme.Runtime::new(limits={
    steps: 100,
    depth: 32,
    frames: 100,
  })
  let message = try {
    ignore(runtime.eval("(let loop () (loop))"))
    ""
  } catch {
    e => @scheme.error_message(e)
  }
  inspect(message, content="Limit exceeded: evaluation steps")
  inspect(@scheme.value_to_string(runtime.eval("(+ 1 2)")), content="3")
  assert_eq(@scheme.Limits::default(), {
    steps: 1000000,
    depth: 256,
    frames: 100000,
  })
}

#Embedding

///|
test "a runtime evaluates source text" {
  let runtime = @scheme.Runtime::new()
  ignore(runtime.eval("(define (inc x) (+ x 1))"))
  let answer = runtime.eval("(inc 41)")
  inspect(@scheme.value_to_string(answer), content="42")
}

///|
test "a host procedure joins the session" {
  let runtime = @scheme.Runtime::new()
  runtime.define_native("shout", fn(_runtime, arguments) raise {
    @scheme.arity(arguments, 1, "shout")
    @scheme.Text(arguments[0].as_text() + "!")
  })
  inspect(
    @scheme.value_to_string(runtime.eval("(shout \"hi\")")),
    content="\"hi!\"",
  )
}

///|
test "a closure belongs to its session" {
  let first = @scheme.Runtime::new()
  let second = @scheme.Runtime::new()
  let closure = first.eval("(lambda (x) x)")
  let message = try {
    ignore(second.call(closure, [@scheme.Unit]))
    ""
  } catch {
    e => @scheme.error_message(e)
  }
  assert_true(message != "")
}

///|
test "error_message includes the error details" {
  let runtime = @scheme.Runtime::new()
  let message = try {
    ignore(runtime.eval("(letrec ((a b) (b 1)) a)"))
    ""
  } catch {
    e => @scheme.error_message(e)
  }
  inspect(message, content="Uninitialized recursive binding: b")
}

#Outside the language

(call/cc (lambda (k) (k 1)))
;; error: Unbound identifier: call/cc