Add new math functions and add arities to equals/inequalities. For #13

- Add docs to README including caveat
- / now does floating division
- n-ary =, <, >
- sin, cos, atan functions
- displayln function
- move more python tests into scheme

README.md

@@ -57,9 +57,10 @@ Example:
 
 # Language
 
-Implemented so far:
+`smallscheme` implements the basics of Scheme required to follow
+examples or work problems in SICP, including the following:
 
-## Functions
+## Primitive Functions
 
  *
  +
@@ -68,15 +69,18 @@ Implemented so far:
  <
  =
  >
+ atan
  car
  cdr
  cons
+ cos
  display
  newline
  not
  random
  remainder
  runtime
+ sin
 
 There are also two simple functions used in the Scheme-language tests: `is` and `test`; `test` currently behaves like a `progn` or `do` in other lisps, in that it collects multiple forms to be evaluated and returns the result of the last evaluation. `is` is basically `assert`.
 ## Special Forms
@@ -95,6 +99,11 @@ reading [Structure and Intepretation of Computer
 Programs](https://mitpress.mit.edu/sites/default/files/sicp/index.html),
 in print or (free!) online.
 
+## Caveat
+
+Not a production-ready language implementation -- error messages
+and performance in particular may not be the best.
+
 # Local Development
 
 ## Setup

smallscheme/builtin.py

@@ -1,3 +1,4 @@
+import math
 import operator
 import random
 import sys
@@ -34,13 +35,16 @@ def minus(args):
  args[0][1] - sum(x for (_, x) in args[1:]))
 
 def divide(args):
- return (argstype(args),
- args[0][1] // reduce(operator.mul,
-  (x for (_, x) in args[1:]),
-  1))
+ return ('float',
+ args[0][1] / reduce(operator.mul,
+ (x for (_, x) in args[1:]),
+ 1))
 
 def equals(args):
- return bool_(operator.eq(*args))
+ assert len(args) > 0, "= needs at least one argument"
+ if len(args) == 1:
+ return TRUE
+ return bool_(reduce(operator.and_, [arg == args[0] for arg in args[1:]]))
 
 def compare(args, oper):
  ((ty1, v1), (ty2, v2)) = args[:2]
@@ -50,11 +54,20 @@ def compare(args, oper):
  (ty1, ty2))
  return bool_(oper(v1, v2))
 
+def pairs(coll):
+ return list(zip(coll, coll[1:]))
+
 def lessthan(args):
- return compare(args, operator.lt)
+ assert len(args) > 0, "= needs at least one argument"
+ if len(args) == 1:
+ return TRUE
+ return bool_(all(value(a) < value(b) for a, b in pairs(args)))
 
 def greaterthan(args):
- return compare(args, operator.gt)
+ assert len(args) > 0, "= needs at least one argument"
+ if len(args) == 1:
+ return TRUE
+ return bool_(all(value(a) > value(b) for a, b in pairs(args)))
 
 def notnot(args):
  if args[0] == FALSE:
@@ -96,6 +109,28 @@ def randint(arg):
  raise Exception("Invalid arg type, '%s'!" % t)
  return int_(random.randint(0, v - 1))
 
+def mathsin(arg):
+ t, v = arg[0]
+ if t not in ('int', 'float'):
+ raise Exception("Invalid arg type, '%s'!" % t)
+ return float_(math.sin(v))
+
+def mathcos(arg):
+ t, v = arg[0]
+ if t not in ('int', 'float'):
+ raise Exception("Invalid arg type, '%s'!" % t)
+ return float_(math.cos(v))
+
+def mathatan(arg):
+ t, v = arg[0]
+ if t not in ('int', 'float'):
+ raise Exception("Invalid arg type, '%s'!" % t)
+ return float_(math.atan(v))
+
+def displayln(arg):
+ print(printable_value(arg[0]))
+ return noop
+
 def display(arg):
  print(printable_value(arg[0]), end='')
  return noop
@@ -146,12 +181,16 @@ def set_bang(args):
  '<': lessthan,
  '>': greaterthan,
  'not': notnot,
+ 'sin': mathsin,
+ 'cos': mathcos,
+ 'atan': mathatan,
  'car': car,
  'cdr': cdr,
  'remainder': remainder,
  'random': randint,
  'cons': cons,
  'display': display,
+ 'displayln': displayln,
  'newline': newline,
  'runtime': runtime,
  'is': is_assert,

smallscheme/test_scheme.py

@@ -7,7 +7,7 @@
 def test_evalu():
  """
  Thin, lower-level smoke test of `evalu` function. Much more
- testing of evaluation is done below.
+ testing of evaluation is done in tests.scm.
  """
  def t(a, b):
  teq(evalu(a, {}), b)
