Cvičení z Neprocedurálního programování - úkol 7

1-zadani.md

7. úkol

Zadání

V tomto úkolu si napíšete interpreter pro malý jazyk "Simpl" (zkratka je rekurzivní: Simpl Is My Programming Language).

Simpl je maličkatý procedurální/imperativní jazyk, který je zhruba tak dobrý jako kalkulačka, která je povolená na maturitních zkouškách. Program v jazyce Simpl se skládá z bloků. Každý blok je posloupnost příkazů a v Simpl je každý příkaz nějaká forma přiřazení.

Ukázka -- co řádek, to jeden příkaz:

x = 42
y = x + 4
y *= 5
z = (y / (2 + y)) * x + 4 - 2 / 5

Snažte se psát co nejhezčí, nejkratší a nejidiomatičtější kód. Pokud něco jde napsat hezky na jeden řádek, učiňte tak. :) Jako obvykle vám může posloužit Style Guide z 5. úkolu.

Za úkol můžete dostat až 15 (nebonusových) bodů. Tentokrát budu klást i důraz na to, aby byl kód hezký!

Deadline

Tento úkol má deadline společně s odevzdáním zápočtového programu.

Instrukce

Stáhněte si soubory Simpl.hs a State.hs a dejte je do jedné složky. Soubor State.hs nebudete měnit, je to jen stavová monáda ze cvičení. Odevzdejte pouze soubor Simpl.hs!

Bonusové úlohy

Pokud by vám ještě chyběly body, nabízím následující bonusové úkoly:

Feedback ke cvičení [1 bonusový bod]

Napište mi feedback ke cvičení -- co jsem udělal dobře, co ne a co můžu do příštích let zlepšit

Meme [1-2 bonusové body dle vtipnosti]

Vytvořte nějaké meme o něčem, co souvisí s předmětem Neprocedurální programování. Meme musí být informaticky korektní a nemělo by být o cvičících/přednášejících -- jen o předmětu/látce.

Simpl.hs

