Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

361 lines (255 sloc) 7.704 kB
use("core")
use("define")
use("cosmetics")
use("control-flow")
use("meta")
Atomy Patterns open:
-- redefine these in atomy so we can have some base cases
Pattern <=> x := precision <=> x precision
Pattern <=> (x: Default) := <=> x pattern
Pattern <=> (x: Named) := <=> x pattern
Pattern <=> (x: BlockPass) := <=> x pattern
Pattern <=> (x: Splat) := <=> x pattern
Pattern <=> Predicate := -1
With = Pattern class:
children(.pattern, .sub-pattern)
attributes(.expression)
construct(g, mod) := do:
get(g)
@pattern construct(g, mod)
@sub-pattern construct(g, mod)
@expression construct(g, mod)
g send(.new, 3)
g push-cpath-top
g find-const(.Atomy)
g send(.current_module, 0)
g send(.in_context, 1)
target(g, mod) := @pattern target(g, mod)
matches(g, mod)? := do:
mismatch = g new-label
done = g new-label
@result = g new-stack-local
g dup
@pattern matches(g, mod)?
g gif(mismatch)
`{ ~@expression } bytecode(g, mod)
g send(.block, 0)
g swap
g push-scope
g send(.call-under, 2)
g set-stack-local(@result)
@sub-pattern matches(g, mod)?
g dup
g git(done)
mismatch set!
g pop
g push-false
done set!
matches-self(g, mod)? := do:
mismatch = g new-label
done = g new-label
@result = g new-stack-local
@pattern matches-self(g, mod)?
g gif(mismatch)
mod compile(g, @expression)
g set-stack-local(@result)
@sub-pattern matches(g, mod)?
g dup
g git(done)
g pop
mismatch set!
g push-false
done set!
deconstruct(g, mod, locals = Hash new) := do:
unless(@result):
g dup
@pattern deconstruct(g, mod, locals)
if(@result)
then: g push-stack-local(@result)
else:
`{ ~@expression } bytecode(g, mod)
g send(.block, 0)
g swap
g push-scope
g send(.call-under, 2)
@sub-pattern deconstruct(g, mod, locals)
And = Pattern class:
children(.a, .b)
target(g, mod) := @a target(g, mod)
matches(g, mod)? :=
condition:
@a wildcard? ->
@b matches(g, mod)?
@b wildcard? ->
@a matches(g, mod)?
otherwise:
mismatch = g new-label
done = g new-label
g dup
@a matches(g, mod)?
g gif(mismatch)
@b matches(g, mod)?
g dup
g git(done)
mismatch set!
g pop
g push-false
done set!
deconstruct(g, mod, locals = Hash new) := do:
g dup
@a deconstruct(g, mod, locals)
@b deconstruct(g, mod, locals)
Or = Pattern class:
children(.a, .b)
target(g, mod) := @a target(g, mod)
matches(g, mod)? := do:
matched = g new-label
done = g new-label
g dup
@a matches(g, mod)?
g git(matched)
@b matches(g, mod)?
g dup
g gif(done)
matched set!
g pop
g push-true
done set!
deconstruct(g, mod, locals = Hash new) := do:
b = g new-label
done = g new-label
g dup
g dup
@a matches(g, mod)?
g gif(b)
@a deconstruct(g, mod, locals)
g pop
g goto(done)
b set!
g pop
@b deconstruct(g, mod, locals)
done set!
Pattern <=> (a: And) := -(a <=> self)
Pattern <=> (o: Or) := -(o <=> self)
Pattern <=> (w: With) := <=> w pattern
-- an And precedes x if either precede it
And <=> x :=
if(@a <=> x == 1)
then: 1
else: @b <=> x
-- an Or precedes x if neither are preceded by
Or <=> x :=
if(@a <=> x == -1)
then: -1
else: @b <=> x
With <=> x := @pattern <=> x
-- TODO
(a: And) <=> (b: And) :=
((a a <=> b a) + (a b <=> b a) + (a a <=> b b) + (a b <=> b b)) <=> 0
(a: Or) <=> (b: Or) :=
((a a <=> b a) + (a b <=> b a) + (a a <=> b b) + (a b <=> b b)) <=> 0
(a: With) <=> (b: With) :=
if(a pattern <=> b pattern == -1)
then: -1
else: a sub-pattern <=> b sub-pattern
-- pattern definition
macro(pattern(~pat): ~*body):
names [mod]:
patdef =
LetMacro new(
node line
`(do: ~*body)
[`(pattern(~(Unquote new(0, 'x))) =
`(~'~mod make-pattern(~x)))])
DefinePattern new(node line, pat, patdef, mod)
-- base patterns
pattern(? to-word):
Atomy Patterns Named new(Atomy Patterns Any new, node to-word text)
pattern(`(~(x ? to-word): ~y)):
Atomy Patterns Named new(pattern(y), x to-word text)
pattern(Primitive):
Atomy Patterns Match new(node value)
pattern(Literal):
Atomy Patterns Literal new(node value)
pattern(`[~*ps]):
Atomy Patterns List new(node elements collect [e]: pattern(e))
pattern(Constant):
Atomy Patterns Constant new(node)
pattern(`(//~(y: Constant))):
Atomy Patterns Constant new(ToplevelConstant new(node line, y name))
pattern(`(/~(y: Constant))):
Atomy Patterns Constant new(ScopedConstant new(node line, 'Self, y name))
pattern(`(~x ~(y: Constant))):
Atomy Patterns Constant new(ScopedConstant new(node line, x, y name))
pattern(Quote):
Atomy Patterns Quote new(node expression)
pattern(QuasiQuote):
Atomy Patterns QuasiQuote new(
node through-quotes([_]: true) [e]:
pattern(e) to-node)
pattern(Block):
Atomy Patterns SingletonClass new(node body)
pattern(`(? ~t)):
Atomy Patterns Predicate new(Atomy Patterns Any new, t)
pattern(`(~p ? ~t)):
Atomy Patterns Predicate new(pattern(p), t)
pattern(`@@~(n ? to-word)):
Atomy Patterns NamedClass new(n to-word text)
pattern(`(~x ~(y ? to-word))):
Atomy Patterns Attribute new(x, y to-word text, [])
pattern(`(~x (~(y ? to-word))(~*as))):
Atomy Patterns Attribute new(x, y to-word text, as)
pattern(`(~x (~(y: Word))(~*as)?)):
Atomy Patterns Attribute new(x, `((~y)?) to-word text, as)
pattern(`(~x (~(y: Word))(~*as)!)):
Atomy Patterns Attribute new(x, `((~y)!) to-word text, as)
pattern(`(~x [~*as])):
Atomy Patterns Attribute new(x, ."[]", as)
pattern('_):
Atomy Patterns Any new
pattern(`(~h . ~t)):
Atomy Patterns HeadTail new(pattern(h), pattern(t))
pattern(`(~p = ~d)):
Atomy Patterns Default new(pattern(p), d)
pattern(`$0):
Atomy Patterns NamedGlobal new("0")
pattern(`$exception):
Atomy Patterns NamedGlobal new("!")
pattern(`$path):
Atomy Patterns NamedGlobal new(":")
pattern(`$separator):
Atomy Patterns NamedGlobal new("/")
pattern(`$~(n: Constant)):
Atomy Patterns NamedGlobal new(n name)
pattern(`$~(n: StringLiteral)):
Atomy Patterns NamedGlobal new(n value)
pattern(`$~(n ? to-word)):
Atomy Patterns NamedGlobal new(n to-word text)
pattern(`@~(n ? to-word)):
Atomy Patterns NamedInstance new(n to-word text)
pattern(`&~x):
Atomy Patterns BlockPass new(pattern(x))
pattern(`*~x):
Atomy Patterns Splat new(pattern(x))
pattern('self):
Atomy Patterns Match new(.self)
pattern('true):
Atomy Patterns Match new(.true)
pattern('false):
Atomy Patterns Match new(.false)
pattern('nil):
Atomy Patterns Match new(.nil)
pattern(`.~(x ? to-word)):
Atomy Patterns Literal new(x to-word text)
pattern(`.~(x: Constant)):
Atomy Patterns Literal new(x name)
pattern(`.~(x: StringLiteral)):
Atomy Patterns Literal new(x value to-sym)
pattern(`(~a & ~b)):
Atomy Patterns And new(pattern(a), pattern(b))
pattern(`(~a | ~b)):
Atomy Patterns Or new(pattern(a), pattern(b))
pattern(`(~x with(~e, ~y))):
Atomy Patterns With new(pattern(x), pattern(y), e)
pattern(`(with(~e, ~y))):
Atomy Patterns With new(Atomy Patterns Any new, pattern(y), e)
Jump to Line
Something went wrong with that request. Please try again.