From 61a467c1be9895cc8c22b73ac0ff4350047d43e6 Mon Sep 17 00:00:00 2001 From: Kleidi Bujari Date: Tue, 13 Oct 2026 23:44:16 -0700 Subject: baseline parsing/eval --- src/Hint/Data.hs | 25 ++++++++++++ src/Hint/Eval.hs | 29 +++++++------ src/Hint/Lexer.hs | 10 +++++ src/Hint/Parser.hs | 117 ++++++++++++++++++++++++++++------------------------- 4 files changed, 113 insertions(+), 68 deletions(-) create mode 100644 src/Hint/Data.hs (limited to 'src/Hint') diff --git a/src/Hint/Data.hs b/src/Hint/Data.hs new file mode 100644 index 0000000..a5faa44 --- /dev/null +++ b/src/Hint/Data.hs @@ -0,0 +1,25 @@ +module Hint.Data where + +import Data.Text (Text) +import Data.String +import qualified Data.Text as T + +newtype Identifier = Identifier Text + deriving (Show, Ord, Eq) + +instance IsString Identifier where + fromString = Identifier . T.pack + +data Literal + = Int Int + | Float Double + | Boolean Bool + | String Text + deriving (Show, Eq) + +data Expr + = Literal Literal + | If Expr Expr Expr + | Bind Identifier Expr Expr + | Ident Identifier + deriving (Show, Eq) diff --git a/src/Hint/Eval.hs b/src/Hint/Eval.hs index 48f7b46..36628dc 100644 --- a/src/Hint/Eval.hs +++ b/src/Hint/Eval.hs @@ -2,31 +2,34 @@ module Hint.Eval where import Control.Applicative ((<|>)) import qualified Data.Map as M -import Hint.Parser (Value (..)) +import Data.Maybe (fromJust) +import Hint.Data -type Ident = String -type Env = M.Map Ident Value +type Env = M.Map Identifier Expr data Scope = Scope { env :: [Env] } deriving (Show, Eq) -defaultEnv :: Env -defaultEnv = M.fromList [("pi", VInt 3), ("version", VString "0.1")] - basic :: Scope -basic = Scope (pure defaultEnv) - -next :: Env -next = M.fromList [("ident", VInt 12), ("pi", VInt 4)] +basic = Scope mempty -enter :: Scope -> Env -> Scope -enter (Scope es) e = Scope (e : es) +enter :: Env -> Scope -> Scope +enter e (Scope es) = Scope (e : es) leave :: Scope -> Scope leave (Scope [] ) = error "bad" leave (Scope (_ : es)) = Scope es -scopeLookup :: Ident -> Scope -> Maybe Value +scopeLookup :: Identifier -> Scope -> Maybe Expr scopeLookup _ (Scope []) = Nothing scopeLookup i (Scope (e : es)) = M.lookup i e <|> scopeLookup i (Scope es) + +eval :: Scope -> Expr -> Maybe Expr +eval _ (Literal l) = Literal <$> pure l +eval s (Ident i) = scopeLookup i s +eval scope (Bind name val rest) = + eval (enter (M.fromList [(name, fromJust $ eval scope val)]) scope) rest +eval s (If cond a b) = do + Literal (Boolean c) <- eval s cond + if c then eval s a else eval s b diff --git a/src/Hint/Lexer.hs b/src/Hint/Lexer.hs index 7aad9a4..19d1266 100644 --- a/src/Hint/Lexer.hs +++ b/src/Hint/Lexer.hs @@ -40,6 +40,11 @@ data TokenKind | TEquals | KeywordLet | KeywordIn + | KeywordTrue + | KeywordFalse + | KeywordIf + | KeywordThen + | KeywordElse deriving (Show, Eq) data Span = Span SourcePos SourcePos @@ -129,6 +134,11 @@ lexKeyword :: Lexer TokenKind lexKeyword = asum $ [ KeywordLet <$ string "let" , KeywordIn <$ string "in" + , KeywordTrue <$ string "true" + , KeywordFalse <$ string "false" + , KeywordIf <$ string "if" + , KeywordThen <$ string "then" + , KeywordElse <$ string "else" ] lexIdent :: Lexer TokenKind diff --git a/src/Hint/Parser.hs b/src/Hint/Parser.hs index 28301e5..c5d23a2 100644 --- a/src/Hint/Parser.hs +++ b/src/Hint/Parser.hs @@ -1,7 +1,10 @@ module Hint.Parser where -import Control.Applicative (Alternative (..), many) +import Control.Applicative (Alternative (..)) +import Control.Monad (void) import Data.Either (fromRight) +import qualified Data.Text as T +import Hint.Data import Hint.Lexer (Input, Token (..), TokenKind (..), runProd) @@ -10,17 +13,9 @@ data ParseError | NoParse deriving (Show, Eq) -data Value - = VInt Int - | VString String - | VList Value - deriving (Show, Eq) - -data Expr - = EVar String - | EValue Value - | EBinding String Expr - | EFunc String [String] Expr +data BinOp + = Add + | Mult deriving (Show, Eq) newtype Parser a = Parser @@ -56,6 +51,32 @@ instance Alternative Parser where runParser :: Parser a -> Input -> Either ParseError (a, [Token]) runParser p = unParser p . fromRight [] . runProd +token :: TokenKind -> Parser Token +token t = sat (== t) + +sat :: (TokenKind -> Bool) -> Parser Token +sat p = Parser parse + where + parse [] = Left $ UnexpectedToken [TEof] + parse (t@(Token kind _) : ts) + | p kind = Right (t, ts) + | otherwise = Left $ UnexpectedToken [kind] + +pStr :: Parser Literal +pStr = String . T.pack <$> Parser parseString + where + parseString (Token (TString s) _ : ts) = pure (s, ts) + parseString _ = Left NoParse + +pBool :: Parser Literal +pBool = (Boolean False <$ sat (== KeywordFalse)) <|> (Boolean True <$ sat (== KeywordTrue)) + +pNumeric :: Parser Literal +pNumeric = Int <$> Parser p + where + p (Token (TInt i) _ : ts) = pure (i, ts) + p _ = Left NoParse + parseWord :: String -> Parser Token parseWord name = Parser parse where @@ -64,51 +85,37 @@ parseWord name = Parser parse | name == n = Right (t, ts) parse _ = Left NoParse -parseValue :: Parser Expr -parseValue = EValue <$> Parser parse +parseLiteral :: Parser Expr +parseLiteral = Literal <$> (pStr <|> pBool <|> pNumeric) + +parseIdentifier :: Parser Identifier +parseIdentifier = Parser p where - parse ((Token (TInt n) _) : ts) = pure (VInt n, ts) - parse ((Token (TString s) _) : ts) = pure (VString s, ts) - parse _ = Left $ UnexpectedToken [] + p (Token (TIdent s) _ : ts) = pure (Identifier $ T.pack s, ts) + p _ = Left NoParse parseBinding :: Parser Expr -parseBinding = EBinding - <$> phrase - <*> expr <* sat (== KeywordIn) - where - phrase = sat (== KeywordLet) *> ident <* sat (== TEquals) - ident = Parser $ \((Token (TIdent name) _) : ts) -> pure (name, ts) - -parseFunc :: Parser Expr -parseFunc = EFunc - <$> ident - <*> many ident <* sat (== TEquals) - <*> parseValue - where - parse ((Token (TIdent name) _) : ts) = pure (name, ts) - parse _ = Left NoParse - ident = Parser parse +parseBinding = do + void $ token KeywordLet + name <- parseIdentifier + void $ token TEquals + value <- expr + void $ token KeywordIn + body <- expr + pure $ Bind name value body + +parseIf :: Parser Expr +parseIf = do + void $ token KeywordIf + cond <- expr + void $ token KeywordThen + a <- expr + void $ token KeywordElse + b <- expr + pure $ If cond a b expr :: Parser Expr -expr = parseValue <|> parseBinding - -sat :: (TokenKind -> Bool) -> Parser Token -sat p = Parser parse - where - parse [] = Left $ UnexpectedToken [TEof] - parse (t@(Token kind _) : ts) - | p kind = Right (t, ts) - | otherwise = Left $ UnexpectedToken [kind] - --- parseBind :: Parser Expr --- parseBind = EBinding <$> name <*> result --- where --- name = Parser $ \(t : ts) -> --- case t of --- (Token (TIdent s) _) -> pure (s, ts) --- _ -> Left $ UnexpectedToken $ [TIdent ""] - --- result = Parser $ \(t : ts) -> --- case t of --- (Token (TInt n) _) -> pure (ELit n, ts) --- _ -> Left $ UnexpectedToken $ [TIdent ""] +expr = parseLiteral + <|> parseIf + <|> parseBinding + <|> Ident <$> parseIdentifier -- cgit v1.3.1