ran the formatter

mlabs-haskell · Aug 29, 2024 · 2074564 · 2074564
1 parent 0de32f9
commit 2074564
Show file tree

Hide file tree

Showing 22 changed files with 479 additions and 387 deletions.
diff --git a/src/Language/PureScript/Constants/PLC.hs b/src/Language/PureScript/Constants/PLC.hs
@@ -4,7 +4,7 @@
 
 module Language.PureScript.Constants.PLC where
 
-import Language.PureScript.Constants.PLC.TH ( mkBuiltinMap )
-import PlutusCore.Default ( DefaultFun )
+import Language.PureScript.Constants.PLC.TH (mkBuiltinMap)
+import PlutusCore.Default (DefaultFun)
 
 mkBuiltinMap ''DefaultFun
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
@@ -30,12 +30,12 @@ import Language.PureScript.AST.SourcePos (nullSourceAnn, pattern NullSourceAnn)
 import Language.PureScript.Constants.Prim qualified as C
 import Language.PureScript.Constants.Purus qualified as PLC
 import Language.PureScript.Crash (internalError)
-import Language.PureScript.Names (Ident(..), ProperName (..), ProperNameType (..), Qualified (..), QualifiedBy (..), coerceProperName, disqualify)
+import Language.PureScript.Names (Ident (..), ProperName (..), ProperNameType (..), Qualified (..), QualifiedBy (..), coerceProperName, disqualify)
 import Language.PureScript.Roles (Role (..))
 import Language.PureScript.TypeClassDictionaries (NamedDict)
 import Language.PureScript.Types (SourceConstraint, SourceType, Type (..), TypeVarVisibility (..), eqType, freeTypeVariables, quantify, srcTypeApp, srcTypeConstructor)
 
-import Language.Purus.Config ( maxTupleSize )
+import Language.Purus.Config (maxTupleSize)
 
 -- | The @Environment@ defines all values and types which are currently in scope:
 data Environment = Environment
@@ -113,16 +113,17 @@ instance A.ToJSON FunctionalDependency where
       , "determined" .= fdDetermined
       ]
 
--- | The initial environment with only builtin PLC functions and Prim PureScript types defined
--- TODO: Move all of the purus-specific stuff out of this module,
---       reset the initEnvironment to the default, and
---       modify it at the call site (Language.PureScript.Make)
---
---       This will improve the dependency structure of the project, but also,
---       allows someone else to adapt Purus for another purpose. The pipeline up to
---       up to `GenerateDataTypes` is more-or-less backend agnostic, so
---       someone could easily use this to compile PureScript to another typed
---       functional language using the IR.
+{- | The initial environment with only builtin PLC functions and Prim PureScript types defined
+TODO: Move all of the purus-specific stuff out of this module,
+      reset the initEnvironment to the default, and
+      modify it at the call site (Language.PureScript.Make)
+
+      This will improve the dependency structure of the project, but also,
+      allows someone else to adapt Purus for another purpose. The pipeline up to
+      up to `GenerateDataTypes` is more-or-less backend agnostic, so
+      someone could easily use this to compile PureScript to another typed
+      functional language using the IR.
+-}
 initEnvironment :: Environment
 initEnvironment = Environment (builtinFunctions <> primFunctions) allPrimTypes primCtors M.empty M.empty allPrimClasses
 
@@ -489,7 +490,7 @@ primTypes =
       , (C.Int, (kindType, ExternData []))
       , (C.Boolean, (kindType, boolData))
       , (C.Partial <&> coerceProperName, (kindConstraint, ExternData []))
-      , (C.Unit, (kindType,ExternData [])) 
+      , (C.Unit, (kindType, ExternData []))
       ]
   where
     boolData =
@@ -952,7 +953,7 @@ tyByteString :: SourceType
 tyByteString = srcTypeConstructor PLC.BuiltinByteString
 
 tyUnit :: SourceType
-tyUnit = srcTypeConstructor C.Unit 
+tyUnit = srcTypeConstructor C.Unit
 
 -- just for readability
 (#@) :: Qualified Ident -> SourceType -> (Qualified Ident, SourceType)
@@ -972,7 +973,7 @@ builtinTypes =
     , (PLC.BuiltinByteString, (kindType, ExternData []))
     ]
 
-primFunctions :: M.Map (Qualified Ident) (SourceType,NameKind,NameVisibility)
+primFunctions :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
 primFunctions = M.singleton (Qualified (ByModuleName C.M_Prim) (Ident "unit")) (tyUnit, Public, Defined)
 
 builtinFunctions :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
