atomy 0.1.1

data/kernel/documentation.ay

@@ -0,0 +1,135 @@
+namespace(atomy/documentation)
+
+in-namespace(atomy):
+  symbols(pretty, show)
+
+for-macro:
+  escape(x) :=
+    x gsub(r"[\{\}\\]", raw"\\\0")
+
+  indent(x, n = 1) :=
+    x split("\n") collect [x] { (" " * n * 2) + x } join("\n")
+
+  str-expr(e) :=
+    escape $:
+      e match:
+        String -> e
+        Atomy::AST::String -> e value
+        _ -> e show
+
+  to-thumb(x: Atomy::AST::Macro) :=
+    indent(escape(x pattern show))
+  to-thumb(`(~meth := ~_)) :=
+    indent(escape(meth show))
+  to-thumb(d: `(data(Object))) :=
+    let(atomy/pretty/multiline? = true):
+      indent(escape(d block body show))
+  to-thumb(d: `(data(~r))) :=
+    let(atomy/pretty/multiline? = true):
+      indent(escape(`(~r ~(d block)) show))
+  to-thumb(`(dynamic(~n, ~r))) :=
+    indent(`^~n show + "\n> " + r show)
+  to-thumb(`(class(~n))) :=
+    indent(n show + "\n> Class")
+  to-thumb(`(module(~n))) :=
+    indent(n show + "\n> Module")
+  to-thumb(x) := str-expr(x)
+
+  to-spec([]) := ""
+  to-spec(b) :=
+    "\n" + indent $:
+      b collect [e] {
+        e match:
+          `(=> ~x) ->
+            "> " + str-expr(x)
+
+          _ ->
+            "| " + str-expr(e)
+      } join("\n")
+
+  to-examples(b) :=
+    b collect [e] {
+      "    " + str-expr(e)
+    } join("\n")
+
+export-to(atomy):
+  -- TODO: shoudln't need to export this; not being resolved in #section
+  macro(for-docs(&body)):
+    `(when(^documentation):
+        ^documentation << ~(body block-body))
+
+  macro-quoter(doc) [c]:
+    for-docs:
+      c + "\n\n"
+
+    c
+
+  macro-quoter(title) [c]:
+    for-docs:
+      "\\title{" + escape(c) + "}\n\n"
+
+    c
+
+  macro(section(name, &body)):
+    `(do:
+        evaluate-when(compile):
+          for-docs: "\\section{" + ~name + "}{\n\\style{Atomy}\n\n"
+
+        res = ~(body caller)
+
+        evaluate-when(compile):
+          for-docs: "}"
+
+        res)
+
+  macro(docs spec(&s) for(&code)):
+    for-docs:
+      [ "\\define{"
+        "\n" + to-thumb(code contents first)
+        to-spec(s contents)
+        "\n}{"
+        docs contents
+        "}\n\n"
+      ] join
+
+    code block-body
+
+  macro(docs for(&code)):
+    for-docs:
+      [ "\\define{"
+        "\n" + to-thumb(code contents first)
+        "\n}{"
+        docs contents
+        "}\n\n"
+      ] join
+
+    code block-body
+
+  macro(docs spec(&s) for(&code) examples(&es)):
+    for-docs:
+      [ "\\define{"
+        "\n" + to-thumb(code contents first)
+        to-spec(s contents)
+        "\n}{"
+        docs contents
+        "\n  \\examples{"
+        "\n" + to-examples(es contents)
+        "\n  }"
+        "\n}\n\n"
+      ] join
+
+    code block-body
+
+  macro(docs for(&code) examples(&es)):
+    for-docs:
+      [ "\\define{"
+        "\n" + to-thumb(code contents first)
+        "\n}{"
+        docs contents
+        "\n  \\examples{"
+        "\n" + to-examples(es contents)
+        "\n  }"
+        "\n}\n\n"
+      ] join
+
+    code block-body

data/kernel/dynamic.ay

@@ -0,0 +1,42 @@
+Atomy::DYNAMIC_ROOTS = Hash new
+
+for-macro:
+  key(n) :=
+    Atomy::AST::Variable new $:
+      n line
+      "atomy_" + n resolve message-name
+
+  dynvar(x) :=
+    `(Thread current [#~key(x)] || Atomy::DYNAMIC_ROOTS [#~x])
+
+  set-dynvar(n, v) :=
+    `(Thread current [#~key(n)] = ~v)
+
+macro(dynamic(n, root)):
+  where = Atomy::Namespace define-target
+
+  Atomy::Namespace register(n namespace-symbol, where)
+
+  Atomy::CodeLoader when-load <<
+    [`(Atomy::Namespace register(~(n namespace-symbol), ~where)), true]
+
+  `(Atomy::DYNAMIC_ROOTS [#~n] = ~root)
+
+macro(^x): dynvar(x)
+
+macro(let(*bindings, &body)):
+  tmps = names(bindings size)
+  save = []
+  set = []
+  restore = []
+
+  bindings zip(tmps) [[`(~n = ~v), tmp]]:
+    save << `(~tmp = ~(dynvar(n)))
+    set << set-dynvar(n, v)
+    restore << set-dynvar(n, tmp)
+
+  `(do:
+      ~*save
+      { ~*set
+        ~(body caller)
+      } ensuring: ~*restore)

