Browse Source

complete conversion to simpler subset ast

master
depsterr 6 months ago
parent
commit
15d4682a16
  1. 3
      app/Main.hs
  2. 10
      readme.txt
  3. 2
      sexprml.cabal
  4. 92
      src/Simple/AST.hs
  5. 91
      src/Simple/Convert.hs
  6. 2
      src/Simple/TC.hs

3
app/Main.hs

@ -5,6 +5,7 @@ module Main where
import Parser.SanityCheck (sanityCheck)
import Parser.Parser (parse)
import Lexer.Lexer (runAlex')
import Simple.Convert
import System.Environment
import System.Exit
@ -12,6 +13,6 @@ import System.Exit
main :: IO ()
main = getArgs >>= \case
[] -> exitSuccess
(f:_) -> readFile f >>= \t -> case runAlex' parse f t >>= sanityCheck f t of
(f:_) -> readFile f >>= \t -> case runAlex' parse f t >>= sanityCheck f t >>= convert f t of
(Left s) -> putStrLn s
(Right r) -> print r

10
readme.txt

@ -20,8 +20,8 @@
-- Much like in haskell one can pattern match in the following manner.
[𝔹 → 𝔹]
(def (not 𝕋) 𝔽)
(def (not 𝔽) 𝕋)
(def (((not 𝕋) 𝔽)
((not 𝔽) 𝕋)))
-- In general one can make multiple definitions in this manner, however, any explicit type
-- signature will only apply to the first definition. Of course all patterns for a function
@ -35,9 +35,8 @@
-- Pattern matching on N arguments desugars into matching on a case tree.
[∀ A B : 𝕄 A → 𝕄 B → 𝔹]
(def (allJust (𝑱 _) (𝑱 _)) 𝕋)
(def (allJust _ _) 𝔽)
(def (((allJust (𝑱 _) (𝑱 _)) 𝕋)
((allJust _ _) 𝔽)))
-- Function definition desugars to binding to a lambda
@ -153,6 +152,7 @@
-- (λ b d (f a b c d e))
-- let ... in
[idk]
(def (q x)
(let (x₂ (+ 1 1))
(x₁ (+ 1 2))

2
sexprml.cabal

@ -27,6 +27,8 @@ library
, Error
, Types
, Misc
, Simple.AST
, Simple.Convert
build-tool-depends: alex:alex >= 3.0, happy:happy >= 1.19.5
build-depends: base ^>=4.14.1.0
, array

92
src/Simple/AST.hs

@ -1,8 +1,94 @@
{-|
Module: Simple.AST
Description: Conversion from parse tree to simple tree
Description: Defines a AST for a simple subset of the language
Defines an AST for a simple subset of the language and a way to convert
the parse tree to said AST
Defines a AST for a simple subset of the language
-}
module Simple.AST where
import Types
data Type
= FuncType PN Type Type
| ChrType PN
| StrType PN
| IntType PN
| UsrType PN Identifier
deriving Show
instance Positioned Type where
pos (FuncType p _ _) = p
pos (ChrType p) = p
pos (StrType p) = p
pos (IntType p) = p
pos (UsrType p _ ) = p
data TopLevel
= Def PN Type [(Identifier, [Pattern], Expr)] -- ^ Variable and function definition
| Dat PN Identifier [(Type, Identifier)] -- ^ Data definition
| Rec PN Identifier [(Type, Identifier)] -- ^ Record definition
deriving Show
instance Positioned TopLevel where
pos (Def p _ _) = p
pos (Dat p _ _) = p
pos (Rec p _ _) = p
data Pattern
= Wild PN
| PVar PN Identifier
| PLit Literal
| PApp PN Identifier [Pattern]
deriving Show
instance Positioned Pattern where
pos (Wild p) = p
pos (PVar p _) = p
pos (PLit l) = pos l
pos (PApp p _ _) = p
data Literal
= LInt PN Integer
| LChr PN Char
| LStr PN String
deriving Show
instance Positioned Literal where
pos (LInt p _) = p
pos (LChr p _) = p
pos (LStr p _) = p
data Term
= TLit Literal
| TLambda PN [Identifier] Expr
| TLambdaCase PN [(Pattern, Expr)]
| TVar PN Identifier
deriving Show
instance Positioned Term where
pos (TLambdaCase p _) = p
pos (TLambda p _ _) = p
pos (TLit l) = pos l
pos (TVar p _) = p
data Expr
= ExpExpr Type Expr1
| ImpExpr Expr1
deriving Show
instance Positioned Expr where
pos (ExpExpr _ e) = pos e
pos (ImpExpr e) = pos e
data Expr1
= Apply PN Expr [Expr]
| Case PN Expr [(Pattern, Expr)]
| Let PN [(Identifier, Expr)] Expr
| Term Term
deriving Show
instance Positioned Expr1 where
pos (Apply p _ _) = p
pos (Case p _ _) = p
pos (Let p _ _) = p
pos (Term t) = pos t

91
src/Simple/Convert.hs

@ -0,0 +1,91 @@
{-|
Module: Simple.Convert
Description: Defines a conversion from the parsed language to a subset
Defines a conversion from the parsed language to a simpler subset of the language
which is used by the Simple modules.
-}
{-# LANGUAGE TupleSections #-}
module Simple.Convert where
import Types
import Error
import Misc
import qualified Parser.Types as P
import qualified Simple.AST as S
convert :: FilePath -> String -> [P.TL] -> Either String [S.TopLevel]
convert fp tx = traverse convertTL
where
-- | create an error message at a provided position
lerror :: PN -> String -> Either String a
lerror p = Left . errorMessage p fp tx
convertTL :: P.TL -> Either String S.TopLevel
convertTL (P.ExDef p t ipes) = S.Def p <$> convertTYSG t <*> convertIPE <~> ipes
convertTL (P.DtDef p i (_:_) _) = lerror p ("Type arguments in definition of type '" <> unId i <> "'")
convertTL (P.DtDef p i [] tis) = S.Dat p i <$> convertTI <~> tis
convertTL (P.RcDef p i (_:_) _) = lerror p ("Type arguments in definition of record '" <> unId i <> "'")
convertTL (P.RcDef p i [] tis) = S.Rec p i <$> convertTI <~> tis
convertPattern :: P.Pattern -> S.Pattern
convertPattern (P.PWild p) = S.Wild p
convertPattern (P.PVar p i) = S.PVar p i
convertPattern (P.PLit l) = S.PLit (convertLiteral l)
convertPattern (P.PApp p i ps) = S.PApp p i (convertPattern <$> ps)
convertTYSG :: P.TYSG -> Either String S.Type
convertTYSG (P.TyAll p _ _) = lerror p "Quanitification in type signature"
convertTYSG (P.TySG1 t) = convertTYSG1 t
convertTYSG1 :: P.TYSG1 -> Either String S.Type
convertTYSG1 (P.TyVar p i) = pure (S.UsrType p i)
convertTYSG1 (P.TyImp p _) = lerror p "Implicit type argument"
convertTYSG1 (P.TyArr p a b) = S.FuncType p <$> convertTYSG1 a <*> convertTYSG1 b
convertTYSG1 (P.TyApp p _ _) = lerror p "Application in type signature"
convertTYSG1 (P.TyType p) = lerror p "Type type"
convertTYSG1 (P.TyChar p) = pure (S.ChrType p)
convertTYSG1 (P.TyString p) = pure (S.StrType p)
convertTYSG1 (P.TyInt p) = pure (S.IntType p)
convertTYSG1 (P.TyNpl p _ _) = lerror p "Npl"
convertLiteral :: P.Literal -> S.Literal
convertLiteral (P.LInt p i) = S.LInt p i
convertLiteral (P.LChar p c) = S.LChr p c
convertLiteral (P.LString p s) = S.LStr p s
convertTerm :: P.Term -> Either String S.Term
convertTerm (P.TLit l) = pure (S.TLit (convertLiteral l))
convertTerm (P.TLambda p is e) = S.TLambda p is <$> convertExpr e
convertTerm (P.TLambdaCase p pes) = S.TLambdaCase p <$> convertPE <~> pes
convertTerm (P.TVar p i) = pure (S.TVar p i)
convertTerm (P.TNpl p _ _) = lerror p "Npl"
convertExpr :: P.Expr -> Either String S.Expr
convertExpr (P.TExp t e) = S.ExpExpr <$> convertTYSG t <*> convertExpr1 e
convertExpr (P.EExp e) = S.ImpExpr <$> convertExpr1 e
convertExpr1 :: P.Expr1 -> Either String S.Expr1
convertExpr1 (P.Apply p e as) = S.Apply p <$> convertExpr e <*> convertArg <~> as
convertExpr1 (P.ECase p e pes) = S.Case p <$> convertExpr e <*> convertPE <~> pes
convertExpr1 (P.ELet p ies e) = S.Let p <$> convertIE <~> ies <*> convertExpr e
convertExpr1 (P.Inst p _) = lerror p "Instance"
convertExpr1 (P.Term t) = S.Term <$> convertTerm t
convertIE :: (Identifier, P.Expr) -> Either String (Identifier, S.Expr)
convertIE (i,e) = (i,) <$> convertExpr e
convertPE :: (P.Pattern, P.Expr) -> Either String (S.Pattern, S.Expr)
convertPE (p,e) = (convertPattern p,) <$> convertExpr e
convertArg :: P.Arg -> Either String S.Expr
convertArg (P.Imp a) = lerror (pos a) "Implicit argument"
convertArg (P.Exp (P.Wild p)) = lerror p "Wildcard argument"
convertArg (P.Exp (P.EArg e)) = convertExpr e
convertTI :: (P.TYSG1, Identifier) -> Either String (S.Type, Identifier)
convertTI (t,i) = (,i) <$> convertTYSG1 t
convertIPE :: (Identifier, [P.Pattern], P.Expr) -> Either String (Identifier, [S.Pattern], S.Expr)
convertIPE (i,ps,e) = (i, convertPattern <$> ps,) <$> convertExpr e

2
src/Simple/TC.hs

@ -14,7 +14,7 @@ import qualified Data.Map as M
data TypeError
= Urk
| TypeMisMatch
| TypeMisMatch PN Got Expected
| UnboundVar PN Identifier
data Env = Map Identifier TypeSignature

Loading…
Cancel
Save