Browse Source

add if expressions (and work around a bug in amc)

master
Amélia Liao 4 years ago
parent
commit
84b9d6c6fe
4 changed files with 20 additions and 5 deletions
  1. +3
    -0
      compile.ml
  2. +5
    -3
      lib/parsers.ml
  3. +7
    -1
      parser.ml
  4. +5
    -1
      tc.ml

+ 3
- 0
compile.ml View File

@ -98,6 +98,7 @@ let rec lambda_lift strict = function
(v,) <$> lambda_lift false e
let! e = lambda_lift true e
pure (Let (vs, e))
| If _ -> error "if expression in lambda-lifting"
let rec eta_contract = function
| Decl (n, a, e) as dec ->
@ -172,6 +173,8 @@ let rec compile_lazy (env : M.t string slot) = function
f # x # (Mkap ::)
| Lam _ ->
error "Can not compile lambda expression, did you forget to lift?"
| If _ ->
error "Can not compile if expression, did you forget to TC?"
| Case _ ->
error "Case expression in lazy context"
| Lit i -> (Push (Int i) ::)


+ 5
- 3
lib/parsers.ml View File

@ -224,11 +224,13 @@ and sep_end_by sep p =
let chainr1 p op =
let rec scan =
let! x = p
rest x
lazy (
let! x = p
rest x
)
and rest x =
( let! f = op
let! y = scan
let! y = force scan
pure (f x y)
) <|> pure x
let _ = rest (* shut up, amc *)


+ 7
- 1
parser.ml View File

@ -47,7 +47,13 @@ and expr : forall 'm. monad 'm => parser_t 'm expr =
let! _ = keyword "in"
let! b = expr
pure (Let (bs, b))
try lam <|> try case <|> try hslet <+> fexp
let hsif =
let! _ = keyword "if"
let! c = fexp <* keyword "then"
let! t = expr <* keyword "else"
let! e = expr
pure (If (c, t, e))
try lam <|> try case <|> try hslet <|> try hsif <+> fexp
let rec ty_atom : forall 'm. monad 'm => parser_t 'm hstype =
map Tyvar (try varid)


+ 5
- 1
tc.ml View File

@ -329,6 +329,11 @@ and check dt_info level scope wanted = function
(con, args, check dt_info level scope' wanted expr)
Case (scrutinee, zip_with go_arm data patterns)
| If (cond, e_then, e_else) ->
let cond = check dt_info level scope (T_con "Bool") cond
let e_t = check dt_info level scope wanted e_then
let e_e = check dt_info level scope wanted e_else
Case (cond, [ ("True", [], e_t), ("False", [], e_e) ])
| x ->
let (x, t) = infer dt_info level scope x
is_subtype t wanted
@ -383,7 +388,6 @@ let dependency_graph defs =
|> M.insert name S.empty
|> (, define name x defs)
let (graph, defs) = foldl go (M.empty, M.empty) defs
G.dot_of_graph graph |> put_line
(G.groups_of_sccs graph, defs)
let mk_lam args body = foldr (curry Lam) body args


Loading…
Cancel
Save