Introduce a new 'set-stack' builtin, to go with the new backquote features

capricon/exe/WiQEE.hs

@@ -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

@@ -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

@@ -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                         ),