Permalink
Browse files

push Strings onto the stack, fix some code I thought was working corr…

…ectly. fold is actually broken
  • Loading branch information...
1 parent 4d245e3 commit 8bbb0ce41d0b3c7525b62c081d0da47d894174a1 @stevej committed Oct 10, 2012
Showing with 30 additions and 14 deletions.
  1. +30 −14 src/Stackist/Interpreter1.hs
@@ -15,6 +15,10 @@ data Expr = Numeric Integer
-- Ladies and Gentlemen, the standard library
-- All functions are typed: [Expr] -> [Expr]
+interpError name xs = error (name ++ " did not expect " ++ (show xs))
+
+_id = id
+
-- | i : [P] -> ... Executes P. So, [P] i == P.
--
-- >> redex [] [JString "a", JString "b", Quote [Literal "concat"], Literal "i"]
@@ -60,9 +64,9 @@ _swap (m : n : xs) = n : m : xs
-- | dip : X [P] -> ... X
-- Saves X, executes P, pushes X back.
--
--- >> redex [] [Numeric 1, Quote [Numeric 2, Numeric 2, Literal "+"], Literal "dip"]
--- [Numeric 4, Numeric 1]
-_dip (m : Quote q : xs) = r ++ (m : xs)
+-- >>> redex [] [Numeric 1, Quote [Numeric 2, Numeric 2, Literal "+"], Literal "dip"]
+-- [Numeric 4,Numeric 1]
+_dip (Quote q : m : xs) = r ++ (m : xs)
where r = _i (Quote q : xs)
-- | [P] -> R Executes P, which leaves R on top of the stack. No matter
@@ -71,48 +75,55 @@ _dip (m : Quote q : xs) = r ++ (m : xs)
-- >>> redex [] [Quote [Numeric 1, Numeric 2, Literal "+"], Literal "nullary"]
-- [Numeric 3]
_nullary (Quote q : xs) = (redex [] q) ++ xs
--- how to keep the rest of the stack from being affected?
-- | S T -> U Sequence U is the concatenation of sequences S and T.
--
--- >> redex [] [JString "a", JString "b", Literal "concat"]
+-- >>> redex [] [JString "a", JString "b", Literal "concat"]
-- [JString "ab"]
-_concat (JString s : JString t : xs) = JString (s ++ t) : xs
+_concat (JString s : JString t : xs) = JString (t ++ s) : 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
--
-- >> redex [] [Quote [JString "b", JString "c", JString "d"], JString "a", Quote [Literal "concat"], Literal "fold"]
-- [JString "abcd"]
-_fold = _swapd . _step
+-- this is broken
+_fold xs = redex xs [Literal "swapd", Literal "step"]
-- | swapd : X Y Z -> Y X Z
--- As if defined by: swapd == [swap] dip
--
--- >> redex [] [Literal "x", Literal "y", Literal "z", Literal "swapd"]
--- [Literal "z", Literal "x", Literal "y"]
+-- >>> redex [] [JString "a", JString "b", JString "c", Literal "swapd"]
+-- [JString "c",JString "a",JString "b"]
_swapd (z : y : x : xs) = z : x : y : 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 4, Numeric 1]
-_step (Quote qs : Quote f : xs) = (concat (map f' qs)) ++ xs
- where f' q = redex [q] f
+-- >>> 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))
+
+
+-- redex :: [Expr] -> [Expr] -> [Expr]
+
preludeMap :: Map.Map String ([Expr] -> [Expr])
preludeMap = Map.fromList
[("+", _add),
("-", _subtract),
("*", _multiply),
("/", _divide),
+ ("id", _id),
("dup", _dup),
("swap", _swap),
("nullary", _nullary),
@@ -141,6 +152,11 @@ redex stack [] = stack
-- >>> redex [] [Quote [Literal 1]]
-- [Quote [Literal 1]]
redex stack (q @ (Quote _) : xs) = redex (q : stack) xs
+-- | push a JString onto the stack
+--
+-- >>> redex [] [JString "hey"]
+-- [JString "hey"]
+redex stack (j @ (JString _) : xs) = redex (j :stack) xs
-- | push a number onto stack.
--
-- >>> redex [] [Numeric 1]

0 comments on commit 8bbb0ce

Please sign in to comment.