@@ -993,7 +994,7 @@ builtinCxt =
     , PLC.I_modInteger #@ tyInt -:> tyInt -:> tyInt
     , PLC.I_equalsInteger #@ tyInt -:> tyInt -:> tyBoolean
     , PLC.I_lessThanInteger #@ tyInt -:> tyInt -:> tyBoolean
-    , PLC.I_lessThanEqualsInteger #@ tyInt -:> tyInt -:> tyBoolean 
+    , PLC.I_lessThanEqualsInteger #@ tyInt -:> tyInt -:> tyBoolean
     , -- ByteStrings
       PLC.I_appendByteString #@ tyByteString -:> tyByteString -:> tyByteString
     , -- \/ Check the implications of the variant semantics for this (https://github.com/IntersectMBO/plutus/blob/973e03bbccbe3b860e2c8bf70c2f49418811a6ce/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs#L1179-L1207)
@@ -1018,11 +1019,11 @@ builtinCxt =
     , PLC.I_decodeUtf8 #@ tyByteString -:> tyString
     , -- Bool
       -- NOTE: Specializing this to "Type", which miiiight not be what we want depending on how we do the data encoding
-      PLC.I_ifThenElse #@ forallT "x" $ \x -> tyBoolean -:> x -:> x -:> x 
+      PLC.I_ifThenElse #@ forallT "x" $ \x -> tyBoolean -:> x -:> x -:> x
     , -- Unit
       PLC.I_chooseUnit #@ forallT "x" $ \x -> tyUnit -:> x -:> x
     , -- Tracing
-      PLC.I_trace #@ forallT "x" $ \x -> tyString -:> x -:> x 
+      PLC.I_trace #@ forallT "x" $ \x -> tyString -:> x -:> x
     , -- Pairs
       PLC.I_fstPair #@ forallT "a" $ \a -> forallT "b" $ \b -> tyBuiltinPair a b -:> a
     , PLC.I_sndPair #@ forallT "a" $ \a -> forallT "b" $ \b -> tyBuiltinPair a b -:> b
@@ -1053,6 +1054,6 @@ builtinCxt =
       PLC.I_mkPairData #@ tyBuiltinData -:> tyBuiltinData -:> tyBuiltinPair tyBuiltinData tyBuiltinData
     , PLC.I_mkNilData #@ tyUnit -:> tyBuiltinList tyBuiltinData
     , PLC.I_mkNilPairData #@ tyUnit -:> tyBuiltinList (tyBuiltinPair tyBuiltinData tyBuiltinData)
-     -- TODO: the Bls12 crypto primfuns
+    -- TODO: the Bls12 crypto primfuns
     -- NOTE: IntegerToByteString & ByteStringToInteger don't appear to be in the version of PlutusCore we have?
     ]
diff --git a/src/Language/Purus/Eval.hs b/src/Language/Purus/Eval.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Language.Purus.Eval (
-    compileToUPLC,
-    evaluateTerm,
-    -- temporary for GHCI testing. TODO move these to the test suite
-    passing
-  ) where
+  compileToUPLC,
+  evaluateTerm,
+  -- temporary for GHCI testing. TODO move these to the test suite
+  passing,
+) where
 
 import Prelude
 

diff --git a/src/Language/Purus/IR.hs b/src/Language/Purus/IR.hs
@@ -18,7 +18,7 @@ import Prelude
 
 import Protolude.List (ordNub)
 
-import Control.Monad ( join, ap )
+import Control.Monad (ap, join)
 import Data.Bifunctor (Bifunctor (first))
 import Data.Kind qualified as GHC
 import Data.List (elemIndex, sortOn)
@@ -29,8 +29,10 @@ import Data.Text (Text)
 import Data.Text qualified as T
 
 import Language.PureScript.Constants.Prim qualified as C
