From 4031b59b19152bb3e9e2d323caa7faffb7557c82 Mon Sep 17 00:00:00 2001 From: s-ol Date: Wed, 29 Jan 2020 23:41:05 +0100 Subject: support tagging --- ast.moon | 66 ++++++++++++++++++++++++++++++++ parsing.moon | 52 ++++--------------------- spec/ast_spec.moon | 15 ++++++++ spec/parsing_spec.moon | 100 +++++++++++++++++++++++++++++++++++++++++++++++++ spec/peg_spec.moon | 71 ----------------------------------- test.alv | 17 +++++++++ 6 files changed, 205 insertions(+), 116 deletions(-) create mode 100644 ast.moon create mode 100644 spec/ast_spec.moon create mode 100644 spec/parsing_spec.moon delete mode 100644 spec/peg_spec.moon create mode 100644 test.alv diff --git a/ast.moon b/ast.moon new file mode 100644 index 0000000..39e2f21 --- /dev/null +++ b/ast.moon @@ -0,0 +1,66 @@ +class Atom + new: (@raw, @style='', @value) => + + _walk_sexpr: => + + stringify: => + switch @style + when '' + @raw + when '"' + "\"#{@raw}\"" + else + error! + + @make_num: (match) -> Atom match, '', tonumber match + @make_sym: (match) -> Atom match, '', match + @make_str: (match) -> Atom match, '"', match + +class Xpr + new: (parts, @style='(', tag) => + @white = {} + @white[0] = parts[1] + + for i = 2,#parts,2 + @[i/2] = parts[i] + @white[i/2] = parts[i+1] + + if tag + @tag = tag.value + + _walk_sexpr: => + if @style == '(' + coroutine.yield @ + + for frag in *@ + frag\_walk_sexpr! + + walk_sexpr: => + coroutine.wrap -> @_walk_sexpr! + + stringify: => + buf = '' + buf ..= @white[0] + for i, frag in ipairs @ + buf ..= frag\stringify! + buf ..= @white[i] + + switch @style + when 'naked' + buf + else + tag = if @tag then "[#{@tag}]" else '' + '(' .. tag .. buf .. ')' + + make_sexpr: (tag, parts) -> + if parts + Xpr parts, '(', tag + else + Xpr tag, '(' + + make_nexpr: (parts) -> Xpr parts, 'naked' + +{ + :Atom + :Xpr +} diff --git a/parsing.moon b/parsing.moon index f9efef4..d4fba0b 100644 --- a/parsing.moon +++ b/parsing.moon @@ -1,47 +1,7 @@ lpeg = require 'lpeg' +import Atom, Xpr from require 'ast' -class Atom - new: (@raw, @style='', @value) => - - stringify: => - switch @style - when '' - @raw - when '"' - "\"#{@raw}\"" - else - error! - - @make_num: (match) -> Atom match, '', tonumber match - @make_sym: (match) -> Atom match, '', match - @make_str: (match) -> Atom match, '"', match - -class Xpr - new: (parts, @style='(') => - @white = {} - @white[0] = parts[1] - - for i = 2,#parts,2 - @[i/2] = parts[i] - @white[i/2] = parts[i+1] - - stringify: => - buf = '' - buf ..= @white[0] - for i, frag in ipairs @ - buf ..= frag\stringify! - buf ..= @white[i] - - switch @style - when 'naked' - buf - else - '(' .. buf .. ')' - - make_sexpr: (parts) -> Xpr parts, '(' - make_nexpr: (parts) -> Xpr parts, 'naked' - -space = (lpeg.S ' \t\r\n') ^ 1 / 1 +space = (lpeg.S ' \t\r\n') ^ 1 / 1 mspace = (lpeg.S ' \t\r\n') ^ 0 / 1 sym = ((lpeg.R 'az', 'AZ') + (lpeg.S '-_+*')) ^ 1 / Atom.make_sym @@ -50,8 +10,10 @@ num = (lpeg.R '09', 'AZ') ^ 1 / Atom.make_num atom = sym + num + str expr = (lpeg.V 'sexpr') + atom -explist = lpeg.Ct mspace * (lpeg.V 'expr') * (space * atom) ^ 0 * mspace -sexpr = (lpeg.P '(') * (lpeg.V 'explist') * (lpeg.P ')') / Xpr.make_sexpr +explist = lpeg.Ct mspace * (lpeg.V 'expr') * (space * (lpeg.V 'expr')) ^ 0 * mspace + +tag = (lpeg.P '[') * num * (lpeg.P ']') +sexpr = (lpeg.P '(') * tag^-1 * (lpeg.V 'explist') * (lpeg.P ')') / Xpr.make_sexpr nexpr = lpeg.P { (lpeg.V 'explist') / Xpr.make_nexpr @@ -63,7 +25,7 @@ sexpr = lpeg.P { :expr, :explist, :sexpr } -program = nexpr +program = nexpr * -1 { :space diff --git a/spec/ast_spec.moon b/spec/ast_spec.moon new file mode 100644 index 0000000..402ce03 --- /dev/null +++ b/spec/ast_spec.moon @@ -0,0 +1,15 @@ +import Atom, Xpr from require 'ast' + +describe 'Xpr', -> + it 'can be walked', -> + aa = Xpr { '', (Atom '1', '', 1), '' } + ab = Xpr { '', (Atom '2', '', 2), '' } + ac = Xpr { '', (Atom '3', '', 3), '' } + b = Xpr { '', aa, ' ', ab, '' } + + root = Xpr { '', ac, ' ', b, '' }, 'naked' + + iter = root\walk_sexpr! + for res in *{ ac, b, aa, ab } + assert.is.equal res, iter! + assert.is.nil iter! diff --git a/spec/parsing_spec.moon b/spec/parsing_spec.moon new file mode 100644 index 0000000..5e6e1fc --- /dev/null +++ b/spec/parsing_spec.moon @@ -0,0 +1,100 @@ +import space, atom, expr, explist, sexpr, nexpr, program from require 'parsing' + +describe 'atom parsing', -> + test 'symbols', -> + sym = atom\match 'some-toast help' + assert.is.equal 'some-toast', sym.raw + assert.is.equal 'some-toast', sym.value + assert.is.equal 'some-toast', sym\stringify! + + test 'numbers', -> + num = atom\match '1234 nope' + assert.is.equal '1234', num.raw + assert.is.equal 1234, num.value + assert.is.equal '1234', num\stringify! + + test 'strings', -> + str = atom\match '"help some stuff!" nope' + assert.is.equal 'help some stuff!', str.raw + assert.is.equal 'help some stuff!', str.value + assert.is.equal '"help some stuff!"', str\stringify! + +test 'whitespace parsing', -> + assert.is.equal ' ', space\match ' ' + assert.is.equal '\n\t ', space\match '\n\t ' + +describe 'nexpr parsing', -> + it 'handles leading whitespace', -> + node = nexpr\match ' 3\tok-yes' + + assert.is.equal 2, #node + assert.is.equal 3, node[1].value + assert.is.equal 'ok-yes', node[2].value + + assert.is.equal ' 3\tok-yes', node\stringify! + + it 'handles trailing whitespace', -> + node = nexpr\match '3\tok-yes\n' + + assert.is.equal 2, #node + assert.is.equal 3, node[1].value + assert.is.equal 'ok-yes', node[2].value + + assert.is.equal '3\tok-yes\n', node\stringify! + + it 'handles whitespace everywhere', -> + node = nexpr\match ' 3\tok-yes\n' + + assert.is.equal 2, #node + assert.is.equal 3, node[1].value + assert.is.equal 'ok-yes', node[2].value + + assert.is.equal ' 3\tok-yes\n', node\stringify! + +describe 'sexpr', -> + test 'basic parsing', -> + str = '( 3 ok-yes + "friend" )' + node = sexpr\match str + + assert.is.equal '(', node.style + assert.is.equal 3, #node + assert.is.equal 3, node[1].value + assert.is.equal 'ok-yes', node[2].value + assert.is.equal 'friend', node[3].value + + assert.is.equal str, node\stringify! + + test 'tag parsing', -> + str = '([42]tagged 2)' + node = sexpr\match str + + assert.is.equal '(', node.style + assert.is.equal 2, #node + assert.is.equal 'tagged', node[1].value + assert.is.equal 2, node[2].value + + assert.is.equal 42, node.tag + assert.is.equal str, node\stringify! + +describe 'resynthesis', -> + test 'mixed parsing', -> + str = '( 3 ok-yes + "friend" )' + node = program\match str + assert.is.equal str, node\stringify! + + test 'complex', -> + str = ' + (osc "/radius" (lfo (cc 14))) + + (osc rot + (step + (note "kick") + (random-rot) + (random-rot) + (random-rot) + (random-rot) + ) + ) ' + assert.is.equal str, (program\match str)\stringify! diff --git a/spec/peg_spec.moon b/spec/peg_spec.moon deleted file mode 100644 index 1b25406..0000000 --- a/spec/peg_spec.moon +++ /dev/null @@ -1,71 +0,0 @@ -import space, atom, expr, explist, sexpr, nexpr, program from require 'parsing' - -describe 'atom parsing', -> - test 'symbols', -> - sym = atom\match 'some-toast help' - assert.is.equal 'some-toast', sym.raw - assert.is.equal 'some-toast', sym.value - assert.is.equal 'some-toast', sym\stringify! - - test 'numbers', -> - num = atom\match '1234 nope' - assert.is.equal '1234', num.raw - assert.is.equal 1234, num.value - assert.is.equal '1234', num\stringify! - - test 'strings', -> - str = atom\match '"help some stuff!" nope' - assert.is.equal 'help some stuff!', str.raw - assert.is.equal 'help some stuff!', str.value - assert.is.equal '"help some stuff!"', str\stringify! - -test 'whitespace parsing', -> - assert.is.equal ' ', space\match ' ' - assert.is.equal '\n\t ', space\match '\n\t ' - -describe 'nexpr parsing', -> - it 'handles leading whitespace', -> - node = nexpr\match ' 3\tok-yes' - - assert.is.equal 2, #node - assert.is.equal 3, node[1].value - assert.is.equal 'ok-yes', node[2].value - - assert.is.equal ' 3\tok-yes', node\stringify! - - it 'handles trailing whitespace', -> - node = nexpr\match '3\tok-yes\n' - - assert.is.equal 2, #node - assert.is.equal 3, node[1].value - assert.is.equal 'ok-yes', node[2].value - - assert.is.equal '3\tok-yes\n', node\stringify! - - it 'handles whitespace everywhere', -> - node = nexpr\match ' 3\tok-yes\n' - - assert.is.equal 2, #node - assert.is.equal 3, node[1].value - assert.is.equal 'ok-yes', node[2].value - - assert.is.equal ' 3\tok-yes\n', node\stringify! - -test 'sexpr parsing', -> - str = '( 3 ok-yes - "friend" )' - node = sexpr\match str - - assert.is.equal '(', node.style - assert.is.equal 3, #node - assert.is.equal 3, node[1].value - assert.is.equal 'ok-yes', node[2].value - assert.is.equal 'friend', node[3].value - - assert.is.equal str, node\stringify! - -test 'mixed parsing', -> - str = '( 3 ok-yes - "friend" )' - node = program\match str - assert.is.equal str, node\stringify! diff --git a/test.alv b/test.alv new file mode 100644 index 0000000..2514822 --- /dev/null +++ b/test.alv @@ -0,0 +1,17 @@ +(osc "/radius" (lfo (cc 14))) + +(set kick (note 38)) +(set pitch (const 440)) + +(osc rot + (step + kick + (random-rot) + (random-rot) + (random-rot) + (random-rot) + ) +) + +(amp (env kick 02 10 05) + (sineosc pitch)) -- cgit v1.2.3