Permalink
Browse files

Fixed step to work with both 1-ary and 2-ary quotes

Added a helper function step'.

Also flipped the order of concat's args.
  • Loading branch information...
1 parent 80653e5 commit bb0ff77a107b06bf84bddf3f56e7ddf4026d2ee5 @stevej committed Oct 11, 2012
Showing with 12 additions and 11 deletions.
  1. +12 −11 src/Stackist/Interpreter1.hs
@@ -81,40 +81,41 @@ _nullary (Quote q : xs) = (redex [] q) ++ xs
-- >>> redex [] [JString "a", JString "b", Literal "concat"]
-- [JString "ab"]
_concat (JString s : JString t : xs) = JString (t ++ s) : xs
+_concat (Quote a : Quote b : xs) = Quote (b ++ a) : xs
_concat xs = interpError "concat" xs
-- | fold : A V0 [P] -> V Starting with value V0, sequentially pushes
-- members of aggregate A and combines with binary operator P to produce value V.
-- fold = swapd step
-- (SJ: I assumed this would be a foldRight but is left)
--- List("b", "c", "d").foldLeft("a")((a,b) => a + b)
--- res1: java.lang.String = abcd
+-- foldl (\a b -> a ++ b) "a" ["b", "c", "d"] => "abcd"
--
--- >> redex [] [Quote [JString "b", JString "c", JString "d"], JString "a", Quote [Literal "concat"], Literal "fold"]
+-- >>> redex [] [Quote [JString "b", JString "c", JString "d"], JString "a", Quote [Literal "concat"], Literal "fold"]
-- [JString "abcd"]
--- this is broken
_fold xs = redex xs [Literal "swapd", Literal "step"]
-- | swapd : X Y Z -> Y X Z
--
-- >>> redex [] [JString "a", JString "b", JString "c", Literal "swapd"]
-- [JString "c",JString "a",JString "b"]
-_swapd (z : y : x : xs) = z : x : y : xs
+_swapd (c : b : a : xs) = c : a : b : xs
-- | step : A [P] -> ...
-- Sequentially putting members of aggregate A onto stack, executes
-- P for each member of A.
--
-- >>> redex [] [Quote [Numeric 1, Numeric 2], Quote [Numeric 2, Literal "*"], Literal "step"]
--- [Numeric 2,Numeric 4]
-_step (Quote f : Quote qs : xs) = (concat $ map f' qs) ++ xs
- where f' quote = redex [quote] f
-_step xs = error ("did not expect" ++ (show xs))
-
+-- [Numeric 4,Numeric 2]
+--
+-- >>> redex [Quote [Literal "concat"],Quote [JString "b",JString "c",JString "d"],JString "a"] [Literal "step"]
+-- [JString "abcd"]
+step' f [] stack = stack
+step' f (x:xs) stack = step' f xs (redex (x : stack) f)
--- redex :: [Expr] -> [Expr] -> [Expr]
+_step (Quote f : Quote qs : xs) = step' f qs xs
+_step xs = error ("step did not expect" ++ (show xs))
preludeMap :: Map.Map String ([Expr] -> [Expr])

0 comments on commit bb0ff77

Please sign in to comment.