git @ Cat's Eye Technologies Tamsin / master lib / tamsin_analyzer.tamsin
master

Tree @master (Download .tar.gz)

tamsin_analyzer.tamsin @masterraw · history · blame

# Desugarer for Tamsin AST, written in Tamsin.
# Distributed under a BSD-style license; see LICENSE.

tamsin_analyzer {

  desugar_all(list(H,T)) =
      desugar(H)  DH &
      desugar_all(T)  DT &
      return list(DH, DT).
  desugar_all(nil) = 'nil'.

  desugar(program(L)) = desugar_all(L)  DL & return program(DL).
  desugar(module(N, L)) =
      desugar_all(L)  DL &
      merge_prod_branches(DL, nil)  DDL &
      return module(N, DDL).
  desugar(production(N, PBs)) =
      desugar_all(PBs)  DPBs &
      return production(N, DPBs).
  desugar(prodbranch(Fs, Ls, B)) =
      desugar_pattern_all(Fs, 0)  Pair &
      fst(Pair)  DFs &
      desugar(B)  DB &
      return prodbranch(DFs, Ls, DB).
  desugar(call(PR, Args)) = return call(PR, Args).
  desugar(or(L, R)) = desugar(L)  DL & desugar(R)  DR & return or(DL, DR).
  desugar(and(L, R)) = desugar(L)  DL & desugar(R)  DR & return and(DL, DR).
  desugar(not(X)) = desugar(X)  DX & return not(DX).
  desugar(while(X)) = desugar(X)  DX & return while(DX).
  desugar(concat(L, R)) = desugar(L)  DL & desugar(R)  DR & return concat(DL, DR).
  desugar(using(R, P)) = desugar(R)  DR & return using(DR, P).
  desugar(on(R, T)) = desugar(R)  DR & desugar(T)  DT & return on(DR, DT).
  desugar(send(R, V)) = desugar(R)  DR & return send(DR, V).
  desugar(set(V, T)) = desugar(T)  DT & return set(V, DT).
  desugar(atom(T)) = return atom(T).
  desugar(constructor(T, Ts)) = return constructor(T, Ts).
  desugar(variable(N)) = return variable(N).
  desugar(fold(R, I, C)) =
      desugar(R)  DR &
      SET  set(variable('_1'), I) &
      SEND  send(DR, variable('_2')) &
      CAT  concat(variable('_1'), variable('_2')) &
      ACC  set(variable('_1'), CAT) &
      ($:equal(C, nil) |
          get_tag(C)  Tag &
          ACC  set(variable('_1'),
                     constructor(Tag, list(variable('_2'),
                                        list(variable('_1'), nil))))) &
      RET  call(prodref('$', 'return'), list(variable('_1'), nil)) &
      return and(and(SET, while(and(SEND, ACC))), RET).

  desugar_pattern_all(list(H,T), I) =
      desugar_pattern(H, I)  Pair &
      fst(Pair)  DH &
      snd(Pair)  I2 &
      desugar_pattern_all(T, I2)  Pair &
      fst(Pair)  DT &
      snd(Pair)  I3 &
      return pair(list(DH, DT), I3).
  desugar_pattern_all(nil, I) = return pair(nil, I).

  desugar_pattern(atom(T), I) = return pair(atom(T), I).
  desugar_pattern(constructor(T, Ts), I) =
      desugar_pattern_all(Ts, I)  Pair &
      fst(Pair)  DTs &
      snd(Pair)  I2 &
      return pair(constructor(T, DTs), I2).
  desugar_pattern(variable(N), I) =
      next(I)  I2 &
      return pair(patternvariable(N, I), I2).

  fst(pair(A,B)) = A.
  snd(pair(A,B)) = B.

  next(0) = '1'.
  next(1) = '2'.
  next(2) = '3'.
  next(3) = '4'.
  next(4) = '5'.
  next(5) = '6'.
  next(6) = '7'.
  next(7) = '8'.
  next(8) = '9'.
  next(9) = '10'.
  next(10) = '11'.
  next(11) = '12'.

  get_tag(atom(T)) = T.

  fetch(K, list(pair(K2, V), T))  = $:equal(K, K2) & V | fetch(K, T).
  fetch(K, nil)                   = 'nil'.
  
  delete(K, list(pair(K2, V), T)) = $:equal(K, K2) & delete(K, T)
                                  | delete(K, T)  R & return list(pair(K2, V), R).
  delete(K, nil)                  = 'nil'.
  
  store(K, V, A)                  = delete(K, A)  A2 &
                                    return list(pair(K, V), A2).

  merge_prod_branches(list(production(N, list(B, nil)),T),Map) =
      fetch(N, Map)  Blist &
      Blist  list(B, Blist) &
      store(N, Blist, Map)  Map &
      merge_prod_branches(T, Map).
  merge_prod_branches(nil,Map) =
      unmap(Map, nil).

  unmap(list(pair(K, V), T), A) =
      list:reverse(V, nil)  RV &
      P  production(K, RV) &
      A  list(P, A) &
      unmap(T, A).
  unmap(nil, A) = A.

  #####
  # CM = current module name

  analyze_all(CM, list(H,T)) =
      analyze(CM, H)  DH &
      analyze_all(CM, T)  DT &
      return list(DH, DT).
  analyze_all(CM, nil) = 'nil'.

  analyze(CM, program(L)) =
      analyze_all(CM, L)  DL &
      return program(DL).
  analyze(CM, module(N, L)) =
      analyze_all(N, L)  DL &
      return module(N, DL).
  analyze(CM, production(N, Bs)) =
      analyze_all(CM, Bs)  DBs &
      return production(N, DBs).
  analyze(CM, prodbranch(Fs, Ls, E)) =
      analyze(CM, E)  DE &
      locals(DE, nil)  Ls &
      list:reverse(Ls, nil)  Ls &
      return prodbranch(Fs, Ls, DE).
  analyze(CM, call(PR, As)) =
      analyze(CM, PR)  DPR &
      analyze_all(CM, As)  DAs &
      return call(DPR, DAs).
  analyze(CM, prodref(MN, PN)) =
      $:equal(MN, '') & return prodref(CM, PN)
                      | return prodref(MN, PN).
  analyze(CM, or(L, R)) =
      analyze(CM, L)  DL &
      analyze(CM, R)  DR &
      return or(DL, DR).
  analyze(CM, and(L, R)) =
      analyze(CM, L)  DL &
      analyze(CM, R)  DR &
      return and(DL, DR).
  analyze(CM, not(X)) =
      analyze(CM, X)  DX &
      return not(DX).
  analyze(CM, while(X)) =
      analyze(CM, X)  DX &
      return while(DX).
  analyze(CM, concat(L, R)) =
      analyze(CM, L)  DL &
      analyze(CM, R)  DR &
      return concat(DL, DR).
  analyze(CM, using(R, PR)) =
      analyze(CM, R)  DR &
      analyze(CM, PR)  DPR &
      return using(DR, DPR).
  analyze(CM, on(R, T)) =
      analyze(CM, R)  DR &
      analyze(CM, T)  DT &
      return on(DR, DT).
  analyze(CM, send(R, V)) =
      analyze(CM, R)  DR &
      return send(DR, V).
  analyze(CM, set(V, T)) =
      analyze(CM, T)  DT &
      return set(V, DT).
  analyze(CM, atom(T)) = return atom(T).
  analyze(CM, constructor(T, Ts)) = return constructor(T, Ts).
  analyze(CM, variable(N)) = return variable(N).

  #####
  # returns a list of locals

  locals(call(PR, As), Ls) =
      Ls.
  locals(or(L, R), Ls) =
      locals(L, Ls)  Ls &
      locals(R, Ls).
  locals(and(L, R), Ls) =
      locals(L, Ls)  Ls &
      locals(R, Ls).
  locals(not(X), Ls) =
      locals(X, Ls).
  locals(while(X), Ls) =
      locals(X, Ls).
  locals(concat(L, R), Ls) =
      locals(L, Ls)  Ls &
      locals(R, Ls).
  locals(using(R, P), Ls) =
      locals(R, Ls).
  locals(on(R, T), Ls) =
      locals(R, Ls)  Ls &
      locals(T, Ls).
  locals(send(R, V), Ls) =
      locals(V, Ls)  Ls &
      locals(R, Ls).
  locals(set(V, T), Ls) =
      locals(V, Ls)  Ls &
      locals(T, Ls).
  locals(atom(T), Ls) = Ls.
  locals(constructor(T, Ts), Ls) =
      locals_all(Ts, Ls).
  locals(variable(N), Ls) =
      list:add_elem(N, Ls).

  locals_all(nil, Ls) = Ls.
  locals_all(list(H,T), Ls) =
      locals(H, Ls)  Ls &
      locals_all(T, Ls).
}