Add quoting and continue macro expansion

.gitignore

@@ -20,3 +20,5 @@ cabal.sandbox.config
 cabal.project.local
 .HTF/
 .ghc.environment.*
+
+resources/autogenerated/*

README.md

@@ -18,6 +18,13 @@ But, there's nothing (that I'm aware of) for all three.
 
 Hence, meet Lihsp! It's a Lisp-like language (with macros and all) that transpiles to Eta, fulfilling all the requirements listed above. :tada:
 
+## TODO
+
+  - [ ] Cleanup
+    - [ ] Use qualified imports
+    - [ ] Standardize use of `($)`
+    - [ ] Rename `AST` to `Target` (?) and `Parse` to `Lisp` (?)
+
 ## Future Plans
   - Finish the JVM backend
   - Add a PureScript backend as well (or maybe first, instead of targeting the JVM initially) to alternatively take advantage of the JavaScript ecosystem.

lihsp.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 596fc166e921fb1d089e6c0008a31999fb69a79ec742eb8f8582f5c30b048f6a
+-- hash: a29ef77f7e9aefca0e574bb8c6b5da0949c57ca81f4668850a02116c3b1a64d0
 
 name:           lihsp
 version:        0.1.0.0
@@ -20,11 +20,11 @@ cabal-version:  >= 1.10
 extra-source-files:
     README.md
     scripts/build.sh
+    scripts/clean.sh
 
 data-files:
+    resources/autogenerated/macros/Header.hs
     resources/macros/Footer.hs
-    resources/macros/Header.hs
-    resources/macros/Imports.hs
 
 source-repository head
   type: git
@@ -55,6 +55,7 @@ library
       Lihsp.Utils.Display
       Lihsp.Utils.Recursion
       Lihsp.Utils.Resources
+      Lihsp.Utils.String
   other-modules:
       Paths_lihsp
   default-language: Haskell2010

resources/macros/Footer.hs

@@ -1,4 +1,4 @@
 %%%MACRO_DEFINITION%%%
 
 main :: IO ()
-main = aUTOGENERATED_MACRO_FUNCTION %%%%ARGUMENTS%%% >>= print
+main = %%%MACRO_NAME%%% %%%ARGUMENTS%%% >>= print

scripts/build.sh

@@ -2,8 +2,8 @@ set -eu
 set -o pipefail
 
 echo "Copying macro header..."
-cat resources/macros/Imports.hs > resources/macros/Header.hs
-cat src/Lihsp/Parse/AST.hs >> resources/macros/Header.hs
+mkdir -p resources/autogenerated/macros
+cp src/Lihsp/Parse/AST.hs resources/autogenerated/macros/Header.hs
 echo "Macro header copied!"
 
 stack build

scripts/clean.sh

@@ -0,0 +1,8 @@
+set -eu
+set -o pipefail
+
+echo "Cleaning autogenerated resources..."
+rm -rf resources/autogenerated
+echo "Autogenerated resources cleaned!"
+
+stack clean

src/Lihsp/AST.hs

@@ -139,13 +139,15 @@ data Literal
   = LChar Char
   | LInt Int
   | LList [Expression]
+  | LSymbol Identifier
   deriving (Eq)
 
 instance Show Literal where
   show :: Literal -> String
   show (LInt int) = show int
   show (LChar char) = surround SingleQuotes [char]
   show (LList list) = surround SquareBrackets $ delimit Commas (map show list)
+  show (LSymbol symbol) = "Literal (LSymbol \"" <> symbol <> "\")"
 
 data Statement
   = SDataDeclaration DataDeclaration
@@ -238,7 +240,7 @@ instance Show MacroDefinition where
   show :: MacroDefinition -> String
   show macroDefinition =
     delimit Newlines $
-    macroDefinition ^. name :
+    (macroDefinition ^. name <> " :: [Expression] -> [Expression]") :
     map
       (showFunctionDefinition $ macroDefinition ^. name)
       (macroDefinition ^. definitions)
@@ -267,23 +269,3 @@ instance Show TypeSynonym where
   show typeSynonym =
     "type " <> show (typeSynonym ^. alias) <> " = " <>
     show (typeSynonym ^. definition)
-
--- TODO Either replace with `MonoTraversable` or make `Expression` polymorphic
---      (in which case, use `Traversable`, recursion schemes, etc.). The latter
---      would be preferable.
--- TODO Remove the dependency on `Monad` (since the standard `traverse` only
---      requires an `Applicative` instance).
-traverseExpression ::
-     (Monad m) => (Expression -> m Expression) -> Expression -> m Expression
-traverseExpression f x =
-  case x of
-    EFunctionApplication functionApplication ->
-      let newArguments =
-            traverse (traverseExpression f) (functionApplication ^. arguments)
-          newFunction = traverseExpression f (functionApplication ^. function)
-      in f =<<
-         (EFunctionApplication <$>
-          (FunctionApplication <$> newFunction <*> newArguments))
-    EIdentifier _ -> f x
-    ELetBlock _ -> f x
-    ELiteral _ -> f x

src/Lihsp/Eval.hs

@@ -31,6 +31,6 @@ execInterpreter fileName = do
 
 evalSource :: (MonadError Error m, MonadIO m) => String -> m String
 evalSource source =
-  withTempFile "TempMaro.hs" $ \fileName handle -> do
+  withTempFile "TempEval.hs" $ \fileName handle -> do
     liftIO $ hPutStr handle source
     execInterpreter fileName

src/Lihsp/Macros.hs

@@ -1,57 +1,84 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Lihsp.Macros where
 
-import Control.Lens.Operators ((.~))
-import Control.Monad.Except (MonadError)
+import Control.Lens.Operators ((^.))
+import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 
-import Data.Function ((&))
 import Data.Semigroup ((<>))
-import Data.Text (pack, replace, unpack)
 
-import Lihsp.AST (Expression, MacroDefinition, name, traverseExpression)
+import Lihsp.AST (name)
+import qualified Lihsp.AST as AST (MacroDefinition)
 import Lihsp.Error (Error(MacroError))
 import Lihsp.Eval (evalSource)
-import qualified Lihsp.Parse as Parse (Expression)
-import Lihsp.Parse (parseProgram)
+import qualified Lihsp.Parse as Parse
+  ( Expression(LiteralChar, LiteralInt, SExpression, Symbol)
+  , parseProgram
+  )
+import Lihsp.Utils.Recursion (Recursive(bottomUpTraverse))
 import Lihsp.Utils.Resources (readDataFile)
+import Lihsp.Utils.String (replace)
 
 generateMacroProgram ::
-     (MonadIO m) => MacroDefinition -> [Expression] -> m String
-generateMacroProgram macroDefinition applicationArguments = do
-  fileHeader <- liftIO $ readDataFile "resources/macros/Header.hs"
-  fileFooter <- liftIO getFileFooter
-  return $ fileHeader <> show fileContents <> fileFooter
+     (MonadIO m) => AST.MacroDefinition -> [Parse.Expression] -> m String
+generateMacroProgram macroDefinition applicationArguments =
+  (<>) <$> liftIO getFileHeader <*> liftIO getFileFooter
   where
+    getFileHeader = readDataFile "autogenerated/macros/Header.hs"
     getFileFooter =
       let insertApplicationArguments =
             let applicationArgumentsPlaceholder = "%%%ARGUMENTS%%%"
-            in unpack .
-               replace
+            in replace
                  applicationArgumentsPlaceholder
-                 (pack $ show applicationArguments) .
-               pack
+                 (show applicationArguments)
           insertDefinitionBody =
             let definitionBodyPlaceholder = "%%%MACRO_DEFINITION%%%"
-            in unpack .
-               replace definitionBodyPlaceholder (pack $ show macroDefinition) .
-               pack
-      in insertApplicationArguments . insertDefinitionBody <$>
-         readDataFile "resources/macros/Footer.hs"
+            in replace definitionBodyPlaceholder (show macroDefinition)
+          insertDefinitionName =
+            let definitionNamePlaceholder = "%%%MACRO_NAME%%%"
+            in replace definitionNamePlaceholder (macroDefinition ^. name)
+      in insertApplicationArguments .
+         insertDefinitionName . insertDefinitionBody <$>
+         readDataFile "macros/Footer.hs"
 
-expandMacroCall ::
+expandMacros ::
      (MonadError Error m, MonadIO m)
-  => MacroDefinition
-  -> [Expression]
-  -> m [Parse.Expression]
-expandMacroCall macroDefinition args =
-  generateMacroProgram macroDefinition args >>= evalSource >>= parseProgram
+  => [AST.MacroDefinition]
+  -> Parse.Expression
+  -> m Parse.Expression
+expandMacros environment =
+  bottomUpTraverse $ \expression ->
+    case expression of
+      Parse.LiteralChar _ -> return expression
+      Parse.LiteralInt _ -> return expression
+      Parse.SExpression functionApplication ->
+        lookupMacroDefinition environment (head functionApplication) >>= \case
+          Just macroDefinition ->
+            Parse.SExpression <$>
+            expandMacroApplication macroDefinition (tail functionApplication)
+          Nothing -> return expression
+      Parse.Symbol _ -> return expression
+  where
+    expandMacroApplication macroDefinition args =
+      generateMacroProgram macroDefinition args >>= evalSource >>=
+      Parse.parseProgram
 
-expandMacros :: Expression -> IO Expression
-expandMacros =
-  traverseExpression $ \expression ->
-    case macroApplication expression of
-      Just (macroName, arguments) -> expandMacroCall
-      Nothing -> return expression
+lookupMacroDefinition ::
+     (MonadError Error m)
+  => [AST.MacroDefinition]
+  -> Parse.Expression
+  -> m (Maybe AST.MacroDefinition)
+lookupMacroDefinition environment identifierExpression =
+  case identifierExpression of
+    Parse.LiteralChar _ -> return Nothing
+    Parse.LiteralInt _ -> return Nothing
+    Parse.SExpression _ -> return Nothing
+    Parse.Symbol identifier ->
+      case filter
+             (\macroDefinition -> macroDefinition ^. name == identifier)
+             environment of
+        [] -> return Nothing
+        [macroDefinition] -> return $ Just macroDefinition
+        _ -> throwError (MacroError "0012")

src/Lihsp/Normalize.hs

@@ -5,12 +5,9 @@
 
 module Lihsp.Normalize where
 
-import Control.Lens.Operators ((%~), (^.))
 import Control.Monad ((>=>))
 import Control.Monad.Except (MonadError, throwError)
 
-import Data.Function ((&))
-
 import Lihsp.AST
   ( ArgumentList(ArgumentList)
   , DataDeclaration(DataDeclaration)
@@ -21,7 +18,7 @@ import Lihsp.AST
   , ImportList(ImportList)
   , LanguagePragma(LanguagePragma)
   , LetBlock(LetBlock)
-  , Literal(LChar, LInt, LList)
+  , Literal(LChar, LInt, LList, LSymbol)
   , MacroDefinition(MacroDefinition)
   , QualifiedImport(QualifiedImport)
   , RestrictedImport(RestrictedImport)
@@ -32,23 +29,19 @@ import Lihsp.AST
   , TypeDefinition(ProperType, TypeConstructor)
   , TypeSynonym(TypeSynonym)
   , TypeclassInstance(TypeclassInstance)
-  , arguments
-  , function
   )
 
 import Lihsp.Error (Error(NormalizeError))
 import qualified Lihsp.Parse as Parse
-  ( Expression(LiteralChar, LiteralInt, LiteralList, SExpression,
-           Symbol)
+  ( Expression(LiteralChar, LiteralInt, SExpression, Symbol)
   )
 
 normalizeExpression :: (MonadError Error m) => Parse.Expression -> m Expression
 normalizeExpression (Parse.LiteralChar char) = return $ ELiteral (LChar char)
 normalizeExpression (Parse.LiteralInt int) = return $ ELiteral (LInt int)
-normalizeExpression (Parse.LiteralList list) =
-  ELiteral . LList <$> traverse normalizeExpression list
 normalizeExpression (Parse.SExpression items) =
   case items of
+    [Parse.Symbol "quote", expression] -> return $ toLihspLiteral expression
     [Parse.Symbol "let", Parse.SExpression bindings', body] ->
       let bindings =
             traverse
@@ -154,14 +147,3 @@ normalizeStatement _ = throwError $ NormalizeError "0008"
 
 normalizeProgram :: (MonadError Error m) => [Parse.Expression] -> m [Statement]
 normalizeProgram = traverse normalizeStatement
-
-bottomUpTraverse :: (Applicative m) => (Expression -> m Expression) -> Expression -> m Expression
-bottomUpTraverse f x =
-  case x of
-    EFunctionApplication functionApplication ->
-      f . EFunctionApplication <$>
-            (FunctionApplication <$> f (functionApplication ^. function) <*>
-            traverse f (functionApplication ^. arguments))
-    EIdentifier _ -> f x
-    ELetBlock _ -> f x
-    ELiteral _ -> f x