Add types for name analysis

elna.cabal

@@ -28,9 +28,15 @@ library elna-internal
     import: warnings
     exposed-modules:
         Language.Elna.AST
+        Language.Elna.Location
+        Language.Elna.NameAnalysis
         Language.Elna.Parser
+        Language.Elna.SymbolTable
     build-depends:
-        parser-combinators ^>= 1.3
+        hashable ^>= 1.4.3,
+        parser-combinators ^>= 1.3,
+        vector ^>= 0.13.1,
+        unordered-containers ^>= 0.2.20
     hs-source-dirs: lib
 
 executable elna

lib/Language/Elna/AST.hs

@@ -12,34 +12,20 @@ module Language.Elna.AST
 
 import Data.Int (Int32)
 import Data.List (intercalate)
-import Data.Word (Word16)
-import Data.Text (Text)
-import qualified Data.Text as Text
+import Data.Word (Word16, Word32)
 import Data.Char (chr)
-import Data.String (IsString(..))
+import Language.Elna.Location (Identifier(..), showArrayType)
 import Numeric (showHex)
 
-newtype Identifier = Identifier { unIdentifier :: Text }
-    deriving Eq
-
-instance Show Identifier
-  where
-    show (Identifier identifier) = Text.unpack identifier
-
-instance IsString Identifier
-  where
-    fromString = Identifier . Text.pack
-
 data TypeExpression
     = NamedType Identifier
-    | ArrayType TypeExpression Int32
+    | ArrayType Word32 TypeExpression
     deriving Eq
 
 instance Show TypeExpression
   where
     show (NamedType typeName) = show typeName
-    show (ArrayType typeName elementCount) = concat
-        [show typeName, "[", show elementCount, "]"]
+    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
 
 data Literal
     = IntegerLiteral Int32

lib/Language/Elna/Location.hs

