aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-09-06 12:10:57 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-09-06 12:10:57 +0100
commit67967f029305c663fb3fbb4e0f1a6e375f5d572c (patch)
treeb4ebdf48e7676a621f72fdc7f0b6c90cbc498639
parent22db8bbbd85028f19eaef5fec70c12f7706771b1 (diff)
downloadmicro-lang-hs-67967f029305c663fb3fbb4e0f1a6e375f5d572c.tar.gz
micro-lang-hs-67967f029305c663fb3fbb4e0f1a6e375f5d572c.zip
Group variable declaration
-rw-r--r--src/Parser.hs59
-rw-r--r--test/Language.hs27
2 files changed, 74 insertions, 12 deletions
diff --git a/src/Parser.hs b/src/Parser.hs
index 2f60b52..2817208 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -63,6 +63,7 @@ type' = do
try typFn
<|> typ <?> "type"
+-- argument
arg :: Parser (String, Type, Bool, SourcePos)
arg = do
pos <- getPosition
@@ -71,6 +72,7 @@ arg = do
t <- type' <?> "type"
return $ (i, t, True, pos)
+-- function definition (common to def and lambda)
fdef :: Ident -> Bool -> Bool -> SourcePos -> Parser Expr
fdef ident priv anon pos = do
args <- parens $ commaSep arg
@@ -81,8 +83,13 @@ fdef ident priv anon pos = do
rtyp <- type' <?> "return type"
return $ rtyp
)
- body <- braces $ many statement
- return $ Func ident args rtyp body priv anon pos
+ body <-
+ braces $
+ many $
+ try (grVar False) <|> do
+ x <- statement
+ pure $ [x]
+ return $ Func ident args rtyp (concat $ body) priv anon pos
function :: Bool -> Parser Expr
function priv = do
@@ -91,20 +98,42 @@ function priv = do
ident <- identifier
fdef ident priv False pos
-var :: Bool -> Parser Expr
-var priv = do
- reserved "var"
+-- ident: type = value
+varWithValue :: Bool -> Parser Expr
+varWithValue priv = do
(ident, typ, _, pos) <- arg
+ -- FIXME: this error hint is not being used
reservedOp "=" <?> "assignation"
value <- expr
- reservedOp ";"
return $ Var ident typ value priv pos
-privateDfn :: Parser Expr
-privateDfn = do
+-- group variable declaration
+grVar :: Bool -> Parser [Expr]
+grVar priv = do
+ reserved "var"
+ xs <- parens $ commaSep $ varWithValue priv
+ reservedOp ";"
+ return $ xs
+
+-- variable declaration
+var :: Bool -> Parser Expr
+var priv = do
+ reserved "var"
+ x <- varWithValue priv
+ reservedOp ";"
+ return $ x
+
+-- private definition
+privateDf :: (Bool -> Parser Expr) -> Parser Expr
+privateDf f = do
+ priv <- optionMaybe $ reserved "private"
+ f (isJust priv)
+
+-- private group definition
+privateDfn :: (Bool -> Parser [Expr]) -> Parser [Expr]
+privateDfn f = do
priv <- optionMaybe $ reserved "private"
- let isPriv = isJust priv
- try (function isPriv) <|> var isPriv
+ f (isJust priv)
lambdaId :: SourcePos -> Ident
lambdaId s =
@@ -162,8 +191,14 @@ module' = do
program :: Parser [Expr]
program = do
m <- module'
- n <- many $ do privateDfn <|> statement
- return $ [m] ++ n
+ n <-
+ many $
+ try (privateDfn grVar) <|> do
+ x <-
+ try (privateDf function) <|> try (privateDf var)
+ <|> statement
+ pure $ [x]
+ return $ [m] ++ (concat $ n)
parse :: Parser [Expr]
parse = program
diff --git a/test/Language.hs b/test/Language.hs
index 84c72ae..5c1bb57 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -204,6 +204,30 @@ testCase14 =
A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 21) True $ newPos "test" 2 13
]
+testCase15 =
+ TestLabel "parse a group variable declaration" $
+ TestCase $
+ assertAst
+ "module main\n\
+ \var (a: u8 = 10,\n\
+ \b: bool = true);"
+ [ A.Module "main" $ newPos "test" 1 1,
+ A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 14) False $ newPos "test" 2 6,
+ A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "test" 3 11) False $ newPos "test" 3 1
+ ]
+
+testCase16 =
+ TestLabel "parse a group of private variable declaration" $
+ TestCase $
+ assertAst
+ "module main\n\
+ \private var (a: u8 = 10,\n\
+ \b: bool = true);"
+ [ A.Module "main" $ newPos "test" 1 1,
+ A.Var "a" (A.Type "u8") (A.Num 10 $ newPos "test" 2 22) True $ newPos "test" 2 14,
+ A.Var "b" (A.Type "bool") (A.Bool' True $ newPos "test" 3 11) True $ newPos "test" 3 1
+ ]
+
-- test errors
testCaseE1 =
@@ -339,6 +363,9 @@ language =
testCase12,
testCase13,
testCase14,
+ testCase15,
+ testCase16,
+ -- errors
testCaseE1,
testCaseE2,
testCaseE3,