diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs index 5ecfb297f..3fd5b5d06 100644 --- a/tools/lsp/squirrel/app/Main.hs +++ b/tools/lsp/squirrel/app/Main.hs @@ -1,7 +1,10 @@ +import Data.Foldable (for_) + import ParseTree import Parser import AST +import PrettyPrint import System.Environment @@ -9,4 +12,8 @@ main :: IO () main = do [fin] <- getArgs toParseTree fin >>= print - runParser contract fin >>= print \ No newline at end of file + (res, errs) <- runParser contract fin + print (pp res) + putStrLn "" + putStrLn "Errors:" + for_ errs (print . nest 2 . pp) \ No newline at end of file diff --git a/tools/lsp/squirrel/squirrel.cabal b/tools/lsp/squirrel/squirrel.cabal index 3878f4801..5d65b8a13 100644 --- a/tools/lsp/squirrel/squirrel.cabal +++ b/tools/lsp/squirrel/squirrel.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: f4f92cb29b0c7d516e57ceee58c9d82900fc41d82cf21f7aa033094288165072 +-- hash: 9aa7bb8abf29ee513a2033ae2b0ef8310107294ad348fa7510ec615a1b11c4ea name: squirrel version: 0.0.0 @@ -14,6 +14,7 @@ library exposed-modules: AST AST.Parser + AST.Pretty AST.Types Parser ParseTree diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index a1880700f..1cdad1e35 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -60,9 +60,13 @@ binding = do stubbed "type" do field "type" type_ consume "is" - expr <- stubbed "body" do - field "locals" anything - return (Function info (recur == Just "recursive") name params ty expr) + exp <- stubbed "body" do + field "expr" expr + return (Function info (recur == Just "recursive") name params ty exp) + +expr :: Parser (Expr Range) +expr = do + fallback "expr" paramDecl :: Parser (VarDecl Range) paramDecl = do diff --git a/tools/lsp/squirrel/src/AST/Pretty.hs b/tools/lsp/squirrel/src/AST/Pretty.hs index ccc3d0245..16efc53fa 100644 --- a/tools/lsp/squirrel/src/AST/Pretty.hs +++ b/tools/lsp/squirrel/src/AST/Pretty.hs @@ -5,18 +5,98 @@ import AST.Types import PrettyPrint import Parser --- instance Pretty (Contract i) where --- pp (Contract _ decls) = --- hang "(* contract *)" 2 do --- vcat $ map (($$ empty) . pp) decls +instance Pretty (Contract i) where + pp = \case + Contract _ decls -> + hang "(* contract *)" 2 do + vcat $ map (($$ empty) . pp) decls --- pp (WrongContract err) = --- pp err + WrongContract err -> + pp err --- instance Pretty Error where --- pp +instance Pretty (Declaration i) where + pp = \case + ValueDecl _ binding -> pp binding + WrongDecl err -> pp err --- instance Pretty (Declaration i) where --- pp ( +instance Pretty (Binding i) where + pp = \case + Irrefutable _ pat expr -> error "irrefs in pascaligo?" + Function _ isRec name params ty body -> + hang + ( fsep + [ if isRec then "recursive" else empty + , "function" + , pp name + , parens $ fsep $ punctuate "," $ map pp params + , ":" + , pp ty + , "is" + ] + ) + 2 + (pp body) + WrongBinding err -> + pp err --- wrap [l, r] a = hang (hang l 2 r) 0 r \ No newline at end of file +instance Pretty (VarDecl i) where + pp = \case + Decl _ mutability name ty -> fsep + [ pp mutability + , pp name + , ":" + , pp ty + ] + WrongVarDecl err -> + pp err + +instance Pretty (Mutable i) where + pp = \case + Mutable _ -> "var" + Immutable _ -> "const" + WrongMutable err -> pp err + +instance Pretty (Type i) where + pp = \case + TArrow _ dom codom -> parens (pp dom <+> "->" <+> pp codom) + Record _ fields -> wrap ["record [", "]"] $ vcat $ map ppField fields + TVar _ name -> pp name + Sum _ variants -> vcat $ map ppCtor variants + Product _ elements -> fsep $ punctuate " *" $ map pp elements + TApply _ f xs -> pp f <> parens (fsep $ punctuate "," $ map pp xs) + WrongType err -> pp err + where + ppField (name, ty) = pp name <> ": " <> pp ty <> ";" + ppCtor (ctor, fields) = + "|" <+> pp ctor <+> parens (fsep $ punctuate "," $ map pp fields) + +instance Pretty (Expr i) where + pp = \case + Let _ decls body -> hang "let" 2 (vcat $ map pp decls) + <> hang "in" 2 (pp body) + Apply _ f xs -> pp f <> parens (fsep $ punctuate "," $ map pp xs) + Constant _ constant -> pp constant + Ident _ qname -> pp qname + WrongExpr err -> pp err + + +instance Pretty (Constant i) where + pp = \case + Int _ c -> int c + String _ c -> doubleQuotes (pp c) + Float _ c -> double c + Bytes _ c -> pp c + WrongConstant err -> pp err + +instance Pretty (QualifiedName i) where + pp = \case + QualifiedName _ src path -> pp src <> cat (map (("." <>) . pp) path) + WrongQualifiedName err -> pp err + + +instance Pretty (Name i) where + pp = \case + Name _ raw -> pp raw + WrongName err -> pp err + +wrap [l, r] a = hang (hang l 2 r) 0 r \ No newline at end of file diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs index e51c3d323..31af78534 100644 --- a/tools/lsp/squirrel/src/AST/Types.hs +++ b/tools/lsp/squirrel/src/AST/Types.hs @@ -32,7 +32,7 @@ instance Stubbed (Declaration info) where stub = WrongDecl data Binding info = Irrefutable info (Pattern info) (Expr info) - | Function info Bool (Name info) [VarDecl info] (Type info) TODO + | Function info Bool (Name info) [VarDecl info] (Type info) (Expr info) | WrongBinding Error deriving stock (Show) @@ -67,7 +67,7 @@ instance Stubbed (Type info) where stub = WrongType data Expr info = Let info [Declaration info] (Expr info) - | Apply info (Expr info) (Expr info) + | Apply info (Expr info) [Expr info] | Constant info (Constant info) | Ident info (QualifiedName info) | WrongExpr Error @@ -94,10 +94,12 @@ data Pattern info instance Stubbed (Pattern info) where stub = WrongPattern -data QualifiedName info = QualifiedName - { source :: Name info - , path :: [Name info] - } +data QualifiedName info + = QualifiedName + { qnInfo :: info + , qnSource :: Name info + , qnPath :: [Name info] + } | WrongQualifiedName Error deriving stock (Show) diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index 20d6754c1..4f48b559f 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/tools/lsp/squirrel/src/Parser.hs @@ -15,6 +15,7 @@ import Data.ByteString (ByteString) import ParseTree import Range +import PrettyPrint import Debug.Trace @@ -26,6 +27,10 @@ data Error } deriving stock (Show) +instance Pretty Error where + pp (Expected msg found r) = "<" <> pp msg <> pp r <> ": " <> pp found <> ">" + + newtype Parser a = Parser { unParser :: WriterT [Error] diff --git a/tools/lsp/squirrel/src/PrettyPrint.hs b/tools/lsp/squirrel/src/PrettyPrint.hs index d8d3e69ee..cb96ac958 100644 --- a/tools/lsp/squirrel/src/PrettyPrint.hs +++ b/tools/lsp/squirrel/src/PrettyPrint.hs @@ -5,7 +5,12 @@ module PrettyPrint ) where +import Data.Text + import Text.PrettyPrint hiding ((<>)) class Pretty p where - pp :: p -> Doc \ No newline at end of file + pp :: p -> Doc + +instance Pretty Text where + pp = text . unpack \ No newline at end of file