lama_byterun/stdlib/Expr.expr

import Ostap;
import List;
import Fun;

public fun left (f) {
  fun (c, x) {
     fun (y) {
       f (c (x), y)
     }
  }
}

public fun right (f) {
  fun (c, x) {
    fun (y) {
      c (f (x, y))
    }
  }
}

--- ops -> fun (x, y) {x `op` y}
fun altl (level) {
  case level of
    [assoc, ps] ->
       local assfun = case assoc of Left -> left | Right -> right | Nona -> left esac;
       case map (fun (p) {
                   case p of
                     [op, sema] -> op @ lift(assfun (sema))
                   esac
                 }, ps) of
         p : ps -> foldl (infix |, p, ps)
       esac
  esac
}

public fun expr (ops, opnd) {
  fun inner (ops) {
    case ops of
      {}         -> fun (c) {opnd @ c}
    | level : tl ->
        local lops = altl (level),
              next = inner (tl);

        case level.fst of
          Nona ->
           fun this (c) {
             next (id) |> fun (l) {lops |> fun (op) {next (id) @ fun (r) {c (op)(id, l)(r)}}}
           | next (id) @ c
           }

           this

        | _    ->
           fun this (c) {
             next (id) |> fun (l) {lops |> fun (op) {this (op (c, l))}}
           | next (id) @ c
           }

           this
        esac
    esac  
  }

  inner (ops)
}

(*
Just some memo from OCaml's Ostap. Will be removed when done.

let left  f c x a y = f (c x) a y
    let right f c x a y = c (f x a y)

fun expr (ops, opnd, atr) {
}


    ops = [is_nona, (atrs, alt_parser at the level),
           ...
          ]
    let expr f ops opnd atr =
      let ops =
        Array.map
          (fun (assoc, (atrs, list)) ->
            let g = match assoc with `Lefta | `Nona -> left | `Righta -> right in
            assoc = `Nona, (atrs, altl (List.map (fun (oper, sema) -> ostap (!(oper) {g sema})) list))
          )
          ops
      in
      let atrr i atr = snd (fst (snd ops.(i)) atr) in
      let atrl i atr = fst (fst (snd ops.(i)) atr) in
      let n      = Array.length ops  in
      let op   i = snd (snd ops.(i)) in
      let nona i = fst ops.(i)      in
      let id   x = x                in
      let ostap (
        inner[l][c][atr]: f[ostap (
          {n = l                } => x:opnd[atr] {c x}
        | {n > l && not (nona l)} => (-x:inner[l+1][id][atrl l atr] -o:op[l] y:inner[l][o c x atr][atrr l atr] |
                                       x:inner[l+1][id][atr] {c x})
        | {n > l && nona l} => (x:inner[l+1][id][atrl l atr] o:op[l] y:inner[l+1][id][atrr l atr] {c (o id x atr y)} |
                                x:inner[l+1][id][atr] {c x})
          )]
      )
      in
      ostap (inner[0][id][atr])d

*)