Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

297 lines (208 sloc) 5.629 kb
use("core")
use("define")
use("cosmetics")
use("control-flow")
Atomy::Patterns open:
With = Pattern class:
children(.pattern, .sub-pattern)
attributes(.expression)
generate
construct(g) := do:
get(g)
@pattern construct(g)
@sub-pattern construct(g)
@expression construct(g)
g send(.new, 3)
target(g) := @pattern target(g)
matches(g)? := do:
mismatch = g new-label
done = g new-label
@result = g new-stack-local
g dup
@pattern matches(g)?
g gif(mismatch)
`{ ~@expression } bytecode(g)
g send(.block, 0)
g swap
g push-scope
g send(.call-under, 2)
g set-stack-local(@result)
@sub-pattern matches(g)?
g dup
g git(done)
mismatch set!
g pop
g push-false
done set!
matches-self(g)? := do:
mismatch = g new-label
done = g new-label
@result = g new-stack-local
@pattern matches-self(g)?
g gif(mismatch)
@expression compile(g)
g set-stack-local(@result)
@sub-pattern matches(g)?
g dup
g git(done)
g pop
mismatch set!
g push-false
done set!
deconstruct(g, locals = ::Hash new) := do:
unless(@result): g dup
@pattern deconstruct(g, locals)
if(@result)
then: g push-stack-local(@result)
else:
`{ ~@expression } bytecode(g)
g send(.block, 0)
g swap
g push-scope
g send(.call-under, 2)
@sub-pattern deconstruct(g, locals)
And = Pattern class:
children(.a, .b)
generate
target(g) := @a target(g)
matches(g)? := do:
mismatch = g new-label
done = g new-label
g dup
@a matches(g)?
g gif(mismatch)
@b matches(g)?
g dup
g git(done)
mismatch set!
g pop
g push-false
done set!
deconstruct(g, locals = ::Hash new) := do:
g dup
@a deconstruct(g, locals)
@b deconstruct(g, locals)
Or = Pattern class:
children(.a, .b)
generate
target(g) := @a target(g)
matches(g)? := do:
matched = g new-label
done = g new-label
g dup
@a matches(g)?
g git(matched)
@b matches(g)?
g dup
g gif(done)
matched set!
g pop
g push-true
done set!
deconstruct(g, locals = ::Hash new) := do:
b = g new-label
done = g new-label
g dup
g dup
@a matches(g)?
g gif(b)
@a deconstruct(g, locals)
g pop
g goto(done)
b set!
g pop
@b deconstruct(g, locals)
done set!
-- base patterns
Atomy::Patterns open:
(Atomy::AST::Node ? to-word) to-pattern :=
Named new $:
Any new
to-word text
Atomy::AST::Primitive to-pattern :=
Match new(@value)
Atomy::AST::Literal to-pattern :=
Literal new(@value)
Atomy::AST::List to-pattern :=
List new $:
@elements collect [e]: e to-pattern
Atomy::AST::Constant to-pattern :=
Constant new(self)
Atomy::AST::ScopedConstant to-pattern :=
Constant new(self)
Atomy::AST::ToplevelConstant to-pattern :=
Constant new(self)
Atomy::AST::Quote to-pattern :=
Quote new(@expression)
Atomy::AST::Block to-pattern :=
SingletonClass new(body)
Atomy::AST::QuasiQuote to-pattern :=
QuasiQuote new(self)
`(~x { ~y }) to-pattern :=
Named new(y to-pattern, x text)
`(? ~t) to-pattern :=
Predicate new(Any new, t)
`(~p ? ~t) to-pattern :=
Predicate new(p to-pattern, t)
`@@~(n: ? to-word) to-pattern :=
NamedClass new(n to-word text)
`(~x ~(y: ? to-word)) to-pattern :=
Attribute new(x, y to-word text, [])
`(~x ~(y: ? to-word)(~*as)) to-pattern :=
Attribute new(x, y to-word text, as)
`(~x ~(y: Atomy::AST::Word)(~*as)?) to-pattern :=
Attribute new(x, `((~y)?) to-word text, as)
`(~x ~(y: Atomy::AST::Word)(~*as)!) to-pattern :=
Attribute new(x, `((~y)!) to-word text, as)
`(~a & ~b) to-pattern :=
And new(a to-pattern, b to-pattern)
`(~a | ~b) to-pattern :=
Or new(a to-pattern, b to-pattern)
`(~x with(~e, ~y)) to-pattern :=
With new(x to-pattern, y to-pattern, e)
`(with(~e, ~y)) to-pattern :=
With new(Any new, y to-pattern, e)
`(~x [~*as]) to-pattern :=
Attribute new(x, ."[]", as)
'_ to-pattern :=
Any new
`(~h . ~t) to-pattern :=
HeadTail new(h to-pattern, t to-pattern)
`(~p = ~d) to-pattern :=
Default new(p to-pattern, d)
`$0 to-pattern :=
NamedGlobal new("0")
`$exception to-pattern :=
NamedGlobal new("!")
`$path to-pattern :=
NamedGlobal new(":")
`$separator to-pattern :=
NamedGlobal new("/")
`$~(n: Atomy::AST::Constant) to-pattern :=
NamedGlobal new(n name)
`$~(n: Atomy::AST::String) to-pattern :=
NamedGlobal new(n value)
`$~(n: ? to-word) to-pattern :=
NamedGlobal new(n to-word text)
`@~(n: ? to-word) to-pattern :=
NamedInstance new(n to-word text)
`&~x to-pattern :=
BlockPass new(x to-pattern)
`*~x to-pattern :=
Splat new(x to-pattern)
'self to-pattern :=
Match new(.self)
'true to-pattern :=
Match new(.true)
'false to-pattern :=
Match new(.false)
'nil to-pattern :=
Match new(.nil)
`.~(x: ? to-word) to-pattern :=
Literal new(x to-word text)
`.~(x: Atomy::AST::Constant) to-pattern :=
Literal new(x name)
`.~(x: Atomy::AST::String) to-pattern :=
Literal new(x value to-sym)
Atomy::AST::Node to-pattern :=
raise("unknown pattern: " + to-sexp inspect)
Jump to Line
Something went wrong with that request. Please try again.