@@ -43,66 +43,21 @@ def test_printable_value():
  def t(s1, *s2):
  multiple_eval_check(s1, {}, *s2)
 
- t("1234", "1234")
- t("#f", "#f")
- t("#t", "#t")
  t("+", "Internal procedure '+'")
  t("/", "Internal procedure '/'")
  t("(quote a)", "a")
  t("()", "()")
  t("(quote 0)", "0")
  t("(quote (1 2 3))", "(1 2 3)")
  t("(quote (a b c))", "(a b c)")
- t("(+ 1 1)", "2")
- t("(+ 1 2 3)", "6")
- t("(+ 1 2 (+ 1 1 1))", "6")
- t("(* 1 1)", "1")
- t("(* 1 2 3 4 5)", "120")
  t("""(+ 1
  2
  3)""", "6")
- t("(- 10 7)", "3")
- t("(- 10)", "-10")
- t("(/ 10 5)", "2")
- t("(/ 16 2 2 2)", "2")
- t("(+ 3 5)", "8")
- t("(* 2 4)", "8")
- t("(+ (* 2 4) (+ 3 5))", "16")
  t("""(+ (* 3
  (+ (* 2 4)
  (+ 3 5)))
  (+ (- 10 7)
  6))""", "57")
- t("(= 1 1)", "#t")
- t("(= 1 2)", "#f")
- t("(= 1 (quote notone))", "#f")
- t("(= #t #t)", "#t")
- t("(not #t)", "#f")
- t("(not #f)", "#t")
- t("(not 1)", "#f")
- t("(> 2 1)", "#t")
- t("(> 1 2)", "#f")
- t("(< 2 1)", "#f")
- t("(< 1 2)", "#t")
- # FIXME: higher arities of < and >.
- t("(cond (#t #t))", "#t")
- t("(cond (#t 3))", "3")
- t("(cond (#t #f))", "#f")
- t("(cond (#f #f) (#t #f))", "#f")
- t("(cond (#f #f) (#t #t))", "#t")
- t("(cond (#f #f) (else #t))", "#t")
- t("(if #t 1 2)", "1")
- t("(if #f 1 2)", "2")
- t("(or)", "#f")
- t("(or 1)", "1")
- t("(or #f 1)", "1")
- t("(or 1 1)", "1")
- t("(and)", "#t")
- t("(and #t)", "#t")
- t("(and 1 #t)", "#t")
- t("(and #t 1)", "1")
- t("(and #t #f)", "#f")
- t("(and #f #f)", "#f")
 
 def test_define():
  def t(a, b, env1):
@@ -120,24 +75,6 @@ def test_runtime():
  assert type(evalu(parse_str("(runtime)")[0],
  env)) is int
 
-def test_multiple_defines():
- env = {}
- def t(s1, *s2):
- multiple_eval_check(s1, env, *s2)
- # Adapted from SICP p. 8:
- t("(define pi 3.14159)")
- t("(define radius 10)")
- t("(* pi (* radius radius))", "314.159")
- t("(define circumference (* 2 pi radius))")
- t("circumference", "62.8318")
- # p. 19:
- t("(define x 7)")
- t("(and (> x 5) (< x 10))", "#t")
- t("(car (quote (1 2 3)))", "1")
- t("(car (quote (a b c)))", "a")
- t("(cdr (quote (1 2 3)))", "(2 3)")
- t("(cdr (quote (a b c)))", "(b c)")
-
 def test_random():
  for _ in range(50):
  t, v = evalu(parse_str("(random 10)")[0], {})

tests.scm

