Can generate some code for static arrays.

src/Emit.hs

@@ -96,6 +96,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
           case obj xobj of
             Lst _   -> visitList indent xobj
             Arr _   -> visitArray indent xobj
+            StaticArr _ -> visitStaticArray indent xobj
             Num IntTy num -> return (show (round num :: Int))
             Num LongTy num -> return (show (round num :: Int) ++ "l")
             Num ByteTy num -> return (show (round num :: Int))
@@ -581,7 +582,6 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                           " .data = CARP_MALLOC(sizeof(" ++ tyToCLambdaFix innerTy ++ ") * " ++ show len ++ ") };\n")
              zipWithM_ (visitArrayElement indent arrayVar innerTy) [0..] xobjs
              return arrayVar
-
         visitArray _ _ = error "Must visit array!"
 
         visitArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
@@ -591,6 +591,27 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                           ".data)[" ++ show index ++ "] = " ++ visited ++ ";\n")
              return ()
 
+        visitStaticArray :: Int -> XObj -> State EmitterState String
+        visitStaticArray indent (XObj (StaticArr xobjs) (Just i) t) =
+          do let arrayVar = freshVar i
+                 arrayDataVar = arrayVar ++ "_data"
+                 len = length xobjs
+                 Just (RefTy (StructTy "StaticArray" [innerTy]) _) = t
+             appendToSrc (addIndent indent ++ tyToCLambdaFix innerTy ++ " " ++ arrayDataVar ++ "[" ++ show len ++ "];\n")
+             appendToSrc (addIndent indent ++ "Array " ++ arrayVar ++
+                           " = { .len = " ++ show len ++ "," ++
+                          " /* .capacity = DOES NOT MATTER, STACK ALLOCATED ARRAY, */" ++
+                          " .data = " ++ arrayDataVar ++ " };\n")
+             zipWithM_ (visitStaticArrayElement indent arrayDataVar innerTy) [0..] xobjs
+             return arrayVar
+        visitStaticArray _ _ = error "Must visit static array!"
+
+        visitStaticArrayElement :: Int -> String -> Ty -> Int -> XObj -> State EmitterState ()
+        visitStaticArrayElement indent arrayDataVar innerTy index xobj =
+          do visited <- visit indent xobj
+             appendToSrc (addIndent indent ++ arrayDataVar ++ "[" ++ show index ++ "] = " ++ visited ++ ";\n")
+             return ()
+
 delete :: Int -> Info -> State EmitterState ()
 delete indent i = mapM_ deleterToC (infoDelete i)
   where deleterToC :: Deleter -> State EmitterState ()
@@ -824,6 +845,7 @@ checkForUnresolvedSymbols = visit
           case obj xobj of
             (Lst _) -> visitList xobj
             (Arr _) -> visitArray xobj
+            (StaticArr _) -> visitStaticArray xobj
             (MultiSym _ _) -> Left (UnresolvedMultiSymbol xobj)
             (InterfaceSym _) -> Left (UnresolvedInterfaceSymbol xobj)
             _ -> return ()
@@ -842,6 +864,13 @@ checkForUnresolvedSymbols = visit
         Right _ -> return ()
     visitArray _ = error "The function 'visitArray' only accepts XObjs with arrays in them."
 
+    visitStaticArray :: XObj -> Either ToCError ()
+    visitStaticArray (XObj (StaticArr xobjs) i t) =
+      case mapM visit xobjs of
+        Left e -> Left e
+        Right _ -> return ()
+    visitStaticArray _ = error "The function 'visitStaticArray' only accepts XObjs with arrays in them."
+
 wrapInInitFunction :: Bool -> String -> String
 wrapInInitFunction with_core src =
   "void carp_init_globals(int argc, char** argv) {\n" ++

src/GenerateConstraints.hs

@@ -248,4 +248,19 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                                headConstraint = Constraint headTy t headObj (genObj x 1) xobj OrdArrHead
                            return (headConstraint : insideExprConstraints ++ betweenExprConstraints)
 
+            -- THIS CODE IS VERY MUCH A DUPLICATION OF THE 'ARR' CODE FROM ABOVE:
+            (StaticArr arr) ->
+              case arr of
+                [] -> Right []
+                x:xs -> do insideExprConstraints <- fmap join (mapM gen arr)
+                           let Just headTy = ty x
+                               genObj o n = XObj (Sym (SymPath [] ("Whereas the " ++ enumerate n ++ " element in the array is " ++ show (getPath o))) Symbol)
+                                  (info o) (ty o)
+                               headObj = XObj (Sym (SymPath [] ("I inferred the type of the static array from its first element " ++ show (getPath x))) Symbol)
+                                  (info x) (Just headTy)
+                               Just (RefTy(StructTy "StaticArray" [t]) _) = ty xobj
+                               betweenExprConstraints = zipWith (\o n -> Constraint headTy (forceTy o) headObj (genObj o n) xobj OrdArrBetween) xs [1..]
+                               headConstraint = Constraint headTy t headObj (genObj x 1) xobj OrdArrHead
+                           return (headConstraint : insideExprConstraints ++ betweenExprConstraints)
+
             _ -> Right []

