Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

Commit 665f8e4b authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Correct the 'substitute' and 'intro before' builtins

parent 558d53b8
......@@ -10,3 +10,4 @@ Curly_Test.hs
*.jsmod
config.mk
*/dist
*.tar.gz
......@@ -2,7 +2,7 @@
-- see http://haskell.org/cabal/users-guide/
name: capricon
version: 0.13.1
version: 0.13.1.1
-- synopsis:
-- description:
license: GPL-3
......
{-# 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,19 +145,22 @@ 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 "")
runWithFS :: JS.JSString -> FSIO a -> JS.CIO a
runWithFS fsname (FSIO r) = newFS fsname >>= r^..readerT
hasteDict = cocDict ("0.13.1-js" :: String) getString getBytes setString setBytes
hasteDict = cocDict ("0.13.1.1-js" :: String) getString getBytes setString setBytes
main :: IO ()
main = do
......@@ -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)
......
......@@ -170,16 +170,18 @@ instance (Show a,IsCapriconString str,MonadReader (Env str (Term str a)) m,Monad
return (ContextTerm d' $ inc_depth (d'-d) e)
substHyp h vh = do
ContextTerm dm vh' <- pullTerm (Just h) vh
ContextTerm dh vh' <- pullTerm (Just h) vh
dm <- length <$> ask
first (\f cv@(ContextTerm d v) ->
if d <= dm then cv
else ContextTerm (d-1) (inc_depth (d-dm) $ f $ inc_depth (dm-d) v)) <$>
if d <= dh then cv
else ContextTerm (d-1) (inc_depth (d-dm) $ f $ inc_depth (dm-d) v)) <$>
substHyp h vh'
insertHypBefore h h' cth' = do
ContextTerm dh th' <- pullTerm h cth'
dm <- length <$> ask
first (\f cx@(ContextTerm d x) ->
if d <= dh then cx
else ContextTerm (d+1) (inc_depth (d-dh) $ f $ inc_depth (dh-d) x))
else ContextTerm (d+1) (inc_depth (d-dm) $ f $ inc_depth (dm-d) x))
<$> insertHypBefore h h' th'
data NodeDir str ax a = NodeDir
......
Markdown is supported
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