@@ -1,6 +1,8 @@
 (test
- ;; basic truthy / equality stuff
+ ;; basic truthy / equality / math stuff
  (is #t)
+ (is (= #t #t))
+ (is (= #f #f))
  (is (not #f))
  (is 0)
  (is ())
@@ -10,13 +12,68 @@
  (is (not (= (quote being) (quote nothingness))))
  (is (= 1 1))
  (is (not (= 1 2)))
- (is (= 2 (+ 1 1))))
+ (is (= 2 (+ 1 1)))
+ (is (= 1234 1234))
+ (is (= 2 (+ 1 1)))
+ (is (= 6 (+ 1 2 3)))
+ (is (= 6 (+ 1 2 (+ 1 1 1))))
+ (is (= 1 (* 1 1)))
+ (is (= 120 (* 1 2 3 4 5)))
+ (is (= 3 (- 10 7)))
+ (is (= -10 (- 10)))
+ (is (= 2.0 (/ 10 5)))
+ (is (= 2.0 (/ 16 2 2 2)))
+ (is (= 8 (+ 3 5)))
+ (is (= 8 (* 2 4)))
+ (is (= 16 (+ (* 2 4) (+ 3 5))))
+ (is (= #t (= 1 1)))
+ (is (= #f (= 1 2)))
+ (is (= #f (= 1 (quote notone))))
+ (is (= #t (= #t #t)))
+ (is (= #f (not #t)))
+ (is (= #t (not #f)))
+ (is (= #f (not 1)))
+ (is (= #t (> 2 1)))
+ (is (= #f (> 1 2)))
+ (is (= #f (< 2 1)))
+ (is (= #t (< 1 2)))
+ (is (= #t (cond (#t #t))))
+ (is (= 3 (cond (#t 3))))
+ (is (= #f (cond (#t #f))))
+ (is (= #f (cond (#f #f) (#t #f))))
+ (is (= #t (cond (#f #f) (#t #t))))
+ (is (= #t (cond (#f #f) (else #t))))
+ (is (= 1 (if #t 1 2)))
+ (is (= 2 (if #f 1 2)))
+ (is (= #f (or)))
+ (is (= 1 (or 1)))
+ (is (= 1 (or #f 1)))
+ (is (= 1 (or 1 1)))
+ (is (= #t (and)))
+ (is (= #t (and #t)))
+ (is (= #t (and 1 #t)))
+ (is (= 1 (and #t 1)))
+ (is (= #f (and #t #f)))
+ (is (= #f (and #f #f))))
 
 (test
  ;; basic state / defines
  (define b 4)
  (define a 3)
- (is (= 13 (+ 1 (* a b)))))
+ (is (= 13 (+ 1 (* a b))))
+ ;; P. 8:
+ (define pi 3.14159)
+ (define radius 10)
+ (is (= 314.159 (* pi (* radius radius))))
+ (define circumference (* 2 pi radius))
+ (is (= 62.8318 circumference))
+ ;; P. 19:
+ (define x 7)
+ (is (= #t (and (> x 5) (< x 10))))
+ (is (= 1 (car (quote (1 2 3)))))
+ (is (= (quote a) (car (quote (a b c)))))
+ (is (= (quote (2 3)) (cdr (quote (1 2 3)))))
+ (is (= (quote (b c)) (cdr (quote (a b c))))))
 
 (define (square x)
  (* x x))
@@ -48,7 +105,7 @@
 
 (test
  (define (abs x)
- (cond ((> x 0) x)
+ (cond ((< 0 x) x)
  ((= x 0) 0)
  ((< x 0) (- x))))
  (is (= 10 (abs 10)))
@@ -66,7 +123,9 @@
  (else x)))
 
  (is (= 10 (abs 10)))
- (is (= 10 (abs -10))))
+ (is (= 10 (abs -10)))
+ (is (= 16 (abs 16)))
+ (is (= 16.0 (abs 16.0))))
 
 (test
  (define (factorial n)
@@ -102,6 +161,23 @@
  ;; (is (= 100.0 (square (sqrt 100))))
 )
 
+(test
+ ;; Different arities for comparison fns:
+ (is (= 0))
+ (is (= 0 0))
+ (is (= 0 0 0))
+ (is (= 0 0 0 0))
+ (is (= (quote foo)
+ (quote foo)
+ (quote foo)))
+ (is (not (= 0 0 1)))
+ (is (< 0)) ;; yes, it's a little strange...
+ (is (> 0))
+ (is (< 0 1 2))
+ (is (not (< 0 1 1)))
+ (is (> 2 1 0))
+ (is (not (> 2 1 1))))
+
 (test
  ;; p. 30
  (define (sqrt x)
@@ -114,7 +190,7 @@
  guess
  (sqrt-iter (improve guess))))
  (sqrt-iter 1.0))
- (is (= 3.0 (sqrt 9))))
+ (is (< 2.999 (sqrt 9) 3.0001)))
 
 (test
  ;; p. 45
@@ -287,3 +363,14 @@
  (let ((x 3)
  (y (+ x 2)))
  (* x y)))))
+
+(test
+ ;; more math
+ (define pi 3.141592653589793)
+ (is (= 0.0 (sin 0)))
+ (is (< (sin pi) 0.000001))
+ (is (= 1.0 (cos 0)))
+ (is (< -0.0001 (cos (/ pi 2)) 0.0001))
+ (is (= -1.0 (cos pi)))
+ (is (= 0.0 (atan 0)))
+ (is (< 1.569 (atan 1000) 1.570)))