-import Language.PureScript.CoreFn.TypeLike
-    ( instantiateWithArgs, TypeLike(..) )
+import Language.PureScript.CoreFn.TypeLike (
+  TypeLike (..),
+  instantiateWithArgs,
+ )
 import Language.PureScript.Names (Ident (..), ProperName (..), ProperNameType (..), Qualified (..), QualifiedBy (..), disqualify, runIdent, runModuleName, showIdent, showQualified)
 import Language.PureScript.PSString (PSString, decodeStringWithReplacement, prettyPrintString)
 import Language.PureScript.Types (
@@ -43,35 +45,39 @@ import Language.Purus.Debug (doTrace)
 import Language.Purus.Pretty ((<::>))
 import Language.Purus.Pretty.Common (prettyStr)
 
-import Bound ( Bound(..), Var(..), Scope, fromScope )
+import Bound (Bound (..), Scope, Var (..), fromScope)
 import Bound.Scope (instantiateEither)
 
-import Control.Lens.Plated ( Plated(..) )
+import Control.Lens.Plated (Plated (..))
 import Control.Lens.TH (makePrisms)
 
-import Data.Functor.Classes
-    ( Eq1(..), Ord1(..), Show1(liftShowsPrec) )
-
-import Prettyprinter
-    ( Doc,
-      Pretty(pretty),
-      viaShow,
-      layoutPretty,
-      (<+>),
-      align,
-      defaultLayoutOptions,
-      encloseSep,
-      group,
-      hardline,
-      hsep,
-      indent,
-      vcat,
-      vsep,
-      dot,
-      parens )
+import Data.Functor.Classes (
+  Eq1 (..),
+  Ord1 (..),
+  Show1 (liftShowsPrec),
+ )
+
+import Prettyprinter (
+  Doc,
+  Pretty (pretty),
+  align,
+  defaultLayoutOptions,
+  dot,
+  encloseSep,
+  group,
+  hardline,
+  hsep,
+  indent,
+  layoutPretty,
+  parens,
+  vcat,
+  viaShow,
+  vsep,
+  (<+>),
+ )
 import Prettyprinter.Render.Text (renderStrict)
 
-import Text.Show.Deriving ( deriveShow1, makeLiftShowsPrec )
+import Text.Show.Deriving (deriveShow1, makeLiftShowsPrec)
 
 -- The final representation of types and terms, where all constructions that
 

diff --git a/src/Language/Purus/IR/Utils.hs b/src/Language/Purus/IR/Utils.hs
@@ -32,31 +32,33 @@ module Language.Purus.IR.Utils (
   allBoundVars,
   stripSkolems,
   stripSkolemsFromExpr,
-  ) where
+) where
 
 import Prelude
 
-import Bound ( Scope, Var(..), abstract, fromScope )
-import Control.Monad ( join )
+import Bound (Scope, Var (..), abstract, fromScope)
+import Control.Monad (join)
 import Data.Void (Void)
 import Language.PureScript.CoreFn.Expr (PurusType)
-import Language.PureScript.CoreFn.TypeLike ( TypeLike(KindOf) )
-import Language.PureScript.Names
-    ( Ident(Ident),
-      ModuleName(ModuleName),
-      Qualified(..),
-      QualifiedBy(ByModuleName) )
-import Language.Purus.IR
-    ( BindE(..),
-      FVar(..),
-      BVar(..),
-      Exp(..),
-      Alt(..),
-      Lit(ObjectL, IntL, StringL, CharL),
-      Pat(ConP, VarP, LitP),
-      XAccessor,
-      XObjectLiteral,
-      XObjectUpdate )
+import Language.PureScript.CoreFn.TypeLike (TypeLike (KindOf))
+import Language.PureScript.Names (
+  Ident (Ident),
+  ModuleName (ModuleName),
+  Qualified (..),
+  QualifiedBy (ByModuleName),
+ )
+import Language.Purus.IR (
+  Alt (..),
+  BVar (..),
+  BindE (..),
+  Exp (..),
+  FVar (..),
+  Lit (CharL, IntL, ObjectL, StringL),
+  Pat (ConP, LitP, VarP),
+  XAccessor,
+  XObjectLiteral,
+  XObjectUpdate,
+ )
 import Prettyprinter (Pretty)
 
 import Data.Set (Set)

diff --git a/src/Language/Purus/Make.hs b/src/Language/Purus/Make.hs
@@ -32,9 +32,9 @@ import Language.PureScript.Names (
   runModuleName,
  )
 
+import Language.Purus.Eval
 import Language.Purus.IR.Utils (IR_Decl, foldBinds)
 import Language.Purus.Pipeline.CompileToPIR (compileToPIR)
