Pls

danieljharvey · Oct 30, 2023 · 9933c72 · 9933c72
1 parent 051fd85
commit 9933c72
Show file tree

Hide file tree

Showing 7 changed files with 102 additions and 105 deletions.
diff --git a/smol-core/src/Smol/Core/Interpreter/Types/InterpreterError.hs b/smol-core/src/Smol/Core/Interpreter/Types/InterpreterError.hs
@@ -2,16 +2,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Smol.Core.Interpreter.Types.InterpreterError (InterpreterError (..), interpreterErrorDiagnostic) where
-import Smol.Core.Types.Annotation
-import qualified Error.Diagnose as Diag
-import qualified Data.Text as T
 
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Error.Diagnose as Diag
 import GHC.Natural
 import qualified Prettyprinter as PP
 import Smol.Core.Interpreter.Types.Stack
 import Smol.Core.Printer
+import Smol.Core.Types.Annotation
 import Smol.Core.Types.Expr
 import Smol.Core.Types.Identifier
 import Smol.Core.Types.Op
@@ -48,18 +48,15 @@ commaSep =
 interpreterErrorDiagnostic :: InterpreterError Annotation -> Diag.Diagnostic T.Text
 interpreterErrorDiagnostic intError =
   Diag.addReport mempty $
-        Diag.Err
-          Nothing
-          (prettyPrint intError)
-          []
-          []
+    Diag.Err
+      Nothing
+      (prettyPrint intError)
+      []
+      []
   where
     prettyPrint :: (Printer a) => a -> T.Text
     prettyPrint = renderWithWidth 40 . prettyDoc
 
-
-
-
 instance Printer (InterpreterError ann) where
   prettyDoc (CouldNotFindVar items name) =
     "Could not find var " <> prettyDoc name <> " in " <> itemList

diff --git a/smol-core/src/Smol/Core/Modules/FromParts.hs b/smol-core/src/Smol/Core/Modules/FromParts.hs
@@ -1,9 +1,10 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-  {-# LANGUAGE NamedFieldPuns #-}
+
 module Smol.Core.Modules.FromParts (addModulePart, moduleFromModuleParts, exprAndTypeFromParts) where
 
 import Control.Monad (unless)
@@ -40,7 +41,7 @@ addModulePart ::
   m (Module ParseDep ann)
 addModulePart allParts part mod' =
   case part of
-    ModuleExpression (ModuleExpressionC {meAnn, meIdent,meArgs,meExpr}) -> do
+    ModuleExpression (ModuleExpressionC {meAnn, meIdent, meArgs, meExpr}) -> do
       errorIfExpressionAlreadyDefined mod' meAnn meIdent
       let tle = exprAndTypeFromParts allParts meIdent meArgs meExpr
       pure $

diff --git a/smol-core/src/Smol/Core/Modules/Monad.hs b/smol-core/src/Smol/Core/Modules/Monad.hs
@@ -27,8 +27,9 @@ errorIfExpressionAlreadyDefined ::
 errorIfExpressionAlreadyDefined mod' ann ident =
   case M.lookup ident (moExpressions mod') of
     Nothing -> pure ()
-    Just tle -> throwError $
-      DuplicateDefinition (Duplicate ident ann (getTopLevelExpressionAnnotation tle))
+    Just tle ->
+      throwError $
+        DuplicateDefinition (Duplicate ident ann (getTopLevelExpressionAnnotation tle))
 
 checkDataType ::
   (MonadError (ModuleError ann) m) =>

diff --git a/smol-core/src/Smol/Core/Modules/Types/ModuleError.hs b/smol-core/src/Smol/Core/Modules/Types/ModuleError.hs
@@ -5,19 +5,20 @@ module Smol.Core.Modules.Types.ModuleError
     moduleErrorDiagnostic,
     ResolveDepsError (..),
     TestError (..),
-    Duplicate(..)
+    Duplicate (..),
   )
 where
+
 import Data.Maybe (catMaybes)
 import Data.Set (Set)
 import qualified Data.Text as T
 import qualified Error.Diagnose as Diag
 import Smol.Core.Interpreter.Types.InterpreterError
 import Smol.Core.Modules.Types.DefIdentifier
 import Smol.Core.Modules.Types.TestName
+import Smol.Core.SourceSpan (sourceSpan, ssColEnd, ssColStart, ssRowEnd, ssRowStart)
 import Smol.Core.Typecheck
 import Smol.Core.Types
-import Smol.Core.SourceSpan (sourceSpan,ssRowStart,ssColStart,ssRowStart,ssRowEnd,ssColEnd)
 
 -- todo: make share library for this
 positionFromAnnotation ::
@@ -31,10 +32,9 @@ positionFromAnnotation path input (Location locStart locEnd) =
           (ssRowStart ss, ssColStart ss)
           (ssRowEnd ss, ssColEnd ss)
           path
-      dropOneAnn = Location locStart (locEnd -2 ) -- TODO: the real fix is drop trailing linebreaks in parsing
+      dropOneAnn = Location locStart (locEnd - 2) -- TODO: the real fix is drop trailing linebreaks in parsing
    in toPos <$> sourceSpan input dropOneAnn
 
-
 data TestError ann
   = TestDoesNotTypecheck T.Text (TCError ann)
   deriving stock (Eq, Ord, Show)
@@ -68,7 +68,7 @@ resolveDepsErrorDiagnostic (CannotFindTypes tys) =
 
 data Duplicate thing ann
   = Duplicate thing ann ann
-  deriving stock (Eq,Ord,Show)
+  deriving stock (Eq, Ord, Show)
 
 data ModuleError ann
   = DuplicateDefinition (Duplicate Identifier ann)
@@ -85,81 +85,75 @@ data ModuleError ann
   deriving stock (Eq, Ord, Show)
 
 moduleErrorDiagnostic :: T.Text -> ModuleError Annotation -> Diag.Diagnostic T.Text
-moduleErrorDiagnostic input moduleError
-  = let filename = "<repl>"
-        diag = Diag.addFile mempty filename (T.unpack input)
-  in case moduleError of
-    (DefDoesNotTypeCheck _ typeErr) ->
-      typeErrorDiagnostic input typeErr
-    (DictionaryPassingError typeErr) ->
-      typeErrorDiagnostic input typeErr
-    (ErrorInTest _ testErr) ->
-      testErrorDiagnostic testErr
-    (ErrorInInterpreter interpreterErr) ->
-      interpreterErrorDiagnostic interpreterErr
-    (ErrorInResolveDeps resolveErr) ->
-      resolveDepsErrorDiagnostic resolveErr
-    (EmptyTestName _expr) ->
-      Diag.addReport mempty $
+moduleErrorDiagnostic input moduleError =
+  let filename = "<repl>"
+      diag = Diag.addFile mempty filename (T.unpack input)
+   in case moduleError of
+        (DefDoesNotTypeCheck _ typeErr) ->
+          typeErrorDiagnostic input typeErr
+        (DictionaryPassingError typeErr) ->
+          typeErrorDiagnostic input typeErr
+        (ErrorInTest _ testErr) ->
+          testErrorDiagnostic testErr
+        (ErrorInInterpreter interpreterErr) ->
+          interpreterErrorDiagnostic interpreterErr
+        (ErrorInResolveDeps resolveErr) ->
+          resolveDepsErrorDiagnostic resolveErr
+        (EmptyTestName _expr) ->
+          Diag.addReport mempty $
             Diag.Err
               Nothing
-              (T.pack $ "Test name must not be empty!" )
+              (T.pack "Test name must not be empty!")
               []
               []
-
-    (DuplicateDefinition (Duplicate ident ann1 ann2))
-     -> Diag.addReport diag $
+        (DuplicateDefinition (Duplicate ident ann1 ann2)) ->
+          Diag.addReport diag $
             Diag.Err
               Nothing
-              (T.pack $ "Duplicate definition in module: " <> show ident )
-                      ( catMaybes
-                          [ (,)
-                              <$> positionFromAnnotation
-                                filename
-                                input
-                                ann1
-                              <*> pure
-                                ( Diag.This (T.pack "Defined here")
-                                ),
-                            (,)
-                              <$> positionFromAnnotation
-                                filename
-                                input
-                                ann2
-                              <*> pure (Diag.Where (T.pack "Also defined here"))
-                          ]
-                      )
-                      [Diag.Note $ T.pack "Remove one of these definitions"]
-    (DuplicateTypeName typeName)
-     -> Diag.addReport mempty $
+              (T.pack $ "Duplicate definition in module: " <> show ident)
+              ( catMaybes
+                  [ (,)
+                      <$> positionFromAnnotation
+                        filename
+                        input
+                        ann1
+                      <*> pure
+                        ( Diag.This (T.pack "Defined here")
+                        ),
+                    (,)
+                      <$> positionFromAnnotation
+                        filename
+                        input
+                        ann2
+                      <*> pure (Diag.Where (T.pack "Also defined here"))
+                  ]
+              )
+              [Diag.Note $ T.pack "Remove one of these definitions"]
+        (DuplicateTypeName typeName) ->
+          Diag.addReport mempty $
             Diag.Err
               Nothing
-              (T.pack $ "Duplicate type name definition in module: " <> show typeName )
+              (T.pack $ "Duplicate type name definition in module: " <> show typeName)
               []
               []
-    (DuplicateConstructor constructor)
-     -> Diag.addReport mempty $
+        (DuplicateConstructor constructor) ->
+          Diag.addReport mempty $
             Diag.Err
               Nothing
-              (T.pack $ "Duplicate constructor defined in module: " <> show constructor )
+              (T.pack $ "Duplicate constructor defined in module: " <> show constructor)
               []
               []
-    (DuplicateTypeclass typeclassName)
-     -> Diag.addReport mempty $
+        (DuplicateTypeclass typeclassName) ->
+          Diag.addReport mempty $
             Diag.Err
               Nothing
-              (T.pack $ "Duplicate typeclass defined in module: " <> show typeclassName )
+              (T.pack $ "Duplicate typeclass defined in module: " <> show typeclassName)
               []
               []
-    (MissingTypeclass typeclassName)
-     -> Diag.addReport mempty $
+        (MissingTypeclass typeclassName) ->
+          Diag.addReport mempty $
             Diag.Err
               Nothing
-              (T.pack $ "Could not find typeclass: " <> show typeclassName )
+              (T.pack $ "Could not find typeclass: " <> show typeclassName)
               []
               []
-
-
-
-
-
diff --git a/smol-core/src/Smol/Core/Modules/Types/ModuleItem.hs b/smol-core/src/Smol/Core/Modules/Types/ModuleItem.hs
@@ -12,7 +12,7 @@
 
 module Smol.Core.Modules.Types.ModuleItem
   ( ModuleItem (..),
-    ModuleExpression (..)
+    ModuleExpression (..),
   )
 where
 
@@ -58,13 +58,13 @@ deriving stock instance
   Show (ModuleItem ann)
 
 -- a top level expression
-data ModuleExpression ann
-  = ModuleExpressionC {
-      meAnn :: ann,
-      meIdent :: Identifier,
-      meArgs :: [Identifier],
-      meExpr :: Expr ParseDep ann
-  } deriving stock (Eq,Ord,Functor)
+data ModuleExpression ann = ModuleExpressionC
+  { meAnn :: ann,
+    meIdent :: Identifier,
+    meArgs :: [Identifier],
+    meExpr :: Expr ParseDep ann
+  }
+  deriving stock (Eq, Ord, Functor)
 
 deriving stock instance
   ( Show ann,

diff --git a/smol-core/src/Smol/Core/Modules/Types/TopLevelExpression.hs b/smol-core/src/Smol/Core/Modules/Types/TopLevelExpression.hs
@@ -5,30 +5,31 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
-  {-# LANGUAGE NamedFieldPuns #-}
+
 module Smol.Core.Modules.Types.TopLevelExpression
   ( TopLevelExpression (..),
-    getTopLevelExpressionAnnotation
+    getTopLevelExpressionAnnotation,
   )
 where
 
 import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import GHC.Generics (Generic)
+import Smol.Core.Typecheck.Annotations
 import Smol.Core.Typecheck.Types
 import Smol.Core.Types.Constructor
 import Smol.Core.Types.Expr
 import Smol.Core.Types.Identifier
 import Smol.Core.Types.Type
 import Smol.Core.Types.TypeName
-import Smol.Core.Typecheck.Annotations
 
 getTopLevelExpressionAnnotation :: (Monoid ann) => TopLevelExpression dep ann -> ann
-getTopLevelExpressionAnnotation (TopLevelExpression {tleExpr,tleType= Nothing})
-  = getExprAnnotation tleExpr
-getTopLevelExpressionAnnotation (TopLevelExpression {tleExpr,tleType= Just ty})
-  = getExprAnnotation tleExpr <> getTypeAnnotation ty
+getTopLevelExpressionAnnotation (TopLevelExpression {tleExpr, tleType = Nothing}) =
+  getExprAnnotation tleExpr
+getTopLevelExpressionAnnotation (TopLevelExpression {tleExpr, tleType = Just ty}) =
+  getExprAnnotation tleExpr <> getTypeAnnotation ty
 
 -- a module is, broadly, one file
 -- it defines some datatypes, infixes and definitions

diff --git a/smol-core/src/Smol/Core/Parser/Module.hs b/smol-core/src/Smol/Core/Parser/Module.hs
@@ -63,21 +63,24 @@ moduleTypeDeclarationParser = ModuleDataType <$> dataTypeParser
 moduleDefinitionParser :: Parser (ModuleItem Annotation)
 moduleDefinitionParser =
   let parser = do
-            myString "def"
-            ident <- identifierParser
-            args <-
-              chainl1 ((: []) <$> identifierParser) (pure (<>))
-                <|> pure mempty
-            myString "="
-            (,,) ident args <$> expressionParser
-  in withLocation
+        myString "def"
+        ident <- identifierParser
+        args <-
+          chainl1 ((: []) <$> identifierParser) (pure (<>))
+            <|> pure mempty
+        myString "="
+        (,,) ident args <$> expressionParser
+   in withLocation
         ( \ann (ident, args, expr) ->
-            ModuleExpression (ModuleExpressionC {
-              meAnn = ann,
-              meIdent = ident,
-              meArgs = args,
-              meExpr = expr}
-                             ))
+            ModuleExpression
+              ( ModuleExpressionC
+                  { meAnn = ann,
+                    meIdent = ident,
+                    meArgs = args,
+                    meExpr = expr
+                  }
+              )
+        )
         parser
 
 -- top level type definition