<commit_before>module BreveEval
    -- ( run
    -- , runEnv
    -- , interp
    -- ) where
    where
import BreveLang
import BrevePrelude
import qualified Euterpea (play, line)
import qualified Euterpea.Music.Note.Music as E
import Text.Parsec (runParser)

import Control.Monad (msum)
import Data.List (intercalate)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, catMaybes)
import Data.Monoid (mappend)

type Music = E.Music E.Pitch

type Binding = (String, Val)
type Env = [Binding]

type TraceMap = Map.Map Loc Val

data Trace = TrLoc Loc | TrOp BinOp Trace Trace | TrUn UnOp Trace deriving (Eq)

instance Show Trace where
    show (TrLoc l) = show l
    show (TrOp op a b) = '(' : shows a (shows op (shows b ")"))
    show (TrUn op x) = shows op (show x)

data Val = Vp E.PitchClass Trace
         | Vn Integer Trace
         | Vd Double Trace
         | Vb Bool
         | Vnote Val Val Val     -- Note
         | Vrest Val     -- Rest
         | Vseq Val Val   -- represents :+: (and therefore Snippet)
         | Vpar Val Val   -- represents the :=: operator for rest, notes and snippets
         | Vlist [Val]     -- Expr List
         | Vfunc Expr      -- Lambda

instance Show Val where
    show (Vp p t) = "Val_PitchClass <" ++ shows p (' ' : shows t ">")
    show (Vn n t) = "Val_Integer <" ++ shows n (' ' : shows t ">")
    show (Vd d t) = "Val_Double <" ++ shows d (' ' :  shows t ">")
    show (Vb b) = "Val_Bool <" ++ shows b ">"
    show (Vnote p o d) = "Val_Note <" ++ unwords (map show [p,o,d]) ++ ">"
    show (Vrest r) = "Val_Rest <" ++ shows r ">"
    show (Vseq a b) = '(' : shows a " :+: " ++ shows b ")"
    show (Vpar a b) = '(' : shows a " :=: " ++ shows b ")"
    show (Vlist l) = "Vlist [" ++ intercalate ", " (map show l) ++ "]"
    show (Vfunc l) = show l

instance Eq Val where
    (Vp a _) == (Vp b _) = a == b
    (Vn a _) == (Vn b _) = a == b
    (Vn a _) == (Vd b _) = fromInteger a == b
    a@(Vd _ _) == b@(Vn _ _) = b == a
    (Vd a _) == (Vd b _) = a == b
    (Vb a) == (Vb b) = a == b
    (Vnote a b c) == (Vnote d e f) = and $ zipWith (==) [a,b,c] [d,e,f]
    (Vrest a) == (Vrest b) = a == b
    (Vseq a b) == (Vseq c d) = a == c && b == d
    (Vpar a b) == (Vpar c d) = a == c && b == d
    (Vlist a) == (Vlist b) = a == b
    a == b = error $ unwords ["Cannot compare", show a, "and", show b]

instance Ord Val where
    (Vp a _) <= (Vp b _) = a <= b
    (Vn a _) <= (Vn b _) = a <= b
    (Vn a _) <= (Vd b _) = fromInteger a <= b
    (Vd a _) <= (Vn b _) = a <= fromInteger b
    (Vd a _) <= (Vd b _) = a <= b
    (Vb a) <= (Vb b) = a <= b
    (Vnote a b c) <= (Vnote d e f) = or (zipWith (<=) [a,b,c] [d,e,f])
    (Vrest a) <= (Vrest b) = a <= b
    (Vpar a b) <= (Vpar c d) = a <= c && b <= d
    (Vseq a b) <= (Vseq c d) = a <= c && b <= d
    (Vlist a) <= (Vlist b) = a <= b
    a <= b = error $ unwords ["Cannot compare", show a, "and", show b]

-- Takes source code and parses it to generate the AST and parse traces
parse :: String -> (Statement, Traces)
parse input = case runParser breveParser [] "input" input of
    Left err -> error (show err)
    Right st -> st

-- Produce the Environment defined by a program.
parseEval :: String -> (Env, TraceMap)
parseEval = parseEvalEnv initEnv

parseEvalEnv :: Env -> String -> (Env, TraceMap)
parseEvalEnv env source = let (prog, traces) = parse source in
     (eval env prog, makeTraceMap traces)

