Implementing global variable assignment (:=)

Author: mirvoxtm

src/Language/Ast.hs

@@ -145,6 +145,7 @@ data Clause = Clause [Pattern] FunctionBody
 data Command = Skip
                 | Print Expression
                 | Assign String Expression                    -- (=)
+                | GlobalAssign String Expression              -- (:=) - global assignment
                 | AssignIndex String [Expression] Expression  -- var[idx..] = expr
                 | Conditional Expression Command Command      -- if-then-else
                 | Repeat Expression Command                   -- for 3 do {}

src/Language/Eval.hs

@@ -15,6 +15,14 @@ import Text.Megaparsec (errorBundlePretty, sourcePosPretty, SourcePos)
 import Text.Megaparsec.Pos (sourceName, sourceLine, sourceColumn, unPos)
 import Data.List (isInfixOf)
 import qualified Language.FFI as FFI
+import Control.Concurrent.MVar
+import System.Mem.StableName
+
+-- Global mutable reference to the global scope using MVar
+{-# NOINLINE globalScopeMVar #-}
+globalScopeMVar :: MVar (Hashtable String Value)
+globalScopeMVar = unsafePerformIO $ do
+    newMVar emptyHashtable
 
 -- | Error type for better error messages
 data EvalError = EvalError
@@ -107,8 +115,69 @@ interpretCommand mpos (Assign name expr) table =
         Right v@(Function _)  -> return (insertHashtable table name v)
         Right v@(Lambda _)    -> return (insertHashtable table name v)
         Right v@(AlgebraicDataType _ _) -> return (insertHashtable table name v)
-        Right v@(CBinding _ _) -> return (insertHashtable table name v)
-        Right v@(NaN)          -> return (insertHashtable table name v)
+
+interpretCommand mpos (GlobalAssign name expr) table =
+    case evaluate expr table of
+        Right v@(Integer _)   -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Double _)    -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Boolean _)   -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Character _) -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(List _ _)    -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Set _ _)     -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Object _)    -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Function _)  -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(Lambda _)    -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(AlgebraicDataType _ _) -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(CBinding _ _) -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
+        Right v@(NaN)          -> do
+            globalScope <- takeMVar globalScopeMVar
+            let newGlobalScope = insertHashtable globalScope name v
+            putMVar globalScopeMVar newGlobalScope
+            return (insertHashtable table name v)
         Right v               -> die (mkEvalErrorHint mpos
             ("cannot assign unexpected value to '" ++ name ++ "'")
             ("value type: " ++ show v))
@@ -503,10 +572,17 @@ evaluate (Index expr idxExpr) table = do
                 Nothing -> Left $ mkEvalError Nothing ("key '" ++ [c] ++ "' not found")
         _ -> Left $ mkEvalError Nothing ("cannot index " ++ getValueType collection ++ " with " ++ getValueType idx)
 
-evaluate (Variable name) table =
-    case lookupHashtable table name of
-        Just val -> Right val
-        Nothing  -> Right Undefined
+evaluate (Variable name) table = unsafePerformIO $ do
+    globalScopeNow <- readMVar globalScopeMVar
+    case lookupHashtable globalScopeNow name of
+        Just val -> do
+            return (Right val)
+        Nothing  ->
+            case lookupHashtable table name of
+                Just val -> do
+                    return (Right val)
+                Nothing  -> do
+                    return (Right Undefined)
 
 evaluate (ReadFile filenameExpr) table = do
     pathVal <- evaluate filenameExpr table

src/Parsing/Parser.hs

@@ -384,25 +384,30 @@ parseVarWithIndices = do
     return (varName, idxs)
 
 parseAssignment :: Parser Command
-parseAssignment = try parseIndexedAssign <|> parseSimpleAssign
+parseAssignment = try parseIndexedAssign <|> try parseGlobalAssign <|> parseSimpleAssign
   where
     parseIndexedAssign = try $ do
         (varName, idxs) <- lexeme parseVarWithIndices
         if null idxs then fail "no indices" else pure ()
-        -- Allow zero-or-more horizontal whitespace between the variable and '='
         _ <- optional scn
         _ <- symbol "="
-        _ <- optional sc  -- allow newline before rhs
+        _ <- optional sc
         expr <- parseExpression
         return $ AssignIndex varName idxs expr
+    parseGlobalAssign = do
+        (varName, idxs) <- lexeme parseVarWithIndices
+        if not (null idxs) then fail "indexed" else pure ()
+        _ <- optional scn
+        _ <- symbol ":="
+        _ <- optional sc
+        expr <- parseExpression
+        return $ GlobalAssign varName expr
     parseSimpleAssign = do
         (varName, idxs) <- lexeme parseVarWithIndices
         if not (null idxs) then fail "indexed" else pure ()
-        -- Allow zero-or-more horizontal whitespace between the variable and '='
         _ <- optional scn
         _ <- symbol "="
-        _ <- optional sc  -- allow newline before rhs
-        -- Check if right-hand side is input() call
+        _ <- optional sc
         inputCall <- optional $ try $ do
             _ <- keyword "input"
             _ <- symbolNoNl "("