From e307654521870df1c9cd753825952fcdc9262647 Mon Sep 17 00:00:00 2001 From: Veit Heller Date: Fri, 17 Sep 2021 05:57:50 +0200 Subject: [PATCH] feat: add expand-compiled (#1310) --- src/Eval.hs | 12 ++++++++++++ src/StartingEnv.hs | 1 + 2 files changed, 13 insertions(+) diff --git a/src/Eval.hs b/src/Eval.hs index fe52a650..123ff519 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -986,6 +986,18 @@ commandC ctx xobj = do liftIO (putStr c) pure (newCtx, dynamicNil) +-- | This function will return the compiled AST. +commandExpandCompiled :: UnaryCommandCallback +commandExpandCompiled ctx xobj = do + (newCtx, result) <- expandAll (evalDynamic ResolveLocal) ctx xobj + case result of + Left err -> pure (newCtx, Left err) + Right expanded -> do + (_, annotated) <- annotateWithinContext newCtx expanded + case annotated of + Left err -> pure $ evalError newCtx (show err) (xobjInfo xobj) + Right (annXObj, _) -> pure (newCtx, Right annXObj) + -- | Helper function for commandC printC :: XObj -> String printC xobj = diff --git a/src/StartingEnv.hs b/src/StartingEnv.hs index bb531c4e..aa7896ad 100644 --- a/src/StartingEnv.hs +++ b/src/StartingEnv.hs @@ -256,6 +256,7 @@ dynamicModule = f "not" commandNot "negates its boolean argument." "(not false) ; => true", f "c" commandC "prints the C code emitted for a binding." "(c '(+ 2 3)) ; => int _3 = Int__PLUS_(2, 3);", f "expand" commandExpand "expands a macro and prints the result." "(expand '(when true 1)) ; => (if true 1 ())", + f "expand-compiled" commandExpandCompiled "expands and desugars the code." "(expand-compiled '(+ 2 3)) ; => (Int.+ 2 3)", f "system-include" commandAddSystemInclude "adds a system include, i.e. a C `#include` with angle brackets (`<>`)." "(system-include \"stdint.h\")", f "relative-include" commandAddRelativeInclude "adds a relative include, i.e. a C `include` with quotes. It also prepends the current directory." "(relative-include \"myheader.h\")", f "read-file" commandReadFile "reads a file into a string." "(read-file \"myfile.txt\")",