update/rename kpeg kernel, use for interpolation

vito · Dec 17, 2011 · d9c27b4 · d9c27b4
1 parent e2e27b7
commit d9c27b4
Show file tree

Hide file tree

Showing 5 changed files with 212 additions and 226 deletions.
diff --git a/kernel/grammar.ay b/kernel/grammar.ay
@@ -0,0 +1,199 @@
+use("core")
+use("define")
+use("control-flow")
+use("dynamic")
+use("particles")
+use("comparison")
+
+require("kpeg")
+require("set")
+
+dynamic(actions)
+dynamic(setups)
+dynamic(vars)
+dynamic(rule)
+dynamic(rule-vars)
+
+const-name(c: Atomy::AST::Constant) := c name to-s
+const-name(c: Atomy::AST::ScopedConstant) := const-name(c parent) + "::" + c name to-s
+const-name(c: Atomy::AST::ToplevelConstant) := "::" + c name to-s
+
+process-val(g, `(~a ~b)) :=
+  `(~g seq(~process-val(g, a), ~process-val(g, b)))
+
+process-val(g, `(~a | ~b)) :=
+  `(~g any(~process-val(g, a), ~process-val(g, b)))
+
+process-val(g, a: `{ ~*bs }) :=
+  if(^actions)
+    then:
+      vars = ^rule-vars to-a
+      call = "actions[" + ^actions size to-s + "][" + vars join(", ") + "]"
+      ^actions << [a, ^rule-vars to-a]
+      `(~g action(~call))
+    else:
+      `(~g action({ ~*bs }))
+
+process-val(g, `<(~x)) := do:
+  when(^rule-vars): ^rule-vars << "text"
+  `(~g collect(~process-val(g, x)))
+
+process-val(g, `@<(~x)) :=
+  `(~g bounds(~process-val(g, x)))
+
+process-val(g, `[~*xs]) :=
+  `(~g any(~*(xs map [x]: process-val(g, x))))
+
+process-val(g, s: Atomy::AST::String) :=
+  `(~g str(~s))
+
+process-val(g, `/~(b: Atomy::AST::String)) :=
+  `(~g reg(~(b raw)))
+
+process-val(g, c: Atomy::AST::Call) := do:
+  args = "(" + c arguments collect #show join(", ") + ")"
+
+  `(~g ref(~(c name text to-s), nil, ~args))
+
+process-val(g, `@~(c: Atomy::AST::Call)) := do:
+  args = "(" + c arguments collect #show join(", ") + ")"
+
+  `(~g invoke(~(c name text to-s), ~args))
+
+process-val(g, `^~(c: Atomy::AST::Call)) := do:
+  args = "(" + c arguments collect #show join(", ") + ")"
+
+  `(~g foreign-invoke("parent", ~(c name text to-s), ~args))
+
+process-val(g, `%~(c: Atomy::AST::Call)) := do:
+  [gram, name] = c name text to-s split(".")
+  args = "(" + c arguments collect #show join(", ") + ")"
+
+  `(~g foreign-invoke(~gram, ~name, ~args))
+
+process-val(g, w: Atomy::AST::Word) :=
+  `(~g ref(~(w text to-s)))
+
+process-val(g, `@~(w: Atomy::AST::Word)) := do:
+  `(~g invoke(~(w text to-s)))
+
+process-val(g, `^~(w: Atomy::AST::Word)) := do:
+  `(~g foreign-invoke("parent", ~(w text to-s)))
+
+process-val(g, `%~(w: Atomy::AST::Word)) := do:
+  [gram, name] = w text to-s split(".")
+  `(~g foreign-invoke(~gram, ~name))
+
+process-val(g, `=~(name)(~v)) := do:
+  when(^rule-vars): ^rule-vars << name text
+  `(~g t(~process-val(g, v), ~(name text to-s)))
+
+process-val(g, `?~v) :=
+  `(~g maybe(~process-val(g, v)))
+
+process-val(g, `+~v) :=
+  `(~g many(~process-val(g, v)))
+
+process-val(g, `*~v) :=
+  `(~g kleene(~process-val(g, v)))
+
+process-val(g, `&~v) :=
+  `(~g andp(~process-val(g, v)))
+
+process-val(g, `!~v) :=
+  `(~g notp(~process-val(g, v)))
+
+process-val(g, '_) :=
+  `(~g dot)
+
+process-val(_, s) :=
+  raise(ArgumentError, "unknown operator: " + s to-sexp inspect)
+
+class(Atomy::AST::ParserDefiner < Atomy::AST::Node):
+  attributes(#source)
+  generate
+
+  bytecode(g) := do:
+    g push-rubinius
+    g push-literal(#"__parser_init__")
+    g push-literal(Rubinius::Compiler compile-string(@source))
+    g push-scope
+    g push-self
+    g send(#attach-method, 4)
+    g pop
+
+    g push-self
+    g send(#"__parser_init__", 0)
+
+
+macro(grammar: ~*body): names [g]:
+  b = body collect [n]:
+    n match:
+      `%%{ ~*xs } -> do:
+        call =
+          if(^setups)
+            then:
+              ^setups << `{ ~*xs }
+              "setups[" + (^setups size - 1) to-s + "][]"
+            else:
+              `{ ~*xs }
+
+        `(~g add-setup(~g action(~call)))
+
+      `(%~name := ~const) ->
+        `(~g add-foreign-grammar(~(name text to-s), ~const-name(const)))
+
+      `(%~name = ~expr) -> do:
+        -- TODO: fix this, yo
+        call =
+          if(^vars)
+            then:
+              ^vars << `{ ~*xs }
+              "vars[" + (^vars size - 1) to-s + "][]"
+            else:
+              `{ ~*xs }
+
+        `(~g set-variable(~(name text to-s), call))
+
+      `(~(name)(~*args) := ~val) -> do:
+        let(rule = name text,
+            rule-vars = ::Set new(args to-a collect #text)):
+          `(~g set(~(name text to-s)
+                   ~process-val(g, val)
+                   ~(args collect [x]: x text to-s)))
+
+      `(~name := ~val) -> do:
+        let(rule = name text,
+            rule-vars = ::Set new):
+          `(~g set(~(name text to-s), ~process-val(g, val)))
+
+      _ -> `unknown(~n)
+
+  `(::KPeg::Grammar new tap [~g]: ~*b)
+
+
+macro(parser(~name): ~*grammar):
+  let(actions = Array[],
+      setups = Array[],
+      vars = Array[]):
+    g = `(grammar: ~*grammar) evaluate
+
+    acts = ^actions collect [[a, as]]:
+      args = as collect [a]: Atomy::AST::Word new(0, a)
+      `([~*args] ~a)
+
+    def = Atomy::AST::ParserDefiner new(
+      node line
+      ::KPeg::CodeGenerator new(const-name(name), g) output
+    )
+
+    `(do:
+        class(~name < ::KPeg::CompiledParser):
+          { self } setups := @setups ||= ~^setups
+          { self } vars := @vars ||= ~^vars
+
+          actions := @actions ||= ~acts
+
+        ~def
+
+        ~name)
diff --git a/kernel/interpolation.ay b/kernel/interpolation.ay
@@ -3,6 +3,16 @@ use("define")
 use("control-flow")
 use("quotes")
 use("range")
+use("grammar")
+
+module(::Atomy):
+  parser(InterpolationParser):
+    %atomy := Atomy::Parser
+
+    root := %atomy.wsp =es(%atomy.expressions) %atomy.wsp "}" {
+      Atomy::AST::Tree new(0, Array(es))
+    }
+
 
 intp-segments(s) :=
   s split(Regexp new("(?<!\\\\)#\\{"), 2) match:
@@ -11,9 +21,9 @@ intp-segments(s) :=
     [x] -> [x to-node]
 
     [pre, chunk]:
-      p = Atomy::Parser new(chunk)
+      p = Atomy::InterpolationParser new(chunk)
 
-      unless(p parse("interpolated")):
+      unless(p parse):
         p raise-error
 
       segments = [pre to-node, `(~(p result) to-s)]
@@ -27,7 +37,7 @@ intp-segments(s) :=
 
 export
 
-module(Atomy::AST):
+module(::Atomy::AST):
   class(Interpolation < Node):
     children([#segments])
     generate