Commit cef94eca authored by Marc Coiffier's avatar Marc Coiffier
Browse files

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

parent eac58301
......@@ -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))
......
......@@ -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
......
......@@ -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 ),
......
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