10 Macros
The built-in macros cannot really be implemented this way, for example, if and case cannot really both be implemented by expanding to the other. Certain built-in macros cannot be implemented with rewrite rules or necessarily rewrite into implementation-dependent code, so blank right-hand sides are shown for them.
define macro begin
{ begin ?:body end } => { ?body }
end;
define macro block
{ block (?:name) ?ebody end }
=> { with-exit(method(?name) ?ebody end) }
{ block () ?ebody end }
=> { ?ebody }
// Left-recursive so leftmost clause is innermost
ebody:
{ ... exception (?excp, #rest ?options:expression,
#key ?test:expression,
?init-arguments:expression)
?:body }
=> { with-handler(method() ... end,
method() ?body end,
?excp, ?options) }
{ ?abody cleanup ?cleanup:body}
=> { with-cleanup(method() ?abody end, method () ?cleanup end) }
{ ?abody }
=> { ?abody }
abody:
{ ?main:body afterwards ?after:body }
=> { with-afterwards(method() ?main end, method () ?after end) }
{ ?main:body }
=> { ?main }
excp:
{ ?type:expression } => { ?type }
{ ?:name :: ?type:expression } => { ?type, condition: ?name }
end;
define macro case
{ case ?:case-body end } => { ?case-body }
case-body:
{ ?test:expression => ?:body ... } => { if (?test) ?body
else ... end if }
{ otherwise ?:body } => { ?body }
{ } => { #f }
end;
// This macro has three auxiliary macros, whose definitions follow
define macro for
{ for (?header) ?fbody end } => { for-aux ?fbody ?header end }
// pass main body and finally body as two expressions
fbody:
{ ?main:body } => { ?main, #f }
{ ?main:body finally ?val:body } => { ?main, ?val }
// convert iteration clauses to property list via for-clause macro
header:
{ ?v:variable in ?c:expression, ... }
=> { for-clause(?v in ?c) ... }
{ ?v:variable = ?e1:expression then ?e2:expression, ... }
=> { for-clause(?v = ?e1 then ?e2) ... }
{ ?v:variable from ?e1:expression ?to, ... }
=> { for-clause(?v from ?e1 ?to) ... }
{ #key ?while:expression } => { for-clause(~?while stop) }
{ #key ?until:expression } => { for-clause(?until stop) }
{ } => { }
// parse the various forms of numeric iteration clause
to:
{ to ?limit:expression by ?step:expression }
=> { hard ?limit ?step }
{ to ?limit:expression } => { easy ?limit 1 > }
{ above ?limit:expression ?by } => { easy ?limit ?by <= }
{ below ?limit:expression ?by } => { easy ?limit ?by >= }
{ ?by } => { loop ?by }
by:
{ by ?step:expression } => { ?step }
{ } => { 1 }
end;
// Auxiliary macro to make the property list for an iteration clause.
// Each iteration clause is a separate call to this macro so the
// hygiene rules will keep the temporary variables for each clause
// distinct.
// The properties are:
// init0: - constituents for start of body, outside the loop
// var1: - a variable to bind on each iteration
// init1: - initial value for that variable
// next1: - value for that variable on iterations after the first
// stop1: - test expression, stop if true, after binding var1's
// var2: - a variable to bind on each iteration, after stop1 tests
// next2: - value for that variable on every iteration
// stop2: - test expression, stop if true, after binding var2's
define macro for-clause
// while:/until: clause
{ for-clause(?e:expression stop) }
=> { , stop2: ?e }
// Explicit step clause
{ for-clause(?v:variable = ?e1:expression then ?e2:expression) }
=> { , var1: ?v, init1: ?e1, next1: ?e2 }
// Collection clause
{ for-clause(?v:variable in ?c:expression) }
=> { , init0: [ let collection = ?c;
let (initial-state, limit,
next-state, finished-state?,
current-key, current-element)
= forward-iteration-protocol(collection); ]
, var1: state, init1: initial-state
, next1: next-state(collection, state)
, stop1: finished-state?(collection, state, limit)
, var2: ?v, next2: current-element(collection, state) }
// Numeric clause (three cases depending on ?to right-hand side)
{ for-clause(?v:name :: ?t:expression from ?e1:expression
loop ?by:expression) }
=> { , init0: [ let init = ?e1;
let by = ?by; ]
, var1: ?v :: ?t, init1: init, next1: ?v + by }
{ for-clause(?v:name :: ?t:expression from ?e1:expression
easy ?limit:expression ?by:expression ?test:token) }
=> { , init0: [ let init = ?e1;
let limit = ?limit;
let by = ?by; ]
, var1: ?v :: ?t, init1: init, next1: ?v + by
, stop1: ?v ?test limit }
{ for-clause(?v:name :: ?t:expression from ?e1:expression
hard ?limit:expression ?by:expression) }
=> { , init0: [ let init = ?e1;
let limit = ?limit;
let by = ?by; ]
, var1: ?v :: ?t, init1: init, next1: ?v + by
, stop1: if (by >= 0) ?v > limit else ?v < limit end if }
end;
// Auxiliary macro to expand multiple for-clause macros and
// concatenate their expansions into a single property list.
define macro for-aux
{ for-aux ?main:expression, ?value:expression, ?clauses:* end }
=> { for-aux2 ?main, ?value ?clauses end }
clauses:
{ ?clause:macro ... } => { ?clause ... }
{ } => { }
end;
// Auxiliary macro to assemble collected stuff into a loop.
// Tricky points:
// loop iterates by tail-calling itself.
// return puts the finally clause into the correct lexical scope.
// ??init0 needs an auxiliary rule set to strip off the shielding
// brackets that make it possible to stash local declarations in
// a property list.
// ??var2 and ??next2 need a default because let doesn't allow
// an empty variable list.
// ??stop1 and ??stop2 need a default because if () is invalid.
define macro for-aux2
{ for-aux2 ?main:expression, ?value:expression,
#key ??init0:*, ??var1:variable,
??init1:expression, ??next1:expression,
??stop1:expression = #f,
??var2:variable = x, ??next2:expression = 0,
??stop2:expression = #f
end }
=> { ??init0 ...
local method loop(??var1, ...)
let return = method() ?value end method;
if (??stop1 | ...) return()
else let (??var2, ...) = values(??next2, ...);
if(??stop2 | ...) return()
else ?main; loop(??next1, ...)
end if;
end if;
end method;
loop(??init1, ...) }
// strip off brackets used only for grouping
init0:
{ [ ?stuff:* ] } => { ?stuff }
end;
define macro if
{ if (?test:expression) ?:body ?elses end }
=> { case ?test => ?body;
otherwise ?elses end }
elses:
{ elseif (?test:expression) ?:body ... }
=> { case ?test => ?body;
otherwise ... end }
{ else ?:body } => { ?body }
{ } => { #f }
end;
define macro method
{ method (?parameters:*) => (?results:*) ; ?:body end } =>
{ method (?parameters:*) => (?results:*) ?:body end } =>
{ method (?parameters:*) => ?result:variable ; ?:body end } =>
{ method (?parameters:*) ; ?:body end } =>
{ method (?parameters:*) ?:body end } =>
end;
define macro select
{ select (?what) ?:case-body end } => { ?what; ?case-body }
what:
{ ?object:expression by ?compare:expression }
=> { let object = ?object;
let compare = ?compare }
{ ?object:expression } => { let object = ?object;
let compare = \== }
case-body:
{ otherwise ?:body } => { ?body }
{ } => { error("select error") }
{ ?keys => ?:body ... } => { if (?keys) ?body
else ... end if }
keys:
{ ?key:expression } => { compare(?key, object) }
{ ?key:expression, ... } => { compare(?key, object) | ... }
end;
define macro unless
{ unless (?test:expression) ?:body end }
=> { if (~ ?test) ?body end }
end;
define macro until
{ until (?test:expression) ?:body end }
=> { local method loop ()
if (~ ?test)
?body;
loop()
end if;
end method;
loop() }
end;
define macro while
{ while (?test:expression) ?:body end }
=> { local method loop ()
if (?test)
?body;
loop()
end if;
end method;
loop() }
end;
define macro class-definer
{ define ?mods:* class ?:name (?supers) ?slots end } =>
supers:
{ ?super:expression, ... } =>
{ } =>
// the = feature in slot specs is missing from this.
slots:
{ inherited slot ?:name, #rest ?options:*; ... } =>
{ ?mods:* slot ?:name, #rest ?options:*; ... } =>
{ ?mods:* slot ?:name :: ?type:expression, #rest ?options:*; ... }
=>
{ required keyword ?key:expression, #rest ?options:*; ... } =>
{ keyword ?key:expression, #rest ?options:*; ... } =>
{ } =>
end;
define macro constant-definer
{ define ?mods:* constant ?vars:* = ?init:expression } =>
end;
define macro domain-definer
{ define inert domain ?:name ( ?types ) } =>
types:
{ ?type:expression, ... } => { ?type, ... }
{ } => { }
end;
define macro generic-definer
{ define ?mods:* generic ?:name ?rest:* } =>
rest:
{ ( ?parameters:* ), #key } =>
{ ( ?parameters:* ) => ?:variable, #key } =>
{ ( ?parameters:* ) => (?variables:*), #key } =>
end;
define macro library-definer
{ define library ?:name ?items end } =>
items:
{ use ?:name, #rest ?options:*; ... } =>
{ export ?names; ... } =>
{ } =>
names:
{ ?:name } =>
{ ?:name, ... } =>
end;
define macro method-definer
{ define ?mods:* method ?:name ?rest end } =>
rest:
{ (?parameters:*) => (?results:*) ; ?:body } =>
{ (?parameters:*) => (?results:*) ?:body } =>
{ (?parameters:*) => ?result:variable ; ?:body } =>
{ (?parameters:*) ; ?:body } =>
{ (?parameters:*) ?:body } =>
end;
define macro module-definer
{ define module ?:name ?items end } =>
items:
{ use ?:name, #rest ?options:*; ... } =>
{ export ?names; ... } =>
{ create ?names; ... } =>
{ } =>
names:
{ ?:name } =>
{ ?:name, ... } =>
end;
define macro variable-definer
{ define ?mods:* variable ?vars:* = ?init:expression } =>
end;
define macro test
{ test(?object:expression) } =>
{ frame-slot-getter(?object, #"test") }
end macro;
define macro test-setter
{ test-setter(?value:expression, ?object:expression) }
=> { frame-slot-setter(?value, ?object, #"test") }
end macro;
test(foo.bar) := foo.baz;
define macro transform!
// the main rule
{ transform!(?xform:expression, ?x:expression, ?y:expression,
#rest ?more:expression) }
=> { let xform = ?xform;
let (nx, ny) = transform(xform, ?x, ?y);
?x := nx; ?y := ny;
transform!(xform, ?more) }
// base case
{ transform!(?xform:expression) } => { ?xform }
end macro;
transform!(w.transformation, xvar, yvar, w.pos.x, w.pos.y);
define macro formatting-table
{ formatting-table (?:expression,
#rest ?options:expression,
#key ?x-spacing:expression = 0,
?y-spacing:expression = 0)
?:body end }
=> { do-formatting-table(?expression, method() ?body end,
?options) }
end macro;
formatting-table (stream, x-spacing: 10, y-spacing: 12)
foobar(stream)
end;
define macro with-input-context
{ with-input-context (?context-type:expression,
#key ?override:expression = #f)
?bbody end }
=> { do-with-input-context(?context-type, ?bbody,
override: ?override) }
bbody:
{ ?:body ?clauses } => { list(?clauses), method() ?body end }
clauses:
{ } => { }
{ on (?:name :: ?spec:expression, ?type:variable) ?:body ... }
=> { pair(?spec, method (?name :: ?spec, ?type) ?body end),
... }
end macro;
with-input-context (context-type, override: #t)
// the body that reads from the user
read-command-or-form (stream);
// the clauses that dispatch on the type
on (object :: <command>, type) execute-command (object);
on (object :: <form>, type) evaluate-form (object, type);
end;
define macro command-definer
{ define command ?:name (?arguments:*) (#rest ?options:expression)
?:body end }
=> { define-command-1 ?name (?arguments) ?body end;
define-command-2 ?name (?arguments) (?options) end }
end macro;
// define the method that implements a command
// throws away the "stuff" in each argument used by the command parser
define macro define-command-1
{ define-command-1 ?:name (?arguments) ?:body end }
=> { define method ?name (?arguments) ?body end }
// map over ?arguments, reducing each to a parameter-list entry
// but when we get to the first argument that has a default, put
// in #key and switch to the key-arguments loop
arguments:
{ ?:variable = ?default:expression ?stuff:*, ?key-arguments }
=> { #key ?variable = ?default, ?key-arguments }
{ ?argument, ... } => { ?argument, ... }
{ } => { }
// map over keyword arguments the same way, each must
// have a default
key-arguments:
{ ?key-argument, ... } => { ?key-argument, ... }
{ } => { }
// reduce one required argument spec to a parameter-list entry
argument:
{ ?:variable ?stuff:* } => { ?variable }
// reduce one keyword argument spec to a parameter-list entry
key-argument:
{ ?:variable = ?default:expression ?stuff:* }
=> { ?variable = ?default }
end macro;
// generate the datum that describes a command and install it
define macro define-command-2
{ define-command-2 ?:name (?arguments) (#rest ?options:*) end }
=> { install-command(?name, list(?arguments), ?options) }
// map over ?arguments, reducing each to a data structure
arguments:
{ ?argument, ... } => { ?argument, ... }
{ } => { }
// reduce one argument specification to a data structure
argument:
{ ?:name :: ?type:expression = ?default:expression ?details }
=> { make(<argument-info>, name: ?"name", type: ?type,
default: ?default, ?details) }
{ ?:name :: ?type:expression ?details }
=> { make(<argument-info>, name: ?"name", type: ?type, ?details) }
// translate argument specification to <argument-info> init keywords
details:
{ ?key:name ?value:expression ... } => { ?#"key" ?value, ... }
{ } => { }
end macro;
define command com-show-home-directory
(directory :: <type> provide-default #t,
before :: <time> = #() prompt "date",
after :: <time> = #() prompt "date")
// Options
(command-table: directories,
name: "Show Home Directory")
body()
end command com-show-home-directory;
// The idea is that in this application each library has its own
// variable named $library, which is accessible to modules in that
// library. Get-resource gets a resource associated with the library
// containing the call to it. Get-resource-from-library is a function.
// The get-resource macro is a device to make programs more concise.
define macro get-resource
{ get-resource(?type:expression, ?id:expression) }
=> { get-resource-from-library(?=$library, ?type, ?id) }
end macro;
show-icon(get-resource(ResType("ICON"), 1044));
// The completing-from-suggestions macro defines a lexically visible
// helper function called "suggest", which is only meaningful inside
// of calls to the completer. The "suggest" function is passed as an
// argument to the method passed to complete-input; alternatively it
// could have been defined in a local declaration wrapped around the
// method.
define macro completing-from-suggestions
{ completing-from-suggestions (?stream:expression,
#rest ?options:expression)
?:body end }
=>{ complete-input(?stream,
method (?=suggest) ?body end,
?options) }
end macro;
completing-from-suggestions (stream, partial-completers: #(' ', '-'))
for (command in commands)
suggest (command, command-name (command))
end for;
end completing-from-suggestions;
define macro jump-instruction-definer
{ define jump-instruction ?:name ?options:* end }
=> { register-instruction("j" ## ?#"name",
make(<instruction>,
debug-name: "j" ## ?"name",
?options)) }
end macro;
define jump-instruction eq cr-bit: 2, commutative?: #t end;
Generated with Harlequin WebMaker