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
cef94eca
Commit
cef94eca
authored
Apr 03, 2019
by
Marc Coiffier
Browse files
Introduce a new 'set-stack' builtin, to go with the new backquote features
parent
eac58301
Changes
3
Hide whitespace changes
Inline
Side-by-side
capricon/exe/WiQEE.hs
View file @
cef94eca
...
...
@@ -28,7 +28,8 @@ instance Sequence JS.JSString where splitAt = JSS.splitAt
instance
StackSymbol
JS
.
JSString
where
atomClass
c
=
case
c
JSS
.!
0
of
'{'
|
JSS
.
length
c
==
1
->
Open
Brace
','
|
JSS
.
length
c
==
2
&&
c
JSS
.!
1
==
'{'
->
Open
Splice
','
|
JSS
.
length
c
==
2
&&
c
JSS
.!
1
==
'{'
->
Open
(
Splice
CloseConstant
)
'$'
|
JSS
.
length
c
==
2
&&
c
JSS
.!
1
==
'{'
->
Open
(
Splice
CloseExec
)
'}'
|
JSS
.
length
c
==
1
->
Close
'
\'
'
->
Quoted
(
drop
1
c
)
'"'
->
Quoted
(
take
(
JSS
.
length
c
-
2
)
(
drop
1
c
))
...
...
capricon/src/Algebra/Monad/Concatenative.hs
View file @
cef94eca
...
...
@@ -66,7 +66,7 @@ runStep _ _ (ClosureStep True (StackClosure _ _ p)) = stack =~ (StackProg p:)
runStep
execBuiltin'
onComment
(
ClosureStep
_
c
)
=
runClosure
execBuiltin'
onComment
c
data
StackBuiltin
b
=
Builtin_ListBegin
|
Builtin_ListEnd
|
Builtin_Clear
|
Builtin_Stack
|
Builtin_Clear
|
Builtin_Stack
|
Builtin_SetStack
|
Builtin_Pick
|
Builtin_Shift
|
Builtin_Shaft
|
Builtin_Pop
|
Builtin_PopN
|
Builtin_Dup
|
Builtin_DupN
...
...
@@ -163,6 +163,9 @@ execBuiltinImpl runExtra onComment = go
ex
acc
[]
=
(
acc
,
[]
)
in
let
(
h
,
t
)
=
ex
[]
st
in
StackList
h
:
t
go
Builtin_Stack
=
stack
=~
\
x
->
StackList
x
:
x
go
Builtin_SetStack
=
stack
=~
\
case
(
StackList
s
:
_
)
->
s
st
->
st
go
Builtin_Clear
=
stack
=-
[]
go
Builtin_Pick
=
stack
=~
\
st
->
case
st
of
StackInt
i
:
StackInt
n
:
t
|
i
<
n
,
x
:
t'
<-
drop
i
t
->
x
:
drop
(
n
-
i
-
1
)
t'
_
->
st
...
...
capricon/src/CaPriCon/Run.hs
View file @
cef94eca
...
...
@@ -428,6 +428,7 @@ cocDict version getResource getBResource writeResource writeBResource =
(
"set-vocabulary"
,
Builtin_SetCurrentDict
),
(
"stack"
,
Builtin_Stack
),
(
"set-stack"
,
Builtin_SetStack
),
(
"clear"
,
Builtin_Clear
),
(
"shift"
,
Builtin_Shift
),
(
"shaft"
,
Builtin_Shaft
),
...
...
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