git.haldean.org del / 30e5126 src / Language / Del / Compile.hs
30e5126

Tree @30e5126 (Download .tar.gz)

Compile.hs @30e5126raw · history · blame

{-# LANGUAGE OverloadedStrings #-}

module Language.Del.Compile (compile) where

import           Debug.Trace
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.Text as T
import           Language.Del.AST
import           Language.Del.CompileDefs
import           Language.Del.Constants
import           Language.Del.Glsl
import           Language.Del.Imports
import           Language.Del.InRep
import           Language.Del.Inlining
import           Language.Del.Ops
import           Language.Del.Properties
import qualified Language.Del.Reader as R
import           Language.Del.TypeCheck
import           Language.Del.Types

buildAST :: [R.Form] -> AST
buildAST fs = AST defs imps
    where namePair (R.DefForm n t a b) = Just (n, Def n t a b)
          namePair _ = Nothing
          defs = Map.fromList $ mapMaybe namePair fs
          importFromForm (R.ImportForm s a) = Just $ Import s a
          importFromForm _ = Nothing
          imps = mapMaybe importFromForm fs

-- Drops all definitions other than the root definition
dropNonRoot :: AST -> Artifact Def
dropNonRoot (AST m _) = return $ (Map.!) m rootKey

printStage :: Show a => String -> a -> Artifact a
printStage n a = trace (n ++ "\n" ++ show a ++ "\n") $ return a

runCompile :: AST -> Artifact GLSL
runCompile fs =  loadOps fs
             >>= printStage "Parsed AST"
             >>= checkRecursive
             >>= parseTypes
             >>= typeCheck
             >>= checkRoot
             >>= uniqueParams
             >>= substFuncs
             >>= dropNonRoot
             >>= propConstants
             >>= foldConstantExprs
             >>= printStage "Post-optimization AST"
             >>= toIR
             >>= printStage "Intermediate representation"
             >>= glsl

compile :: T.Text -> IO (Artifact GLSL)
compile prog =
    case R.read prog of
         Success forms -> do
             let ast = buildAST forms
             r <- collectImports [] ast
             case r of
                  Success res -> return $ runCompile res
                  Failure err -> return $ Failure err
         Failure err -> return $ Failure err