From d91a94718602e01833fa467ae841c9de7bb6b484 Mon Sep 17 00:00:00 2001 From: pingu Date: Mon, 17 Nov 2025 19:58:03 +0100 Subject: [PATCH] Tehee --- 3/Assignment.hs | 49 +++++++++++++++++++++++++------------------------ 3/assig.org | 44 +++++++++++++++++++++++--------------------- 2 files changed, 48 insertions(+), 45 deletions(-) diff --git a/3/Assignment.hs b/3/Assignment.hs index 69ebd3b..b15d63f 100644 --- a/3/Assignment.hs +++ b/3/Assignment.hs @@ -2,14 +2,10 @@ module Assignment where import Chi -import Control.Monad -import Control.Monad.Identity -import Debug.Trace (trace) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HM import Data.Functor ( (<&>) ) import Control.Monad.Identity (Identity(runIdentity)) +-- Task 3 subst :: Variable -> Exp -> Exp -> Exp subst var e = \case Apply e1 e2 -> Apply (subst var e e1) (subst var e e2) @@ -22,27 +18,32 @@ subst var e = \case substBr :: Br -> Br substBr (Branch c vs e') = Branch c vs $ if var `notElem` vs then subst var e e' else e' -lookupBranch :: Constructor -> [Br] -> Identity ([Variable], Exp) -lookupBranch c [] = error "No matching branch" -lookupBranch c ((Branch c' bs e):brs) = if c == c' then pure (bs,e) else lookupBranch c brs - -eval' :: Exp -> Identity Exp -eval' = \case - e@(Apply e1 e2) -> eval' e1 >>= \case - Lambda x e' -> eval' e2 >>= eval' . flip (subst x) e' - _ -> error $ "Function was not function in evaluation: " <> show e - Const c es -> mapM eval' es <&> Const c - Rec x e -> eval' $ subst x (Rec x e) e - Case e bs -> eval' e >>= \case - Const c vs -> lookupBranch c bs >>= \case - (xs,e') -> - if length vs /= length xs then error "Not the same amount of arguments in case" else - eval' $ foldr (uncurry subst) e' (zip xs vs) - e -> error $ "Non const in case: " <> show e - x -> pure x - +-- Task 5 eval :: Exp -> Exp eval = runIdentity . eval' + where + eval' :: Exp -> Identity Exp + eval' = \case + e@(Apply e1 e2) -> eval' e1 >>= \case + Lambda x e' -> eval' e2 >>= eval' . flip (subst x) e' + _ -> error $ "Function was not function in evaluation: " <> show e + Const c es -> mapM eval' es <&> Const c + Rec x e -> eval' $ subst x (Rec x e) e + Case e bs -> eval' e >>= \case + Const c vs -> lookupBranch c bs >>= \case + (xs,e') -> + if length vs /= length xs then error "Not the same amount of arguments in case" else + eval' $ foldr (uncurry subst) e' (zip xs vs) + e -> error $ "Non const in case: " <> show e + x -> pure x + + lookupBranch :: Constructor -> [Br] -> Identity ([Variable], Exp) + lookupBranch c [] = error "No matching branch" + lookupBranch c ((Branch c' bs e):brs) = + if c == c' + then pure (bs,e) + else lookupBranch c brs + main :: IO () main = getLine >>= print . eval . parse diff --git a/3/assig.org b/3/assig.org index ebe45c2..aa2596c 100644 --- a/3/assig.org +++ b/3/assig.org @@ -12,17 +12,18 @@ This time you can make use of a [[http://bnfc.digitalgrammars.com/][BNFC]] speci If you want to use Haskell then there is also a wrapper module ([[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.cf][~Chi.cf~]]) that exports the generated abstract syntax and some definitions that may be useful for testing your code ([[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.html][documentation]]). The wrapper module comes with a Cabal file ([[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/chi.cabal][~chi.cabal~]]) and a [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/cabal.project][~cabal.project~]] file that might make installation a little easier. Here is one way to (hopefully) get started: -- Install all dependencies properly, including suitable versions of GHC and cabal-install ([[https://www.haskell.org/downloads/][installation instructions]]), as well as [[http://bnfc.digitalgrammars.com/][BNFC]]. -- Put [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.cf][~Chi.cf~]], [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.hs][~Chi.hs~]], [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/chi.cabal][~chi.cabal~]] and [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/cabal.project][~cabal.project~]] in an otherwise empty directory. -- Run ~bnfc --haskell Chi.cf~ in that directory. - - Now it is hopefully possible to use standard ~cabal~ commands. You could for instance try the following (still in the same directory): - - First use cabal repl to start GHCi. - - Then issue the following commands at the GHCi command prompt: ++ Install all dependencies properly, including suitable versions of GHC and cabal-install ([[https://www.haskell.org/downloads/][installation instructions]]), as well as [[http://bnfc.digitalgrammars.com/][BNFC]]. ++ Put [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.cf][~Chi.cf~]], [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.hs][~Chi.hs~]], [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/chi.cabal][~chi.cabal~]] and [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/cabal.project][~cabal.project~]] in an otherwise empty directory. ++ Run ~bnfc --haskell Chi.cf~ in that directory. + + Now it is hopefully possible to use standard ~cabal~ commands. You could for instance try the following (still in the same directory): + + First use cabal repl to start GHCi. + + Then issue the following commands at the GHCi command prompt: #+begin_src haskell import Chi import Prelude - pretty <$> (runDecode (decode =<< - asDecoder (code =<< code (parse "\\x. x")))) + pretty <$> + (runDecode (decode =<< asDecoder + (code =<< code (parse "\\x. x")))) #+end_src * Exercises @@ -49,7 +50,7 @@ rec foo = \m. \n. case m of Give a high-level explanation of the mathematical function in $\mathbb{N} \rightarrow \mathbb{N} \rightarrow \text{Bool}$ that is implemented by this code. *** Answer -The function will check for equality of the two natural numbers. If they are both $Zero()$, then it returns true, and if both are the successor of a some values, it checks if they are equal. In the other cases, it returns false. +The function will check for equality of the two natural numbers. If they are both $\text{Zero}()$, then it returns true, and if both are the successor of a some values, it checks if they are equal. In the other cases, it returns false. ** (2p) Consider the $\chi$ term /t/ with concrete syntax $C (\lambda z.z)$: @@ -77,14 +78,14 @@ If you use the BNFC specification above and Haskell, then the substitution funct Variable -> Exp -> Exp -> Exp #+end_src Test your implementation. Here are some test cases that must work: -| Variable | Substituted term | Term | Result | -|----------+------------------+---------------------------------------------+---------------------------------------------| -| ~x~ | ~Z()~ | ~rec x = x~ | ~rec x = x~ | -| ~y~ | $\lambda x.x$ | $\lambda x. (x y)$ | $\lambda x . (x (\lambda x . x))$ | +| Variable | Substituted term | Term | Result | +|----------+------------------+---------------------------------------------+------------------------------------------------------| +| ~x~ | $Z()$ | $\text{rec}\ x = x$ | $\text{rec}\ x = x$ | +| ~y~ | $\lambda x.x$ | $\lambda x. (x y)$ | $\lambda x . (x (\lambda x . x))$ | | ~z~ | $C(\lambda z . z)$ | $\text{case}\ z\ \text{of}\ \{ C(z) \rightarrow z \}$ | $\text{case}\ C(\lambda z. z) \ \text{of}\ \{ C(z) \rightarrow z \}$ | *** Answer -See Assignment.hs +See =Assignment.hs=. ** (1p) Implement multiplication of natural numbers in $\chi$, using the representation of natural numbers given in the $\chi$ specification. @@ -117,13 +118,13 @@ If you use the BNFC specification above and Haskell, then the interpreter should Test your implementation, for instance by testing that addition (defined in the [[https://chalmers.instructure.com/courses/36941/file_contents/course%20files/chi/Chi.hs][wrapper module]]) works for some inputs. If addition doesn’t work when your code is tested, then your solution will not be accepted. Also make sure that the following examples are implemented correctly: - The following programs should fail to terminate: - + $C() C()$ - + $case \lambda x.x of {}$ - + $case C() of { C(x) \rightarrow C() }$ - + $case C(C()) of { C() \rightarrow C() }$ - + $case C(C()) of { C() \rightarrow C(); C(x) \rightarrow x }$ - + $case C() of { D() \rightarrow D() }$ - + $(\lambda x.\lambda y.x) (rec x = x)$ + + $\text{C}()\ \text{C}()$ + + $\text{case}\ \lambda x.x\ \text{of}\ {}$ + + $\text{case}\ \text{C}()\ \text{of}\ { \text{C}(x) \rightarrow \text{C}() }$ + + $\text{case}\ \text{C}(\text{C}())\ \text{of}\ { \text{C}() \rightarrow \text{C}() }$ + + $\text{case}\ \text{C}(\text{C}())\ \text{of}\ { \text{C}() \rightarrow \text{C}(); \text{C}(x) \rightarrow x }$ + + $\text{case} \text{C}()\ \text{of}\ { \text{D}() \rightarrow \text{D}() }$ + + $(\lambda x.\lambda y.x) (\text{rec}\ x = x)$ - The following programs should terminate with specific results: + The program $case C(D(),E()) of { C(x, x) \rightarrow x }$ should terminate with the value $E()$. + The program $case C(\lambda x.x, Zero()) of { C(f, x) \rightarrow f x }$ should terminate with the value $Zero()$. @@ -133,3 +134,4 @@ Test your implementation, for instance by testing that addition (defined in the Note that implementing a call-by-value semantics properly in a language like Haskell, which is by default non-strict, can be tricky. However, you will not fail if the only problem with your implementation is that some programs that should fail to terminate instead terminate with a “reasonable” result. *** Answer +See =Assignment.hs=.