Programming Language for Old Timers


by David A. Moon
February 2006 .. September 2008

Comments and criticisms to dave underscore moon atsign alum dot mit dot edu.


Previous page   Table of Contents   Next page


S-Expressions

PLOT does not include Lisp's S-expressions (lists made out of conses) but if you like them you can easily implement them yourself, as follows. There might be a 50% space penalty compared to a typical Lisp implementation that has a special representation for cons cells. Of course if the implementation does have a special representation for cons cells you would simply add ": intrinsic(cons)" to defclass list and the compiler would know to use that representation.

For clarity (?) I have omitted the export: keyword from in front of the following definitions.

module:
defmodule S-expressions
  shadow: list, $list           ; don't import PLOT's definition of list

;; The base class of all S-expression lists
defclass list (car, cdr) is assignable-array : abstract
  _car := car
  _cdr := cdr

;; The class of all S-expression lists except the empty list
defclass cons (car, cdr) is list

;; A special class just for the empty list
defclass null ()
        ;; car and cdr of nil are nil
        is list (this, this)

;; A named constant whose value is the empty list
;; By convention this is the only instance of null
def nil = null()

;; null() is the constructor, null(x) is a predicate
defun null(x) x eq nil

;; The usual functions on lists
;; car and cdr are defined as slot readers
;; car:= and cdr:= are defined as slot writers
;; but need to be overridden for null - since the slot
;; writers are sealed, we have to use private slot names
;; to allow this override.

defun car(x is list) : sealed
  x._car
defun cdr(x is list) : sealed
  x._cdr
defun car(x is list) := y
  x._car := y
defun cdr(x is list) := y
  x._cdr := y

defun car:=(x is null, y) error("Can't change car of nil")
defun cdr:=(x is null, y) error("Can't change cdr of nil")
defun atom?(x) not (x is cons)
defun null?(x) x eq nil

defun rplaca(x is cons, y)
  x._car := y
  x

defun rplacd(x is cons, y)
  x._cdr := y
  x

defun list(rest: x)
  def result := nil
  for i from x.length - 1 downto 0
    result := cons(x[i], result)
  result

;; This uses eval-once which introduces temporary variables
;; as needed to prevent arguments in list from being evaluated twice
defmacro push(?item, ?list) =>
  def [temps, values, expr] = eval-once(list)
  `block
    { def ?temps = ?values & ^ }*
    ?expr := cons(?item, ?expr)`

defmacro pop(?list) =>
  def [temps, values, expr] = eval-once(list)
  `block
     { def ?temps = ?values & ^ }*
     def result = car(?expr)
     ?expr := cdr(?expr)
     result`

defun print(x is list, stream)
  def where := x
  write('(', stream)                    ; TODO add pretty-print hook
  until atom?(where)
    print(where.car, stream)
    write(' ', stream)                  ; TODO add pretty-print hook
    where := where.cdr
    if atom?(where) and not null?(where)
      write(". ", stream)
      print(where, stream)
  write(')', stream)                    ; TODO add pretty-print hook

;; Implement the sequence protocol, which all arrays implement
;; The iteration state is the current cons in the list

defun start-iteration(x is list) x
defun end?(x is list, state) atom?(state)
defun advance(x is list, state is list) state.cdr
defun next(x is list, state is cons) state.car

;; Implement the assignable-sequence protocol

defun next(x is list, state is cons) := new-element
  state.car := new-element

;; Implement the collection protocol

defun length(x is list)
  def length := 0
  def where := x
  while where is cons
    length := length + 1
    where := where.cdr
  length

defun empty?(x is list) x is null

;; Use default implementation of member?, any?, every?, map, reduce,
;; reduce-right, and = in terms of iteration

;; Implement the array protocol

;; Subroutine of the [ and [:= methods
;; Find the i'th cons in list x
defun _subscript(x is list, i is 0..max-length) is cons
  def where := x
  def count := i
  while count > 0 and where is cons
    count := count - 1
    where := where.cdr
  if atom?(where)
    subscript-range-error(x, i)
  where

defun (x is list)[i is integer]
  _subscript(x, i).car

defun position(element, list is list) is integer or false
  for item in list, pos from 0
    if item eq element
      return pos

;; Or you could implement position this way:
defun position(element, list is list) is integer or false
  defun loop(list, pos)
    if atom?(list)
      false
    else if car(list) eq element
      pos
    else loop(cdr(list), pos + 1)
  loop(list, 0)

defun (x is list) + (y is list) is list
  if x is null
    y
  else cons(car(x), cdr(x) + y)

;; A better way to implement + without recursion, but one extra cons, might be:
defun (x is list) + (y is list) is list
  def head = cons(nil, nil)
  defun loop(in, out)
    if in is null
      cdr(out) := y
    else
      loop(cdr(in), cdr(out) := cons(car(in), nil))
  loop(x, head)
  cdr(head)

defun (x is list) + (y is array) is list
  x + list(y...)

defun (x is list) + (y is anything) is list
  x + cons(y, nil)

defun reverse(x is list) is list
  defun loop(in, out)
    if in is null then out
    else loop(cdr(in), cons(car(in), out))
  loop(x, nil)

defun first(x is list)
  car(x)

defun last(x is list)
  if cdr(x) is null
    car(x)
  else last(cdr(x))

;; Implement the assignable-array protocol

defun (x is list)[i is integer] := y
  _subscript(x, i).car := y

defun first(x is list) := y
  car(x) := y

defun last(x is list) := y
  if cdr(x) is null
    car(x) := y
  else last(cdr(x)) := y


Previous page   Table of Contents   Next page