@@ -0,0 +1,58 @@
+module Language.Elna.Location
+    ( Identifier(..)
+    , Location(..)
+    , Node(..)
+    , showArrayType
+    ) where
+
+import Data.Hashable (Hashable(..))
+import Data.String (IsString(..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Word (Word32)
+
+data Location = Location
+    { line :: Word32
+    , column :: Word32
+    } deriving (Eq, Show)
+
+instance Semigroup Location
+  where
+    (Location thisLine thisColumn) <> (Location thatLine thatColumn) = Location
+        { line = thisLine + thatLine
+        , column = thisColumn + thatColumn
+        }
+
+instance Monoid Location
+  where
+   mempty = Location{ line = 1, column = 1 }
+
+data Node a = Node a Location
+    deriving (Eq, Show)
+
+instance Functor Node
+  where
+    fmap f (Node node location) = Node (f node) location
+
+newtype Identifier = Identifier { unIdentifier :: Text }
+    deriving Eq
+
+instance Show Identifier
+  where
+    show (Identifier identifier) = Text.unpack identifier
+
+instance IsString Identifier
+  where
+    fromString = Identifier . Text.pack
+
+instance Ord Identifier
+  where
+    compare (Identifier lhs) (Identifier rhs) = compare lhs rhs
+
+instance Hashable Identifier
+  where
+    hashWithSalt salt (Identifier identifier) = hashWithSalt salt identifier
+
+showArrayType :: Show a => Word32 -> a -> String
+showArrayType elementCount typeName = concat
+    ["array[", show elementCount, "] of ", show typeName]

lib/Language/Elna/NameAnalysis.hs

@@ -0,0 +1,3 @@
+module Language.Elna.NameAnalysis
+    (
+    ) where

lib/Language/Elna/Parser.hs

@@ -80,7 +80,7 @@ typeExpressionP = arrayTypeExpression
     <|> NamedType <$> identifierP
     <?> "type expression"
   where
-    arrayTypeExpression = flip ArrayType
+    arrayTypeExpression = ArrayType
         <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
         <*> (symbol "of" *> typeExpressionP)
 

lib/Language/Elna/SymbolTable.hs

@@ -0,0 +1,45 @@
+module Language.Elna.SymbolTable
+    ( Info(..)
+    , ParameterInfo(..)
+    , SymbolTable(..)
+    , Type(..)
+    , booleanType
+    , intType
+    ) where
+
+import Data.HashMap.Strict (HashMap)
+import Data.Text (Text)
+import Data.Vector (Vector)
+import Data.Word (Word32)
+import Language.Elna.Location (Identifier(..), showArrayType)
+
+data Type
+    = PrimitiveType Text
+    | ArrayType Word32 Type
+    deriving Eq
+
+instance Show Type
+  where
+    show (PrimitiveType typeName) = show typeName
+    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
+
+intType :: Type
+intType = PrimitiveType "int"
+
+booleanType :: Type
+booleanType = PrimitiveType "boolean"
+
+newtype SymbolTable = SymbolTable (HashMap Identifier Info)
+    deriving (Eq, Show)
+
+data ParameterInfo = ParameterInfo
+    { name :: Identifier
+    , type' :: Type
+    , isReferenceParameter :: Bool
+    } deriving (Eq, Show)
+
+data Info
+    = TypeInfo Type
+    | VariableInfo Type Bool
+    | ProcedureInfo SymbolTable (Vector ParameterInfo)
+    deriving (Eq, Show)

tests/Language/Elna/ParserSpec.hs

@@ -29,21 +29,21 @@ spec =
              in actual `shouldParse` expected
 
         it "parses array type definition" $
-            let expected = Program [TypeDefinition "t" $ ArrayType (NamedType "integer") 10]
-                actual = parse programP "" "type t = array[10] of integer"
+            let expected = Program [TypeDefinition "t" $ ArrayType 10 (NamedType "int")]
+                actual = parse programP "" "type t = array[10] of int"
              in actual `shouldParse` expected
 
         it "parses parameters" $
-            let given = "proc main(x: integer) {}"
-                parameters = [Parameter "x" (NamedType "integer") False]
+            let given = "proc main(x: int) {}"
+                parameters = [Parameter "x" (NamedType "int") False]
                 expected = Program [ProcedureDefinition "main" parameters [] []]
                 actual = parse programP "" given
              in actual `shouldParse` expected
 
         it "parses ref parameters" $
-            let given = "proc main(x: integer, ref y: boolean) {}"
+            let given = "proc main(x: int, ref y: boolean) {}"
                 parameters =
-                    [ Parameter "x" (NamedType "integer") False
+                    [ Parameter "x" (NamedType "int") False
                     , Parameter "y" (NamedType "boolean") True
                     ]
                 expected = Program [ProcedureDefinition "main" parameters [] []]
@@ -51,7 +51,7 @@ spec =
              in actual `shouldParse` expected
 
         it "parses variable declaration" $
-            let given = "proc main() { var x: integer; }"
+            let given = "proc main() { var x: int; }"
                 expected (Program [ProcedureDefinition _ _ variables _]) =
                     not $ null variables
                 expected _ = False
@@ -59,11 +59,11 @@ spec =
              in actual `parseSatisfies` expected
 
         it "parses negation" $
-            let given = "proc main(x: integer) { var y: integer; y := -x; }"
-                parameters = pure $ Parameter "x" (NamedType "integer") False
+            let given = "proc main(x: int) { var y: int; y := -x; }"
+                parameters = pure $ Parameter "x" (NamedType "int") False
                 variables = pure
                     $ VariableDeclaration "y"
-                    $ NamedType "integer"
+                    $ NamedType "int"
                 body = pure
                     $ AssignmentStatement (VariableExpression "y")
                     $ NegationExpression
@@ -91,10 +91,10 @@ spec =
              in actual `shouldParse` expected
 
         it "parses hexadecimals" $
-            let given = "proc main() { var x: integer; x := 0x10; }"
+            let given = "proc main() { var x: int; x := 0x10; }"
                 variables = pure
                     $ VariableDeclaration "x"
-                    $ NamedType "integer"
+                    $ NamedType "int"
                 body = pure
                     $ AssignmentStatement (VariableExpression "x")
                     $ LiteralExpression (HexadecimalLiteral 16)