Skip to content

Instantly share code, notes, and snippets.

@heitor-lassarote
Last active May 31, 2022 16:25
Show Gist options
  • Save heitor-lassarote/fec2bb3feeb30f47be5a685937011917 to your computer and use it in GitHub Desktop.
Save heitor-lassarote/fec2bb3feeb30f47be5a685937011917 to your computer and use it in GitHub Desktop.
Parser.y: Declarations (first part)
{
{-# LANGUAGE DeriveFoldable #-}
module Parser
( parseMiniML
) where
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Maybe (fromJust)
import Data.Monoid (First (..))
import qualified Lexer as L
}
%name parseMiniML dec
%tokentype { L.RangedToken }
%error { parseError }
%monad { L.Alex } { >>= } { pure }
%lexer { lexer } { L.RangedToken L.EOF _ }
%token
-- Identifiers
identifier { L.RangedToken (L.Identifier _) _ }
-- Constants
string { L.RangedToken (L.String _) _ }
integer { L.RangedToken (L.Integer _) _ }
-- Keywords
let { L.RangedToken L.Let _ }
in { L.RangedToken L.In _ }
if { L.RangedToken L.If _ }
then { L.RangedToken L.Then _ }
else { L.RangedToken L.Else _ }
-- Arithmetic operators
'+' { L.RangedToken L.Plus _ }
'-' { L.RangedToken L.Minus _ }
'*' { L.RangedToken L.Times _ }
'/' { L.RangedToken L.Divide _ }
-- Comparison operators
'=' { L.RangedToken L.Eq _ }
'<>' { L.RangedToken L.Neq _ }
'<' { L.RangedToken L.Lt _ }
'<=' { L.RangedToken L.Le _ }
'>' { L.RangedToken L.Gt _ }
'>=' { L.RangedToken L.Ge _ }
-- Logical operators
'&' { L.RangedToken L.And _ }
'|' { L.RangedToken L.Or _ }
-- Parenthesis
'(' { L.RangedToken L.LPar _ }
')' { L.RangedToken L.RPar _ }
-- Lists
'[' { L.RangedToken L.LBrack _ }
']' { L.RangedToken L.RBrack _ }
',' { L.RangedToken L.Comma _ }
-- Types
':' { L.RangedToken L.Colon _ }
'->' { L.RangedToken L.Arrow _ }
%%
name :: { Name L.Range }
: identifier { unTok $1 (\range (L.Identifier name) -> Name range name) }
dec :: { Dec L.Range }
: let name '=' exp { Dec (L.rtRange $1 <-> info $4) $2 [] Nothing $4 }
exp :: { Exp L.Range }
: integer { unTok $1 (\range (L.Integer int) -> EInt range int) }
| name { EVar (info $1) $1 }
| string { unTok $1 (\range (L.String string) -> EString range string) }
{
parseError :: L.RangedToken -> L.Alex a
parseError _ = do
(L.AlexPn _ line column, _, _, _) <- L.alexGetInput
L.alexError $ "Parse error at line " <> show line <> ", column " <> show column
lexer :: (L.RangedToken -> L.Alex a) -> L.Alex a
lexer = (=<< L.alexMonadScan)
-- | Build a simple node by extracting its token type and range.
unTok :: L.RangedToken -> (L.Range -> L.Token -> a) -> a
unTok (L.RangedToken tok range) ctor = ctor range tok
-- | Unsafely extracts the the metainformation field of a node.
info :: Foldable f => f a -> a
info = fromJust . getFirst . foldMap pure
-- | Performs the union of two ranges by creating a new range starting at the
-- start position of the first range, and stopping at the stop position of the
-- second range.
-- Invariant: The LHS range starts before the RHS range.
(<->) :: L.Range -> L.Range -> L.Range
L.Range a1 _ <-> L.Range _ b2 = L.Range a1 b2
-- * AST
data Name a
= Name a ByteString
deriving (Foldable, Show)
data Type a
= TVar a (Name a)
deriving (Foldable, Show)
data Argument a
= Argument a (Name a) (Maybe (Type a))
deriving (Foldable, Show)
data Dec a
= Dec a (Name a) [Argument a] (Maybe (Type a)) (Exp a)
deriving (Foldable, Show)
data Exp a
= EInt a Integer
| EVar a (Name a)
| EString a ByteString
deriving (Foldable, Show)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment