git.s-ol.nu alive / 29a466d alv / builtins.moon
29a466d

Tree @29a466d (Download .tar.gz)

builtins.moon @29a466draw · history · blame

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
----
-- Builtin `Builtin`s and `Op`s.
--
-- Please see the [reference](../../reference/index.html#builtins) for
-- documentation.
--
-- @module builtins
import Builtin, Op, PureOp, T, FnDef, Input, const, sig, evt, Struct, Array
  from require 'alv.base'
import Constant from require 'alv.result'
import Error from require 'alv.error'
import RTNode from require 'alv.rtnode'
import Cell from require 'alv.cell'
import Scope from require 'alv.scope'
import Tag from require 'alv.tag'
import op_invoke from require 'alv.invoke'
lfs = require 'lfs'

doc = Constant.meta
  meta:
    name: 'doc'
    summary: "Print documentation in console."
    examples: { '(doc sym)' }
    description: "Print the documentation for `sym` to the console"

  value: class extends Builtin
    format_meta = =>
      str = @summary
      if @examples
        for example in *@examples
          str ..= '\n' .. example
      if @description
        str ..= '\n' .. @description\match '^\n*(.+)\n*$'
      str

    eval: (scope, tail) =>
      assert #tail == 1, "'doc' takes exactly one parameter"

      node = L\push tail[1]\eval, scope
      super with RTNode children: { def }
        meta = node.result.meta
        L\print "(doc #{tail[1]}):\n#{format_meta meta}\n"

def = Constant.meta
  meta:
    name: 'def'
    summary: "Declare symbols in current scope."
    examples: { '(def sym1 val-expr1 [sym2 val-expr2…])' }
    description: "
Define the symbols `sym1`, `sym2`,  to resolve to the values of `val-expr1`,
`val-expr2`, ."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail > 1, "'def' requires at least 2 arguments"
      assert #tail % 2 == 0, "'def' requires an even number of arguments"

      children = L\push ->
        return for i=1,#tail,2
          name, val_expr = tail[i], tail[i+1]
          name = name\unwrap T.sym

          with val_expr\eval scope
            scope\set name, \make_ref!

      super RTNode :children

use = Constant.meta
  meta:
    name: 'use'
    summary: "Merge scopes into current scope."
    examples: { '(use scope1 [scope2…])' }
    description: "
Copy all symbol definitions from `scope1`, `scope2`,  to the current scope.
All arguments have to be evaltime constant."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      for child in *tail
        node = L\push child\eval, scope
        value = node\const!
        scope\use value\unwrap 'scope', "'use' only works on scopes"

      super RTNode!

require_ = Constant.meta
  meta:
    name: 'require'
    summary: "Load a module."
    examples: { '(require name)' }
    description: "Load a module and return its scope."

  value: class extends Builtin
    eval: (scope,  tail) =>
      L\trace "evaling #{@}"
      assert #tail == 1, "'require' takes exactly one parameter"

      node = L\push tail[1]\eval, scope
      name = node\const!\unwrap 'str'

      L\trace @, "loading module #{name}"
      super COPILOT\require name

import_ = Constant.meta
  meta:
    name: 'import'
    summary: "Require and define modules."
    examples: { '(import sym1 [sym2…])' }
    description: "
Requires modules `sym1`, `sym2`,  and define them as `sym1`, `sym2`,  in the
current scope."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail > 0, "'import' requires at least one arguments"

      children = for i, child in ipairs tail
        name = child\unwrap T.sym
        with COPILOT\require name
          scope\set name, \make_ref!
      super RTNode :children

import_star = Constant.meta
  meta:
    name: 'import*'
    summary: "Require and use modules."
    examples: { '(import* sym1 [sym2…])' }
    description: "
Requires modules `sym1`, `sym2`,  and merges them into the current scope."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail > 0, "'import' requires at least one arguments"

      children = for i, child in ipairs tail
        with COPILOT\require child\unwrap T.sym
          scope\use .result\unwrap T.scope
      super RTNode :children

export_ = Constant.meta
  meta:
    name: 'export'
    summary: "Evaluate definitions in a new scope and return it."
    examples: { '(export expr1 [expr2…])' }
    description: "
Evaluate `expr1`, `expr2`,  in a new Scope and return scope."

  value: class extends Builtin
    eval: (scope, tail) =>
      new_scope = Scope scope
      children = [expr\eval new_scope for expr in *tail]
      super RTNode :children, result: Constant.wrap new_scope

export_star = Constant.meta
  meta:
    name: 'export*'
    summary: "Export specific symbol definitions as a module/scope."
    examples: { '(export* sym1 [sym2…])', '(export*)' }
    description: "
Creates a scope containing the symbols `sym1`, `sym2`,  and returns it.

Copies the containing scope if no symbols are given."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      new_scope = Scope!

      children = if #tail == 0
        for k,node in pairs scope.values
          new_scope\set k, node
          node
      else
        for child in *tail
          name = child\unwrap T.sym
          with node = scope\get name
            new_scope\set name, node

      super RTNode :children, result: Constant.wrap new_scope

fn = Constant.meta
  meta:
    name: 'fn'
    summary: "Declare a function."
    examples: { '(fn (p1 [p2…]) body-expr)' }
    description: "
The symbols `p1`, `p2`, ... will resolve to the arguments passed when the
function is invoked."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail == 2, "'fn' takes exactly two arguments"
      { params, body } = tail

      assert params.__class == Cell, "'fn's first argument has to be an expression"
      param_symbols = for param in *params.children
        assert param.type == T.sym, "function parameter declaration has to be a symbol"
        param

      super RTNode result: with Constant.wrap FnDef param_symbols, body, scope
        .meta = {
          summary: "(user defined function)"
          examples: { "(??? #{table.concat [p! for p in *param_symbols], ' '})" }
        }

defn = Constant.meta
  meta:
    name: 'defn'
    summary: "Define a function."
    examples: { '(defn name-sym (p1 [p2…]) body-expr)' }
    description: "
Declare a function and define it as `name-sym` in the current scope.
The symbols `p1`, `p2`, ... will resolve to the arguments passed when the
function is invoked."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail == 3, "'defn' takes exactly three arguments"
      { name, params, body } = tail

      name = name\unwrap T.sym
      assert params.__class == Cell, "'defn's second argument has to be an expression"
      param_symbols = for param in *params.children
        assert param.type == T.sym, "function parameter declaration has to be a symbol"
        param

      result = with Constant.wrap FnDef param_symbols, body, scope
        .meta =
          :name
          summary: "(user defined function)"
          examples: { "(#{name} #{table.concat [p! for p in *param_symbols], ' '})" }

      scope\set name, RTNode :result
      super RTNode!

do_expr = Constant.meta
  meta:
    name: 'do'
    summary: "Evaluate multiple expressions in a new scope."
    examples: { '(do expr1 [expr2…])' }
    description: "
Evaluate `expr1`, `expr2`,  and return the value of the last expression."

  value: class extends Builtin
    eval: (scope, tail) =>
      scope = Scope scope
      children = [expr\eval scope for expr in *tail]
      result = if last = children[#children] then last.result
      if result and result.metatype == '='
        result = result.type\mk_sig result\unwrap!

      super RTNode :children, result

if_ = Constant.meta
  meta:
    name: 'if'
    summary: "Make an evaltime const choice."
    examples: { '(if bool then-expr [else-expr])' }
    description: "
`bool` has to be an evaltime constant. If it is truthy, this expression is equivalent
to `then-expr`, otherwise it is equivalent to `else-xpr` if given, or nil otherwise."

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail >= 2, "'if' needs at least two parameters"
      assert #tail <= 3, "'if' needs at most three parameters"

      { xif, xthen, xelse } = tail

      xif = L\push xif\eval, scope
      if not xif\is_const!
        msg = "'if'-expression needs to be constant, did you mean 'switch'?"
        error Error 'argument', msg
      xif = xif\result!\unwrap!

      super if xif
        xthen\eval scope
      elseif xelse
        xelse\eval scope
      else
        RTNode!

switch_ = Constant.meta
  meta:
    name: 'switch'
    summary: "Switch between multiple inputs."
    examples: { '(switch i v1 v2…)' }
    description: "
- When fed a bang! trigger, steps forward to the next step on each trigger.
- When fed a num~ or num! stream, reproduces the matching argument (indexed
  starting from 0).
- When fed a bool~ or bool! stream, outputs the first or second argument for
  `true` and `false` respectively. This version takes at most two argumetns."

  value: class extends Op
    val_or_evt = (sig! / evt!)!
    pattern = (sig.num / sig.bool / evt.num / evt.bool / evt.bang) + val_or_evt*0
    setup: (inputs) =>
      { i, values } = pattern\match inputs

      @out = if values[1].result.metatype ~= '!'
        values[1]\type!\mk_sig!
      else
        values[1]\type!\mk_evt!

      if i\type! == T.bang
        @state or= 1

      super
        i: Input.hot i
        values: [Input.hot v for v in *values]

    tick: =>
      { :i, :values } = @inputs

      if i\type! == T.bang
        if i\dirty!
          @state += 1
          while @state >= #values
            @state -= #values
        @state
      else
        @state = switch i!
          when true then 0
          when false then 1
          else (math.floor i!) % #values
        @state

      @out\set if v = values[@state + 1] then v!

    vis: => step: @state

trace_ = Constant.meta
  meta:
    name: 'trace='
    summary: "Trace an expression's value at evaltime."
    examples: { '(trace= expr)' }

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail == 1, "'trace!' takes exactly one parameter"

      super with node = L\push tail[1]\eval, scope
        L\print "trace! #{tail[1]\stringify 2}: #{node.result}"

trace = Constant.meta
  meta:
    name: 'trace'
    summary: "Trace an expression's values at runtime."
    examples: { '(trace expr)' }

  value: class extends Builtin
    class traceOp extends Op
      setup: (inputs) =>
        super
          prefix: Input.cold inputs[1]
          value: Input.hot inputs[2]

      tick: =>
        L\print "trace #{@inputs.prefix!}: #{@inputs.value.result}"

    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail == 1, "'trace!' takes exactly one parameter"

      tag = @tag\clone Tag.parse '-1'
      inner = Cell tag, {
        Constant.literal T.opdef, traceOp, 'trace'
        Constant.str tail[1]\stringify 2
        tail[1]
      }
      super inner\eval scope

print_ = Constant.meta
  meta:
    name: 'print'
    summary: "Print string values."
    examples: { '(print str)' }

  value: class extends Op
    setup: (inputs) =>
      value = (sig.str / evt.str)\match inputs
      super value: Input.hot value

    tick: =>
      if @inputs.value\metatype! == 'event'
        for msg in *@inputs.value!
          L\print msg
      else
        L\print @inputs.value!

to_const = Constant.meta
  meta:
    name: '='
    summary: "Assert expression is constant."
    examples: { '(= val)' }
    description: "Asserts that `val` is a constant expression and returns it."
  value: class extends Op
    setup: (inputs) =>
      super {}
      input = const!\match inputs
      @out = input\type!\mk_const input.result!

to_sig = Constant.meta
  meta:
    name: '~'
    summary: "Cast to ~-stream."
    examples: { '(~ event initial)' }
    description: "
Casts !-stream to ~-stream by always reproducing the last received value.
Since ~-streams cannot be emtpy, specifying an `initial` value is necessary."
  value: class extends Op
    setup: (inputs) =>
      { event, initial } = (evt! + sig!)\match inputs
      assert event\type! == initial\type!,
        Error 'argument', "~ arguments have to be of the same type"

      super event: Input.hot event

      if not @out or @out.type != input\type!
        @out = event\type!\mk_sig initial.result!

    tick: => @out\set @inputs.event!

to_evt = Constant.meta
  meta:
    name: '!'
    summary: "Cast to !-stream."
    examples: { '(! val)', '(! sig trig)' }
    description: "Casts anything to a !-stream depending on arguments:

- if `val` is a ~-stream, emits events on changes.
- if `val` is a !-stream, emits a bang for each incoming event.
- if `trig` is given, samples `sig` as a new event when `trig` arrives."
  value: class extends Op
    pattern = (sig! + evt.bang) / (sig! / evt!)\rep(1,1)
    setup: (inputs) =>
      { sig, trig } = pattern\match inputs
      if trig
        super
          trig: Input.hot trig
          sig: Input.cold sig
      elseif sig\metatype! == '!'
        super
          trig: Input.hot sig
          sig: Input.cold Constant.bang true
      else
        super sig: Input.hot sig
      @out = @inputs.sig\type!\mk_evt!

    tick: =>
      @out\set @inputs.sig!

array = Constant.meta
  meta:
    name: 'array'
    summary: "Construct an array."
    examples: { '(array a b c…)' }
    description: "Produces an array of values."

  value: do
    any = sig! / evt!

    class extends PureOp
      pattern: any!*0
      type: (args) => Array #args, args[1]\type!

      tick: =>
        args = @unwrap_all!
        @out\set args

struct = Constant.meta
  meta:
    name: 'struct'
    summary: "Construct an struct."
    examples: { '(struct key1 val1 [key2 val2…])' }
    description: "Produces an struct of values."

  value: do
    key = const.str / const.sym
    val = sig! / evt!
    pair = (key + val)\named 'key', 'val'

    class extends PureOp
      pattern: pair*0
      type: (pairs) =>
        Struct {key.result!, val\type! for {:key, :val} in *pairs}

      tick: =>
        pairs = @unwrap_all!
        @out\set {key, val for {:key, :val} in *pairs}

get = Constant.meta
  meta:
    name: 'get'
    summary: "Index into Arrays and Structs."
    examples: { '(get val key [key2…])' }

  value: class extends Op
    pattern = (sig! / evt!) + (const.str / const.sym / const.num)*0
    setup: (inputs) =>
      { val, keys } = pattern\match inputs
      super val: Input.hot val

      @state = [key.result! for key in *keys]

      type = val\type!
      for key in *@state
        type = type\get key

      if val\metatype == '!'
        @out = type\mk_evt!
      else
        @out = type\mk_sig!

    tick: =>
      val = @inputs.val!
      for key in *@state
        if type(key) == 'number'
          key = key + 1
        val = val[key]
      @out\set val

loop = Constant.meta
  meta:
    name: 'loop'
    summary: "Loop on arbitrary data via recursion."
    examples: { '(loop (k1 v1 [k2 v2…]) body)' }
    description: "
Defines a recursive loop function `*recur*` with parameters `k1`, `k2`,  and
function body `body`, then invokes it immediately with arguments `v1`, `v2`, 

Inside the `body`, `(recur)` is used to recursively restart loop evaluation
with a different set of arguments, e.g. to sum the first `5` integers:

    (loop (n 5)
      (if (= n 0)
        0
        (+ n (recur (n - 1)))))"

  value: class extends Builtin
    eval: (scope, tail) =>
      L\trace "evaling #{@}"
      assert #tail == 2, "'loop' takes exactly two arguments"
      { binds, body } = tail

      assert binds.__class == Cell, "loops bindings have to be an cell"
      assert #binds.children % 2 == 0, "key without binding in loop binding"

      names = {}
      inner = { Constant.sym '*recur*' }
      for i=1,#binds.children,2
        table.insert names, binds.children[i]
        table.insert inner, binds.children[i+1]

      loop_fn = FnDef names, body, scope

      def_scope = Scope scope
      def_scope\set '*recur*', RTNode result: Constant.wrap loop_fn

      tag = @tag\clone Tag.parse '-1'
      inner = Cell tag, inner
      super inner\eval def_scope

recur = Constant.meta
  meta:
    name: 'recur'
    summary: "Reenter the innermost loop."
    examples: { '(recur nv1 [nv2…])' }
    description: "
Reenters the innermost `(loop)` from the top, with `k1` bound to `nv1`, `k2`
bound to `nv2`…

`(recur nv1 [nv2])` is equivalent to `(*recur* nv1 [nv2])`."

  value: class extends Builtin
    eval: (caller_scope, tail) =>
      L\trace "evaling #{@}"
      recur_fn = assert caller_scope\get '*recur*', "not currently in any loop"
      fndef = recur_fn.result\unwrap T.fndef, "*recur* has to be a fndef"

      { :params, :body } = fndef
      if #params != #tail
        err = Error 'argument', "expected #{#params} loop arguments, found #{#tail}"
        error err

      fn_scope = Scope fndef.scope, caller_scope

      children = for i=1,#params
        name = params[i]\unwrap T.sym
        with L\push tail[i]\eval, caller_scope
          fn_scope\set name, \make_ref!

      clone = body\clone @tag
      node = clone\eval fn_scope

      table.insert children, node
      super RTNode :children, result: node.result


Scope.from_table {
  :doc
  :trace, 'trace=': trace_, print: print_

  :def, :use
  require: require_
  import: import_
  'import*': import_star
  export: export_
  'export*': export_star

  :fn, :defn
  'do': do_expr
  'if': if_
  'switch': switch_

  '=': to_const
  '~': to_sig
  '!': to_evt

  :array, :struct, :get

  :loop, :recur

  true: Constant.meta
    meta:
      name: 'true'
      summary: "The boolean constant `true`."
    value: Constant.bool true

  false: Constant.meta
    meta:
      name: 'false'
      summary: "The boolean constant `false`."
    value: Constant.bool false

  bang: Constant.meta
    meta:
      name: 'bang'
      summary: "A `bang` value-constant."
    value: Constant T.bang, true
}