Browse Source

If expressions

main
Gil Mizrahi 6 months ago
parent
commit
441c245ae8
11 changed files with 87 additions and 9 deletions
  1. +3
    -5
      examples/factorial.giml
  2. +12
    -0
      src/compiler/src/Language/Giml/Compiler/Translate.hs
  3. +19
    -0
      src/compiler/test/Tests/CompileSpec.hs
  4. +8
    -0
      src/frontend/src/Language/Giml/Builtins.hs
  5. +2
    -0
      src/frontend/src/Language/Giml/Rewrites/PreInfer/GroupDefsByDeps.hs
  6. +2
    -0
      src/frontend/src/Language/Giml/Syntax/Ast.hs
  7. +10
    -2
      src/frontend/src/Language/Giml/Syntax/Parser.hs
  8. +11
    -0
      src/frontend/src/Language/Giml/Types/Infer.hs
  9. +18
    -0
      src/frontend/test/Tests/NegativeSpec.hs
  10. +1
    -1
      todo.org
  11. +1
    -1
      wishlist.org

+ 3
- 5
examples/factorial.giml View File

@@ -1,8 +1,6 @@
fac n =
case n of
| 0 -> 1
| 1 -> 1
| _ -> mul n (fac (sub n 1))
end
if int_lesser 1 n
then mul n (fac (sub n 1))
else 1

main = ffi("console.log", fac 5)

+ 12
- 0
src/compiler/src/Language/Giml/Compiler/Translate.hs View File

@@ -159,6 +159,18 @@ translateExpr = \case
]
pure $ JS.EFunCall fun [expr']

EIf cond trueBranch falseBranch -> do
cond' <- translateExpr cond
trueBranch' <- translateExpr trueBranch
falseBranch' <- translateExpr falseBranch
pure $ JS.EFunCall
( JS.EFun []
[ JS.SIf cond' [ JS.SRet trueBranch' ]
, JS.SIf (JS.ELit $ JS.LBool True) [ JS.SRet falseBranch' ]
]
)
[]

ECase expr patterns -> do
expr' <- translateExpr expr
var <- genVar "case"


+ 19
- 0
src/compiler/test/Tests/CompileSpec.hs View File

@@ -20,10 +20,29 @@ main = do
spec :: Spec
spec = parallel $ do
describe "compilation" $ do
simple
programs
io
ffi

simple :: Spec
simple = do
describe "Simple" $ do
it "if" $
check $ Check
{ program = [r|
main =
ffi( "console.log" : String -> IO {}
, if False
then "Yes"
else if False
then "Maybe"
else "No"
)
|]
, expected = [r|No|]
}

programs :: Spec
programs = do
describe "programs" $ do


+ 8
- 0
src/frontend/src/Language/Giml/Builtins.hs View File

@@ -139,6 +139,14 @@ ints = M.fromList

, binop "int_equals" (typeFun [tInt, tInt] tBool)
"==="
, binop "int_lesser" (typeFun [tInt, tInt] tBool)
"<"
, binop "int_lesser_eq" (typeFun [tInt, tInt] tBool)
"<="
, binop "int_greater" (typeFun [tInt, tInt] tBool)
">"
, binop "int_greater_eq" (typeFun [tInt, tInt] tBool)
">="
]
where
binInt = typeFun [tInt, tInt] tInt


+ 2
- 0
src/frontend/src/Language/Giml/Rewrites/PreInfer/GroupDefsByDeps.hs View File

@@ -89,6 +89,8 @@ freeVarsExpr = \case
fmap S.unions . (:)
<$> freeVarsExpr e
<*> traverse freeVarsPat pats
EIf e1 e2 e3 ->
S.unions <$> traverse freeVarsExpr [e1, e2, e3]
EFfi _ _ exprs ->
S.unions <$> traverse freeVarsExpr exprs



+ 2
- 0
src/frontend/src/Language/Giml/Syntax/Ast.hs View File

@@ -83,6 +83,8 @@ data Expr a
| ERecordAccess (Expr a) Label
-- | Extends a record
| ERecordExtension (Record (Expr a)) (Expr a)
-- | A 2-way if expression
| EIf (Expr a) (Expr a) (Expr a)
-- | A case expression (pattern matching)
| ECase (Expr a) [(Pattern, Expr a)]
-- | A foreign function interface call


+ 10
- 2
src/frontend/src/Language/Giml/Syntax/Parser.hs View File

@@ -176,6 +176,9 @@ reservedWords =
, "case"
, "of"
, "ffi"
, "if"
, "then"
, "else"
]


@@ -369,6 +372,11 @@ parseExpr'' =
, ELet
<$> (rword "let" *> newlines *> parseTermDef <* newlines <?> "a definition")
<*> (rword "in" *> newlines *> parseExpr)
, EIf
<$> (rword "if" *> newlines *> lexeme parseExpr <* newlines)
<*> (rword "then" *> newlines *> lexeme parseExpr <* newlines)
<*> (rword "else" *> newlines *> parseExpr)
<?> "an if expression"
, EVariant
<$> typename
<?> "a variant"
@@ -412,9 +420,9 @@ parseFfi = do
parens $ do
fun <- lexeme stringLiteral
typ <- P.optional (colon *> lexeme parseType)
comma
comma *> newlines
EFfi fun typ
<$> P.sepBy (lexeme parseExpr <* newlines) comma
<$> P.sepBy (lexeme parseExpr <* newlines) (comma *> newlines)

parseLambda :: Parser (Expr Ann)
parseLambda = do


+ 11
- 0
src/frontend/src/Language/Giml/Types/Infer.hs View File

@@ -591,6 +591,17 @@ elaborateExpr ann = \case
pure $ EAnnotated (Ann ann t) $
EVariant constr

-- For if expressions, the condition should be of type Bool,
-- and the two branches should match.
EIf cond trueBranch falseBranch -> do
cond' <- elaborateExpr ann cond
trueBranch' <- elaborateExpr ann trueBranch
falseBranch' <- elaborateExpr ann falseBranch
constrain ann $ Equality tBool (getType cond')
constrain ann $ Equality (getType trueBranch') (getType falseBranch')
pure $ EAnnotated (Ann ann (getType trueBranch')) $
EIf cond' trueBranch' falseBranch'

ECase expr patterns -> do
expr' <- elaborateExpr ann expr
patT <- TypeVar <$> genTypeVar "t"


+ 18
- 0
src/frontend/test/Tests/NegativeSpec.hs View File

@@ -114,6 +114,24 @@ illTyped = do
_ -> False
)

it "if cond not bool" $
shouldSatisfy
(testinfer [r|x = if 1 then 1 else 0|])
( \case
Left (TypeError (_, TypeMismatch t1 t2))
| t1 == tBool, t2 == tInt -> True
_ -> False
)

it "if arms mismatch" $
shouldSatisfy
(testinfer [r|x = if True then 1 else "0"|])
( \case
Left (TypeError (_, TypeMismatch t1 t2))
| t1 == tInt, t2 == tString -> True
_ -> False
)

it "pattern mismatch" $
shouldSatisfy
(testinfer [r|


+ 1
- 1
todo.org View File

@@ -42,7 +42,7 @@ modifyIORef : IORef a -> (a -> a) -> IO {}
#+END_SRC

~IORef~ is an opaque mutable box. We can manipulate it in IO code.
** TODO If expressions
** DONE If expressions
** TODO Prettyprinting
We want to be able to print types, source positions and constraints so we can have
better error messages and easier debugging experience.


+ 1
- 1
wishlist.org View File

@@ -43,7 +43,7 @@ case False of
| True -> False
#+END_SRC
** DONE IORef
** If expressions
** DONE If expressions
** Record Reduction
Remove fields from a record



Loading…
Cancel
Save