Lunar Programming Language

by David A. Moon
January 2017 - January 2018



Collection Types

A collection is a datum that contains other data, but not in named slots. The contained data are the collection's members.

Sequences

A sequence is any collection that can enumerate its members using the sequence iteration protocol. This protocol is based on a position, which specifies where the iteration currently is at in the sequence. The data type that represents a position is unspecified; most sequences use non-negative integers but you should not use a position for anything other than a parameter to a function in the sequence iteration protocol, except when writing the implementation of a specific sequence class.

There are several classes that implement the sequence iteration protocol. They advertise that fact by inheriting from sequence as a superclass. Depending on the specific class, the order of members may be part of the semantics of the class or may be accidental.

sequence is a generic class with an optional generic formal parameter that specifies the type of the members of the sequence.

The sequence iteration protocol could have been defined by:

abstract:
defclass sequence[optional: member_type = everything type]

require iterate(seq sequence) => ?                     ; initial position
require more?(seq sequence, pos ?) => boolean          ; false if iteration is finished
require[type] next(seq sequence[type], pos ?) => type  ; next member of the sequence
require iterate(seq sequence, pos ?) => ?              ; next position
Since the type of a position is unspecified, it is ? in the protocol.

It is an error to call iterate or next with a position for which more? returns false.

The sequence iteration protocol does not have side-effects on the sequence nor on the position.

Every sequence has a known length, its number of members, which can be accessed by reading the length slot. This might be a real slot or a pseudo-slot. This part of the sequence protocol could have been defined by:

def max_length = (an implementation-dependent positive integer)

require (seq sequence).length => 0..max_length

A constant sequence is a sequence whose members cannot be replaced. The members themselves could be constant or mutable. The constant sequence protocol could have been defined by:

abstract:
defclass constant_sequence[optional: member_type = everything type] sequence[member_type]
This class simply adds the "constancy" feature to the sequence class.

A variable sequence is a sequence whose members can be replaced. The variable sequence protocol could have been defined by:

abstract:
defclass sequence![optional: member_type = everything type] sequence[member_type]
  disjoint: constant_sequence

require[type] next(seq sequence![type], pos ?) := (new_value type)
This class simply adds the "variability" feature to the sequence class. The disjoint: specification guarantees that no sequence can be both constant and variable.

The + operator works on sequences, producing the concatenation of the two sequences. It does not copy the sequences, so if they are variable the result changes when an input changes.

The * operator works on a non-negative integer and a sequence (in either order). It concatenates the sequence with itself the number of times specified. It does not copy the sequence, so if it is variable the result changes when the sequence changes.

Reversible Sequences

A reversible sequence is a sequence that can be iterated backwards.

The reversible sequence iteration protocol could have been defined by:

abstract:
defclass reversible_sequence[optional: member_type = everything type] sequence[member_type]

require reverse_iterate(seq reversible_sequence) => ?            ; initial position
require reverse_more?(seq reversible_sequence, pos ?) => boolean ; false if iteration is finished
require reverse_iterate(seq reversible_sequence, pos ?) => ?     ; next position

;use next(seq, pos) to get the member at the position
A reversible_sequence can be constant or variable.

Keyed Sequences

A keyed sequence is a collection that associates each member with a key. No two keys can be =.

