From b3f51e5259a6da5e0858c19ff1a786f8ffb380da Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 19 Jul 2024 13:08:44 +0300 Subject: [PATCH] wip --- hbs2-cli/app/Main.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/hbs2-cli/app/Main.hs b/hbs2-cli/app/Main.hs index fcb03978..9f0adf3d 100644 --- a/hbs2-cli/app/Main.hs +++ b/hbs2-cli/app/Main.hs @@ -164,6 +164,7 @@ apply :: forall c m . ( IsContext c -> [Syntax c] -> RunM c m (Syntax c) apply name args' = do + -- notice $ red "APPLY" <+> pretty name what <- ask >>= readTVarIO <&> HM.lookup name . fromDict case bindAction <$> what of Just (BindLambda e) -> mapM runExpr args' >>= e @@ -180,6 +181,23 @@ runExpr syn = handle (handleForm syn) $ case syn of ListVal [ w, SymbolVal ".", b] -> do pure $ mkList [w, b] + ListVal [ SymbolVal "quot", ListVal b] -> do + pure $ mkList b + + ListVal [SymbolVal "lambda", arglist, body] -> do + pure $ mkForm @c "lambda" [ arglist, body ] + + ListVal (ListVal [SymbolVal "lambda", ListVal decl, body] : args) -> do + error "oopsie" + -- d <- ask + -- void $ liftIO do + -- dd <- readTVarIO d + -- undefined + -- runReaderT $ runExpr body + -- error "FUCK!" + -- -- liftIO (run d body) + pure nil + ListVal (SymbolVal name : args') -> do apply name args' @@ -404,6 +422,12 @@ main = do es -> do pure $ mkForm "dict" es + tell $ bindMatch "lambda" $ \case + [a, b] -> do + pure $ mkForm @C "lamba" [ mkSym "_", mkSym "..." ] + + _ -> error "SHIT" + tell $ bindMatch "map" $ \syn -> do case syn of [ListVal (SymbolVal "lambda" : SymbolVal fn : _), ListVal rs] -> do