Permalink
Browse files

r28766@phanatique: nelhage | 2007-12-21 11:26:43 -0800

 Desguar let to lambda
 


git-svn-id: svn+ssh://lunatique.mit.edu/data/svn/flnv/trunk@34 e7f7c2cb-1e20-0410-8c26-a6ba679ee1f5
  • Loading branch information...
1 parent 3198820 commit 492333dc3cdc4cc0a3efd04af4089cf472f0f99b nelhage committed Jul 25, 2008
Showing with 15 additions and 2 deletions.
  1. +15 −2 FLNV/AST.hs
View
@@ -31,7 +31,7 @@ specialForms = [ ("quote", desugarQuoted)
, ("lambda", desugarLambda)
, ("if", desugarIf)
, ("begin", desugarSequence)
- -- , ("let", desugarLet)
+ , ("let", desugarLet)
]
runDesugar :: Desugar x -> Either Error x
@@ -64,7 +64,20 @@ desugarLambda (Cons args body@(Cons fst rest)) =
return $ Lambda argl bexp
desugarLambda form = throwError $ SyntaxError "Malformed Lambda" form
--- desugarLet :: Expression -> Desugar AST
+desugarLet :: Expression -> Desugar AST
+desugarLet (Cons bindings body@(Cons fst rest)) =
+ do (vars, vals) <- letBindings bindings
+ lambda <- desugarLambda (Cons (foldr Cons Nil vars) body)
+ liftM (Apply lambda) $ mapM desugar vals
+desugarLet err = throwError $ SyntaxError "Malformed Let" err
+
+
+letBindings :: Expression -> Desugar ([Expression],[Expression])
+letBindings Nil = return $ ([],[])
+letBindings (Cons (Cons var (Cons val Nil)) rest) =
+ do (vars,vals) <- letBindings rest
+ return $ (var:vars,val:vals)
+letBindings err = throwError $ SyntaxError "Malformed let bindings" err
desugarIf :: Expression -> Desugar AST
desugarIf (Cons predicate (Cons cons tail)) =

0 comments on commit 492333d

Please sign in to comment.