A collection of program examples that might be interesting:
If you wanted 32 bits and 47 unsigned bits to be types, you could do
defoperator bits precedence: 40 macro: => `bits_type($lhs)` defoperator unsigned precedence: 40 macro: "bits" => `unsigned_bits_type($lhs)` def bits_type(nbits) def shift = nbits - 1 -1 << shift ..< 1 << shift def unsigned_bits_type(nbits) 0 ..< 1 << nbits
If you wanted 120 * 5% = 6 and 120 + 5% = 126 but 2% + 5% = 7%, you could do something like this:
constant: defclass percentage(percent number) number defoperator % precedence: 90 macro: => `percentage($lhs)` def (x number) * (y percentage) number * y.percent / 100.0 def (x percentage) * (y percentage) percentage(x.percent * y.percent) def (x number) + (y percentage) number * (100.0 + y.percent) / 100.0 def (x percentage) + (y percentage) percentage(x.percent + y.percent)
Lunar 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: in front of defclass list and the compiler would know to use that representation.
For clarity (?) I have omitted the export: annotation from in front of the following definitions.
module:
defmodule S_expressions
local: list ; don't import Lunar's definition of list
;; The base class of all S-expression lists
abstract:
defclass list (car, cdr)
_car := car
_cdr := cdr
;; The class of all S-expression lists except the empty list
defclass cons (car, cdr) list(car, cdr)
;; A special class just for the empty list
defclass null constructor: _make_null() list(0, 0)
;; A named constant whose value is the empty list
;; By convention this is the only instance of null
def nil = _make_null()
;; car and cdr of nil are nil
nil._car := nil._cdr := 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.
def car = _car
def cdr = _cdr
def car(x list) := (y everything) x._car := y
def cdr(x list) := (y everything) x._cdr := y
def car(x null) := (y everything) error("Can't change car of nil")
def cdr(x null) := (y everything) error("Can't change cdr of nil")
;; Allow car and cdr to be accessed via slot syntax as well as function syntax
sealed: def (x list).car car(x)
sealed: def (x list).cdr cdr(x)
sealed: def (x list).car := (y everything) car(x) := y
sealed: def (x list).cdr := (y everything) cdr(x) := y
def atom?(x) not (x in cons)
def null?(x) x eq nil
def rplaca(x cons, y)
x._car := y
x
def rplacd(x cons, y)
x._cdr := y
x
def list(x...)
def result := nil
for i = x.length - 1 then i - 1 while i >= 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_expression, list_expression) =>
def [temps, values, expr] = eval-once(list_expression)
`block
${ def $temps = $values & ^ }*
$expr := cons($item_expression, $expr)`
defmacro pop($list_expression) =>
def [temps, values, expr] = eval-once(list_expression)
`block
${ def $temps = $values & ^ }*
def result = car($expr)
$expr := cdr($expr)
result`
def print(x 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
;; The iteration state is the current cons in the list
def iterate(x list) x
def more?(x list, position) not atom?(position)
def next(x list, position cons) position.car
def iterate(x list, position list) position.cdr
def (x is list).length
def length := 0
def where := x
while where in cons
length := length + 1
where := where.cdr
length
Parsing expressions is inherently complicated, but it is not beyond understanding. The main expression parser could have been defined by:
;;---TODO: support ternary operators
def parse_expression_without_currying(lexer, indentation, scope, required?,
optional: precedence = -1, modifiers = empty_modifiers)
;; Three stacks to hold temporary state
def lhs_stack = stack() ; expression...
def unary_stack = stack() ; alternating name and bundle...
def binary_stack = stack() ; alternating name and bundle...
;; Auxiliary functions
def do_lhs()
def token = next(lexer)
if token in number | character | string
;; A literal
next!(lexer)
else if same_spelling?(token, #\\)
;; \ operator denatures the next name
parse_denatured_name(lexer)
else if token in name
def bundle = known_definition(scope, token)
if bundle in operator
if bundle.macro_expander
;; A prefix macro
def expansion = bundle.macro_expander(lexer, indentation, scope, modifiers,
next!(lexer).context)
if expansion in expression then expansion
else if expansion in sequence
;; The macro expansion is a sequence of tokens, push it back and try again
insert!(lexer, expansion)
do_lhs()
else
parse_error(lexer, "Macro $token returned unrecognized expansion")
else
;; bundle is a non-macro operator
push!(unary_stack, next!(lexer))
push!(unary_stack, bundle)
do_lhs()
;; Not an operator or a macro
else if punctuation?(token)
do_unrecognized_token()
else
;; A plain ordinary name
next!(lexer)
else if token in expression
;; An already parsed expression
next!(lexer)
else
do_unrecognized_token()
def do_unrecognized_token()
;; End of expression
if empty?(lhs_stack) and empty?(binary_stack) and unary_stack.length = 2
;; Special case of an operator by itself
pop!(unary_stack) ; discard bundle
pop!(unary_stack) ; return operator name
else if required? or not empty?(unary_stack) or not empty?(lhs_stack)
wrong_token_error(lexer, "a literal, a name, or a prefix or unary operator")
else
;; Valid end of lhs
false
def do_unit()
if def lhs := do_lhs()
while not empty?(unary_stack)
def bundle = pop!(unary_stack)
def operator = pop!(unary_stack)
if #unary in bundle.arity
lhs := call_expression(operator, lhs)
else
parse_error(lexer, "$operator is not a unary operator")
else if not empty?(unary_stack)
parse_error(lexer, "unary operator(s) ${$unary_stack&, } not followed by operand")
def do_operator(lhs)
def token = next(lexer)
def bundle = token in name and known_definition(scope, token)
if bundle in operator
;; Next token is an operator
if #binary in bundle.arity or #infix in bundle.arity or #suffix in bundle.arity
def operator_precedence = bundle.left_precedence
if operator_precedence <= precedence
;; precedence parameter to parse_expression prevents seeing this operator
;; so this is the end of the expression
drain(lhs, precedence)
else if bundle.infix_macro_expander
;; Infix or suffix macro, drain higher precedence operators to left
;; then expand and continue looking for operators
def lhs = drain(lhs, operator_precedence)
def expansion = bundle.infix_macro_expander(lhs, lexer, indentation, scope,
next!(lexer).context, false)
if expansion in expression
do_operator(expansion)
else if expansion in sequence
;; Push back the macro expansion and try again
insert!(lexer, expansion)
do_operator(do_lhs())
else
parse_error(lexer, "Macro $token returned unrecognized expansion")
else
;; Non-macro operator
;; Drain higher precedence operators to left, stack this
push!(lhs_stack, drain(lhs, operator_precedence))
push!(binary_stack, next!(lexer))
push!(binary_stack, bundle)
do_operator(do_lhs())
else
parse_error(lexer, "$token is not a binary, infix, or suffix operator")
else
;; No operator found, must be end of expression
drain(lhs, precedence)
def drain(rhs, precedence)
;; drain operators to left whose right_precedence is not less than precedence
;; precedence is the left_precedence of the next operator after rhs
def rhs := rhs
while not empty?(binary_stack) and binary_stack.top.right_precedence >= precedence
pop!(binary_stack) ; discard bundle
rhs := call_expression(pop!(binary_stack), ; binary operator name
pop!(lhs_stack), ; left-hand side
rhs) ; right-hand side
rhs
;; Start with a unit on the left hand side
def lhs = do_unit()
;; Allow for operators and additional units, or false if not required?
def result = lhs and do_operator(lhs)
;; Some consistency checking
assert empty?(lhs_stack)
assert empty?(unary_stack)
assert empty?(binary_stack)
;; Return the parsed expression, or false if not required?
result
;; To avoid making a new set every time parse_expression is called without modifiers
def empty_modifiers = set!()
;; The \ prefix macro
def parse_denatured_name(lexer)
next!(lexer) ; swallow the backslash
def result = next(lexer)
if result in name
next!(lexer)
result
else if result in string
next!(lexer)
name(result)
else
wrong_token_error(lexer, "a name or a string (after a backslash)")
Then the currying feature could have been added by
def parse_expression(lexer, indentation, scope, required?,
optional: precedence = -1, modifiers = empty_modifiers)
def temps = stack() ; currying parameters
def result = apply_currying(parse_expression_without_currying(lexer, indentation,
scope, required?,
precedence, modifiers),
scope,
temps)
if empty?(temps)
;; No currying
result
else
;; Result is a curried function
def parameter_scope = formal_parameter_scope(scope)
def parameters = formal_parameters(scope: parameter_scope,
required: mapf(fun(temp)
def defn = formal_parameter_definition(
name: temp, type: everything)
add_definition(parameter_scope, temp, defn)
defn,
temps))
method_expression(method_head(name: false, ; anonymous
modifiers: method_modifiers(),
formal_parameters: parameters,
result_type: everything),
;; body is result
result)
;; Replace blanks in expr with unique names added to temps
def apply_currying(expr, scope scope, temps stack)
;; Default method does nothing
expr
def apply_currying(expr call_expression, scope scope, temps stack)
def initial_length = temps.length
def new_parameters = mapf(fun(param)
if same_spelling?(param, #_)
def temp = name("temp", macro_context(scope))
push!(temps, temp)
temp
else
apply_currying(param, scope, temps),
expr.parameters)
if temps.length = initial_length
;; Nothing changed
expr
else
;; Substitute new parameters
(if expr in spread_call_expression then spread_call_expression else call_expression)(
expr.function, new_parameters...)
TODO more examples TBD
TODO Enumeration Types example
TODO Regular Expressions example
Previous page Table of Contents Next page