initEnv = fst $ parseEvalEnv [] prelude

makeTraceMap :: Traces -> TraceMap
makeTraceMap = Map.fromList . map (makepair . evalExpr [])
    where
        makepair v@(Vp _ (TrLoc l)) = (l, v)
        makepair v@(Vd _ (TrLoc l)) = (l, v)
        makepair v@(Vn _ (TrLoc l)) = (l, v)

-- Takes source code and evaluates the "main" expression.
run :: String -> Val
run = runEnv initEnv

-- Same as run, but with a given initial environment.
runEnv :: Env -> String -> Val
runEnv env source =
    fromMaybe (error "No main to evaluate!") (lookup "main" (fst $ parseEvalEnv env source))

-- Transforms a Val into a Music object that can be played.
toMusic :: Val -> Music
toMusic (Vnote (Vp p _) o d) = E.note (valToDur d) (p, valToOct o)
toMusic (Vrest d) = E.rest (valToDur d)
toMusic (Vseq a b) = toMusic a E.:+: toMusic b
toMusic (Vpar a b) = toMusic a E.:=: toMusic b
toMusic v = error $ "Cannot create a music object from " ++ show v

-- Performs the Music represented by the program.
perform :: String -> IO()
perform = Euterpea.play . toMusic . run

-- ==========
-- Evaluating
-- ==========

-- Given an environment, evaluate the given statement.
-- Assign statements create a binding between the name and the evaluated
-- expression.
-- Return statements do the same with the name "return" -- which means there
-- must only be one per function, at the end of the function body!
-- Sequence statements are evaluated top-to-bottom, building the environment as
-- each component statement is evaluated.
eval :: Env -> Statement -> Env
eval env (Seq ss) = foldl eval env ss
eval env (Assign n e) = (n, evalExpr env e) : env
eval env (Return e) = ("return", evalExpr env e) : env

evalExpr :: Env -> Expr -> Val
evalExpr env expr = let evalE = evalExpr env in
    case expr of
    (PitchClass p l) -> Vp p (TrLoc l)
    (N n l) -> Vn n (TrLoc l)
    (D d l) -> Vd d (TrLoc l)
    (B b) -> Vb b
    (UnOpExpr op e) -> evalUnOp op (evalExpr env e)
    (BinOpExpr op e1 e2) -> evalBinOp op (evalExpr env e1) (evalExpr env e2)
    (Note p o d) -> Vnote (evalE p) (evalE o) (evalE d)
    (Rest d) -> Vrest (evalE d)
    (Snippet ss) -> snippet (map evalE ss)
    (List ls) -> Vlist (map evalE ls)
    (Var s) -> lookupVar env s
    l@(Lambda _ _) -> Vfunc l
    (App name args) -> evalApp env name (map evalE args)
    (If c t f) -> evalIf env c t f
    (Case cond cases) -> evalCase env (evalE cond) cases

-- note :: Val -> Val -> Val -> Val
-- note (Vp p _) o d = Vnote $ E.note (valToDur d) (p, valToOct o)
-- note _ _ _ = error "Note takes a pitch class, an octave and a duration"

-- rest :: Val -> Val
-- rest (Vd d _) = Vrest (E.rest (toRational d))
-- rest (Vn n _) = Vrest (E.rest (toRational n))
-- rest _ = error "Rests take a duration"

valToDur :: Val -> E.Dur
valToDur (Vd d _) = toRational d
valToDur (Vn n _) = toRational n
valToDur _ = error "Durations must be numeric types"

valToOct :: Val -> E.Octave
valToOct (Vn n _) = fromInteger n
valToOct _ = error "Octaves must be integers"

snippet :: [Val] -> Val
snippet (v@(Vnote{}):vs) = case vs of
    [] -> v
    _ -> Vseq v (snippet vs)
snippet (v@(Vrest _):vs) = case vs of
    [] -> v
    _ -> Vseq v (snippet vs)
snippet (_:vs) = error "A snippet should only contain Note or Rest objects"

lookupVar :: Env -> String -> Val<commit_msg>added more type checks to evalExpr<commit_after>module BreveEval
    -- ( run
    -- , runEnv
    -- , interp
    -- ) where
    where
