[lec12] lab4 live code

Author: andreasabel

README.md

@@ -57,8 +57,8 @@ Material: plt = course book, dragon = Dragon book. Slides follow closely the plt
 | *Wed 04/12* | *23* | *Lab 2 deadline* |  |
 | Thu 05/12 | 13-15 | Functional programming languages | [slides](plt-book/ipl-book/slides/7-slides-ipl-book.pdf), plt 7, dragon 6.5,7.3, [script](notes/cbn-cbv.html) |
 | Tue 10/12 | 13-15 | Type inference and polymorphism | plt 7.7-9, [script](notes/typing.html), [visualization tool](https://github.com/teach-plt/visualize-type-inference) |
-| Thu 12/12 **HC1** | 13-14 | Hands-on with Lab 4 (Haskell) |  |
-| Thu 12/12 | 14-15 | Hands-on with Lab 4 (Java)    |  |
+| Thu 12/12 **HC1** | 13-14 | Hands-on with Lab 4 (Haskell) | [live code](live/2024/lab4/Interpreter.hs) |
+| Thu 12/12 | 14-15 | Hands-on with Lab 4 (Java)    | [live code](live/2024/lab4/Interpreter.java) |
 | Tue 17/12 | 13-15 | Dependent types (Agda) |  |
 | *Wed 18/12* | *23* | *Lab 3 deadline* |  |
 | Thu 19/12 **SB-H5** | 13-15 | Preparing for the exam | |

live/2024/lab4/Interpreter.hs

@@ -0,0 +1,94 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-} -- Turn off unused import warning off in stub
+{-# OPTIONS_GHC -Wno-unused-matches #-} -- Turn off unused binding warning off in stub
+
+{-# LANGUAGE LambdaCase #-}
+
+-- | Interpreter for lambda-calculus with if, +, -, <.
+--
+--   Strategy can be either call-by-value or call-by-name.
+
+module Interpreter (interpret, Strategy(..)) where
+
+import Control.Applicative
+import Control.Monad.Except
+import Control.Monad.Reader
+
+import Data.Functor
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Fun.Abs
+import Fun.Print
+
+-- | Evaluation strategy.
+
+data Strategy
+  = CallByName
+  | CallByValue
+
+-- | Error monad.
+
+type Err = Except String
+
+-- | Signature maps identifiers to closed expressions.
+
+type Sig = Map Ident Exp
+
+-- | Call-by-value environment maps identifiers to values.
+
+type Env = Map Ident Val
+
+-- | Values.
+
+data Val
+  = VInt Integer        -- ^ Integer literal.
+  | VFun Ident Exp Env  -- ^ Function closure.
+
+-- | Read-only data for the evaluator.
+
+data EvDat = EvDat
+  { _strategy :: Strategy
+  , _sig      :: Sig
+  }
+
+-- | Entry point: Program computes a number.
+
+interpret :: Strategy -> Program -> Err Integer
+interpret strategy (Prog defs (DMain mainExp)) = do
+  -- Build Sig
+  let sig = Map.fromList $ map (\ (DDef f xs e) -> (f, abstract xs e)) defs
+  -- Evaluate main
+  case runExcept (eval (EvDat strategy sig) Map.empty mainExp) of
+    Left err -> throwError err
+    Right v -> case v of
+      VInt i -> return i
+      VFun{} -> throwError $ "main returned a function, but should return an integer"
+
+-- | @abstract [x1,...,xn] e = EAbs x1 $ ... $ EAbs xn e@.
+abstract :: [Ident] -> Exp -> Exp
+abstract xs e = foldr EAbs e xs
+
+eval :: EvDat -> Env -> Exp -> Err Val
+eval dat env = \case
+  EInt i     -> return $ VInt i  -- return :: Val -> Err Val
+  EVar x     -> lookupVar dat env x
+  EAbs x e   -> return $ VFun x e env
+  EApp e1 e2 -> do
+    v1 <- eval dat env e1
+    v2 <- eval dat env e2
+    case v1 of
+      VFun x e env1 -> eval dat (Map.insert x v2 env1) e
+      VInt{} -> throwError $ printTree e1 ++ " is not a function, but applied to " ++ printTree e2
+  e -> nyi e
+
+lookupVar :: EvDat -> Env -> Ident -> Err Val
+lookupVar dat env x =
+  case Map.lookup x env of
+    Just v  -> return v
+    Nothing ->
+      case Map.lookup x (_sig dat) of
+        Just e  -> eval dat Map.empty e
+        Nothing -> throwError $ "unbound identifier " ++ printTree x
+
+nyi :: Print e => e -> Err a
+nyi e = throwError $ "not yet implemented: interpreting " ++ printTree e

live/2024/lab4/Interpreter.java

@@ -0,0 +1,102 @@
+import java.util.*;
+import fun.Absyn.*;
+import fun.PrettyPrinter;
+
+public class Interpreter {
+
+  final Strategy strategy;
+
+  final Map<String,Exp> sig = new TreeMap<String,Exp>();
+
+  public Interpreter(Strategy strategy) {
+    this.strategy = strategy;
+  }
+
+  public void interpret(Program p) {
+    switch(p) {
+      case Prog prg -> {
+        DMain main = (DMain)prg.main_;
+        // Make sig from listdef_
+        for (var d : prg.listdef_) {
+          DDef dd = (DDef)d;
+          Exp e = dd.exp_;
+          // [x1,x2] e --> new EAbs(x1, new EAbs(x2, e))
+          var xs = dd.listident_;
+          Collections.reverse(xs);
+          for (String x : xs) {
+            e = new EAbs(x, e);
+          }
+          sig.put(dd.ident_, e);
+        }
+
+        // Evaluate main_
+        System.out.println(eval(new Env(), main.exp_).intValue());
+      }
+      default -> { throw new RuntimeException("Interpreter not implemented yet"); }
+    }
+  }
+
+  // Evaluate expressions
+
+  Value eval(Env env, Exp e) {
+    switch(e) {
+      case EInt p -> { return new VInt(p.integer_); }
+      case EAbs p -> { return new VFun(p.ident_, p.exp_, env); }
+      case EApp p -> {
+        Value v1 = eval(env, p.exp_1);
+        Value v2 = eval(env, p.exp_2);
+        return v1.apply(v2);
+      }
+      case EVar p -> {
+        String x = p.ident_;
+        Value v = env.lookup(x);
+        if (v == null) {
+          Exp f = sig.get(x);
+          if (f == null) throw new RuntimeException("unbound identifier " + x);
+          return eval(new Env(), f);
+        } else return v;
+      }
+      default -> { throw new RuntimeException("not yet implemented" + PrettyPrinter.print(e)); }
+    }
+  }
+
+  // Values
+
+  abstract class Value {
+    abstract public Integer intValue();
+    abstract public Value   apply(Value arg);
+  }
+
+  class VInt extends Value {
+    final Integer i;
+    VInt(Integer i) { this.i = i; }
+    public Integer intValue()       { return i; }
+    public Value   apply(Value arg) { throw new RuntimeException("cannot apply number"); }
+  }
+
+  class VFun extends Value {
+    final String x;
+    final Exp body;
+    final Env env;
+    VFun (String x, Exp body, Env env) { this.x = x; this.body = body; this.env = env; }
+    public Integer intValue() { throw new RuntimeException("function does not have intValue()"); }
+    public Value   apply (Value arg) { return eval(new Extend(x, arg, env), body); }
+  }
+
+  // Environments
+
+  class Env {
+    public Value lookup(String x) { return null; }
+  }
+
+  class Extend extends Env {
+    final String x;
+    final Value v;
+    final Env env;
+    Extend(String x, Value v, Env env) { this.x = x; this.v = v; this.env = env; }
+    public Value lookup(String x) {
+      if (x.equals(this.x)) return v;
+      else return env.lookup(x);
+    }
+  }
+}