<commit_before>module Evaluator where

import Types

import Control.Lens
import qualified Data.Map as M
import qualified Data.Set as S

data LispState = Form LispValue | Value LispValue |
                 StateList [LispState] Int |
                 Apply LispFunction [LispValue] |
                 Special String [LispState]
               deriving Show


specialForms = S.Set String
specialForms = S.fromList ["def", "do", "if", "lambda", "quote"]

isSpecialForm :: LispValue -> Bool
isSpecialForm (LVList (LVSymbol str)) = str `S.elem` specialForms

resolveSymbol :: String -> [LispFrame] -> LispFrame -> Maybe LispValue
resolveSymbol str [] globals' = M.lookup str globals'
resolveSymbol str (frame:rest) globals' =
  case M.lookup str frame of
   Just val -> Just val
   Nothing  -> resolveSymbol str rest globals'

oneStep :: LispState -> Lisp LispState
oneStep v@(Value _) = return v

oneStep (Apply lispFn lispValues) =
  case lispFn of
    (LFPrimitive _ apply) ->
      case apply lispValues of
        Left  err -> lispFail err
        Right v   -> return $ Value v
    (LFAction _ action) ->
      Value `fmap` action lispValues
    (LFClosure _ _ _) -> error "TODO"

oneStep (Form (LVSymbol str)) = do
  theStack   <- use stack
  theGlobals <- use globals
  case resolveSymbol str theStack theGlobals of
   Just value -> return $ Value value
   Nothing    -> lispFail $ LispError (LVString $ "Can't resolve symbol: " ++ str)

-- empty list is "self-evaluating"
oneStep (Form (LVList [])) = return $ Value (LVList [])

oneStep f@(Form (LVList list)) =
  if isSpecialForm f
  then undefined
  else return $ StateList (map Form list) 0

oneStep (Form selfEval) = return $ Value selfEval
<commit_msg>beginning support for special forms: 'quote<commit_after>module Evaluator where

import Types

import Control.Lens
import qualified Data.Map as M
import qualified Data.Set as S

data LispState = Form LispValue | Value LispValue |
                 StateList [LispState] Int |
                 Apply LispFunction [LispValue] |
                 Special String [LispState]
               deriving Show


specialForms :: S.Set String
specialForms = S.fromList ["def", "do", "if", "lambda", "quote"]

specialFormCheck :: LispValue -> Maybe (String, [LispValue])
specialFormCheck (LVList ((LVSymbol str):rest)) = 
  if str `S.member` specialForms
  then Just (str, rest)
  else Nothing
specialFormCheck _ = Nothing

resolveSymbol :: String -> [LispFrame] -> LispFrame -> Maybe LispValue
resolveSymbol str [] globals' = M.lookup str globals'
resolveSymbol str (frame:rest) globals' =
  case M.lookup str frame of
   Just val -> Just val
   Nothing  -> resolveSymbol str rest globals'

oneStep :: LispState -> Lisp LispState
oneStep v@(Value _) = return v

oneStep (Apply lispFn lispValues) =
  case lispFn of
    (LFPrimitive _ apply) ->
      case apply lispValues of
        Left  err -> lispFail err
        Right v   -> return $ Value v
    (LFAction _ action) ->
      Value `fmap` action lispValues
    (LFClosure _ _ _) -> error "TODO"

oneStep (Form (LVSymbol str)) = do
  theStack   <- use stack
  theGlobals <- use globals
  case resolveSymbol str theStack theGlobals of
   Just value -> return $ Value value
   Nothing    -> lispFail $ LispError (LVString $ "Can't resolve symbol: " ++ str)

-- empty list is "self-evaluating"
oneStep (Form (LVList [])) = return $ Value (LVList [])

oneStep (Form form@(LVList list)) =
  case specialFormCheck form of
    Just (string, rest) ->
      return $ Special string (map Form rest)
    Nothing -> return $ StateList (map Form list) 0

oneStep (Form selfEval) = return $ Value selfEval

oneStep (Special "quote" ((Form val):_)) =
  return $ Value val

oneStep (Special "quote" _) = error "illegal state : quote"

oneStep (Special name _) = error $ "illegal state : unknown special form " ++ name

{'fraction_non_alphanumeric': 0.09789665022072189, 'fraction_numerical': 0.0005193456245131135, 'mean_word_length': 3.1241970021413277, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 33, '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': '6145557', 'n_tokens_mistral': 1199, 'n_tokens_neox': 1170, 'n_words': 419}