import BreveLang
import BrevePrelude
import qualified Euterpea (play, line)
import qualified Euterpea.Music.Note.Music as E
import Text.Parsec (runParser)

import Control.Monad (msum)
import Data.List (intercalate)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, catMaybes)
import Data.Monoid (mappend)

type Music = E.Music E.Pitch

type Binding = (String, Val)
type Env = [Binding]

type TraceMap = Map.Map Loc Val

data Trace = TrLoc Loc | TrOp BinOp Trace Trace | TrUn UnOp Trace deriving (Eq)

instance Show Trace where
    show (TrLoc l) = show l
    show (TrOp op a b) = '(' : shows a (shows op (shows b ")"))
    show (TrUn op x) = shows op (show x)

data Val = Vp E.PitchClass Trace
         | Vn Integer Trace
         | Vd Double Trace
         | Vb Bool
         | Vnote Val Val Val     -- Note
         | Vrest Val     -- Rest
         | Vseq Val Val   -- represents :+: (and therefore Snippet)
         | Vpar Val Val   -- represents the :=: operator for rest, notes and snippets
         | Vlist [Val]     -- Expr List
         | Vfunc Expr      -- Lambda

instance Show Val where
    show (Vp p t) = "Val_PitchClass <" ++ shows p (' ' : shows t ">")
    show (Vn n t) = "Val_Integer <" ++ shows n (' ' : shows t ">")
    show (Vd d t) = "Val_Double <" ++ shows d (' ' :  shows t ">")
    show (Vb b) = "Val_Bool <" ++ shows b ">"
    show (Vnote p o d) = "Val_Note <" ++ unwords (map show [p,o,d]) ++ ">"
    show (Vrest r) = "Val_Rest <" ++ shows r ">"
    show (Vseq a b) = '(' : shows a " :+: " ++ shows b ")"
    show (Vpar a b) = '(' : shows a " :=: " ++ shows b ")"
    show (Vlist l) = "Vlist [" ++ intercalate ", " (map show l) ++ "]"
    show (Vfunc l) = "Vfunc <" ++ shows l ">"

instance Eq Val where
    (Vp a _) == (Vp b _) = a == b
    (Vn a _) == (Vn b _) = a == b
    (Vn a _) == (Vd b _) = fromInteger a == b
    a@(Vd _ _) == b@(Vn _ _) = b == a
    (Vd a _) == (Vd b _) = a == b
    (Vb a) == (Vb b) = a == b
    (Vnote a b c) == (Vnote d e f) = and $ zipWith (==) [a,b,c] [d,e,f]
    (Vrest a) == (Vrest b) = a == b
    (Vseq a b) == (Vseq c d) = a == c && b == d
    (Vpar a b) == (Vpar c d) = a == c && b == d
    (Vlist a) == (Vlist b) = a == b
    a == b = error $ unwords ["Cannot compare", show a, "and", show b]

instance Ord Val where
    (Vp a _) <= (Vp b _) = a <= b
    (Vn a _) <= (Vn b _) = a <= b
    (Vn a _) <= (Vd b _) = fromInteger a <= b
    (Vd a _) <= (Vn b _) = a <= fromInteger b
    (Vd a _) <= (Vd b _) = a <= b
    (Vb a) <= (Vb b) = a <= b
    (Vnote a b c) <= (Vnote d e f) = or (zipWith (<=) [a,b,c] [d,e,f])
    (Vrest a) <= (Vrest b) = a <= b
    (Vpar a b) <= (Vpar c d) = a <= c && b <= d
    (Vseq a b) <= (Vseq c d) = a <= c && b <= d
    (Vlist a) <= (Vlist b) = a <= b
    a <= b = error $ unwords ["Cannot compare", show a, "and", show b]

-- Takes source code and parses it to generate the AST and parse traces
parse :: String -> (Statement, Traces)
parse input = case runParser breveParser [] "input" input of
    Left err -> error (show err)
    Right st -> st

-- Produce the Environment defined by a program.
parseEval :: String -> (Env, TraceMap)
parseEval = parseEvalEnv initEnv

parseEvalEnv :: Env -> String -> (Env, TraceMap)
parseEvalEnv env source = let (prog, traces) = parse source in
     (eval env prog, makeTraceMap traces)

initEnv = fst $ parseEvalEnv [] prelude

makeTraceMap :: Traces -> TraceMap
makeTraceMap = Map.fromList . map (makepair . evalExpr [])
    where
        makepair v@(Vp _ (TrLoc l)) = (l, v)
        makepair v@(Vd _ (TrLoc l)) = (l, v)
        makepair v@(Vn _ (TrLoc l)) = (l, v)

-- Takes source code and evaluates the "main" expression.
run :: String -> Val
run = runEnv initEnv

-- Same as run, but with a given initial environment.
runEnv :: Env -> String -> Val
runEnv env source =
    fromMaybe (error "No main to evaluate!") (lookup "main" (fst $ parseEvalEnv env source))

-- Transforms a Val into a Music object that can be played.
toMusic :: Val -> Music
toMusic (Vnote (Vp p _) o d) = E.note (valToDur d) (p, valToOct o)
toMusic (Vrest d) = E.rest (valToDur d)
toMusic (Vseq a b) = toMusic a E.:+: toMusic b
toMusic (Vpar a b) = toMusic a E.:=: toMusic b
toMusic v = error $ "Cannot create a music object from " ++ show v

-- Performs the Music represented by the program.
perform :: String -> IO()
perform = Euterpea.play . toMusic . run

-- ==========
-- Evaluating
-- ==========

-- Given an environment, evaluate the given statement.
-- Assign statements create a binding between the name and the evaluated
-- expression.
-- Return statements do the same with the name "return" -- which means there
-- must only be one per function, at the end of the function body!
-- Sequence statements are evaluated top-to-bottom, building the environment as
-- each component statement is evaluated.
eval :: Env -> Statement -> Env
eval env (Seq ss) = foldl eval env ss
eval env (Assign n e) = (n, evalExpr env e) : env
eval env (Return e) = ("return", evalExpr env e) : env

evalExpr :: Env -> Expr -> Val
evalExpr env expr = let evalE = evalExpr env in
    case expr of
    (PitchClass p l) -> Vp p (TrLoc l)
    (N n l) -> Vn n (TrLoc l)
    (D d l) -> Vd d (TrLoc l)
    (B b) -> Vb b
    (UnOpExpr op e) -> evalUnOp op (evalExpr env e)
    (BinOpExpr op e1 e2) -> evalBinOp op (evalE e1) (evalE e2)
    (Note p o d) -> note (evalE p) (evalE o) (evalE d)
    (Rest d) -> rest (evalE d)
    (Snippet ss) -> snippet (map evalE ss)
    (List ls) -> Vlist (map evalE ls)
    (Var s) -> lookupVar env s
    l@(Lambda _ _) -> Vfunc l
    (App name args) -> evalApp env name (map evalE args)
    (If c t f) -> evalIf env c t f
    (Case cond cases) -> evalCase env (evalE cond) cases

note :: Val -> Val -> Val -> Val
note p@(Vp{}) o@(Vn{}) d = case d of
    (Vd{}) -> Vnote p o d
    (Vn{}) -> Vnote p o d
    _ -> error $ "Expected a numeric duration, received " ++ show d
note _ _ _ = error "Note takes a pitch class, an integer octave and a numeric duration"

rest :: Val -> Val
rest v@(Vd d _) = Vrest v
rest v@(Vn n _) = Vrest v
rest _ = error "Rests take a numeric duration"

valToDur :: Val -> E.Dur
valToDur (Vd d _) = toRational d
valToDur (Vn n _) = toRational n
valToDur _ = error "Durations must be numeric types"

valToOct :: Val -> E.Octave
valToOct (Vn n _) = fromInteger n
valToOct _ = error "Octaves must be integers"

snippet :: [Val] -> Val
snippet (v@(Vnote{}):vs) = case vs of
    [] -> v
    _ -> Vseq v (snippet vs)
snippet (v@(Vrest _):vs) = case vs of
    [] -> v
    _ -> Vseq v (snippet vs)
snippet (_:vs) = error "A snippet should only contain Note or Rest objects"

lookupVar :: Env -> String -> Val
{'fraction_non_alphanumeric': 0.1500259048182962, 'fraction_numerical': 0.0005921101324846421, 'mean_word_length': 2.539025667888947, 'pattern_counts': {'":': 0, '<': 66, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '301057', 'n_tokens_mistral': 4948, 'n_tokens_neox': 4897, 'n_words': 1961}