The infix [ operator can be used to retrieve a member given its key.

The types of keys and members can each be restricted.

The keyed sequence iteration protocol enumerates the keys and members, using a position just like the sequence iteration protocol.

Some classes implement both the sequence iteration protocol and the keyed sequence iteration protocol. The members enumerated by the two protocols are not necessarily the same. The positions must be compatible if they are of non-disjoint types, because the two protocols share the more? function.

The keyed sequence protocol could have been defined by:

abstract:
defclass keyed_sequence[optional: key_type = everything type,
                                  member_type = everything type]

require keyed_iterate(seq keyed_sequence) => ?                    ; initial position
require more?(seq keyed_sequence, pos ?) => boolean               ; false if iteration is finished
require[key_type, member_type]                                    ; next key of the sequence
  next_key(seq keyed_sequence[key_type, member_type], pos ?) => key_type
require[key_type, member_type]                                    ; next member of the sequence
  next_member(seq keyed_sequence[key_type, member_type], pos ?) => member_type
require keyed_iterate(seq keyed_sequence, pos ?) => ?             ; next position
require[key_type, member_type]                                    ; member for key, error if not found
  (seq keyed_sequence[key_type, member_type])[key key_type] => member_type
require[key_type, member_type]                                    ; member for key or default value
  (seq keyed_sequence[key_type, member_type])[key key_type, named: default]
Since the type of a position is unspecified, it is ? in the protocol.

It is an error to call keyed_iterate, next_key, or next_member with a position for which more? returns false.

The keyed sequence iteration protocol does not have side-effects on the sequence nor on the position.

Note that [ with a default does not require the default to be in member_type.

A constant keyed sequence is a keyed sequence whose members cannot be replaced. This protocol could have been defined by:

abstract:
defclass constant_keyed_sequence[optional: key_type = everything type,
                                           member_type = everything type] \
         keyed_sequence[key_type, member_type]
This class simply adds the "constancy" feature to the keyed_sequence class.

A variable keyed sequence is a keyed sequence whose members can be replaced. The affected member can be identified by key or by position. This protocol could have been defined by:

abstract:
defclass keyed_sequence![optional: key_type = everything type,
                                   member_type = everything type] \
         keyed_sequence[key_type, member_type]
         disjoint: constant_keyed_sequence

require[key_type, member_type]                               ; change next member of the sequence
  next_member(seq keyed_sequence![key_type, member_type], pos ?) := (new_value member_type)
require[key_type, member_type]                               ; change member by key
  (seq keyed_sequence![key_type, member_type])[key key_type] := (new_value member_type)

The | operator works on keyed sequences, producing the union of the two keyed sequences. If the same key is in both keyed sequences, | chooses the member from the left-hand operand. | does not copy the keyed sequences, so if they are variable the result changes when an input changes.

Note that if two data are both sequence and keyed_sequence, + will produce a sequence and lose the keys, while | will produce a keyed_sequence that retains the keys.

Successions

A succession is a sequence whose positions are monotonically increasing integers starting from zero and not larger than max_length. The positions are not necessarily consecutive integers.

A succession is also a keyed_sequence whose keys are the same as its sequence positions and whose members in the keyed sequence protocol are the same as its members in the sequence protocol.

Besides the keyed_sequence lookup operator [, successions support [ with a range of positions, whose result is a subsuccession containing each member whose key is in the range. It does not make a copy of the input succession, so if the succession is variable the result changes when the input changes.

The succession protocol could have been defined by:

abstract:
defclass succession[optional: member_type = everything type] sequence[member_type],
                keyed_sequence[0..max_length, member_type]

require iterate(s succession) => 0..0  ; starting position must be zero
require (s succession).end_position => 0..max_length              ; where more? becomes false
require[T] (s succession[T])[r range[integer]] => succession[T]   ; subsuccession

A succession can be constant. The constant succession protocol could have been defined by:

abstract:
defclass constant_succession[optional: member_type = everything type] succession[member_type],
                constant_sequence[member_type],
                constant_keyed_sequence[0..max_length, member_type]

require[T] (s constant_succession[T])[r range[integer]] => constant_succession[T] ; constant subsuccession

A succession can be variable. The variable succession protocol could have been defined by:

abstract:
defclass succession![optional: member_type = everything type] succession[member_type],
                sequence![member_type],
                keyed_sequence![0..max_length, member_type]

require[T] (s succession![T])[r range[integer]] => succession![T]    ; variable subsuccession

Lists

Perhaps the simplest and most commonly used sequence is a list. Its constructor takes any number of actual parameters and returns a list whose members are the actual parameters. It is a generic class so the member type can be restricted.

Lists are successions. The key and iteration position are the 0-origin index into the list.

list could have been defined by:

sealed: abstract:
defclass list[optional: member_type = everything type](members member_type...) \
           succession[member_type], reversible_sequence[member_type]
  _members[members.length] := members   ; _members is a private slot
                                        ; unauthorized access could break immutability

;; Implement the sequence protocol, the position is the subscript
def (x list).length                      x._members.length
def iterate(x list)                      0           ; initial position
def more?  (x list, pos 0..max_length)   pos < x._members.length
def next   (x list, pos 0..max_length-1) x._members[pos]
def iterate(x list, pos 0..max_length-1) pos + 1

;; Implement the reversible_sequence protocol, same position
def reverse_iterate(x list)                      x.length - 1
def reverse_more?(x list, pos -1..max_length-1)  pos >= 0
def reverse_iterate(x list, pos 0..max_length-1) pos - 1

;; Implement the keyed_sequence protocol
def keyed_iterate(x list)                      0     ; initial position
def next_key     (x list, pos 0..max_length-1) pos
def next_member  (x list, pos 0..max_length-1) x._members[pos]
def keyed_iterate(x list, pos 0..max_length-1) pos + 1
def (x list)[y 0..max_length-1]                x._members[y]
def (x list)[y integer]                        subscript_range_error(x, y, 0..<x.length)
def (x list)[y integer, named: default]
  if 0 <= y < x.length then x._members[y] else default

;; Implement the succession protocol
def (x list).end_position                x.length
def[T] (x list[T])[r range[integer]]     subsuccession[T](x, r)

The list function returns a constant list, an instance of the constant_list class which could have been defined by:

defclass constant_list[optional: member_type = everything type] \
            constructor: list(members member_type...) \
            list[member_type](members...), constant_succession[member_type]
This class simply adds the "constancy" feature to the list class.

A variable list is an instance of the list! class which could have been defined by:

defclass list![optional: member_type = everything type](members member_type...) \
            list[member_type](members...),
            succession![member_type]

;; Implement the variable sequence protocol
def[T] next(x list![T], pos 0..max_length-1) := (new_value T)
  x._members[pos] := new_value

;; Implement the variable keyed sequence protocol
def[T] next_member(x list![T], pos 0..max_length-1) := (new_value T)
  x._members[pos] := new_value

def[T] (x list![T])[pos 0..max_length-1] := (new_value T)
  x._members[pos] := new_value

;; Implement the variable succession protocol
def[T] (x list![T])[r range[integer]] subsuccession![T](x, r)
This class adds the "variability" feature to the list class.

Stacks

A stack is a variable-length sequence. The push! and pop! functions increment or decrement the length and add or remove a member at the end of the sequence. The append! function pushes the members of a sequence onto the stack. Although stack is variable, there is no ! in the name, because it would make no sense to have a constant variant of stack.

stack could have been defined by:

sealed:
defclass stack[optional: member_type = everything type](initial_content member_type...) \
            succession![member_type]
  length    := initial_content.length                   0..max_length
  _contents := list![member_type](initial_content...)   list![member_type]

;; Add to the top of the stack
def[member_type] push!(stk stack[member_type], val member_type)
  if stk._contents.length > stk.length
    stk._contents[stk.length] := val
  else
    def expansion = if stk.length < 10 then 10
                    else if stk.length < 200 then stk.length
                    else stk.length / 2
    stk._contents := list![member_type](stk._contents + expansion * [val]...)

  stk.length := stk.length + 1
  val

;; Remove from the top of the stack
def[member_type] pop!(stk stack[member_type])
  assert stk.length > 0
  stk.length := stk.length - 1
  stk._contents[stk.length]

def[member_type] (stk stack[member_type]).top
  assert stk.length > 0
  stk._contents[stk.length - 1]

;; Append all members of a sequence to the top of the stack
;; For convenience the sequence does not have to have the same member type
;; but of course the actual members have to be of the stack's member type
def[member_type] append!(stk stack[member_type], seq sequence)
  if stk._contents.length >= stk.length + seq.length
    for mem in seq
      stk._contents[stk.length] := mem
      stk.length := stk.length + 1
  else
    stk._contents = list![member_type](stk + seq...)
    stk.length := stk._contents.length
  stk

;; Implement the sequence protocol, the position is the subscript

def iterate (s stack)                     0
def more?   (s stack, i 0..max_length)    i < s.length
def next    (s stack, i 0..max_length-1)  s._contents[i]
def iterate (s stack, i 0..max_length-1)  i + 1

;; Implement the sequence! protocol

def[member_type] next(s stack[member_type], i 0..max_length-1) := (v member_type)
  s._contents[i] := v

;; Implement the reversible_sequence protocol, same position
def reverse_iterate(s stack)                      s.length - 1
def reverse_more?(s stack, pos -1..max_length-1)  pos >= 0
def reverse_iterate(s stack, pos 0..max_length-1) pos - 1

;; Implement the keyed_sequence protocol
;; members are the same as in the sequence protocol

def keyed_iterate    (s stack)                      0
def next_key         (s stack, i 0..max_length-1)   i
def next_member      (s stack, i 0..max_length-1)   s._contents[i]
def keyed_iterate    (s stack, i 0..max_length-1)   i + 1

def (s stack)[i 0..max_length-1]
  ;; Subscript the stack from the bottom
  if i < s.length
    s._contents[i]
  else
    subscript_range_error(s, i, 0..<s.length)

;; Implement the variable sequence protocol

def[member_type] next(s stack[member_type], i 0..max_length-1) := (new_value member_type)
  s._contents[i] := new_value

;; Implement the variable keyed sequence protocol

def[member_type] next_member(s stack[member_type], i 0..max_length-1) := (new_value member_type)
  s._contents[i] := new_value

def[member_type] (s stack[member_type])[i 0..max_length-1] := (new_value member_type)
  ;; Subscript the stack from the bottom
  if i < s.length
    s._contents[i] := new_value
  else
    subscript_range_error(s, i, 0..<s.length)

;; Implement the succession and variable succession protocols

def (s stack).end_position            s.length
def[T] (s stack[T])[r range[integer]] subsuccession![T](s, r)

Ranges

The class range is a subclass of type that is a range of integers or characters. A range is also a constant_sequence; unlike most other types it is enumerable. It could have been defined by:

constant: sealed:
defclass range[T set(integer, character)]    \
           constructor: _range(min T, max T) \
           type, constant_sequence[T]

;; Constructors

def range(min integer, max integer)       _range[integer](min, max)
def range(min character, max character)   _range[character](min, max)

defoperator ..   precedence: 40
defoperator ..<  precedence: 40
defoperator <..  precedence: 40
defoperator <..< precedence: 40

def (min integer)..(max integer)          _range[integer](min, max)
def (min integer)..<(max integer)         _range[integer](min, max - 1)
def (min integer)<..(max integer)         _range[integer](min + 1, max)
def (min integer)<..<(max integer)        _range[integer](min + 1, max - 1)

def (min character)..(max character)      _range[character](min, max)
def (min character)..<(max character)     _range[character](min, character(max.code - 1))
def (min character)<..(max character)     _range[character](character(min.code + 1), max)
def (min character)<..<(max character)    _range[character](character(min.code + 1),
                                                            character(max.code - 1))

;; Implement the type protocol

TODO: in, =, subtype?, disjoint?, special cases of union and intersection of two ranges
other relational operators are provided for types in general

;; Implement the sequence protocol
;; The position is the member itself

def iterate(r range)                           r.min
def more?(r range, pos)                        pos <= r.max
def next(r range, pos)                         pos
def iterate(r range[integer], pos integer)     pos + 1
def iterate(r range[character], pos character) character(pos.code + 1)
def (rng range[integer]).length                check_type(max - min + 1, 0..max_length)
def (rng range[character]).length              max.code - min.code + 1

Strings

A string is a constant sequence of characters. See Strings

Sets

The abstract class set is a sequence that cannot have two members that are =. Unlike most other types it is enumerable.

set is a generic class with one optional generic parameter, as usual for sequences. The generic parameter is the type of the members of the set and defaults to everything.

In addition to the sequence protocol, set supports the + operator which returns the union of two sets, the | operator which does the same, the & operator which returns the intersection of two sets, the - operator which returns a set containing members of one set that are not members of another set, and the in operator which tests set membership. For example,

1 in {1, 2, 3}
yields true

#Shemp in {#Moe, #Larry, #Curly}
yields false

See Displays and Comprehensions for an explanation of the { operator.

Note that the + operator behaves differently from its usual sequence behavior when both operands are sets.

The * operator does not have special behavior for sets, so it returns a sequence (not a set) containing the members of the set repeated N times.

The class constant_set is a subclass of set whose members cannot be changed. It also a subclass of type because it is a constant set of specific data. It is a generic class with one optional generic parameter, as usual for sequences. The generic parameter is the type of the members of the set and defaults to everything.

The set function returns an instance of constant_set whose members are the actual parameters.

The type set! is a variable set. It is a subclass of set and sequence! but not of type.

set! is a generic class with one optional generic parameter, as usual for sequences. The generic parameter is the type of the members of the set and defaults to everything.

In addition to the sequence! protocol, set! supports the push! function which adds a member to the set and returns true if the member was not already present, the append! function which adds the members of a sequence to the set and returns true if any member was not already present, and the remove! function which removes a member from the set. remove! returns true if the member was present.

Sets could have been defined by the following code. In practice a more efficient implementation based on hash coding for data that support it would likely be used.

abstract: sealed:
defclass set[optional: member_type = everything type] sequence[member_type]

;; This internal requirement allows constant_set and set! to share a lot of code
require[member_type] (s set)._members => sequence[member_type]

defclass constant_set[optional: member_type = everything type] \
         constructor: _constant_set(members member_type...) \
         set[member_type], constant_sequence[member_type], type
  _members[members.length] = members

defclass set![optional: member_type = everything type] \
         constructor: _set!(members member_type...) \
         set[member_type], sequence![member_type]
  _members = stack[member_type](members...)

def set[optional: member_type = everything type](members member_type...)
  verify_unique(members)
  _constant_set(members...)

def set![optional: member_type = everything type](members member_type...)
  verify_unique(members)
  _set!(members...)

def verify_unique(seq sequence)
  def loop1(pos1)
    def loop2(item, pos2)
      if more?(seq, pos2)
        if next(seq, pos2) = item then error("$item is duplicated in $seq")
        loop2(item, iterate(seq, pos2))
    if more?(seq, pos1)
      loop2(next(seq, pos1), iterate(seq, pos1))
      loop1(iterate(seq, pos1))
  loop1(iterate(seq))

;; Implement the sequence protocol

def iterate(seq set)            iterate(seq._members)
def more?(seq set, pos)         more?(seq._members, pos)
def next(seq set, pos)          next(seq._members, pos)
def iterate(seq set, pos)       iterate(seq._members, pos)
def (seq set).length            seq._members.length

;; Implement the sequence! protocol

def[member_type] next(seq set![member_type], pos) := (new_value member_type)
  next(seq._members, pos) := new_value

;; Implement the + - & | operators

;; Set union
def[T1, T2] (s1 set[T1]) + (s2 set[T2])
  def result_type = T1 | T2
  def buffer = stack[result_type](s1...)
  for item in s2
    if not (item in s1) then push!(buffer, item)
  _constant_set[result_type](buffer...)

def (s1 set) | (s2 set) s1 + s2

;; Set difference
def[T1, T2] (s1 set[T1]) - (s2 set[T2])
  def buffer = stack[T1]()
  for item in s1
    if not (item in s2) then push!(buffer, item)
  _constant_set[T1](buffer...)

;; Set intersection
def[T1, T2] (s1 set[T1]) & (s2 set[T2])
  def result_type = T1 & T2
  def buffer = stack[result_type]()
  for item in s1
    if item in s2 then push!(buffer, item)
  _constant_set[result_type](buffer...)

;; Implement the push! append! remove! functions on variable sets

def[member_type] push!(s set![member_type], item member_type)
  if not (item in s)
    push!(s._members, item)
    true
  else
    false

def[member_type] append!(s set![member_type], items sequence[member_type])
  def result := false
  for item in items
    if not (item in s)
      push!(s._members, item)
      result := true
  result

def[member_type] remove!(s set![member_type], item member_type)
  def pos = position(item, s._members)
  if pos
    if pos < s._members.length - 1
      s._members[pos] := s._members[s._members.length - 1]
    s._members.length := s._members.length - 1
    true
  else
    false

Maps

A map is a collection whose members are identified by keys of arbitrary type. Maps implement the keyed sequence protocol in the obvious way. Maps also implement the sequence protocol; the sequence members are alternating keys and members. The map constructor accepts a similar alternating sequence as its actual parameters and returns a constant map.

constant_map is a constant map.

map! is a variable map. It supports [:= to add or change the member for a key and remove! to remove a key. remove! returns true if the key was present.

The in operator checks whether a given item is = to any key of the map. It looks only at keys, not members.

TODO fill this in

Sequence Operators

The in operator tests whether any member of a sequence is = to a given datum. It could have been defined by:

def[T] (item T) in (seq sequence[T])
  for pos = iterate(seq) then iterate(seq, pos) while more?(seq, pos) using any
    any next(seq, pos) = item

;; Quickly return false if the left-hand operand is the wrong type
;; Note that this is less specific than the previous method
def[T] (item everything) in (seq sequence[T]) false

The + operator works on sequences, producing the concatenation of the two sequences. It does not copy the sequences, so if they are variable the result changes when an input changes. It could have been defined by:

def[T1, T2] (s1 sequence[T1]) + (s2 sequence[T2])
  concatenated_sequence[T1, T2](s1, s2)

constant:
defclass concatenated_sequence[T1 type, T2 type]   \
                (s1 sequence[T1], s2 sequence[T2]) \
                sequence[T1 | T2]

constant:
defclass concatenated_sequence_position(iteration 0..max_length, position)

def (seq concatenated_sequence).length
  check_type(seq.s1.length + seq.s2.length, 0..max_length)

def iterate(seq concatenated_sequence) concatenated_sequence_position(1, iterate(seq.s1))

def more?(seq concatenated_sequence, pos concatenated_sequence_position)
  if pos.iteration = 1
    more?(seq.s1, pos.position) or more?(seq.s2, iterate(seq.s2))
  else more?(seq.s2, pos.position)

def next(seq concatenated_sequence, pos concatenated_sequence_position)
  if pos.iteration = 1
    next(seq.s1, pos.position)
  else
    next(seq.s2, pos.position)

def iterate(seq concatenated_sequence, pos concatenated_sequence_position)
  if pos.iteration = 1
    def newpos = iterate(seq.s1, pos.position)
    if more?(seq.s1, newpos)
      concatenated_sequence_position(1, newpos)
    else
      concatenated_sequence_position(2, iterate(seq.s2))
  else
    concatenated_sequence_position(2, iterate(seq.s2, pos.position))

We can optimize the implementation for successions like this:

def[T1, T2] (s1 succession[T1]) + (s2 succession[T2])
  concatenated_succession[T1, T2](s1, s2)

constant:
defclass concatenated_succession[T1 type, T2 type]      \
                (s1 succession[T1], s2 succession[T2])  \
                succession[T1 | T2]

def (seq concatenated_succession).length
  check_type(seq.s1.length + seq.s2.length, 0..max_length)

def iterate(seq concatenated_succession) 0  ;= iterate(seq.s1)

def more?(seq concatenated_succession, pos 0..max_length)
  if pos < s1.end_position then more?(seq.s1, pos)
  else more?(seq.s2, pos - s1.end_position)

def next(seq concatenated_succession, pos 0..max_length-1)
  if pos < s1.end_position then next(seq.s1, pos)
  else next(seq.s2, pos - s1.end_position)

def iterate(seq concatenated_succession, pos 0..max_length-1)
  if pos < s1.end_position then iterate(seq.s1, pos)
  else
    s1.end_position + iterate(seq.s2, pos - s1.end_position)

def (seq concatenated_succession).end_position
  check_type(s1.end_position + s2.end_position, 0..max_length)

def[T] (seq concatenated_succession[T])[r range[integer]] subsuccession[T](x, r)

Note that + regards a string as a sequence of characters, not as an atomic object. Thus [1, 2] + "xy" is [1, 2, 'x', 'y'] not [1, 2, "xy"]. Note that [1, 2] + 3 is a no_applicable_method_error not [1, 2, 3].

The * operator works on a non-negative integer and a sequence (in either order). It concatenates the sequence with itself the number of times specified. It does not copy the sequence, so if it is variable the result changes when the sequence changes. It could have been defined by:

def[T] (n 0..max_length) * (s sequence[T])
  repeated_sequence[T](n, s)

def[T] (s sequence[T]) * (n 0..max_length)
  repeated_sequence[T](n, s)

constant:
defclass repeated_sequence[T type]                      \
                (count 0..max_length, seq sequence[T])  \
                sequence[T]

def (seq repeated_sequence).length
  check_type(seq.seq.length * seq.count, 0..max_length)

def iterate(seq repeated_sequence) concatenated_sequence_position(1, iterate(seq.seq))

def next(seq repeated_sequence, pos concatenated_sequence_position)
  next(seq.seq, pos.position)

def more?(seq repeated_sequence, pos concatenated_sequence_position)
  pos.iteration <= seq.count and more?(seq.seq, pos.position)
                        ;; more? check is only in case seq.seq is empty

def iterate(seq repeated_sequence, pos concatenated_sequence_position)
  def next_position = iterate(seq.seq, pos.position)
  if more?(seq.seq, next_position)
    concatenated_sequence_position(pos.iteration, next_position)
  else
    concatenated_sequence_position(pos.iteration + 1, iterate(seq.seq))

We can optimize the implementation for successions like this:

def[T] (n 0..max_length) * (s succession[T])
  repeated_succession[T](n, s)

def[T] (s succession[T]) * (n 0..max_length)
  repeated_succession[T](n, s)

constant:
defclass repeated_succession[T type]                      \
                (count 0..max_length, seq succession[T])  \
                succession[T]

def (seq repeated_succession).length
  check_type(seq.seq.length * seq.count, 0..max_length)

def iterate(seq repeated_succession) 0

def more?(seq repeated_succession, pos 0..max_length)
  pos < seq.seq.end_position * seq.count

def next(seq repeated_succession, pos 0..max_length-1)
  next(seq.seq, pos mod seq.seq.end_position)

def iterate(seq repeated_succession, pos 0..max_length-1)
  iterate(seq.seq, pos mod seq.seq.end_position) + pos /
                     seq.seq.end_position * seq.seq.end_position

def keyed_iterate(seq repeated_succession) 0

def next_key(seq repeated_succession, pos 0..max_length-1) pos

def next_member(seq repeated_succession, pos 0..max_length-1) next(seq, pos)

def keyed_iterate(seq repeated_succession, pos 0..max_length-1) iterate(seq, pos)

def (seq repeated_succession)[key 0..max_length-1]
  seq.seq[key mod seq.seq.end_position]

def (seq repeated_succession)[key], named: default]
  if key in 0..max_length-1 and key < seq.length
    seq.seq[key mod seq.seq.end_position, default: default]
  else default

def (seq repeated_succession).end_position
  check_type(seq.seq.end_position * seq.count, 0..max_length)

def[T] (seq repeated_succession[T])[r range[integer]] subsuccession[T](x, r)

The | operator works on keyed sequences, producing the union of the two keyed sequences. If the same key is in both keyed sequences, | chooses the member from the left-hand operand. | does not copy the keyed sequences, so if they are variable the result changes when an input changes. It could have been defined by

def[K1, T1, K2, T2] (ks1 keyed_sequence[K1, T1]) | (ks2 keyed_sequence[K2, T2])
  if for k => m in ks2 using always
         always k in ks1
    ;; ks2 doesn't add any keys so the result is just ks1
    ks1
  else
    keyed_sequence_union[K1, T1, K2, T2](ks1, ks2)

constant:
defclass keyed_sequence_union[K1 type, T1 type, K2 type, T2 type]         \
                (ks1 keyed_sequence[K1, T1], ks2 keyed_sequence[K2, T2])  \
                keyed_sequence[K1 | K2, T1 | T2]

def keyed_iterate(seq keyed_sequence_union)
  concatenated_sequence_position(1, keyed_iterate(seq.ks1))

def more?(seq keyed_sequence_union, pos concatenated_sequence_position)
  pos.iteration = 1 or more?(seq.ks2, pos.position)

def next_key(seq keyed_sequence_union, pos concatenated_sequence_position)
  if pos.iteration = 1 then next_key(seq.ks1, pos.position)
  else next_key(seq.ks2, pos.position)

def next_member(seq keyed_sequence_union, pos concatenated_sequence_position)
  if pos.iteration = 1 then next_member(seq.ks1, pos.position)
  else next_member(seq.ks2, pos.position)

def keyed_iterate(seq keyed_sequence_union, pos concatenated_sequence_position)
  if pos.iteration = 1
    def newpos = keyed_iterate(seq.ks1, pos.position)
    if more?(seq.ks1, newpos)
      concatenated_sequence_position(1, newpos)
    else
      concatenated_sequence_position(2, keyed_iterate(seq.ks2))
  else concatenated_sequence_position(2, keyed_iterate(seq.ks2, pos.position))

def (seq keyed_sequence_union)[key]
  if key in seq.ks1 then seq.ks1[key] else seq.ks2[key]

def (seq keyed_sequence_union)[key, named: default]
  if key in seq.ks1 then seq.ks1[key] else seq.ks2[key, default: default]

The subsuccession function is the constructor for a class of succession that represents part of another succession. It could have been defined by

defclass subsuccession[member_type type]                                           \
         constructor: _subsuccession(s succession[member_type], r range[integer])  \
         succession[member_type]
  parent = s
  end_position = r.length
  offset = r.min                0..max_length

def[member_type] subsuccession(s succession[member_type], r range[integer])
  assert r.min >= 0
  assert r.max < s.end_position
  _subsuccession[member_type](s, r)

def iterate(seq subsuccession)                      0
def more?(seq subsuccession, pos 0..max_length)     pos < seq.end_position
def next(seq subsuccession, pos 0..max_length-1)    seq.parent[pos + seq.offset]
def iterate(seq subsuccession, pos 0..max_length-1)
 iterate(seq.parent, pos + seq.offset) - seq.offset

def (seq subsuccession).length
  if seq.parent in list | stack
    seq.end_position
  else
    for pos = offset then iterate(seq.parent, pos) while more?(seq.parent, pos) using count
      count

def[T] (seq subsuccession[T])[r range[integer]]
  subsuccession[T](seq.parent, (r.min + seq.offset)..(r.max + seq.offset))

Sequence Functions

Lunar provides several useful functions on sequences.

first produces the first member of a non-empty sequence. It could have been defined by

def first(seq sequence)
  def pos = iterate(seq)
  if more?(seq, pos) then next(seq, pos)
  else error("empty sequence")

def[T] first(seq sequence![T]) := (new_member T)
  def pos = iterate(seq)
  if more?(seq, pos) then next(seq, pos) := new_member
  else error("empty sequence")

last produces the last member of a non-empty, reversible sequence. It could have been defined by

def last(seq reversible_sequence)
  def pos = reverse_iterate(seq)
  if reverse_more?(seq, pos) then next(seq, pos)
  else error("empty sequence")

def[T] last(seq reversible_sequence![T]) := (new_member T)
  def pos = reversible_iterate(seq)
  if reversible_more?(seq, pos) then next(seq, pos) := new_member
  else error("empty sequence")

butlast produces a reversible sequence containing all but the last member of a non-empty, reversible sequence. It may or may not copy the argument, so the result may or may not change if the argument is variable and changes.

reverse produces a sequence with the same members but in reverse order. It may or may not copy the argument, so the result may or may not change if the argument is variable and changes. It could have been defined by

require[T] reverse(s sequence[T]) => sequence[T]

;; The general method makes a copy
def[T] reverse(s sequence[T])
  if s.length = 0 then list[T]()
  else
    def result = list![T](s.length * [next(s, iterate(s)]...)
    for item in s, i = s.length - 1 then i - 1
      result[i] := item
    result

;; The reversible_sequence method can just use reverse_iterate
def[T] reverse(s reversible_sequence[T]) reversed_sequence[T](s)

constant:
defclass reversed_sequence[T type](seq reversible_sequence[T])

def iterate(s reversed_sequence)      reverse_iterate(s.seq)
def more?(s reversed_sequence, pos)   reverse_more?(s.seq, pos)
def iterate(s reversed_sequence, pos) reverse_iterate(s.seq, pos)
def next(s reversed_sequence, pos)    next(s.seq, pos)
def (s reversed_sequence).length      s.seq.length

reverse! reverses the order of members of a variable list or stack. It could have been defined by

def reverse!(x list!)
  def midpoint = x.length / 2
  def endpoint = x.length - 1
  for i = 0 then i + 1 while i < midpoint
    def item = x[endpoint - i]
    x[endpoint - i] := x[i]
    x[i] := item
  x

def reverse!(x stack)
  reverse!(x._contents)
  x

position returns the position (as used by the sequence iteration protocol) of the first occurrence of a given item as a member of a sequence, or false if the specified item is not a member. A starting position can be specified.

positionf returns the position (as used by the sequence iteration protocol) where a given function is first true of a member of a sequence, or false if the specified function is never true. A starting position can be specified.

They could have been defined by

def[T] position(item T, seq sequence[T], optional: start = iterate(seq))
  block exit: return
    for pos = start then iterate(seq, pos) while more?(seq, pos)
      if next(seq, pos) = item then return(pos)
    return(false)

def positionf(fcn function, seq sequence, optional: start = iterate(seq))
  block exit: return
    for pos = start then iterate(seq, pos) while more?(seq, pos)
      if fcn(next(seq, pos)) then return(pos)
    return(false)

There are also reverse versions for reversible sequences. They could have been defined by

def[T] reverse_position(item T, seq reversible_sequence[T], optional: start = reverse_iterate(seq))
  block exit: return
    for pos = start then reverse_iterate(seq, pos) while reverse_more?(seq, pos)
      if next(seq, pos) = item then return(pos)
    return(false)

def reverse_positionf(fcn function, seq reversible_sequence, optional: start = reverse_iterate(seq))
  block exit: return
    for pos = start then reverse_iterate(seq, pos) while reverse_more?(seq, pos)
      if fcn(next(seq, pos)) then return(pos)
    return(false)

There are the usual map (called mapf since map is a map constructor) and reduce operations. They use delayed evaluation.

mapf could have been defined by

constant:
defclass mapf(function function, sequence sequence) constant_sequence

def (m mapf).length      m.sequence.length
def iterate(m mapf)      iterate(m.sequence)
def more?(m mapf, pos)   more?(m.sequence, pos)
def iterate(m mapf, pos) iterate(m.sequence, pos)
def next(m mapf, pos)    (m.function)(next(m.sequence, pos))

constant:
defclass general_mapf constructor: mapf(function function, sequences sequence...) constant_sequence

def (m general_mapf).length
  (for seq in m.sequences using minimize
     minimize seq.length) or 0

def iterate(m general_mapf)
  ;; position in the map is a list of positions in the sequences
  [iterate(seq) for seq in m.sequences]

def more?(m general_mapf, positions list)
  m.sequences.length > 0 and
    for seq in m.sequences, pos in positions using always
      always more?(seq, pos)

def iterate(m general_mapf, positions list)
  [iterate(seq, pos) for m in m.sequences, pos in positions]

def next(m general_mapf, positions list)
  (m.function)([next(seq, pos) for m in m.sequences, pos in positions]...)

reduce could have been defined by

def reduce(fcn function, initial_value, seq sequence)
  def result := initial_value
  for item in seq
    result := fcn(result, item)
  result
or in no-assignment style
def reduce(fcn function, initial_value, seq sequence)
  def loop(result, pos)
    if more?(seq, pos)
      loop(fcn(result, next(seq, pos)), iterate(seq, pos))
    else result
  loop(initial_value, iterate(seq))

reduce also allows multiple sequences. It calls the function as many times as the length of the shortest sequence. This could have been defined by

def reduce(fcn function, initial_value, sequences sequence...)
  if sequences.length = 0 then initial_value
  else
    def result := initial_value
    for states = mapf(iterate, sequences) then mapf(iterate, sequences, states) \
        while every?(more, sequences, states)
      result := fcn(result, mapf(next, sequences, states)...)
    result

There are also Boolean reductions any?, notany?, and every?. They could have been defined by

def any?(fcn function, sequences sequence...)
  block exit: return
    if sequences.length = 0 then return(false)

    for states = mapf(iterate, sequences) then mapf(iterate, sequences, states) \
        while every?(more, sequences, states)
      if fcn(result, mapf(next, sequences, states)...) then return(true)

    return(false)

def notany?(fcn function, sequences sequence...) not any?(fcn, sequences...)

def every?(fcn function, sequences sequence...)
  block exit: return
    if sequences.length = 0 then return(true)

    for states = mapf(iterate, sequences) then mapf(iterate, sequences, states) \
        while every?(more, sequences, states)
      if not fcn(result, mapf(next, sequences, states)...) then return(false)

    return(true)

The mapf function is not very useful on maps, since a map is a sequence of alternating keys and members. The mapkf function maps a function over the members of one or more maps and produces a map with the same keys, whose members are the results of the function. If not all map parameters have the same keys, mapkf uses the keys of the first map parameter and substitutes false for any members missing from the remaining map parameters. It could have been defined by

def mapkf(fcn function, m map)
  map([k, fcn(v) for k => v in m]...)

def mapkf(fcn function, m1 map, more_maps map...)
  map([k, fcn(v, mapf(_[k, default: false], more_maps)...) for k => v in m1]...)

A sequence can have a specified member, or all members that satisfy a specified function, trimmed off the beginning of the sequence. A reversible sequence can be trimmed off the end, or both the beginning and the end. The trim functions could have been defined by

def[T] left_trim(item T, seq sequence[T])
  block exit: return
    def start = iterate(seq)
    for pos = start then iterate(seq, pos) while more?(seq, pos)
      if next(seq, pos) ~= item
        if pos = start then return(seq)
        else return(left_trimmed_sequence[T](seq, pos))
    ;; result is empty sequence
    list[T]()

def[T] left_trimf(fcn function, seq sequence[T])
  block exit: return
    def start = iterate(seq)
    for pos = start then iterate(seq, pos) while more?(seq, pos)
      if not fcn(next(seq, pos))
        if pos = start then return(seq)
        else return(left_trimmed_sequence[T](seq, pos))
    ;; result is empty sequence
    list[T]()

constant:
defclass left_trimmed_sequence[T type](seq sequence[T], start_pos) sequence[T]

def (seq left_trimmed_sequence).length
  seq.seq.length -
    (for pos = iterate(seq.seq) then iterate(seq.seq, pos) while pos ~= seq.start_pos using count
       count)

def iterate(seq left_trimmed_sequence)       seq.start_pos
def more?(seq left_trimmed_sequence, pos)    more?(seq.seq, pos)
def next(seq left_trimmed_sequence, pos)     next(seq.seq, pos)
def iterate(seq left_trimmed_sequence, pos)  iterate(seq.seq, pos)

def[T] right_trim(item T, seq reversible_sequence[T])
  block exit: return
    for pos = reverse_iterate(seq) then reverse_iterate(seq, pos),
        prev_pos = false then pos while reverse_more?(seq, pos)
      if next(seq, pos) ~= item
        if prev_pos then return(right_trimmed_sequence[T](seq, prev_pos))
        else return(seq)
    ;; result is empty sequence
    list[T]()

def[T] right_trimf(fcn function, seq reversible_sequence[T])
  block exit: return
    for pos = reverse_iterate(seq) then reverse_iterate(seq, pos),
        prev_pos = false then pos while reverse_more?(seq, pos)
      if not fcn(next(seq, pos))
        if prev_pos then return(right_trimmed_sequence[T](seq, prev_pos))
        else return(seq)
    ;; result is empty sequence
    list[T]()

constant:
defclass right_trimmed_sequence[T type](seq sequence[T], end_pos) sequence[T]

def (seq right_trimmed_sequence).length
  for pos = iterate(seq.seq) then iterate(seq.seq, pos) while pos ~= seq.end_pos using count
    count

def iterate(seq right_trimmed_sequence)      iterate(seq.seq)
def more?(seq right_trimmed_sequence, pos)   pos ~= seq.end_pos
def next(seq right_trimmed_sequence, pos)    next(seq.seq, pos)
def iterate(seq right_trimmed_sequence, pos) iterate(seq.seq, pos)

def[T] trim(item T, seq reversible_sequence[T]) left_trim(item, right_trim(item, seq))

def[T] trimf(fcn function, seq reversible_sequence[T]) left_trimf(fcn, right_trimf(fcn, seq))

TODO search, match, begins?, ends? ...


Previous page   Table of Contents   Next page



Creative Commons License
Lunar by David A. Moon is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License.
Please inform me if you find this useful, or use any of the ideas embedded in it.
Comments and criticisms to dave underscore moon atsign alum dot mit dot edu.