Add degenerate implementation of MVars.

This implementation will error out whenever a code path blocks on an MVar,
as the non-concurrent environment guarantees that no other thread will come
along to unblock the MVar.

This commit fixes half of #11.

haste.cabal

@@ -21,6 +21,7 @@ Data-Files:
  stdlib.js
  eval.js
  eval-trampoline.js
+ MVar.js
 
 Library
  Hs-Source-Dirs: src

lib/MVar.js

@@ -0,0 +1,56 @@
+// MVar implementation.
+// Since Haste isn't concurrent, takeMVar and putMVar don't block on empty
+// and full MVars respectively, but terminate the program since they would
+// otherwise be blocking forever.
+
+function newMVar(st) {
+ return [1, st, {empty: true}];
+}
+
+function tryTakeMVar(mv, st) {
+ if(mv.empty) {
+ return [1, st, 0, undefined];
+ } else {
+ mv.empty = true;
+ mv.x = null;
+ return [1, st, 1, mv.x];
+ }
+}
+
+function takeMVar(mv, st) {
+ if(mv.empty) {
+ // TODO: real BlockedOnDeadMVar exception, perhaps?
+ err("Attempted to take empty MVar!");
+ }
+ mv.empty = true;
+ mv.x = null;
+ return [1,st,mv.x];
+}
+
+function putMVar(mv, val, st) {
+ if(!mv.empty) {
+ // TODO: real BlockedOnDeadMVar exception, perhaps?
+ err("Attempted to put full MVar!");
+ }
+ mv.empty = false;
+ mv.x = val;
+ return [1,st];
+}
+
+function tryPutMVar(mv, val, st) {
+ if(!mv.empty) {
+ return [1, st, 0];
+ } else {
+ mv.empty = false;
+ mv.x = val;
+ return [1, st, 1];
+ }
+}
+
+function sameMVar(a, b) {
+ return (a == b);
+}
+
+function isEmptyMVar(mv, st) {
+ return [1, st, mv.empty ? 1 : 0];
+}

src/BootVer.hs

@@ -21,7 +21,7 @@ data RebuildInfo = Dont | Libs | Everything
 bootVer :: BootVer
 bootVer = BootVer {
  codegenVer = 1,
- libVer = 1
+ libVer = 2
  }
 
 -- | Returns which parts of Haste need rebooting. A change in the boot file

src/CodeGen/Javascript/Config.hs

@@ -1,5 +1,5 @@
 module CodeGen.Javascript.Config (
- Config (..), AppStart, defConfig, stdRtsLib, stdJSLib, startASAP,
+ Config (..), AppStart, defConfig, stdJSLibs, startASAP,
  startOnLoadComplete, appName, sysLibPath, hastePath, evalTrampolining,
  eval, fastMultiply, safeMultiply) where
 import CodeGen.Javascript.PrettyM (PrettyOpts, compact)
@@ -12,11 +12,10 @@ import Paths_haste_compiler (getDataFileName)
 
 type AppStart = String -> String
 
-stdRtsLib :: FilePath
-stdRtsLib = unsafePerformIO $ getDataFileName "rts.js"
-
-stdJSLib :: FilePath
-stdJSLib = unsafePerformIO $ getDataFileName "stdlib.js"
+stdJSLibs :: [FilePath]
+stdJSLibs = unsafePerformIO $ mapM getDataFileName [
+ "rts.js", "stdlib.js", "MVar.js"
+ ]
 
 -- | Name of the application; decides which directories to keep app specific
 -- data in.
@@ -102,7 +101,7 @@ data Config = Config {
 -- | Default compiler configuration.
 defConfig :: Config
 defConfig = Config {
- rtsLibs = [stdRtsLib,stdJSLib],
+ rtsLibs = stdJSLibs,
  evalLib = eval,
  libPath = sysLibPath,
  targetLibPath = ".",

src/CodeGen/Javascript/PrimOps.hs

@@ -169,6 +169,15 @@ genOp cfg op xs =
  UnsafeFreezeByteArrayOp -> Right $ Array $ [litN 1,xs!!1,xs!!0]
  ByteArrayContents_Char -> Right $ head xs
 
+ -- MVars
+ NewMVarOp -> call "newMVar"
+ TakeMVarOp -> call "takeMVar"
+ TryTakeMVarOp -> call "tryTakeMVar"
+ PutMVarOp -> call "putMVar"
+ TryPutMVarOp -> call "tryPutMVar"
+ SameMVarOp -> call "sameMVar"
+ IsEmptyMVarOp -> call "isEmptyMVar"
+
  -- Misc. ops
  -- Get the data constructor tag from a value.
  DataToTagOp -> Right $ Index (head xs) (xs !! 0)