-import Language.Purus.Eval
 import Language.Purus.Pipeline.DesugarCore (desugarCoreModule)
 import Language.Purus.Pipeline.DesugarObjects (
   desugarObjects,
@@ -58,7 +58,7 @@ import Language.Purus.Pipeline.Monad (
  )
 import Language.Purus.Pretty.Common (prettyStr)
 import Language.Purus.Prim.Data (primDataPS)
-import Language.Purus.Types (PIRTerm, initDatatypeDict, PLCTerm)
+import Language.Purus.Types (PIRTerm, PLCTerm, initDatatypeDict)
 import Language.Purus.Utils (
   decodeModuleIO,
   findDeclBodyWithIndex,
@@ -77,10 +77,9 @@ import Algebra.Graph.AdjacencyMap.Algorithm (topSort)
 import System.FilePath.Glob qualified as Glob
 
 import PlutusCore.Evaluation.Result (EvaluationResult)
--- import Debug.Trace (traceM)
---import PlutusIR.Core.Instance.Pretty.Readable (prettyPirReadable)
-
 
+-- import Debug.Trace (traceM)
+-- import PlutusIR.Core.Instance.Pretty.Readable (prettyPirReadable)
 
 {-  Compiles a main function to PIR, given its module name, dependencies, and a
     Prim module that will be compiled before anything else. (This is kind of a hack-ey shim
@@ -113,38 +112,39 @@ compile primModule orderedModules mainModuleName mainFunctionName =
     go :: CounterT (Either String) PIRTerm
     go = do
       (summedModule, dsCxt) <- runDesugarCore $ desugarCoreModules primModule orderedModules
-      let --traceBracket lbl msg = traceM ("\n" <> lbl <> "\n\n" <> msg <> "\n\n")
-          decls = moduleDecls summedModule
-          declIdentsSet = foldBinds (\acc nm _ -> S.insert nm acc) S.empty decls
-          couldn'tFindMain n =
-            "Error: Could not find a main function with the name ("
-              <> show (n :: Int)
-              <> ") '"
-              <> T.unpack (runIdent mainFunctionName)
-              <> "' in module "
-              <> T.unpack (runModuleName mainModuleName)
-              <> "\nin declarations:\n"
-              <> prettyStr (S.toList declIdentsSet)
+      let
+        -- traceBracket lbl msg = traceM ("\n" <> lbl <> "\n\n" <> msg <> "\n\n")
+        decls = moduleDecls summedModule
+        declIdentsSet = foldBinds (\acc nm _ -> S.insert nm acc) S.empty decls
+        couldn'tFindMain n =
+          "Error: Could not find a main function with the name ("
+            <> show (n :: Int)
+            <> ") '"
+            <> T.unpack (runIdent mainFunctionName)
+            <> "' in module "
+            <> T.unpack (runModuleName mainModuleName)
+            <> "\nin declarations:\n"
+            <> prettyStr (S.toList declIdentsSet)
       mainFunctionIx <- note (couldn'tFindMain 1) $ dsCxt ^? globalScope . at mainModuleName . folded . at mainFunctionName . folded
-      --traceM $ "Found main function Index: " <> show mainFunctionIx
+      -- traceM $ "Found main function Index: " <> show mainFunctionIx
       mainFunctionBody <- note (couldn'tFindMain 2) $ findDeclBodyWithIndex mainFunctionName mainFunctionIx decls
-      --traceM "Found main function body"
+      -- traceM "Found main function body"
       inlined <- runInline summedModule $ lift (mainFunctionName, mainFunctionIx) mainFunctionBody >>= inline
-      --traceBracket "Done inlining. Result:" $ prettyStr inlined
+      -- traceBracket "Done inlining. Result:" $ prettyStr inlined
       let !instantiated = applyPolyRowArgs $ instantiateTypes inlined
-      --traceBracket "Done instantiating types. Result:" $ prettyStr instantiated
+      -- traceBracket "Done instantiating types. Result:" $ prettyStr instantiated
       withoutObjects <- instantiateTypes <$> runCounter (desugarObjects instantiated)
-      --traceBracket  "Desugared objects. Result:\n" $ prettyStr withoutObjects
+      -- traceBracket  "Desugared objects. Result:\n" $ prettyStr withoutObjects
       datatypes <- runCounter $ desugarObjectsInDatatypes (moduleDataTypes summedModule)
-      --traceM "Desugared datatypes"
+      -- traceM "Desugared datatypes"
       runPlutusContext initDatatypeDict $ do
         generateDatatypes datatypes
-        --traceM "Generated PIR datatypes"
+        -- traceM "Generated PIR datatypes"
         withoutCases <- eliminateCases datatypes withoutObjects
-        --traceM "Eliminated case expressions. Compiling to PIR..."
+        -- traceM "Eliminated case expressions. Compiling to PIR..."
         compileToPIR datatypes withoutCases
-        --traceM . docString $ prettyPirReadable pirTerm
 
+-- traceM . docString $ prettyPirReadable pirTerm
 
 modulesInDependencyOrder :: [[FilePath]] -> IO [Module (Bind Ann) PurusType PurusType Ann]
 modulesInDependencyOrder (concat -> paths) = do
@@ -218,10 +218,9 @@ makeForTest main = make "tests/purus/passing/Misc" "Lib" main Nothing
 evalForTest_ :: Text -> IO ()
 evalForTest_ main = evalForTest main >>= print
 
-evalForTest :: Text -> IO (EvaluationResult PLCTerm,[Text])
+evalForTest :: Text -> IO (EvaluationResult PLCTerm, [Text])
 evalForTest main = makeForTest main >>= evaluateTerm
 
-
 -- TODO put this somewhere else
 note :: (MonadError String m) => String -> Maybe a -> m a
 note msg = \case