四則演算

EXTENDを使わないでCamlp4使って四則演算を作れるところまで何段階かに分けて書いてみました。

今はocamllex/ulex + menhir がよいらしいんですけど
ま、使ってみないと分からないし。

(*
$ ocamlc -pp camlp4o test2.ml
$ ./a.out
*)
open Format

(* 字句解析 *)

type token =
  | Number of float
  | Op of char

let print_token ppf = function
  | Number n -> fprintf ppf "Number(%f)@?" n
  | Op o -> fprintf ppf "Op(%c)@?" o

let rec lex = parser
  (* Skip any whitespace. *)
  | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream

  (* number: [0-9.]+ *)
  | [< ' ('0' .. '9' as c); stream >] ->
    let buffer = Buffer.create 1 in
    Buffer.add_char buffer c;
    lex_number buffer stream
  | [< ' (('+' | '*' | '-' | '/' | '(' | ')') as o); stream=lex >] -> [<' (Op o); stream >]
  (* end of stream. *)
  | [< >] -> [< >]

and lex_number buffer = parser
  | [< ' ('0' .. '9' | '.' as c); stream >] ->
    Buffer.add_char buffer c;
    lex_number buffer stream
  | [< stream=lex >] ->
    [< 'Number (float_of_string (Buffer.contents buffer)); stream >]

let _ = printf "tst\n"

(* mutable ハッシュテーブル *)

let ps:(string, int) Hashtbl.t = Hashtbl.create 10

let () = Hashtbl.add ps "+" 10
let () = Hashtbl.add ps "*" 20

let _ = printf "+ %d\n" (Hashtbl.find ps "+")
let _ = printf "* %d\n" (Hashtbl.find ps "*")
let _ =
  (*match Stream.peek(lex (Stream.of_channel stdin)) with*)
  (*match Stream.peek(lex [< ''1'; ''2'; ''3' >]) with*)
  match Stream.peek(lex (Stream.of_string "123")) with
  | Some t -> printf "%a\n" print_token t
  | None -> printf "ng\n"

(* parser関数と字句解析を使う *)

let are = parser
  | [<'Number n ; stream >] -> printf "are %f\n" n

let _ = are (lex [< ''1'; ''2'; ''3' >])
let _ = (parser [<'Number n ; stream >] -> printf "num %f\n" n) (lex [< ''1'; ''2'; ''3' >])

(* 文字列からパース *)

let parse2 = parser
  | [<'Number n ; 'Op '+'; 'Number n2; stream >] -> printf "parse2 %f + %f \n" n n2
let _ = parse2 (lex (Stream.of_string "1 + 2"))


(* 構文木を作る *)

type e =
| Num of float
| Bin of e * string * e

let rec print_e ppf = function
  | Num(n) -> fprintf ppf "Num(%f)@?" n
  | Bin(e1,op,e2) -> fprintf ppf "Bin(%a,\"%s\",%a)@?" print_e e1 op print_e e2

let rec parse3_prim = parser
  | [<'Number n >] -> Num n
let rec parse3 = parser
  | [< e1=parse3_prim ; 'Op '+'; e2=parse3_prim >] -> Bin(e1,"+",e2)
  | [< e1=parse3_prim>] -> e1

let _ = printf "%a\n" print_e (parse3 (lex (Stream.of_string "1 + 2")))

(* 右再帰 *)
let rec parse4_prim = parser
  | [<'Number n >] -> Num n

let rec parse4_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse4_prim stream in
    let rhs = parse4_bin rhs stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse4_bin lhs stream
  | _ -> lhs

and parse4 = parser
  | [< lhs=parse4_prim; stream >] -> parse4_bin lhs stream

let _ = printf "%a\n" print_e (parse4 (lex (Stream.of_string "1 + 2 + 3")))

(* 左再帰 *)
let rec parse5_prim = parser
  | [<'Number n >] -> Num n

let rec parse5_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse5_prim stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse5_bin lhs stream
  | _ -> lhs

and parse5 = parser
  | [< lhs=parse5_prim; stream >] -> parse5_bin lhs stream

let _ = printf "%a\n" print_e (parse5 (lex (Stream.of_string "1 + 2 + 3")))


(* 括弧 *)
let rec parse6_prim = parser
  | [<'Number n >] -> Num n
  | [<'Op '('; e=parse6; 'Op ')' >] -> e

and parse6_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse6_prim stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse6_bin lhs stream
  | _ -> lhs

and parse6 = parser
  | [< lhs=parse6_prim; stream >] -> parse6_bin lhs stream

let _ = printf "%a\n" print_e (parse6 (lex (Stream.of_string "1 + (2 + 3)")))

(* 四則演算 *)
let rec parse7_prim = parser
  | [<'Number n >] -> Num n
  | [<'Op '('; e=parse7; 'Op ')' >] -> e

and parse7_mul stream = 
  let lhs = parse7_prim stream in
  let rec loop lhs =
    match Stream.peek stream with
    | Some (Op ('*' as op))
    | Some (Op ('/' as op)) ->
      Stream.junk stream;
      let rhs = parse7_prim stream in
      let lhs = Bin (lhs, sprintf "%c" op, rhs) in
      loop lhs
    | _ -> lhs
  in loop lhs

and parse7_add stream =
  let lhs = parse7_mul stream in
  let rec loop lhs =
    match Stream.peek stream with
    | Some (Op ('+' as op))
    | Some (Op ('-' as op)) ->
      Stream.junk stream;
      let rhs = parse7_mul stream in
      let lhs = Bin (lhs, sprintf "%c" op, rhs) in
      loop lhs
    | _ -> lhs
  in loop lhs

and parse7 stream = parse7_add stream

let _ = printf "parse7 %a\n" print_e (parse7 (lex (Stream.of_string "0-1 + 2 * 3 / 4")))

CamlP4を使ってトークンを１つ取り出す

とりあえず、取り出すだけなら以下のコードで出来ました。

(*
$ ocamlc -pp camlp4o test2.ml
*)
open Format

type token =
  Number of float

let print_token ppf = function
  | Number n -> fprintf ppf "Number(%f)@?" n

let rec lex = parser
  (* Skip any whitespace. *)
  | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream

  (* number: [0-9.]+ *)
  | [< ' ('0' .. '9' as c); stream >] ->
    let buffer = Buffer.create 1 in
    Buffer.add_char buffer c;
    lex_number buffer stream
  (* end of stream. *)
  | [< >] -> [< >]

and lex_number buffer = parser
  | [< ' ('0' .. '9' | '.' as c); stream >] ->
    Buffer.add_char buffer c;
    lex_number buffer stream
  | [< stream=lex >] ->
    [< 'Number (float_of_string (Buffer.contents buffer)); stream >]

let _ = 
  (*match Stream.peek(lex (Stream.of_channel stdin)) with*)
  match Stream.peek(lex [< ''1'; ''2'; ''3' >]) with
  | Some t -> printf "%a\n" print_token t
  | None -> printf "ng\n"

LLVM OCaml Samples

OCamlでLLVMのライブラリを使うのにサンプルコードが欲しいので書き始めました。

https://bitbucket.org/h_sakurai/llvm-ocaml-samples/wiki/Home

名前書き換えスクリプト

TAPLのScala版のソースを呼んでいた訳ですが、変数名や型名を自分に合わせて書き換えたかった。
大量にある、ソースコードはIDEのリファクタリング機能を持ってしても手に余るので以下のようなコードがあると便利です。

実行する前にバックアップを着実に取ります。
それと、書き換え中の履歴も出来るだけ多く取っておくと良いです。
要するに、何かしらsvnなりgitなりhgなりを使うと良い。
そして、１個ずつ範囲を限定しながら書き換えていきます。
テストが沢山あればあるだけよいでしょう。
なくても、コンパイルが通るとか、ざっと動かしてみるとかでもよいです。
書き換えの作業が必要で大量にある場合は人がやってもミスは出ます。
どちらにしても、ミスはあり得るので履歴を取っておいて、後でおかしくなっている事に気がついたら、履歴を遡って原因を究明します。
原因が人為的ミスならその人に注意を促し、書き換えプログラムに問題があったのならその問題に対応したバージョンの書き換えプログラムに更新します。

こういうスクリプトを使う時の心得としては、出来るだけ範囲を限定した書き換えをして書き換えようと思ったけど辞めたっていうものをリストアップして表示して変更箇所を狭めていく事です。

そうすることで、間違えて書き換えてしまう事が減ります。

こういうスクリプトによる書き換えで１週間コースでバグ有りな変更を３時間くらいで行う事が出来たりします。

このノウハウを伝えるのはなかなか難しくて、良くわからないから手でやりますとか言う人が多くいたりします。

例えば、TyをTに書き換えたいのだけど、Typeは書き換えたくないとかいろいろあります。
書き換えたくないリストとしてignoresに書いておいたりすると便利な訳です。
ファイル名のリストはディレクトリを検索して先に作っておき、範囲を限定するために、このソースだけとか選べるようにしておくと、便利なときは便利です。

あと、コマンドライン引数の有無で書き換えを実行するか、書き換え箇所の出力のみにするとか機能をいろいろ付けると便利です。

でも、正規表現を使っている場合には限界があるので出来れば字句解析くらいしてから書き換えしたいよねとかは思う訳です。例えば文字列のなかにdon'tとかあって、tをeに書き換えるとdon'eになってしまうとかあった訳ですけど。
それでも、作業効率的に言って圧倒的に正規表現で作業した方が良いことはままある訳です。

<?php

$files = array();
$files[] = "./p04arith/core.scala";
$files[] = "./p04arith/demo.scala";
:
$files[] = "./p27fullfomsubref/parser.scala";
$files[] = "./p27fullfomsubref/syntax.scala";
/**/

$datas = array();

foreach($files as $file) {
  $src = file_get_contents($file);
  // $src = "abcdtt1T2 t t t t1 t1 (t3) (T1) (t1_)";

  $changes = array(
   // "t1"=>"e1", "t"=>"e", "t2"=>"e2", "t3"=>"e3",
/*
"ctx" => "c",
"ctx1" => "c1",
"ctx2" => "c2",
*/
/*
"Ty" => "T",
"TyVar" => "TVar",
"TyId" => "TId",
"TyTop" => "TTop",
"TyBot" => "TBot",
"TyArr" => "TArr",
"TyBool" => "TBool",
"TyRecord" => "TRecord",
"TyString" => "TString",
"TyUnit" => "TUnit",
"TyAll" => "TAll",
"TyNat" => "TNat",
"TySome" => "TSome",
"TyVariant" => "TVariant",
"TyVarBind" => "TVarBind",
"TyAbbBind" => "TAbbBind",
"TyRef" => "TRef",
"TySource" => "TSource",
"TySink" => "TSink",
"TyRec" => "TRec",
"TyApp" => "TApp",
"TyAbs" => "TAbs",
*/

"tyX" => "tX",
"tyX1" => "tX1",
"tyT" => "tT",
"tyTi" => "tTi",
"tyTi1" => "tTi1",
"tyTi2" => "tTi2",
"tyTiExpected" => "tTiExpected",
"tyS" => "tS",
"tySi" => "tSi",
"tyT1" => "tT1",
"tyT11" => "tT11",
"tyT12" => "tT12",
"tyT2" => "tT2",
"tyT3" => "tT3",
"tyS1" => "tS1",
"tyS2" => "tS2",
"ty" => "t",
"ty1" => "t1",
"ty2" => "t2",
"ty3" => "t3",
"tyi" => "ti",
"tyi1" => "ti1",
'tyI' => "tI",
'tyC2' => "tC2",
'tyY' => "tY",
'tyU' => "tU",
'tyU1' => "tU1",
"t11" => "e11",
"t21" => "e21",
"tyの型" => "Tの型",
    );
  // $changes = array("t"=>"e",);

$ignores = array(
  "type",
  "typeof",
  "tytermSubst",
  "typeShift",
  "typeSubst",
  "tyBody",
  "tyEqv",
  "tyMap",
  "tyBinder",
  "tyESubstTop",
  'types',
  'tyarith',
  'typeShiftAbove',
  'typeSubstTop',
  'typechecking',
  'typer',
  'typing',
  'tyAbbArgs',
  'tyBound',
);

  if($argv[1]){
    foreach($changes as $s=>$d) {
        $src = preg_replace("/\b(".$s.")\b/", $d, $src)."\n";
    }
  }

  $srcs = explode("\n", $src);
  $dst = "";
  foreach($srcs as $sr) {
    foreach($changes as $s=>$d) {
      
      if (preg_match("/\b".$s."\b/", $sr)>0) {
        $dst .= preg_replace("/\b(".$s.")\b/", "**\$1**", $sr)."\n";
      }
      foreach($ignores as $ss) {
        $sr = preg_replace("/\b(".$ss.")\b/", "", $sr);
      }
      if (preg_match("/\b(".$s."[a-zA-Z0-9_]*)/", $sr,$m)>0) {
        $datas[$m[1]] = 1;
        $rests .= preg_replace("/\b(".$s."[a-zA-Z0-9_]*)/", "**\$1**", $sr)."\n";
      }
    }
  }
  print $dst;

  print "\n======\n";
  print $rests;
  $src = preg_replace("/\n\n+\$/","\n", $src);
  // print $src;

  if($argv[1]=="save") {
    file_put_contents($file, $src);
  }
}

$dt2 = array();
foreach($datas as $k=>$v) {
  $dt2[] = $k;
}

var_export($dt2);

部分的型付け

多相型推論をする言語を作りたいのですが、その前に部分的型付けを勉強しておきたい所です。TAPLのrcdsubbot*1から型付け部分だけ抜き出して名前をオレオレに変換してScalaで書いてみました。TopはScalaでいうとAny型で、どんな型でもTopの子になります。Botは最小型というどの型の子にでもなり得る、IPS細胞みたいな型です。サンプルコード*2の変数定義以外が動きます。

このプログラムで実現しているサブタイピングは構造的なサブタイピングといいます。C++等のオブジェクト指向の継承は、更に順番も必要になるでしょうが、サブタイピングの規則を書き換える事でいろいろなサブタイピングが出来るようになります。

package rcdsubbot

sealed trait T
case object TTop extends T // 最大の型
case object TBot extends T // 最小の型
case class TFun(t1: T, t2: T) extends T // 関数の型
case class TRecord(els: List[(String, T)]) extends T // レコードの型

sealed trait E
case class EVar(i: String) extends E // 変数
case class EFun(v: String, y: T, t: E) extends E // λ抽象
case class EApp(t1: E, t2: E) extends E // 関数適用
case class ERecord(fields: List[(String, E)]) extends E // レコード
case class EProj(t: E, proj: String) extends E // レコードのフィールド参照

object main extends App {
  // lambda x:Top.x
  println(typing(EFun("x",TTop,EVar("x"))))

  //((lambda x: Top -> Top. x) (lambda x: Top. x)): Top -> Top;
  println(typing(
    EApp(
      EFun("x",TFun(TTop,TTop),EVar("x")),
      EFun("x",TTop,EVar("x")))
  ))
  /*
  ((lambda r: {x: Top -> Top}. r.x (r.x))
      {x=lambda z: Top. z,
      y=lambda z: Top. z}):
    Top;
  */
  println(typing(
    EApp(
      EFun("r",TRecord(List("x"->TFun(TTop,TTop))),
        EApp(EProj(EVar("r"), "x"),EProj(EVar("r"), "x"))),
      ERecord(List(
        "x"->EFun("z",TTop,EVar("z")),
        "y"->EFun("z",TTop,EVar("z"))
      )))
  ))

  //(lambda x: Bot. x): Bot -> Bot;
  println(typing(EFun("x",TBot,EVar("x"))))


  //(lambda x: Bot. x x): Bot -> Bot;
  println(typing(EFun("x",TBot,EApp(EVar("x"),EVar("x")))))
}

object typing {

  def apply(e:E):T = {
    visit(Map(), e)
  }

  def subtype(cT:T, pT:T): Boolean = {
    cT == pT || // 
    ((cT, pT) match {
      case (_, TTop) => true // SA-Top
      case (TBot, _) => true // SA-Bot
      case (TFun(ct1,ct2), TFun(pt1,pt2)) => // SA-Arrow
        subtype(ct1, pt1) &&
        subtype(ct2, pt2)
      case (TRecord(css), TRecord(pts)) => // SA-Rcd
        pts.forall {
          case (s,pt) =>
            css.find{case (s1,_) => s1 == s} match {
              case Some((_,ct)) => subtype(ct, pt)
              case None => false
            }
        } 
      case _ => false
    })
  }

  def visit(env:Map[String,T], e:E):T = {
    e match {
    case EVar(v) => env(v) // TA-Var
    case EFun(v, t, e) => // TA-Abs
      val t2 = visit(env+(v->t), e)
      TFun(t, t2)
    case EApp(e1, e2) => // TA-App
      val t1 = visit(env, e1)
      val t2 = visit(env, e2)
      t1 match {
        case TFun(t11, t12) =>
          if (!subtype(t2, t11))
            throw new Exception("type error "+t2 + "!="+t12)
          t12
        case TBot => TBot // TA-AppBot
        case _ => throw new Exception("type error")
      }
    case ERecord(fs) => // TA-Rcd
      val fts = fs.map {
        case(s, e) => (s, visit(env, e))
      }
      TRecord(fts)
    case EProj(e1, s) => // TA-Proj
      visit(env, e1) match {
        case TRecord(fts) =>
          fts.find{case (s1, _) => s1 == s} match {
            case Some((_,t)) => t
            case None => throw new Exception("type error")
          }
        case TBot => TBot // TA-ProjBot
        case _ => throw new Exception("type error")
      }
    }
  }
}

*1:https://github.com/ilya-klyuchnikov/tapl-scala/tree/master/src/main/scala/tapl/rcdsubbot

*2:https://github.com/ilya-klyuchnikov/tapl-scala/blob/master/examples/rcdsubbot.tapl

texを覚えた

前から本を書いてみたいなぁとは思っていたのですが、書ける気がしないなぁと思ってました。
大学のときの卒業論文はワードか一太郎で書いたような覚えがあります。
先輩達はlatexがどうのと言ってた気はするんだけど、まぁ、いいやと。
でも、texで書いている同人誌とか書くという話を見ててやれば出来るんじゃないかと思い始めました。

markdownからtexに変換出来るツール(pandoc)とかもあるようだし。
最初はmarkdownで書けば良いかなと軽い気持で初めて見ました。

気がついたら大分覚えてmarkdown介するのがめんどくさくなるくらい使い慣れてきました。
とはいえ知らない事をいきなり書くのも難しい事なので、分かっている事を書いてみようと思いました。

というわけで、練習用にLLVMで作るコンパイラのノウハウを書いてみてます。

https://bitbucket.org/h_sakurai/lll/src/tip/main.pdf

日記と違って、思った事をガーッと書いて終わりというよりも、校正に校正を重ねてみたいな作業が必要になるので大変です。

でも慣れれば、無駄な文章を書かずに一発で終わらせる事も出来るのかなとも思います。

コンパイラ技術的な所は、必要な知識は分かったので後は実戦あるのみです。
１つ１つ潰していけば、作りたいものは作れそうです。

λで前方参照

Cっぽいλ計算にトポロジカルソートを利用した前方参照を付けてみました。
トップレベルだけは、前方参照できます。

main=mul(add(1)(2))(3)
add=(a)=>(b)=>a+b
mul=(a)=>(b)=>a*b

なプログラムがちゃんと動きます。
以下ソースです。

package C2E7

import util.parsing.combinator._

object tsort extends App {

  // 参照してない物から取り除く
  def apply[A](toPreds: Map[A, Set[A]], done: List[A]): Iterable[A] = {

    // 参照していないものと参照しているものを分ける
    val (noPreds, hasPreds) = toPreds.foldLeft((Map[A,Set[A]](),Map[A,Set[A]]())) {
      case ((no,has),(a1,a2)) =>
        if(a2.isEmpty) (no+(a1->a2),has) else (no,has+(a1->a2))
    }

    // 参照していない集合が空
    if (noPreds.isEmpty) {
      // 参照している集合も空なら終わり
      if (hasPreds.isEmpty) done
      // 参照をもっている物があれば循環参照があるのでエラー
      else sys.error(hasPreds.toString)
    } else {
      // 参照していない物を取り出す
      val found = noPreds.map { case (a1, a2) => a1 }
      // 参照している集合から、参照していない名前を取り除く
      val nextPreds = hasPreds.map{ case (p, a) => (p, a -- found) }
      // 再帰呼び出しする
      tsort(nextPreds, done ++ found)    
    }
  }
}

sealed trait E
case class EInt(a:Int) extends E
case class EAdd(a:E,b:E) extends E
case class EMul(a:E,b:E) extends E
case class ELet(a:String, b:E, c:E) extends E
case class EId(a:String) extends E
case class EFun(m:Map[String,E], a:String, b:E) extends E
case class EApp(a:E, b:E) extends E
case class EAssign(id:String,e:E) extends E
case object EUnit extends E


object graph {


  // 依存グラフ取得
  def getDep(e:E): Set[String] = {
    e match {
      case EAssign(id,e)=> Set(id) ++ getDep(e)
      case EApp(e1,e2)=> getDep(e1)++getDep(e2)
      case EAdd(e1,e2)=> getDep(e1)++getDep(e2)
      case EMul(e1,e2)=> getDep(e1)++getDep(e2)
      case EId(id)=> Set(id)
      case EFun(m,id,e) => getDep(e)--Set(id)
      case ELet(id,e1,e2) => getDep(e1)++(getDep(e2)--Set(id))
      case EInt(_) => Set()
      case EUnit => Set()
    }
  }

  // 依存グラフ取得
  def getDep(p:List[E]):Map[String,Set[String]] = {
    p.foldLeft(Map[String,Set[String]]()){
      case (map,EAssign(id,e)) => map +(id->(getDep(e)--Set(id)))
      case _ => throw new Exception("error")
    }
  }

  case class FoundExprException(e:E) extends Exception

  // a = bという式の連続から1つの式を取得する
  def list2let(p:List[E]):E = {
    println("list "+p)
    val e = try {
      val map = p.foldLeft(Map[String,E]()){
        case (map,e@EAssign(id,_))=>map+(id->e)
        case (_,e) => throw FoundExprException(e)
      }
      val datas = tsort(getDep(p),List())
      datas.foldRight(null:E) {
        case (s,n)=> map(s) match {
          case EAssign("main",b)=>b
          case EAssign(a,b)=>ELet(a,b,n)
          case _ => throw new Exception("error")
        }
      }
    } catch {
      case FoundExprException(e) => e
    }
    println("e="+e)
    e
  }
}

// パーサ
object parse extends RegexParsers{

  def expr: Parser[E] = term~rep("+"~>term) ^^ {
    case a ~ b => b.foldLeft[E](a){case (a, b)=> EAdd(a,b)}
  }

  def term : Parser[E] = app~rep("*"~>app) ^^ {
    case a ~ b => b.foldLeft[E](a){case(a, b) => EMul(a,b)}
  }

  def app : Parser[E] = factor~rep("("~>expr<~")") ^^ {
    case a ~ b => b.foldLeft[E](a){case(a, b) => EApp(a,b)}
  }

  def factor: Parser[E] = intLiteral | valExpr | id | fun | "("~>expr<~")" | block | unit

  def fun: Parser[E] = ("("~>id<~")") ~ ("=>"~> expr) ^^ {
    case (EId(a)~b) => EFun(Map(),a,b)
  }

  def unit: Parser[E] = ";" ^^ {
    a => EUnit
  }

  def top = rep(assign|expr)

  def assign = id ~ ("=" ~> expr) ^^ {
    case EId(a)~b => EAssign(a,b)
  }

  def block: Parser[E] = "{" ~> rep(expr) <~ "}" ^^ {
    a =>
      def c2e(l:List[E]):E = {
        l match {
          case List() => EUnit
          case List(a) => a
          case ELet(a,b,EUnit)::c => ELet(a, b, c2e(c))
          case a::b => ELet(null, a, c2e(b))
        }
      }
      ELet(null,EUnit,c2e(a.filter{a=>a != EUnit}))
  }

  def valExpr : Parser[E] = ("val"~>id)~("="~>expr) ^^ {
    case(EId(a) ~ b) => ELet(a, b, EUnit)
  }

  def intLiteral : Parser[E] = """-?[1-9][0-9]*|0""".r ^^ {
    a => EInt(a.toInt)
  }

  def id : Parser[EId] = """[_a-zA-Z][_a-zA-Z0-9]*""".r ^^ {
    a => EId(a)
  }


  def apply(str:String) = {
    parseAll(top, str) match {
      case Success(tree,_) => graph.list2let(tree)
      case e => throw new Exception(""+e)
    }
  }
}

object eval {
  def apply(env:Map[String,E], e:E):E = {
    println("eval "+env+" |- "+e)
    e match {
    case EInt(a) => EInt(a)
    case EAdd(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EInt(a1), EInt(b1)) => EInt(a1 + b1)
        case _ => throw new Exception("error "+e)
      }
    case EMul(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EInt(a1), EInt(b1)) => EInt(a1 * b1)
        case _ => throw new Exception("error "+e)
      }
    case ELet(null, b, c) => eval(env,b); eval(env,c)
    case ELet(a, b, c) => eval(env+(a->eval(env,b)),c)
    case EId(a) => env(a)
    case EFun(m,a,b) => EFun(env,a,b) 
    case EApp(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EFun(m,name,body), b1:E) => eval(m+(name->b1), body)
        case _ => throw new Exception("error "+e)
      }
    case EUnit => EUnit
    case EAssign(a,b) => throw new Exception("error")

    }
  }
}

object main extends App {

  def test(env:Map[String,E],s:String,e:E) {
    val e2 = parse(s)
    if (e2 != e) throw new Exception("error "+s+"  expected "+e+" but found "+e2)
    println(s+"="+eval(env,e2))
  }

  def test(s:String,e:E) {
    val e2 = parse(s)
    println("test "+s)
    val e3 = eval(Map(), e2)
    if (e3 != e) throw new Exception("error "+s+"  expected "+e+" but found "+e3)
    println(s+"="+e3)
  }


  val progs = List(
    EAssign("main",EApp(EApp(EId("sub"), EApp(EApp(EId("add"), EInt(1)),EInt(2))),EInt(2))),
    EAssign("add",EFun(Map(),"a",EFun(Map(),"b",EAdd(EId("a"),EId("b"))))),
    EAssign("sub",EFun(Map(),"a",EFun(Map(),"b",EMul(EId("a"),EId("b")))))
  )

  println(graph.list2let(progs))

  test(Map(),"1",EInt(1))
  test(Map("a"->EInt(1)),"a", EId("a"))
  test(Map(),"1+2", EAdd(EInt(1),EInt(2)))
  test(Map(),"val a = 1", ELet("a",EInt(1),EUnit))
  test(Map(),"{}", ELet(null, EUnit, EUnit))

  test(Map(),"{1}",ELet(null,EUnit,EInt(1)))
  test(Map("a"->EInt(1)),"{a}", ELet(null,EUnit,EId("a")))
  test(Map(),"{1+2}", ELet(null,EUnit,EAdd(EInt(1),EInt(2))))
  test(Map(),"{val a = 1}", ELet(null,EUnit,ELet("a",EInt(1),EUnit)))
  test(Map(),"{{}}", ELet(null, EUnit,ELet(null, EUnit, EUnit)))

  test(Map(),"{1 1}",ELet(null, EUnit,ELet(null,EInt(1),EInt(1))))
  test(Map(),"{1 2 3}",ELet(null, EUnit, ELet(null,EInt(1),ELet(null, EInt(2), EInt(3)))))
  test(Map(),"{val a = 1 a}", ELet(null,EUnit,ELet("a",EInt(1),EId("a"))))
  test(Map(),"{val a = 1 val b = 2}",ELet(null,EUnit, ELet("a",EInt(1),ELet("b",EInt(2),EUnit))))
  test(Map(),"{{ val a = 1} val b = 2}",ELet(null,EUnit, ELet(null,ELet(null,EUnit, ELet("a",EInt(1),EUnit)),ELet("b",EInt(2),EUnit))))
  test("{val a = 5 { val a = 1 {}} val b = 2 a}", EInt(5))
  test(Map(),"(a)=>a", EFun(Map(),"a", EId("a")))
  test(Map(),"((a)=>a)(2)", EApp(EFun(Map(), "a", EId("a")),EInt(2)))
  test("((a)=>a+a)(4)", EInt(8))
  test("((a)=>(b)=>a+b)(4)(5)", EInt(9))
  test("{val f4=((a)=>(b)=>a+b)(4) val f2=((a)=>(b)=>a+b)(2) f4(5)+f2(8)}", EInt(19))
  test("{(a)=>(b)=>(c)=>a+b*c}(4)(5)(6)", EInt(34))
  test("{val a = 1 val f=(b)=>a+b f(2)}", EInt(3))
  test("{val a = 1 a}", EInt(1))
  test("{1}", EInt(1))
  test("""
{
  val add = (a)=>(b)=>a+b
  val mul = (a)=>(b)=>a*b
  mul(add(1)(2))(3)
}
""",EInt(9))

  test("""
main=mul(add(1)(2))(3)
add=(a)=>(b)=>a+b
mul=(a)=>(b)=>a*b
""",EInt(9))

  test("""
main = {
  val a = add(1)(2)
  val a = mul(a)(3)
  a
}
add = (a)=>(b)=>a+b
mul = (a)=>(b)=>a*b
""",EInt(9))

}