Commit c6dc9907 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Successful build (on Sat Apr 27 04:15:58 CEST 2019)

parent 4fe07ccc
{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, DeriveGeneric, StandaloneDeriving #-}
module Main where
import Definitive
......@@ -22,6 +22,9 @@ import qualified Haste.Binary as JS hiding (get)
import qualified Prelude as P
import qualified Data.Array.Unboxed as Arr
deriving instance Show BraceKind
deriving instance Show s => Show (AtomClass s)
instance Semigroup JS.JSString where (+) = JSS.append
instance Monoid JS.JSString where zero = JSS.empty
instance Sequence JS.JSString where splitAt = JSS.splitAt
......@@ -142,12 +145,15 @@ setString f v = setFSItem (fromString f) (fromString v :: JS.JSString)
setBytes :: String -> [Word8] -> FSIO ()
setBytes f v = setString f (map (toEnum . fromIntegral) v)
type WiQEEState = StackState (COCState String) String (COCBuiltin FSIO String) (COCValue FSIO String)
runWordsState :: [String] -> WiQEEState -> FSIO (WiQEEState,String)
runWordsState ws st = ($st) $ from (stateT.concatT) $^ do
foldr (\w tl -> do
x <- runExtraState (getl endState)
unless x $ do execSymbol runCOCBuiltin runComment (atomClass w); tl) unit ws
let cl = atomClass w
liftIO (JS.ffi ("console.log" :: JS.JSString) (fromString ("Executing symbol: "+show w+" (class "+show cl+")") :: JS.JSString) :: IO ())
unless x $ do execSymbol runCOCBuiltin runComment cl; tl) unit ws
out <- runExtraState (outputText <~ \x -> (id,x))
return (out "")
......@@ -169,7 +175,7 @@ main = do
case req :: Int of
-- run a block of code, and return a handle to a new state
0 -> do
(st',_) <- runWordsState (map toString $ stringWords (code :: JS.JSString)) st
(st',_) <- runWordsState (stringWords (toString (code :: JS.JSString))) st
id <- appendState capriconObject st'
postMessage (reqID :: Int,id)
......
......@@ -135,6 +135,7 @@ instance StackSymbol String where
atomClass "${" = Open (Splice CloseExec)
atomClass "}" = Close
atomClass ('\'':t) = Quoted t
atomClass ('\x8217':t) = Quoted t
atomClass ('"':t) = Quoted (init t)
atomClass (':':t) = Comment (TextComment t)
atomClass x = maybe (Other x) Number (matches Just readable x)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment