From fe46c706eab9aa61f29811f6e4619abc4374e4dd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 1 Feb 2022 14:29:13 -0500 Subject: [PATCH] Construct nested let-bindings. --- semantic-analysis/src/Analysis/Syntax.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-analysis/src/Analysis/Syntax.hs b/semantic-analysis/src/Analysis/Syntax.hs index da99c23e3..0612d9c44 100644 --- a/semantic-analysis/src/Analysis/Syntax.hs +++ b/semantic-analysis/src/Analysis/Syntax.hs @@ -32,7 +32,7 @@ module Analysis.Syntax import Analysis.Effect.Domain import Analysis.Effect.Env (Env, bind) import Analysis.Effect.Store -import Analysis.Name (Name, formatName) +import Analysis.Name (Name, formatName, nameI) import Control.Applicative (Alternative(..), liftA3) import Control.Effect.Labelled import Control.Monad (guard) @@ -161,7 +161,7 @@ parseNode o = do "false" -> pure (const (bool False)) "throw" -> fmap throw <$> resolve (head edges) "if" -> liftA3 iff <$> findEdge (edgeNamed "condition") <*> findEdge (edgeNamed "consequence") <*> findEdge (edgeNamed "alternative") <|> pure (const noop) - "block" -> pure (const (bool True)) + "block" -> fmap (foldl' (\ l (i, r) -> let_ (nameI i) l (const r)) noop . zip [0..]) . sequenceA <$> traverse resolve edges t -> A.parseFail ("unrecognized type: " <> t) edge :: (IntMap.Key -> A.Object -> A.Parser a) -> A.Value -> A.Parser a edge f = A.withObject "edge" (\ edge -> do