Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Marc Coiffier
BHR
Commits
a28cf1f5
Commit
a28cf1f5
authored
Mar 29, 2019
by
Marc Coiffier
Browse files
Remove the 'module' builtin in favor of the more flexible 'redirect' / 'set-vocabulary' combination
parent
b7645d66
Changes
5
Hide whitespace changes
Inline
Side-by-side
capricon/capricon.cabal
View file @
a28cf1f5
...
...
@@ -2,7 +2,7 @@
-- see http://haskell.org/cabal/users-guide/
name: capricon
version: 0.1
0.
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.1
1
,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2
build-depends: base >=4.8 && <4.10,capricon >=0.10 && <0.1
2
,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.1
1
,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.1
2
,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.1
0.
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
ge
t
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
\"
>> <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
\"
>> <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.1
1
,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.1
2
,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.1
1
,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.1
2
,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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment