<commit_before>module Eval ( toyEval ) where

import Value ( Value(
	Var, Comp, App, Fun, Lambda, Closure, Case, Letin, Let, Module, Error ),
	Pattern, match, patVars, Env, setVars, setPat, setPats, getVal, Var )
import Data.Maybe ( fromMaybe )

--------------------------------------------------------------------------------

toyEval :: Env -> Value -> Value
toyEval env val = case noVars env val of
	[ ]	-> eval env val
	vars	-> Error $ unlines ( map errMsg vars ) -- ++ "\n" ++ show env ++ "\n\n" ++ show val
	where errMsg ( var, n ) = "\tNot in scope: `" ++ var ++ case n of
		0 -> "'"
		_ -> "~" ++ show n ++ "'"

get :: Env -> Var -> Maybe Value
get env var = getVal ( eval env ) var env

noVars :: Env -> Value -> [ Var ]
noVars env ( Var v n )		= maybe [ ( v, n ) ] ( noVars env ) $ env `get` ( v, n )
noVars env ( App f a )		= noVars env f ++ noVars env a
noVars env ( Lambda ps ex )	= ps `filterVars` noVars env ex
noVars env ( Case key sels )	= noVars env key ++ nvc `concatMap` sels
	where nvc ( pat, ex ) = [ pat ] `filterVars` noVars env ex
noVars env ( Letin defs ex )	=
	map fst defs `filterVars` noVars env ex ++ noVars env ( Let defs )
noVars env ( Let defs )		=
	map fst defs `filterVars` ( noVars env . snd ) `concatMap` defs
noVars env ( Module defs )	= noVars env ( Let defs )
noVars _ _			= [ ]

infixl	8 `filterVars`
filterVars :: [ Pattern ] -> [ Var ] -> [ Var ]
filterVars pats = filter ( `notElem` patVars `concatMap` pats )

eval :: Env -> Value -> Value
eval env ( Var v n )		= eval env $ fromMaybe ( noVar v n env ) $ env `get` ( v, n )
eval env ( Comp con mems )	= Comp con $ eval env `map` mems
eval env ( App f a )		= case eval env f of
	Fun fun			-> fun $ eval env a
	Closure ce [ p ] e	-> eval ( setPat p ( eval env a ) ce ) e
	Closure ce ( p : ps ) e	-> Closure ( setPat p ( eval env a ) ce ) ps e
	err@( Error _ )		-> err
	_			-> notFunction f
eval env ( Lambda ps ex )	= Closure env ps ex
eval env ( Case key sels )	= ec sels
	where
	ec [ ]			= nonExhaustive
	ec ( ( pat, ex ) : r )	= let k = eval env key in
		maybe ( ec r ) ( flip eval ex . flip setVars env ) $ match k pat
eval env ( Letin defs ex )	= eval ( setPats defs env ) ex
eval _ v			= v


--------------------------------------------------------------------------------

noVar :: String -> Int -> Env -> Value
noVar var n e = Error $ "Not in scope: `" ++ var ++ "' here" ++ show n ++ " " ++ show e

notFunction :: Value -> Value
notFunction nf = Error $ "Not Function: " ++ show nf

nonExhaustive :: Value
nonExhaustive = Error "Non-exhaustive patterns in case"<commit_msg>refactoring: Eval finished<commit_after>module Eval ( toyEval ) where

import Value ( Value(
	Var, Comp, App, Fun, Lambda, Closure, Case, Letin, Let, Module, Error ),
	Pattern, match, patVars, Env, setVars, setPat, setPats, getVal, Var )
import Data.Maybe ( fromMaybe )

--------------------------------------------------------------------------------

toyEval :: Env -> Value -> Value
toyEval env val = case noVars env val of
	[ ]	-> eval env val
	vars	-> Error $ unlines ( map errMsg vars )
	where errMsg ( var, n ) = "\tNot in scope: `" ++ var ++ case n of
		0 -> "'"
		_ -> "~" ++ show n ++ "'"

get :: Env -> Var -> Maybe Value
get env var = getVal ( eval env ) var env

noVars :: Env -> Value -> [ Var ]
noVars env ( Var v n )		= maybe [ ( v, n ) ] ( noVars env ) $ env `get` ( v, n )
noVars env ( App f a )		= noVars env f ++ noVars env a
noVars env ( Lambda ps ex )	= ps `filterVars` noVars env ex
noVars env ( Case key sels )	= noVars env key ++ nvc `concatMap` sels
	where nvc ( pat, ex ) = [ pat ] `filterVars` noVars env ex
noVars env ( Letin defs ex )	=
	map fst defs `filterVars` noVars env ex ++ noVars env ( Let defs )
noVars env ( Let defs )		=
	map fst defs `filterVars` ( noVars env . snd ) `concatMap` defs
noVars env ( Module defs )	= noVars env ( Let defs )
noVars _ _			= [ ]

infixl	8 `filterVars`
filterVars :: [ Pattern ] -> [ Var ] -> [ Var ]
filterVars pats = filter ( `notElem` patVars `concatMap` pats )

eval :: Env -> Value -> Value
eval env ( Var v n )		= eval env $ fromMaybe ( noVar v n ) $ env `get` ( v, n )
eval env ( Comp con mems )	= Comp con $ eval env `map` mems
eval env ( App f a )		= case eval env f of
	Fun fun			-> fun $ eval env a
	Closure ce [ p ] e	-> eval ( setPat p ( eval env a ) ce ) e
	Closure ce ( p : ps ) e	-> Closure ( setPat p ( eval env a ) ce ) ps e
	err@( Error _ )		-> err
	_			-> notFunction f
eval env ( Lambda ps ex )	= Closure env ps ex
eval env ( Case key sels )	= ec sels
	where
	ec [ ]			= nonExhaustive
	ec ( ( pat, ex ) : r )	= let k = eval env key in
		maybe ( ec r ) ( flip eval ex . flip setVars env ) $ match k pat
eval env ( Letin defs ex )	= eval ( setPats defs env ) ex
eval _ v			= v


--------------------------------------------------------------------------------

noVar :: String -> Int -> Value
noVar var n = Error $ "Not in scope: `" ++ var ++ case n of
	0 -> "~" ++ show n  ++ "'"
	_ -> "'"

notFunction :: Value -> Value
notFunction nf = Error $ "Not Function: " ++ show nf

nonExhaustive :: Value
nonExhaustive = Error "Non-exhaustive patterns in case"
{'fraction_non_alphanumeric': 0.18878248974008208, 'fraction_numerical': 0.0009771350400625367, 'mean_word_length': 2.174937965260546, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 50, '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': '2789286', 'n_tokens_mistral': 1786, 'n_tokens_neox': 1816, 'n_words': 721}