Implementing functional languages を頑張って読む.18日目

# 18日目
日数じゃなくて章ごとに書くことにした.時間取れない.

## 2.4 Mark 2: `let(rec)` expressions
`instantiate`を`ELet`コンストラクタのマッチに対応させるだけだからやってね.じゃねーんじゃ.

### Exercise 2.10
するべきことは,
1. `defs`の中のそれぞれの定義の右側をinstantiateする.
2. 1.で出てきたaddrとdefsの名前で,新しい名前とaddrの対応(環境)を作って現在の環境にくっつける.
3. bodyを2.の環境を引数にして`instantiate`を呼ぶ.

これはletのみを扱える.
letのinstantiate結果は非循環グラフを表現するのに対し,letrecの結果は循環グラフである.

### Exercise 2.11
なんとかして`letrec`に対応させてね.じゃねーんじゃ.
(ヒント: ほぼletと同じだけど,ステップ1でinstantiateするときにステップ2でできた環境を渡すこと)

これをHaskellですると何故かうまくいくが,非正格関数型言語では関数に渡された入力は,その関数が呼び出されるまで評価される必要がないからだ.
本当にこれを実装するときにはこれを自分でやらなければならない.
それぞれのallocateされた(ルート)ノードのアドレスを計算し,その情報を環境に反映し,その後定義をinstantiateしなければならない.

### Exercise 2.12
`main = letrec f = f x in f`を実行すると何が起きるか.
→無限ループ
Haskellなどの強い型付き言語だと何が起こるか?
→エラー

***2.4終わり.短すぎ!***

diffとったやーつ
letrecがバグってたので直した

```hs:Language.hs
diff --git a/Language.hs b/Language.hs
index e9d4fbd..7f81355 100644
--- a/Language.hs
+++ b/Language.hs
@@ -50,7 +50,7 @@ preludeDefs :: CoreProgram
 preludeDefs
     = [ ("I", ["x"], EVar "x"),
         ("K", ["x","y"], EVar "x"),
-        ("F",["x","y"], EVar "y"),
+        ("F", ["x","y"], EVar "y"),
         ("S", ["x","y","z"], EAp (EAp (EVar "x") (EVar "z")) (EAp (EVar "y") (EVar "z"))),
         ("C", ["x","y","z"], EAp (EVar "x") (EAp (EVar "y") (EVar "z"))),
         ("B", ["x","y","z"], EAp (EAp (EVar "x") (EVar "z")) (EVar "y")),
@@ -255,7 +255,7 @@ pExpr =     pApply (pOneOrMore pAexpr) mk_ap
     where
     mk_ap e = foldl1 EAp e
     mk_let _ defns _ e = ELet nonRecursive  defns  e
-    mk_letrec _ defns _ e = ELet nonRecursive defns e
+    mk_letrec _ defns _ e = ELet recursive defns e
     mk_case _ e _ a = ECase e a
     mk_lam _ v _ e = ELam v e
 
```

```hs:Main.hs
diff --git a/Main.hs b/Main.hs
index f6bfb48..261a53b 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,3 +1,5 @@
+import Data.List
+
 import Language
 import Utils
 
@@ -87,7 +89,7 @@ scStep (stack, dump, heap, globals, stats) sc_name arg_names body
         new_stack = if length arg_names + 1 <= length stack then result_addr : (drop (length arg_names + 1) stack) else error "too few arguments"
         (new_heap, result_addr) = instantiate body heap env
         env = arg_bindings ++ globals
-        arg_bindings = zip2 arg_names (getargs heap stack)
+        arg_bindings = zip arg_names (getargs heap stack)
         new_stats = (s, if elem sc_name [prim | (prim, _, _) <- preludeDefs] then (rsc, rp + 1) else (rsc + 1, rp), d) where (s, (rsc, rp), d) = stats
 
 -- now getargs since getArgs conflicts with Gofer standard.prelude
@@ -112,15 +114,36 @@ instantiate (ELet isrec defs body) heap env = instantiateLet isrec defs body hea
 instantiate (ECase e alts) heap env = error "Can’t instantiate case exprs"
 
 instantiateConstr tag arity heap env = error "Can’t instantiate constructors yet"
-instantiateLet isrec defs body heap env = error "Can’t instantiate let(rec)s yet"
 
+instantiateLet isrec defs body heap env = instantiate body new_heap new_env -- cheated
+    where
+    ((new_heap, new_env), result_addr) = mapAccumR f (heap, env) defs
+    f (heap, env) (name, expr) = ((heap1, (name, a1) : env), a1)
+        where
+        (heap1, a1) = instantiate expr heap (if isrec then new_env else env)
+-- 正格評価だとmapの中でのinstantiateの中のEVarの出現をマークしてbindの中にその識別子があるかどうかを調べ,有ったらaddr=-indexなどどしておき,全てのrhssのinstantiateが終わったらaddrが負になっている所を実際のaddrに直す?
+-- instantiateの型が変わるよみたいな.isrecとbindを引廻なさないといけない
+{-
+instantiateLet isrec defs body heap env = instantiate body new_heap new_env --error "Can’t instantiate let(rec)s yet"
+    where
+    new_env = local ++ env
+    (new_heap, instanceOfRhss) = getrhss isrec (rhssOf defs) heap (if isrec then new_env else env)
+    local = zip (bindersOf defs) instanceOfRhss
+
+getrhss :: IsRec -> [CoreExpr] -> TiHeap -> ASSOC Name Addr -> (TiHeap, [Addr])
+getrhss isrec rhss heap env = (new_heap, result_addr)
+    where
+    (new_heap, result_addr) = foldr get_rhs (heap, []) rhss
+    get_rhs expr (heap, addr) = (new_heap, result_addr : addr)
+        where (new_heap, result_addr) = instantiate expr heap env
+-}
 showResults :: [TiState] -> String
 showResults states = iDisplay (iConcat [ iLayn (map showState states), showStats (last states) ])
 
 showState :: TiState -> Iseq
 showState (stack, dump, heap, globals, stats)
     = iConcat [
-        showStack heap stack, iNewline,
+        showStack heap stack, iNewline ,
         showHeap heap, iNewline
     ]
 
@@ -192,7 +215,8 @@ showStats (stack, dump, heap, globals, stats)
     ]
 
 main :: IO ()
-main = putStrLn $ runProg $ "main = K I I I I 3"
+main = putStrLn $ runProg $ "main = letrec x = x f in x; x = 5; two = S C I; inc = S C; three = inc two; add = C S (C C); mul = C"
+--main = putStrLn $ runProg $ "pair x y f =f x y ; fst p = p K ; snd p= p F; f x y = letrec a = pair x b ; b = pair y a in fst (snd (snd (snd a))) ; main = f 3 4"
 --main = putStrLn $ iDisplay $ pprExpr (ELet nonRecursive [("att", ENum 2)] (EAp (EAp (EVar "+") (EVar "att")) (EVar "1")))
 --main = putStrLn( pprint $ parse  "f=3;\ng x y = let z = x in z ;\nh x = case (let y = x in y) of\n<1> -> 2 ;\n<2> -> 5;\n i = g (1 + 2 * 3) (5 - 1 / 2)")
 --main = putStrLn $ show $ pOneOrMoreWithSep (pLit "x") (pLit ";") [(1,"x"),(1,";"),(1,"x") ,(1,";"),(2,"x"),(2,";"),(2,"x"),(2,";"),(2,"x") ]
```