Skip to content

GitLab

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 a28cf1f5 authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Remove the 'module' builtin in favor of the more flexible 'redirect' / 'set-vocabulary' combination

parent b7645d66
Hide whitespace changes
Inline Side-by-side
Showing with 25 additions and 19 deletions
capricon/capricon.cabal
View file @ a28cf1f5
......@@ -2,7 +2,7 @@
-- see http://haskell.org/cabal/users-guide/
name: capricon
version: 0.10.1
version: 0.11
-- synopsis:
-- description:
license: GPL-3
......@@ -35,7 +35,7 @@ executable capricon
default-extensions: RebindableSyntax, ViewPatterns, TupleSections, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, LambdaCase, TypeOperators, RankNTypes, GeneralizedNewtypeDeriving, TypeFamilies
-- other-modules:
-- other-extensions:
build-depends: base >=4.8 && <4.10,capricon >=0.10 && <0.11,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2
build-depends: base >=4.8 && <4.10,capricon >=0.10 && <0.12,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2
ghc-options: -Wincomplete-patterns -Wname-shadowing -W -Werror
hs-source-dirs: exe
default-language: Haskell2010
......@@ -47,7 +47,7 @@ executable WiQEE.js
-- other-modules:
-- other-extensions:
haste-options: --opt-all
build-depends: array >=0.5 && <0.6,base >=4.8 && <4.10,capricon >=0.10 && <0.11,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,filepath >=1.4 && <1.5,haste-lib
build-depends: array >=0.5 && <0.6,base >=4.8 && <4.10,capricon >=0.10 && <0.12,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,filepath >=1.4 && <1.5,haste-lib
hs-source-dirs: exe
default-language: Haskell2010
-- executable coinche
......
capricon/exe/WiQEE.hs
View file @ a28cf1f5
......@@ -90,7 +90,7 @@ setBytes :: String -> [Word8] -> JS.CIO ()
setBytes f v = setString f (map (toEnum . fromIntegral) v)
hasteDict :: COCDict JS.CIO String
hasteDict = cocDict ("0.10.1-js" :: String) getString getBytes setString setBytes
hasteDict = cocDict ("0.11-js" :: String) getString getBytes setString setBytes
main :: IO ()
main = JS.concurrent $ void $ do
......@@ -146,6 +146,7 @@ main = JS.concurrent $ void $ do
[con] -> do
context <- JS.getProp con "textContent"
let text = pref+" "+context
-- JS.alert ("Running "+fromString text)
(state',_) <- runWordsState (stringWords text) state
let onEnter x = \case
JS.KeyData 13 False False False False -> x
......
capricon/src/Algebra/Monad/Concatenative.hs
View file @ a28cf1f5
......@@ -47,7 +47,9 @@ runClosure execBuiltin' onComment clos = do
where flatten (StackClosure cs c) = do
pref <- map fold $ for cs $ \(i,StackClosure _ p) -> (i+) <$> do
traverse_ (runStep execBuiltin' onComment) p
stack <~ \(h:t) -> (t,[ConstStep h])
stack <~ \case
(h:t) -> (t,[ConstStep h])
[] -> ([],[])
return (pref + c)
runStep execBuiltin' onComment (VerbStep s) = getl (dict.at s) >>= \case
......@@ -69,9 +71,10 @@ data StackBuiltin b = Builtin_ListBegin | Builtin_ListEnd
| Builtin_Swap | Builtin_SwapN
| Builtin_Range | Builtin_Each | Builtin_Cons
| Builtin_Add | Builtin_Sub | Builtin_Mul | Builtin_Div | Builtin_Mod | Builtin_Sign
| Builtin_DeRef | Builtin_Def
| Builtin_DeRef | Builtin_CurrentDict
| Builtin_Def | Builtin_SetCurrentDict
| Builtin_Exec
| Builtin_CurrentDict | Builtin_Empty | Builtin_Insert | Builtin_Lookup | Builtin_Delete | Builtin_Keys
| Builtin_Empty | Builtin_Insert | Builtin_Lookup | Builtin_Delete | Builtin_Keys
| Builtin_Quote
| Builtin_Extra b
deriving (Show,Generic)
......@@ -149,6 +152,9 @@ execBuiltinImpl runExtra onComment = go
go Builtin_Def = get >>= \st -> case st^.stack of
(val:StackSymbol var:tl) -> do dict =~ insert var val ; stack =- tl
_ -> return ()
go Builtin_SetCurrentDict = get >>= \st -> case st^.stack of
(StackDict d:tl) -> do dict =- d ; stack =- tl
_ -> return ()
go Builtin_ListBegin = stack =~ (StackBuiltin Builtin_ListBegin:)
go Builtin_ListEnd = stack =~ \st -> let ex acc (StackBuiltin Builtin_ListBegin:t) = (acc,t)
ex acc (h:t) = ex (h:acc) t
......
capricon/src/CaPriCon/Run.hs
View file @ a28cf1f5
......@@ -70,7 +70,7 @@ showStackVal toRaw dir ctx = fix $ \go _x -> case _x of
in "{ "+showSteps p+" }"
_ -> fromString $ show _x
data COCBuiltin io str = COCB_Print | COCB_Quit
| COCB_Open (ReadImpl io str str) | COCB_ExecModule (WriteImpl io str str)
| COCB_Open (ReadImpl io str str) | COCB_Redirect (WriteImpl io str str)
| COCB_Cache (ReadImpl io str [Word8]) (WriteImpl io str [Word8])
| COCB_ToInt | COCB_Concat
......@@ -329,17 +329,15 @@ runCOCBuiltin COCB_Pull = do
| otherwise -> StackCOC COCNull:st
st -> st
runCOCBuiltin (COCB_ExecModule (WriteImpl writeResource)) = do
runCOCBuiltin (COCB_Redirect (WriteImpl writeResource)) = do
st <- runStackState get
case st of
StackSymbol f:StackProg p:t -> do
old <- runDictState get
runStackState $ put t
oldH <- runExtraState (outputText <~ \x -> (id,x))
execProgram runCOCBuiltin outputComment p
new <- runDictState (id <~ (old,))
newH <- runExtraState (outputText <~ \x -> (oldH,x))
liftSubIO $ writeResource f (newH "")
runStackState $ put $ StackDict new:t
_ -> return ()
runCOCBuiltin (COCB_Cache (ReadImpl getResource) (WriteImpl writeResource)) = do
......@@ -418,6 +416,8 @@ cocDict version getResource getBResource writeResource writeBResource =
("lookup" , Builtin_Lookup ),
("exec" , Builtin_Exec ),
("quote" , Builtin_Quote ),
("vocabulary" , Builtin_CurrentDict ),
("set-vocabulary" , Builtin_SetCurrentDict ),
("stack" , Builtin_Stack ),
("clear" , Builtin_Clear ),
......@@ -438,7 +438,8 @@ cocDict version getResource getBResource writeResource writeBResource =
("io/print" , Builtin_Extra COCB_Print ),
("io/source" , Builtin_Extra (COCB_Open (ReadImpl getResource))),
("io/cache" , Builtin_Extra (COCB_Cache (ReadImpl getBResource) (WriteImpl writeBResource))),
("io/redirect" , Builtin_Extra (COCB_Redirect (WriteImpl writeResource))),
("string/format" , Builtin_Extra COCB_Format ),
("string/to-int" , Builtin_Extra COCB_ToInt ),
......@@ -453,13 +454,11 @@ cocDict version getResource getBResource writeResource writeBResource =
("list/range" , Builtin_Range ),
("list/cons" , Builtin_Cons ),
("dict/vocabulary" , Builtin_CurrentDict ),
("dict/empty" , Builtin_Empty ),
("dict/insert" , Builtin_Insert ),
("dict/delete" , Builtin_Delete ),
("dict/keys" , Builtin_Keys ),
("dict/module" , Builtin_Extra (COCB_ExecModule (WriteImpl writeResource))),
("term-index/pattern-index" , Builtin_Extra COCB_GetShowDir ),
("term-index/set-pattern-index" , Builtin_Extra COCB_SetShowDir ),
("term-index/index-insert" , Builtin_Extra COCB_InsertNodeDir ),
......@@ -515,5 +514,5 @@ outputComment c = (runExtraState $ do outputText =~ (\o t -> o (commentText+t)))
+ hide +"\"></span><span class=\"capricon-reveal\" data-linecount=\""
+ fromString (show nlines)+"\">"
wrapEnd = "</span></label>"
userInput = "<div class=\"user-input\"><button class=\"capricon-trigger\">Try It</button><label class=\"capricon-input-prefix\">&gt;&nbsp;<input type=\"text\" class=\"capricon-input\" /></label><pre class=\"capricon-output\"></pre></div>"
userInput = "<div class=\"user-input interactive\"><button class=\"capricon-trigger\">Try It Out</button><label class=\"capricon-input-prefix\">&gt;&nbsp;<input type=\"text\" class=\"capricon-input\" /></label><pre class=\"capricon-output\"></pre></div>"
logos/logos.cabal
View file @ a28cf1f5
......@@ -19,7 +19,7 @@ library
default-language: Haskell2010
executable logos
build-depends: base >=4.9 && <4.10,capricon >=0.10 && <0.11,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2,OpenGL >=3.0 && <3.1,StateVar >=1.1 && <1.2,vector >=0.12 && <0.13
build-depends: base >=4.9 && <4.10,capricon >=0.10 && <0.12,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2,OpenGL >=3.0 && <3.1,StateVar >=1.1 && <1.2,vector >=0.12 && <0.13
default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types, AllowAmbiguousTypes, RoleAnnotations, ViewPatterns, LambdaCase
hs-source-dirs: exe
ghc-options: -threaded
......@@ -27,7 +27,7 @@ executable logos
default-language: Haskell2010
executable svgfont
build-depends: base >=4.9 && <4.10,capricon >=0.10 && <0.11,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2
build-depends: base >=4.9 && <4.10,capricon >=0.10 && <0.12,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2
default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types, AllowAmbiguousTypes, RoleAnnotations, ViewPatterns, LambdaCase
hs-source-dirs: exe
ghc-options: -threaded
......
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