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


Source Code Of The For Macro

The for macro defines a complex iteration statement. It is extensible through the use of the define-for-clause and define-for-result macros. The for-statement class provides for communication among these macros.

The features of the for statement are perhaps best explained through its source code and comments:

;; This class holds the state passed between the for statement and its extensions
defclass for-statement(macro-context, previous-context, scope)
  ;; The following five stacks collect information about the clauses.
  ;; The first three stacks must be maintained in parallel with each other.
  ;; The vars stack contains typed-variables, the rest contain expressions.
  ;; The vars are in scope in the steps and endtests, but not in the inits
  ;; and setup.  When the vars are advanced to the steps' values, all vars
  ;; are redefined in parallel.
  ;; The setup expressions are evaluated before anything else.
  vars     = stack()            ; iteration variables
  inits    = stack()            ; initial value expressions for vars
  steps    = stack()            ; next value expressions for vars
  endtests = stack()            ; true => continue iteration
  setup    = stack()            ; evaluated first

  ;; The following slots collect information from result statements.
  result-family          := false       ; to detect inconsistencies
  result                 := false       ; result to return
  _exit is name or false := false       ; exit function name
  exit is name read: _exit or           ; ditto, create on demand
                     _exit := name("for-exit", this.macro-context)

  ;; The following slots contain useful context
  macro-context    = macro-context
  previous-context = previous-context
  scope            = scope

;; Dictionary of all defined for result statements keyed by simple-name.
def *for-result-statements* = dictionary()

;; This is the skeleton of the for statement.
;; The clauses and result statements are all defined as extensions.
defmacro for =>

  ;; The for statement will be enclosed in a block, set up the corresponding
  ;; compiler scope before parsing
  with-new-compiler-scope

    ;; Create the object to hold the state for extensions.
    def state = for-statement(macro-context, previous-context,
                              get-local-compiler-scope())

    ;; Define the for clause parser, which works by calling extensions
    ;; defined by define-for-clause.  Unusually, it returns its results
    ;; by pushing them on the stacks rather than as ordinary values.
    def parse-for-clause(tokens, error?)
      def token = next-after-newline(tokens)
      if token is name
        ;; Look for an endtest clause defined by this name
        def parser = known-definition(name(#"parse-for-?(token)-endtest-clause", token))
        if parser is function
          advance-after-newline(tokens)
          parser(tokens, state)
        else
          ;; Look for an iteration clause, starting with a typed-variable
          def var = parse-typed-variable(tokens, error?)
          if var
            def token = next-after-newline(tokens)
            ;; Look for an iteration clause defined by this name
            def parser = token is name and
                         known-definition(name(#"parse-for-?(token)-iteration-clause", token))
            if parser is function
              advance-after-newline(tokens)
              parser(tokens, var, state)
            else
              wrong-token-error(tokens, "an iteration clause name")
      elseif error?
        wrong-token-error(tokens, "a variable name or an endtest clause name")

    ;; Define the available result statement extensions in the local scope.
    add-for-result-statements(state.scope, previous-context, state)

    ;; Now we are ready to parse the for statement and generate the code.
    defparser for-statement { ?clause is for-clause & ~^ , }+ ?:loop-body =>

      ;; Get the parts of the loop-body
      def body           = loop-body.body
      def result-1       = loop-body.result or `false`
      def cleanup        = loop-body.cleanup
      def exit-1         = loop-body.exit
      def cleanup-clause = cleanup and `cleanup: ?cleanup`
      def exit-clause-1  = exit-1 and `exit: ?exit-1`

      ;; Get the stuff defined by any result statements that were used
      def exit-2         = state._exit
      def exit-clause-2  = exit-2 and `exit: ?exit-2`
      def result-2       = state.result

      ;; Get the stuff defined by iteration and endtest clauses
      if state.endtests.length = 0 state.endtests.push := `true`
      def vars     = state.vars.bottom-up
      def inits    = state.inits.bottom-up
      def steps    = state.steps.bottom-up
      def endtests = state.endtests.bottom-up
      def setup    = state.setup.bottom-up

      ;; Put it all together
      `block
         ?exit-clause-1
         block
           ?exit-clause-2
           { ^ ?setup }*
           def loop({ ?vars &, }*)
             if { ?endtests & and }*
               ?body
               loop({ ?steps &, }*)
           loop({ ?inits &, }*)
           ?result-1
           ?result-2
        ?cleanup-clause`

    ;; Now invoke the locally defined parser to expand the macro
    ;; The true argument means report an error if it fails to parse
    parse-for-statement(tokens, true)

;; Subroutine to define the available result statement extensions in a local scope.
;; A result statement is available if its parser is in scope in the context of the
;; caller of the for statement.
;; This could be written using for but then it would depend on itself.
def add-for-result-statements(scope, previous-context, state)
  def state := start-iteration(*for-result-statements*)
  until end?(*for-result-statements*, state)
    def nam = next-key(*for-result-statements*, state)
    def fcn = next(*for-result-statements*, state)
    if known-definition(name(#"parse-for-?(nam)-result", previous-context)) eq fcn
      constant-definition(scope, name(nam, previous-context), macro(fcn(_, state)))
    state := advance(*for-result-statements*, state)

;; Define a for result statement which will be locally available inside a for
;; statement so long as the function defined here is in scope.
defmacro define-for-result ?:name ?:pattern \=> ?:block =>
  def stmt   = simple-name(name)
  def parser = name-in-context(#"parse-for-?(name)-result", previous-context)
  `do
     def ?parser(?=tokens is token-stream, ?=state is for-statement)
       def ?=macro-context = unique-macro-context()
       ?block
     *for-result-statements*[#?stmt] := ?parser`

;; Define a for clause which will be available when the function
;; defined here is in scope.
;; An iteration clause starts with ? and the name for the typed variable
;; followed by the name of the clause and additional pattern.
;; An endtest clause starts with an ordinary name followed by additional pattern.
;; A clause parses itself into the stacks in the state.
defmacro define-for-clause
  \? ?:variable [ is typed-variable ] ?clause is name ?:pattern \=> ?:block =>
    ;; This is an iteration clause
    def parser = name-in-context(#"parse-for-?(clause)-iteration-clause",
                                 previous-context)
    def possibilities = collect-pattern-starts(list(pattern))
    def err = `wrong-token-error(?=tokens, ?possibilities)`
    def expander = translate-pattern(`?=tokens`, pattern, block, err)
    `def ?parser(?=tokens is token-stream, ?variable is typed-variable,
                 ?=state is for-statement)
       def ?=macro-context = unique-macro-context()
       ?expander`
  ?clause is variable ?:pattern \=> ?:block =>
    ;; This is an endtest clause
    def parser = name-in-context(#"parse-for-?(clause)-endtest-clause",
                                 previous-context)
    def possibilities = collect-pattern-starts(list(pattern))
    def err = `wrong-token-error(?=tokens, ?possibilities)`
    def expander = translate-pattern(`?=tokens`, pattern, block, err)
    `def ?parser(?=tokens is token-stream, ?=state is for-statement)
       def ?=macro-context = unique-macro-context()
       ?expander`

;; Define the "standard" for-clauses.  The user can define more.

;; Continue iterating while a test is true
define-for-clause while ?test => state.endtests.push := test

;; Continue iterating while a test is false
define-for-clause until ?test => state.endtests.push := `not ?test`

;; Set variable to initial-value first time, next-value thereafter
define-for-clause ?var = ?initial-value then ?next-value =>
  state.vars.push  := var
  state.inits.push := initial-value
  state.steps.push := next-value

;; Iterate over elements of a sequence
define-for-clause ?var in ?sequence [ key ?key is typed-variable ] =>
  ;; Set up a variable to hold the sequence being iterated
  state.setup.push := `def sequence = ?sequence`

  ;; Set up an iteration variable to hold the iteration state
  state.vars.push  := typed-variable(`state`, `$anything`)
  state.inits.push := `start-iteration(sequence)`
  state.steps.push := `advance(sequence, state)`

  ;; Set up an endtest to check if the iteration is exhausted
  state.endtests.push := `not end?(sequence, state)`

  ;; Define the variable(s) of iteration in an endtest so later
  ;; endtests will be able to see them
  def vardef = `def ?var = next(sequence, state)`
  def keydef = key and `def ?key = next-key(sequence, state)`
  state.endtests.push := `do
                           ?vardef
                           ?keydef
                           true`

;; Iterate over an arithmetic range
;; Either an initial-value or a limit must be specified.
;; If there is no initial-value, it defaults to 0.
;; If there is no limit, there is no endtest.
;; The increment defaults to 1.  If downfrom, downto, or above
;; is used, the increment is subtracted, otherwise the increment is added.
;; The increment can be written before or after the limit.
;; The order of evaluation of initial-value, increment, and limit
;; is not guaranteed.
define-for-clause ?var [ { from | downfrom ??down } ?initial-value ]
                       [ { { to |
                             downto ??down |
                             below ??exclusive |
                             above ??down ??exclusive }
                           ?limit } |
                         by ?increment ]* =>
  if not initial-value and not limit
    error("Either an initial-value or a limit must be specified.")
  def variable      = var.name
  def increment1    = if increment then `by` else 1
  def addsub        = if down then `-` else `+`
  state.vars.push  := var
  state.inits.push := initial-value or 0
  state.steps.push := `?variable ?addsub ?increment1`

  if increment          ;only evaluate increment expression once
    state.setup.push := `def by = ?increment`

  if limit
    state.setup.push := `def limit = ?limit`
    def op = if down
               if exclusive `>` else `>=`
             else
               if exclusive `<` else `<=`
    state.endtests.push := `?variable ?op limit`

;; Define the "standard" for result statements.  The user can define more.

;; Immediately return from the for statement
;; Any following expressions are the values to return
define-for-result return [ ~^ { ?value & ~^ , }+ ] =>
  def exit = state.exit
  `?exit( { ?value &, }* )`

;; Add up numbers
define-for-result sum ?number =>
  if not state.result-family
    state.result-family := #sum/count
    state.result        := `accumulator`
    state.setup.push    := `def accumulator := 0`
  else if state.result-family ~= #sum/count
    error("Cannot mix sum/count and " + state.result-family + " result statements.")
  def accumulator = state.result
  `?accumulator := ?accumulator + ?number`

;; Count the number of times a test is true
define-for-result count ?test =>
  if not state.result-family
    state.result-family := #sum/count
    state.result        := `accumulator`
    state.setup.push    := `def accumulator := 0`
  else if state.result-family ~= #sum/count
    error("Cannot mix sum/count and " + state.result-family + " result statements.")
  def accumulator = state.result
  `if ?test ?accumulator := ?accumulator + 1`

;; Set result to minimum of occurrences of value
define-for-result minimize ?value =>
  if not state.result-family
    state.result-family := #minimize
    state.result        := `accumulator`
    state.setup.push    := `def accumulator := false`
  else if state.result-family ~= #minimize
    error("Cannot mix minimize and " + state.result-family + " result statements.")
  def accumulator = state.result
  `block
     def temp = ?value
     if not ?accumulator or temp < ?accumulator
       ?accumulator := temp`

;; Set result to maximum of occurrences of value
define-for-result maximize ?value =>
  if not state.result-family
    state.result-family := #maximize
    state.result        := `accumulator`
    state.setup.push    := `def accumulator := false`
  else if state.result-family ~= #maximize
    error("Cannot mix maximize and " + state.result-family + " result statements.")
  def accumulator = state.result
  `block
     def temp = ?value
     if not ?accumulator or temp > ?accumulator
       ?accumulator := temp`

;; Collect value into a collection that will be the result of the for statement
define-for-result collect ?value =>
  if not state.result-family
    state.result-family := #collect/append
    state.result        := `collection-stack.bottom-up`
    state.setup.push    := `def collection-stack = stack()`
  else if state.result-family ~= #collect/append
    error("Cannot mix collect/append and " + state.result-family + " result statements.")
  ;; The first token of state.result is the name of the collection stack.
  ;; This assumes the sequence constructed by `...` is actually an array.
  def collection-stack = state.result[0]
  `?collection-stack.push := ?value`

;; Append elements of value to a collection that will be the result of the for statement
define-for-result append ?value =>
  if not state.result-family
    state.result-family := #collect/append
    state.result        := `collection-stack.bottom-up`
    state.setup.push    := `def collection-stack = stack()`
  else if state.result-family ~= #collect/append
    error("Cannot mix collect/append and " + state.result-family + " result statements.")
  def collection-stack = state.result[0]
  `append-to(?collection-stack, ?value)`

def append-to(stack is stack, value is sequence)
  def state := start-iteration(value)
  until end?(value, state)
    stack.push := next(value, state)
    state := advance(value, state)


Previous page   Table of Contents   Next page