From a4b62aea5b4b2046dcacc380297d2e746a8755c6 Mon Sep 17 00:00:00 2001 From: Joshua Grosso Date: Tue, 6 Nov 2018 20:26:24 -0800 Subject: [PATCH] Eval files and macros in the context of the current project, rather than in a separate ad-hoc directory This allows us to more easily implement module system support, since we don't have to worry about bringing everything into scope in our ad-hoc environment. --- .gitignore | 3 +- axel.cabal | 4 +- package.yaml | 2 +- .../MacroDefinitionAndEnvironmentHeader.hs | 2 +- resources/macros/Scaffold.hs | 4 +- src/Axel/Eff/Resource.hs | 9 +- src/Axel/Haskell/File.hs | 23 ++-- src/Axel/Macros.hs | 46 +++----- src/Axel/Parse/AST.axel | 109 ------------------ 9 files changed, 35 insertions(+), 167 deletions(-) delete mode 100644 src/Axel/Parse/AST.axel diff --git a/.gitignore b/.gitignore index 7f248d8..8eb9c03 100644 --- a/.gitignore +++ b/.gitignore @@ -27,8 +27,9 @@ axelTemp resources/autogenerated/* resources/new-project-template/**/*.hs AUTOGENERATED* +AutogeneratedAxel*.hs flycheck_*.hs ctags -TAGS \ No newline at end of file +TAGS diff --git a/axel.cabal b/axel.cabal index 4888c44..52a92ea 100644 --- a/axel.cabal +++ b/axel.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 01937382699276a02f31dac43a069626cd750821b38768ce5e6092998a14e176 +-- hash: a43890f8651c0db1bdd3ed7a038c1ed4123378c8941a4002427d31a46f0dbb1c name: axel -version: 0.0.8 +version: 0.0.9 synopsis: The Axel programming language. description: Haskell's semantics, plus Lisp's macros. Meet Axel – a purely functional, extensible, and powerful programming language. category: Language, Lisp, Macros, Transpiler diff --git a/package.yaml b/package.yaml index 76d0b4c..97a1512 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: axel -version: '0.0.8' +version: '0.0.9' category: Language, Lisp, Macros, Transpiler author: Joshua Grosso maintainer: jgrosso256@gmail.com diff --git a/resources/macros/MacroDefinitionAndEnvironmentHeader.hs b/resources/macros/MacroDefinitionAndEnvironmentHeader.hs index b829317..77f21a4 100644 --- a/resources/macros/MacroDefinitionAndEnvironmentHeader.hs +++ b/resources/macros/MacroDefinitionAndEnvironmentHeader.hs @@ -1 +1 @@ -module MacroDefinitionAndEnvironment where +module AutogeneratedAxelMacroDefinitionAndEnvironment where diff --git a/resources/macros/Scaffold.hs b/resources/macros/Scaffold.hs index d2b0f9a..1a10b91 100644 --- a/resources/macros/Scaffold.hs +++ b/resources/macros/Scaffold.hs @@ -1,10 +1,10 @@ module Scaffold where import Axel.Parse.AST -import qualified MacroDefinitionAndEnvironment as MacroDefinitionAndEnvironment +import qualified AutogeneratedAxelMacroDefinitionAndEnvironment main :: IO () main = do result <- - MacroDefinitionAndEnvironment.%%%MACRO_NAME%%% %%%ARGUMENTS%%% + AutogeneratedAxelMacroDefinitionAndEnvironment.%%%MACRO_NAME%%% %%%ARGUMENTS%%% putStrLn $ unlines $ map toAxel result diff --git a/src/Axel/Eff/Resource.hs b/src/Axel/Eff/Resource.hs index 792a937..fa3e324 100644 --- a/src/Axel/Eff/Resource.hs +++ b/src/Axel/Eff/Resource.hs @@ -10,14 +10,7 @@ module Axel.Eff.Resource where import Axel.Eff.FileSystem as FS (FileSystem, readFile) import Control.Monad ((>=>)) -import Control.Monad.Freer - ( type (~>) - , Eff - , LastMember - , Member - , Members - , interpretM - ) +import Control.Monad.Freer (type (~>), Eff, LastMember, Members, interpretM) import Control.Monad.Freer.TH (makeEffect) import Paths_axel (getDataFileName) diff --git a/src/Axel/Haskell/File.hs b/src/Axel/Haskell/File.hs index 7e30a34..7d65494 100644 --- a/src/Axel/Haskell/File.hs +++ b/src/Axel/Haskell/File.hs @@ -14,11 +14,7 @@ import Axel.AST (ToHaskell(toHaskell)) import Axel.Eff.Console (putStrLn) import qualified Axel.Eff.Console as Effs (Console) import qualified Axel.Eff.FileSystem as Effs (FileSystem) -import qualified Axel.Eff.FileSystem as FS - ( readFile - , withTemporaryDirectory - , writeFile - ) +import qualified Axel.Eff.FileSystem as FS (readFile, removeFile, writeFile) import Axel.Eff.Process (StreamSpecification(InheritStreams)) import qualified Axel.Eff.Process as Effs (Process) import Axel.Eff.Resource (readResource) @@ -32,7 +28,6 @@ import Axel.Normalize (normalizeStatement) import Axel.Parse (Expression(Symbol), parseSource) import Axel.Utils.Recursion (Recursive(bottomUpFmap)) -import Control.Lens.Operators ((.~)) import Control.Monad (void) import Control.Monad.Freer (Eff, Members) import qualified Control.Monad.Freer.Error as Effs (Error) @@ -41,8 +36,7 @@ import Data.Maybe (fromMaybe) import Data.Semigroup ((<>)) import qualified Data.Text as T (isSuffixOf, pack) -import System.FilePath ((), stripExtension, takeFileName) -import System.FilePath.Lens (directory) +import System.FilePath (stripExtension, takeFileName) convertList :: Expression -> Expression convertList = @@ -101,10 +95,9 @@ evalFile :: -> Eff effs () evalFile path = do putStrLn ("Building " <> takeFileName path <> "...") - FS.withTemporaryDirectory $ \tempDirectoryPath -> do - let astDefinitionPath = tempDirectoryPath "Axel.hs" - readResource Res.astDefinition >>= FS.writeFile astDefinitionPath - let newPath = directory .~ tempDirectoryPath $ axelPathToHaskellPath path - transpileFile path newPath - putStrLn ("Running " <> takeFileName path <> "...") - void $ interpretFile @'InheritStreams newPath + let astDefinitionPath = "AutogeneratedAxelAST.hs" + readResource Res.astDefinition >>= FS.writeFile astDefinitionPath + let newPath = axelPathToHaskellPath path + putStrLn ("Running " <> takeFileName path <> "...") + void $ interpretFile @'InheritStreams newPath + FS.removeFile astDefinitionPath diff --git a/src/Axel/Macros.hs b/src/Axel/Macros.hs index c62161a..163ad64 100644 --- a/src/Axel/Macros.hs +++ b/src/Axel/Macros.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} @@ -22,12 +21,7 @@ import Axel.AST ) import Axel.Denormalize (denormalizeStatement) import qualified Axel.Eff.FileSystem as Effs (FileSystem) -import qualified Axel.Eff.FileSystem as FS - ( createDirectoryIfMissing - , withCurrentDirectory - , withTemporaryDirectory - , writeFile - ) +import qualified Axel.Eff.FileSystem as FS (removeFile, writeFile) import Axel.Eff.Process (StreamSpecification(CreateStreams)) import qualified Axel.Eff.Process as Effs (Process) import Axel.Eff.Resource (readResource) @@ -76,7 +70,6 @@ import Data.Semigroup ((<>)) import qualified Data.Text as T (isSuffixOf, pack, replace, singleton, unpack) import System.Exit (ExitCode(ExitFailure)) -import System.FilePath (()) hygenisizeMacroName :: String -> String hygenisizeMacroName oldName = @@ -262,23 +255,20 @@ evalMacro :: -> String -> String -> Eff effs String -evalMacro astDefinition scaffold macroDefinitionAndEnvironment = - FS.withTemporaryDirectory $ \directoryName -> - FS.withCurrentDirectory directoryName $ do - let astDirectoryPath = "Axel" "Parse" - let macroDefinitionAndEnvironmentFileName = - "MacroDefinitionAndEnvironment.hs" - let scaffoldFileName = "Scaffold.hs" - FS.createDirectoryIfMissing True astDirectoryPath - FS.writeFile (astDirectoryPath "AST.hs") astDefinition - FS.writeFile - macroDefinitionAndEnvironmentFileName - macroDefinitionAndEnvironment - FS.writeFile scaffoldFileName scaffold - interpretFile @'CreateStreams scaffoldFileName "" >>= \case - (ExitFailure _, _, stderr) -> - throwError $ - MacroError - ("Temporary directory: " <> directoryName <> "\n\n" <> "Error:\n" <> - stderr) - (_, stdout, _) -> pure stdout +evalMacro astDefinition scaffold macroDefinitionAndEnvironment = do + let macroDefinitionAndEnvironmentFileName = + "AutogeneratedAxelMacroDefinitionAndEnvironment.hs" + let scaffoldFileName = "AutogeneratedAxelScaffold.hs" + let astDefinitionFileName = "AutogeneratedAxelASTDefinition.hs" + FS.writeFile astDefinitionFileName astDefinition + FS.writeFile + macroDefinitionAndEnvironmentFileName + macroDefinitionAndEnvironment + FS.writeFile scaffoldFileName scaffold + interpretFile @'CreateStreams scaffoldFileName "" >>= \case + (ExitFailure _, _, stderr) -> throwError $ MacroError ("Error:\n" <> stderr) + (_, stdout, _) -> do + FS.removeFile astDefinitionFileName + FS.removeFile macroDefinitionAndEnvironmentFileName + FS.removeFile scaffoldFileName + pure stdout diff --git a/src/Axel/Parse/AST.axel b/src/Axel/Parse/AST.axel deleted file mode 100644 index 2bc8da4..0000000 --- a/src/Axel/Parse/AST.axel +++ /dev/null @@ -1,109 +0,0 @@ -(pragma "LANGUAGE FlexibleInstances") -(pragma "LANGUAGE InstanceSigs") - --- NOTE Because this file will be used as the header of auto-generated macro programs, --- it can't have any project-specific dependencies (such as `Fix`). -(module Axel.Parse.AST) - -(import Data.IORef (IORef modifyIORef newIORef readIORef)) -(import Data.Semigroup (<>)) - -(import System.IO.Unsafe (unsafePerformIO)) - --- PRELUDE_BEGIN -(macro quasiquote ([(AST.SExpression xs)]) - (let ((quasiquoteElem (\ (x) (case x - ((AST.SExpression ['unquote x]) - (AST.SExpression ['list x])) - ((AST.SExpression ['unquoteSplicing x]) - (AST.SExpression ['AST.toExpressionList x])) - (atom - (AST.SExpression - ['list - (AST.SExpression ['quasiquote atom])])))))) - (pure [(AST.SExpression ['AST.SExpression (AST.SExpression ['concat (AST.SExpression (: 'list (map quasiquoteElem xs)))])])]))) -(macro quasiquote ([atom]) - (pure [(AST.SExpression ['quote atom])])) - -(macro applyInfix ([x op y]) - (pure [`(~op ~x ~y)])) - -(macro fnCase (cases) - (<$> (\ (varId) - [`(\ (~varId) (case ~varId ~@cases))]) - AST.gensym)) - -(macro def ({name : {typeSig : cases}}) - (pure - (: `(:: ~name ~typeSig) - (map (\ (x) `(= ~name ~@x)) - cases)))) - -(def mdo' {(List AST.Expression) -> AST.Expression} - (({var : {'<- : {val : rest}}}) - `(>>= ~val (\ (~var) ~(mdo' rest)))) - (((: val rest)) - (case rest - ([] - val) - (_ - `(>> ~val ~(mdo' rest)))))) - -(macro mdo (input) - (pure [(mdo' input)])) - -(macro if ([cond true false]) - (pure [`(case ~cond - (True ~true) - (False ~false))])) --- PRELUDE_END - --- TODO `Expression` should probably be `Traversable`, use recursion schemes, etc. --- I should provide `toFix` and `fromFix` functions for macros to take advantage of. --- (Maybe all macros have the argument automatically `fromFix`-ed to make consumption simpler?) -(data Expression - (LiteralChar Char) - (LiteralInt Int) - (LiteralString String) - (SExpression [Expression]) - (Symbol String)) - deriving (Eq, Show) - --- ****************************** --- Internal utilities --- ****************************** -(def toAxel {Expression -> String} - (((LiteralChar x)) [#\{ x #\}]) - (((LiteralInt x)) (show x)) - (((LiteralString xs)) {"\"" <> {xs <> "\""}}) - (((SExpression xs)) {"(" <> {(unwords (map toAxel xs)) <> ")"}}) - (((Symbol x)) x)) - --- ****************************** --- Macro definition utilities --- ****************************** -(pragma "NOINLINE gensymCounter") -(def gensymCounter (IORef Int) - (() (unsafePerformIO (newIORef 0)))) - -(def gensym (IO Expression) - (() (mdo - <- readIORef gensymCounter - (let ((identifier {"aXEL_AUTOGENERATED_IDENTIFIER_" <> (show suffix)})) - (mdo - (modifyIORef gensymCounter succ) - (pure (Symbol identifier))))))) - --- | This allows splice-unquoting of both `[Expression]`s and `SExpression`s, without requiring special syntax for each. -(class () (ToExpressionList a) - (:: toExpressionList {a -> [Expression]})) - -(instance () (ToExpressionList [Expression]) - (:: toExpressionList {[Expression] -> [Expression]}) - (= toExpressionList (() id))) - --- | Because we do not have a way to statically ensure an `SExpression` is passed (and not another one of `Expression`'s constructors instead), we will error at compile-time if a macro attempts to splice-unquote inappropriately. -(instance () (ToExpressionList Expression) - (def toExpressionList {Expression -> [Expression]} - (((SExpression xs)) xs) - ((x) error {(show x) <> " cannot be splice-unquoted, because it is not an s-expression!"})))