main.rhm

#lang rhombus/static

import:
  rhombus/meta open

export:
  Dyn
  maybe_dyn_block
  dyn_idx_serial
  dyn_append
  dyn_with
  stat_inspector
  rename:
    dyn_app as #%call
    dyn_idx as #%index
    dyn_append_infix as ++
    dyn_with_infix as with

meta:
  // Function to check if a bit of syntax has been given the `Dyn` annotation
  fun has_dyn_dot_provider(stx):
    def maybe_key = statinfo_meta.lookup(stx, statinfo_meta.dot_provider_key)
    maybe_key && Syntax.to_source_string(maybe_key) == "dyn_dot_provider"

  // Syntax class to check has_dyn_dot_provider
  syntax_class DynStx
  | '$(x :: Term)': match_when: has_dyn_dot_provider(x)

annot.macro 'Dyn':
  annot_meta.pack_predicate('fun (x): #true', // anything can flow to Dyn
                            '(($(statinfo_meta.dot_provider_key), dyn_dot_provider),
                              ($(statinfo_meta.sequence_constructor_key), dyn_seq))')

dot.macro 'dyn_dot_provider $left . $right':
  '(block:
      use_dynamic
      $left) . $right'

expr.macro 'stat_inspector $thing':
  '$thing'

expr.macro 'dyn_seq($expr)':
  'block:
     use_dynamic
     $expr'

expr.macro 'maybe_dyn_block $thing:
              $block':
  if has_dyn_dot_provider(thing)
  | 'block:
       use_dynamic
       $block'
  | 'block:
       $block'

expr.macro '$func dyn_app ($args, ...)':
  ~stronger_than: ~other
  if has_dyn_dot_provider(func)
  | def [temps, ...] = [Syntax.make_temp_id(args), ...]
    'block:
       def $temps = $args; ...
       block:
         use_dynamic
         $func #%call ($temps, ...)'
  | '$func #%call ($args, ...)'

repet.macro '$func dyn_app ($(args :: repet_meta.Parsed), ...)':
  ~op_stx self

  fun
  | max([n]): n
  | max([n, ns, ...]):
      let m = max([ns, ...])
      if m > n | m | n

  def '($func_orig, $func_name, $func_expr, $func_depth, $func_use_depth, $func_statinfos, $func_is_immed)':
    repet_meta.unpack_list(func)
  def ['($orig, $name, $expr, $depth, $use_depth, $statinfos, $is_immed)', ...]:
    [repet_meta.unpack_list(args), ...]

  unless func_depth.unwrap() == 0 && for all (d: [depth.unwrap(), ...]): d == 1 || d == 0
  | error("only handle argument repetitions and constants right now")

  def (pred, si):
    annot_meta.unpack_predicate(match 'List' | '$(p :: annot_meta.Parsed)': p)

  def temps_depths = [[Syntax.make_temp_id(expr), expr, depth.unwrap()], ...]
  def [[repet_temps, repet_exprs, _d1], ...] = (for List (i: temps_depths): keep_when i[2] == 1; i)
  def [[const_temps, const_exprs, _dz], ...] = (for List (i: temps_depths): keep_when i[2] == 0; i)
  def [[all_temps, _expr, _depth], ...] = temps_depths

  def max_depth = max([depth.unwrap(), ...])

  repet_meta.pack_list('($self,
                         $func_name,
                         block:
                           let $const_temps = $const_exprs
                           ...
                           for PairList:
                             each:
                               $repet_temps: $repet_exprs :~ PairList
                               ...
                             $func_expr dyn_app ($all_temps, ...),
                         2,     // can hardcode I think... we check that the args depth is 1 above
                         $max_depth,
                         $si,
                         #false)')

expr.macro
| '$thing dyn_idx [$idx] $assn_op $rhs_expr':
    ~stronger_than: ~other
    '$thing #%index [$idx] $assn_op $rhs_expr'
| '$thing dyn_idx [$idx]':
    if has_dyn_dot_provider(thing)
    | 'block:
         def tmp = $idx
         block:
           use_dynamic
           $thing #%index [tmp]'
    | '$thing #%index [$idx]'

expr.macro
| 'dyn_idx_serial $(thing :: DynStx) [$idx]':
    'block:
       def tmp = $idx
       block:
         use_dynamic
         $thing #%index [tmp]'
| 'dyn_idx_serial $thing [$idx]':
    '$thing #%index [$idx]'

expr.macro '$thing1 dyn_append_infix $thing2':
  'dyn_append $thing1 $thing2'

expr.macro
| 'dyn_append $(thing1 :: DynStx) $(thing2 :: DynStx)':
    'block:
       use_dynamic
       $thing1 ++ $thing2'
| 'dyn_append $(thing1 :: DynStx) $thing2':     // Warning: out-of-order evaluation?
    'block:
       def tmp = $thing2
       block:
         use_dynamic
         $thing1 ++ tmp'
| 'dyn_append $thing1 $(thing2 :: DynStx)':
    'block:
       def tmp = $thing1
       block:
         use_dynamic
         tmp ++ $thing2'
| 'dyn_append $thing1 $thing2':
    '$thing1 ++ $thing2'

expr.macro '$thing1 dyn_with_infix ($(var :: Identifier) = $val, ...)':
  'dyn_with $thing1 ($var = $val, ...)'

expr.macro
| 'dyn_with $(thing1 :: DynStx) ($(var :: Identifier) = $val, ...)':
    def [temps, ...] = [Syntax.make_temp_id(var), ...]
    'block:
       def $temps = $val; ...
       block:
         use_dynamic
         $thing1 with ($var = $temps, ...)'
| 'dyn_with $thing1 ($(var :: Identifier) = $val, ...)':
    '$thing1 with ($var = $val, ...)'