src/InitialTypes.hs

@@ -77,6 +77,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                        (Command _)        -> return (Right (xobj { ty = Just DynamicTy }))
                        (Lst _)            -> visitList env xobj
                        (Arr _)            -> visitArray env xobj
+                       (StaticArr _)      -> visitStaticArray env xobj
                        (Dict _)           -> visitDictionary env xobj
                        (Sym symPath _)    -> visitSymbol env xobj symPath
                        (MultiSym _ paths) -> visitMultiSym env xobj paths
@@ -147,6 +148,16 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
 
     visitArray _ _ = error "The function 'visitArray' only accepts XObj:s with arrays in them."
 
+    visitStaticArray :: Env -> XObj -> State Integer (Either TypeError XObj)
+    visitStaticArray env (XObj (StaticArr xobjs) i _) =
+      do visited <- mapM (visit env) xobjs
+         arrayVarTy <- genVarTy
+         lt <- genVarTy
+         return $ do okVisited <- sequence visited
+                     Right (XObj (StaticArr okVisited) i (Just (RefTy (StructTy "StaticArray" [arrayVarTy]) lt)))
+
+    visitStaticArray _ _ = error "The function 'visitStaticArray' only accepts XObj:s with arrays in them."
+
     visitDictionary :: Env -> XObj -> State Integer (Either TypeError XObj)
     visitDictionary env (XObj (Dict xobjs) i _) =
       do visited <- mapM (visit env) xobjs

src/Lookup.hs

@@ -192,7 +192,7 @@ isExternalType _ _ =
 -- | Is this type managed - does it need to be freed?
 isManaged :: TypeEnv -> Ty -> Bool
 isManaged typeEnv (StructTy name _) =
-  (name == "Array") || (name == "Dictionary") || (
+  (name == "Array") || (name == "StaticArray") || (name == "Dictionary") || (
     case lookupInEnv (SymPath [] name) (getTypeEnv typeEnv) of
          Just (_, Binder _ (XObj (Lst (XObj ExternalType _ _ : _)) _ _)) -> False
          Just (_, Binder _ (XObj (Lst (XObj (Deftype _) _ _ : _)) _ _)) -> True

src/Obj.hs

@@ -54,6 +54,7 @@ data Obj = Sym SymPath SymbolMode
          | Bol Bool
          | Lst [XObj]
          | Arr [XObj]
+         | StaticArr [XObj]
          | Dict (Map.Map XObj XObj)
          | Closure XObj ClosureContext
          | Defn (Maybe (Set.Set XObj)) -- if this is a lifted lambda it needs the set of captured variables
@@ -264,6 +265,7 @@ pretty = visit 0
           case obj xobj of
             Lst lst -> "(" ++ joinWithSpace (map (visit indent) lst) ++ ")"
             Arr arr -> "[" ++ joinWithSpace (map (visit indent) arr) ++ "]"
+            StaticArr arr -> "❪" ++ joinWithSpace (map (visit indent) arr) ++ "❫"
             Dict dict -> "{" ++ joinWithSpace (map (visit indent) (concatMap (\(a, b) -> [a, b]) (Map.toList dict))) ++ "}"
             Num IntTy num -> show (round num :: Int)
             Num LongTy num -> show num ++ "l"

src/Parsing.hs

@@ -327,6 +327,16 @@ array = do i <- createInfo
            incColumn 1
            return (XObj (Arr objs) i Nothing)
 
+staticArray :: Parsec.Parsec String ParseState XObj
+staticArray =
+  do i <- createInfo
+     _ <- Parsec.string "❪"
+     incColumn 2
+     objs <- readObjs
+     _ <- Parsec.string "❫"
+     incColumn 2
+     return (XObj (StaticArr objs) i Nothing)
+
 list :: Parsec.Parsec String ParseState XObj
 list = do i <- createInfo
           _ <- Parsec.char '('
@@ -386,7 +396,7 @@ quote = do i1 <- createInfo
            return (XObj (Lst [XObj (Sym (SymPath [] "quote") Symbol) i1 Nothing, expr]) i2 Nothing)
 
 sexpr :: Parsec.Parsec String ParseState XObj
-sexpr = do x <- Parsec.choice [ref, deref, copy, quote, list, array, dictionary, atom]
+sexpr = do x <- Parsec.choice [ref, deref, copy, quote, list, staticArray, array, dictionary, atom]
            _ <- whitespaceOrNothing
            return x