-- Tato možnost zapne všechny warningy:
{-# OPTIONS_GHC -Wall #-}

module Simpl where

-- Modul pro mapu/slovník
-- Dokumentaci najdete zde: https://hackage.haskell.org/package/containers-0.6.4.1/docs/Data-Map-Lazy.html
--
-- Modul je importován tzv. kvalifikovaně.
-- Pokud chcete použít např. funkci 'lookup', musíte napsat 'Map.lookup'
import qualified Data.Map                      as Map

-- Modul pro State (víceméně stejný jako ze cvičení až na funkce 'modify' a 'evalState')
import           State

-- | Proměnná je řetězec
type Var = String                -- <var>

-- | Příkazy samy o sobě nemají hodnotu, ale manipulují s proměnnými
data Statement
  = Assign Var Expression        -- <var> = <expr>
  | AssignOp Op Var Expression   -- <var> <op>= <expr>
  deriving (Eq, Show)

-- | Skupina příkazů je blok
type Block = [Statement]

-- | Výrazy mají hodnotu samy o sobě
data Expression                       -- <expr>
  = Number Int                        -- 42
  | Variable Var                      -- <var>
  | BinaryOp Op Expression Expression -- <expr> <op> <expr>
  deriving (Eq, Show)

-- | Reprezentuje druh binární operace
data Op                             -- <expr>
  = Add                             -- (+)
  | Sub                             -- (-)
  | Mul                             -- (*)
  | Div                             -- (/)
  deriving (Eq, Show)

-- | Hodnoty jsou pouze čísla.
type Value = Int

-- | 'Store' je mapa, která proměnným přiřazuje hodnoty.
type Store = Map.Map Var Value

{- Příkladný program si můžete představit například následovně:

> x = 4 + 5 + 3
> y = (x * 42) + 1
> z = x + y
> x += z
> result = (x * x * x * x) / 4

-}

-- | Vyhodnocení výrazu probíhá následovně:
--
-- Pokud je výraz číslo, tak jej vrátí.
-- Pokud je výraz proměnná, tak se podívá do 'Store'.
--   Pokud má proměnná přiřazenou hodnotu, pak ji vrátí.
--   Pokud proměnná nemá přiřazenou hodnotu, vrátí nulu.
-- Pokud je výraz nějaká binární operace, zavolá 'evalBinaryOp'
--
-- Pokud se výraz skládá z více částí, je nejprve vyhodnocena levá část a až potom pravá část
evalExpr :: Expression -> State Store Value
evalExpr expr = undefined -- <- FIXME

-- | Vyhodnocení binární operace
evalBinaryOp :: Op -> Expression -> Expression -> State Store Value
evalBinaryOp = apply . getOp
 where
  -- | Převede 'Op' na funkci, která vezme dvě hodnoty a vrátí novou hodnotu
  getOp :: Op -> (Value -> Value -> Value)
  getOp op = undefined -- <- FIXME

  -- | Vezme funkci získanou z 'getOp' výše,
  -- dva výrazy, které vyhodnotí pomocí 'evalExpr'
  -- a aplikuje na ně kombinující funkci.
  --
  -- Pokuste se o co nejelegantnější zápis.
  --
  -- Hint: Tady budete potřebovat 'do'-notaci.
  apply
    :: (Value -> Value -> Value)
    -> Expression
    -> Expression
    -> State Store Value
  apply opFn e1 e2 = undefined -- <- FIXME

-- | Vyhodnocení příkazu
--
-- Přiřazení (Assign) je vyhodnoceno tak, že je vyhodnocen výraz na pravé straně
-- a potom je výsledná hodnota přiřazena do proměnné (vložena do 'Store').
--
-- Přiřazení s operací (AssignOp) je vyhodnoceno podobně jako výše uvedené přiřazení.
-- Využijte funkci 'evalBinaryOp', abyste si ulehčili práci.
-- [Nápověda: x += y je to samé jako x = (x + y)]
evalStatement :: Statement -> State Store ()
evalStatement stmt = undefined -- <- FIXME

-- | Vyhodnocení bloku příkazů probíhá tak,
-- že je postupně vyhodnocen každý příkaz
evalBlock :: Block -> State Store ()
evalBlock = mapM_ evalStatement

-- | Celkové vyhodnocení znamená spustit stavový výpočet 'evalBlock' s prázdným Storem
eval :: Block -> Store
eval = evalState Map.empty . evalBlock

-- Pokud chcete bonusové body:
--
-- * Vyrobte sadu testů, která pokryje většinu situací, které mohou nastat
-- * Přidejte `==`, které vrací 0/1, `if` příkaz [(If Expr Block Block)] a napište pro něj vyhodnocení
-- * Přidejte hezkou `Show` instanci, která vše hezky vypíše
-- * Napište parser pomocí monády `Parser` ze cvičení!

State.hs

{-# LANGUAGE InstanceSigs #-}

module State where

import qualified Control.Monad                 as M

newtype State s a = State { runState :: s -> (s, a) }
-- Připomínám: runState :: State s a -> s -> (s, a)

instance Functor (State s) where
  fmap :: (a -> b) -> State s a -> State s b
  fmap f stavovyVypocet = State $ \s ->       -- Nový stavový výpočet bere stav
    let (s', a) = runState stavovyVypocet s -- spustí starý výpočet, čímž dostane nový stav a ačko 
    in  (s', f a)                           -- a vrátí nový stav a 'f a :: b'

instance Monad (State s) where
  return :: a -> State s a
  return a = State $ \s -> (s, a)

  (>>=) :: State s a -> (a -> State s b) -> State s b
  stavovyVypocet >>= f = State $ \s ->
    let (s', a)         = runState stavovyVypocet s  -- spustíme starý výpočet, dostaneme nový stav a ačko
        stavovyVypocet' = f a                -- aplikací f na a dostaneme nový stavový výpočet
    in  runState stavovyVypocet' s'          -- který spustíme aplikací na nový stav

-- | Vrátí aktuální stav
get :: State s s
get = State $ \s -> (s, s)

-- | Nastaví nový stav
set :: s -> State s ()
set s = State $ const (s, ())

-- | Změní stav pomocí dodané funkce
modify :: (s -> s) -> State s ()
modify f = State $ \s -> (f s, ())

-- | Spustí stavový výpočet s počátečním stavem,
-- vrátí konečný stav.
evalState :: s -> State s a -> s
evalState initialState action = fst $ runState action initialState

-- | Tuto instanci potřebujeme, protože Applicative je nadtřída Monad.
-- Reálně ji ale můžeme definovat pomocí Monad samotné, tedy tak učiňme :)
instance Applicative (State s) where
  pure  = return
  (<*>) = M.ap