data/kernel/errors.ay

@@ -0,0 +1,6 @@
+MethodFail message :=
+  ("method '" + @method-name to-s + "' did not understand " +
+  "its arguments (non-exhaustive patterns)")
+
+PatternMismatch message :=
+  "irrefutable pattern failed for " + @pattern to-s

data/kernel/format.ay

@@ -0,0 +1,13 @@
+namespace(atomy/format)
+
+base = File expand-path("../", _FILE)
+
+import(base + "/format/data")
+import(base + "/format/formatter")
+import(base + "/format/parser")
+
+symbols(parse)
+
+export-to(atomy):
+  macro-quoter(f) [c]:
+    Atomy::Format::Parser parse(c)

data/kernel/format/data.ay

@@ -0,0 +1,89 @@
+namespace(atomy/format)
+
+macro(ast(root, &nodes)):
+  parent = root || 'Atomy::AST::Node
+  cs = nodes contents map [e]:
+    e match:
+      Atomy::AST::Send -> do:
+        name = Atomy::AST::Constant new(0, e method-name)
+
+        children = []
+        attributes = []
+
+        e arguments each [a]:
+          a match:
+            `[@~name] ->
+              attributes << `[#~name]
+
+            `@~name ->
+              attributes << `#~name
+
+            _ ->
+              children << a
+
+        `(class(~name < ~parent):
+            children(~*children)
+            attributes(~*attributes)
+            generate)
+
+      _ ->
+        `(class(~e < ~parent):
+            generate)
+
+  when(root):
+    cs unshift(`(class(~root < Atomy::AST::Node) {}))
+
+  `(do: ~*cs)
+
+module(Atomy::Format):
+  ast(Segment):
+    Chunk([#flags], @text)
+    String([#flags])
+    Decimal([#flags])
+    Hex([#flags])
+    Octal([#flags])
+    Binary([#flags])
+    Radix([#flags])
+    Float([#flags])
+    Exponent([#flags])
+    General([#flags])
+    Character([#flags])
+    Any([#flags])
+    Pluralize(#singular, [#flags], #plural?)
+    Lowercase(#content, [#flags])
+    Capitalize(#content, [#flags])
+    Uppercase(#content, [#flags])
+    Justify([#segments], [#flags])
+    Skip([#flags])
+    Indirection([#flags])
+    Iterate(#content, [#flags])
+    Break([#flags])
+    Conditional([#branches], [#flags], #default?)
+
+  ast(Flag):
+    Number(@value)
+    Symbol(@character)
+    ZeroPad
+    Precision(@value)
+
+  ast:
+    Formatter([#segments])
+
+  Segment symbol?(m) :=
+    @flags any? [f]:
+      f match:
+        Symbol -> f character == m
+        _ -> false
+
+  Segment precision := do:
+    @flags each [f]:
+      when(f is-a?(Precision)):
+        return(f value)
+
+    nil
+
+  Segment zero-pad? :=
+    @flags any? [f]:
+      f match:
+        ZeroPad -> true
+        _ -> false

data/kernel/format/formatter.ay

@@ -0,0 +1,345 @@
+namespace(atomy/format)
+
+module(Atomy::Format):
+  class(Formatter):
+    attr-accessor(#position)
+
+    export:
+      initialize(@line, @segments) :=
+        reset!
+
+      bytecode(g) := do:
+        pos(g)
+        construct(g)
+
+    reset! := do:
+      @input = []
+      @output = ""
+      @position = 0
+      @stop? = false
+      @iterating = []
+
+    scan(*@input) := do:
+      @segments each [s]:
+        s match:
+          Break ? symbol?(".") -> do:
+            when(@iterating empty?):
+              @stop? = true
+              break
+
+          Break ->
+            when(next-inputs empty?):
+              break
+
+          _ -> process(s)
+
+      @output
+
+    export-to(atomy):
+      format(*inputs) := do:
+        res = scan(*inputs)
+        reset!
+        res
+
+      -- TODO: use alias-method
+      self [*inputs] := format(*inputs)
+
+    peek-input := @input [@position]
+
+    next-input := do:
+      v = peek-input
+      @position += 1
+      v
+
+    next-inputs := @input [@position .. -1] || []
+
+    process(c: Chunk) :=
+      @output << c text
+
+    process(s: String) :=
+      @output << justified(s, next-input to-s, true)
+
+    process(i: Decimal) :=
+      @output << integer(i, 10)
+
+    process(i: Hex) :=
+      @output << integer(i, 16)
+
+    process(i: Octal) :=
+      @output << integer(i, 8)
+
+    process(i: Binary) :=
+      @output << integer(i, 2)
+
+    process(i: Radix) :=
+      @output << integer(i, i precision)
+
+    process(f: Float) :=
+      @output << float(f, "f")
+
+    process(f: Exponent) :=
+      @output << float(f, "e")
+
+    process(f: General) :=
+      @output << float(f, "g")
+
+    process(c: Character) :=
+      @output << char(c, next-input)
+
+    process(a: Any) :=
+      @output << justified(a, next-input show, true)
+
+    process(p: Pluralize) := do:
+      word = sub-format(p singular)
+      num =
+        if(p symbol?(">"))
+          then: peek-input
+          else: next-input
+
+      condition:
+        num == 1 ->
+          @output << word
+
+        p plural ->
+          @output << sub-format(p plural)
+
+        otherwise ->
+          @output << pluralize(word)
+
+    process(l: Lowercase) :=
+      @output << sub-format(l content) downcase
+
+    process(c: Capitalize) := do:
+      words = sub-format(c content) split(" ")
+      number(c, words size) times [n]:
+        unless(n == 0):
+          @output << " "
+
+        @output << words shift capitalize
+
+      unless(words empty?):
+        @output << " " + words join(" ")
+
+    process(u: Uppercase) :=
+      @output << sub-format(u content) upcase
+
+    process(s: Skip) :=
+      if(s symbol?("<"))
+        then: @position -= number(s)
+        else: @position += number(s)
+
+    process(i: Indirection) :=
+      if(i symbol?("*"))
+        then:
+          @output << sub-format(next-input)
+        else:
+          @output << next-input format(*next-input)
+
+    process(i: Iterate) := do:
+      splat? = i symbol?("*")
+      sub? = i symbol?(".")
+      always-run? = i symbol?("+")
+      iterations = number(i, nil)
+
+      inputs =
+        if(splat?)
+          then: next-inputs
+          else: next-input
+
+      before = [@input, @position]
+
+      when(inputs empty? && always-run? &&
+            iterations != 0):
+        @output << sub-format(i content)
+        return(nil)
+
+      iterations match:
+        nil ->
+          if(sub?)
+            then:
+              @iterating = inputs
+              inputs each [is]:
+                @output << i content format(*is)
+            else:
+              @input = inputs
+              @position = 0
+              iterate(i content)
+        n -> do:
+          @input = inputs
+          @position = 0
+          iterate-max(n, i content)
+
+      if(splat?)
+        then: @position = @input size
+        else: [@input, @position] = before
+
+    process(c: Conditional) :=
+      [c symbol?("?"), c branches] match:
+        [true, t . (f . _)] ->
+          @output << sub-format(if(next-input) then: t; else: f)
+
+        [true, [t]] ->
+          when(next-input):
+            @output << sub-format(t)
+
+        _ -> do:
+          n = next-number(c)
+          if(n >= c branches size)
+            then:
+              when(c default):
+                @output << sub-format(c default)
+            else:
+              @output << sub-format(c branches [n])
+
+    process(j: Justify) :=
+      @output <<
+        justify(j, j segments collect [s]: sub-format(s))
+
+    process(x) := raise("todo formatting: " + x inspect)
+
+
+    pluralize(s) :=
+      condition:
+        s =~ r"o$"(i) ->
+          s + "es"
+
+        s =~ r"[aeiou]$"(i) ->
+          s + "s"
+
+        s =~ r"(?<root>.+[aeiou])y$"(i) ->
+          s + "s"
+
+        s =~ r"(lay-by|stand-by)$"(i) ->
+          s + "s"
+
+        s =~ r"(.+)y$"(i) ->
+          $1 + "es"
+
+        s =~ r"(.+)us$"(i) ->
+          $1 + ""
+
+        s =~ r"(.+)sis$"(i) ->
+          $1 + "es"
+
+        s =~ r"(.+)(ex|ix)$"(i) ->
+          $1 + "ces"
+
+        s =~ r"(.+)(ss|sh|ch|dge)$"(i) ->
+          s + "es"
+
+        otherwise ->
+          s + "s"
+
+
+    iterate(f) :=
+      until(next-inputs empty? || @stop?):
+        @output << sub-format(f)
+
+    iterate-max(max, f) :=
+      max times:
+        when(next-inputs empty? || @stop?):
+          break
+
+        @output << sub-format(f)
+
+    next-number(s) :=
+      number(s, nil) || next-input
+
+    char(c, n: Integer) := justified(c, n chr, true)
+    char(c, s) := justified(c, s to-s [0, 1], true)
+
+    integer(i, base) := justified(i, Integer(next-input) to-s(base))
+
+    float(f, x) := do:
+      format =
+        if(f precision)
+          then: "%." + f precision to-s + x
+          else: "%" + x
+
+      justified(f, sprintf(format, Float(next-input)))
+
+    sub-format(sub) := do:
+      sub position = @position
+      out = sub scan(*@input)
+      @position = sub position
+      sub reset!
+      out
+
+    number(s, default = 1) := do:
+      s flags each [f]:
+        when(f is-a?(Number)):
+          return(f value || next-inputs size)
+
+      default
+
+    justified(j, s, left? = false) :=
+      number(j, nil) match:
+        nil -> s
+        w -> do:
+          padding = if(j zero-pad?) then: "0"; else: " "
+
+          condition:
+            j symbol?("=") || j symbol?("<") && j symbol?(">") ->
+              s center(w, padding)
+
+            left? && !(j symbol?(">")) || j symbol?("<") ->
+              s ljust(w, padding)
+
+            otherwise ->
+              s rjust(w, padding)
+
+    justify(j, [s]) := justified(j, s)
+    justify(j, ss) :=
+      number(j, nil) match:
+        nil -> ss join
+        to -> justify-to(j, to, ss)
+
+    justify-to(_, _, []) := ""
+    justify-to(j, to, all: s . ss) := do:
+      needed = to - all collect(&#size) inject(*#"+")
+
+      spacings =
+        condition:
+          j symbol?("<") && j symbol?(">") || j symbol?("=") ->
+            all size + 1
+
+          j symbol?("<") ->
+            all size
+
+          j symbol?(">") ->
+            all size
+
+          otherwise ->
+            all size - 1
+
+      naive-average = needed / spacings
+
+      average =
+        if(needed - naive-average * spacings >= spacings - 1)
+          then: naive-average + 1
+          else: naive-average
+
+      condition:
+        j symbol?("<") || j symbol?("=") ->
+          [ " " * naive-average
+            s
+            " " * average
+            spaced(j, average, needed - naive-average - average, ss)
+          ] join
+
+        otherwise ->
+          [ s
+            " " * naive-average
+            spaced(j, average, needed - naive-average, ss)
+          ] join
+
+    spaced(_, _, _, []) := ""
+    spaced(j, _, left, [s]) :=
+      if(j symbol?(">") || j symbol?("="))
+        then: s + " " * left
+        else: " " * left + s
+    spaced(j, average, left, s . ss) :=
+      [ s
+        " " * average
+        spaced(j, average, left - average, ss)
+      ] join