The fifth installment. Our language has grown quite a bit. See the factorial definition in the initlib to see what it can do.

Our library now includes

Arithmetic + * - / > <
Boolean =? and or not
Predicates: odd? even? zero? empty?
Control Structures: if, if*
Definitions: .
Stack management:
dup    | 1 2 3 dup == 1 2 3 3
swap   | 1 2 3 swap == 1 3 2
pop    | 1 2 3 pop  == 1 2
cons   | 1 [2 3 4] cons == [1 2 3 4]
concat | [1 2 3] [4 5 6] concat = [1 2 3 4 5]
nwrap  | 1 2 3 4 5 2 nwrap == 1 2 3 [4 5]
| 1 2 3 4 5 1 nwrap == 1 2 3 4 
| 1 2 3 4 5 0 nwrap == 1 2 3 4 5 []
i      | 1 2 3 4 5 [+] i == 1 2 3 9
| 1 2 3 4 5 [+ +] i == 1 2 12
!      | 1 2 3 4 5 [+] ! == 1 2 3 4 5 9
| 1 2 3 4 5 [+ +] ! == 1 2 3 4 5 12

dip    | 1 2 3 4 [+] 5 dip == 1 2 7 5
dip    | 1 2 3 4 [* +] 5 dip == 1 14 5


What you can do.

1. Evaluate the following.
ghci> eval "5 factorial"
ghci> eval "1 2 3 4 2 nwrap [+] dip"

1. Can you write sigma of a given n i.e (sum 0..n)? Hint. look at factorial definition in initlib.
ghci> eval "5 sigma"
15

1. can you define the word nrotate that does the following
ghci> eval "1 2 3 4 5 6 7 8 9 2 nrotate"
1 2 3 4 5 6 8 9 7
ghci> eval "1 2 3 4 5 6 7 8 9 4 nrotate"
1 2 3 4 6 7 8 9 5


### Here is the code so far.

module Main where

import System.Environment
import System.IO
import Data.Char

-- Parsing code: Parses into Nest data type
-- Our nesting in expressions is provided by square brackets.
import Text.ParserCombinators.Parsec

type Word = String
type Env = [(String, [Nest])]
type Stack = [Nest]

initlib = unlines[
"[succ 1 +].",
"[pred 1 -].",
"[even? odd? not].",
"[double dup +].",
"[half dup odd? [succ 2 /] [2 /] if].",
"[if* 2 nwrap [!] swap dip i if].",
"[zero? 0 =?].",
"[factorial [zero?] [pop 1] [dup pred factorial *] if*]."
]

-- Read a line and Parse it, returing the Nest data structure.

readLine :: String -> Nest
readLine input = case parse parseExpr "nest" input of
Left err -> error (show err)
Right q -> q

eval :: String -> String
eval str = unwords $map show$ bigStep [] e []
where  Nested e = readLine (initlib ++ " " ++ str)

evalFile file = do
str <- readFile file
return $eval str main = do fn <- getArgs case fn of [] -> error "Need file.nst to evaluate." (x:xs) -> do res <- evalFile$ fn !! 0
putStrLn (show res)

-- Parse a number of words or nested structures.
parseExpr = do
x <- many parseSingle
return $Nested x -- Parse either a single word or a nested [] parseSingle :: Parser Nest parseSingle = do spaces x <- (try parseFloat) <|> (try parseInt) <|> (try parseBool) <|> (try parseString) <|> (try parseWord) <|> (try parseNest) spaces return x -- Parse a nested structure starting with [ and ending with ] parseNest :: Parser Nest parseNest = do char '[' e <- parseExpr char ']' return e parseFloat :: Parser Nest parseFloat = do I i <- parseInt char '.' I j <- parseInt res <- return$ (show i) ++ ['.'] ++ (show j)
return $F (read res) parseInt :: Parser Nest parseInt = do i <- many1 digit return$ I (read i)

-- Parse a simple word without any spaces or nesting between them.
parseWord :: Parser Nest
parseWord = do
w <- many1 (noneOf " nrt[]")
return $W w parseBool :: Parser Nest parseBool = do (x:xs) <- string "true" <|> string "false" return$ B (read (toUpper x : xs))

parseString :: Parser Nest
parseString = do
char '''
s <- many (noneOf "'")
char '''
return $S s -- bigStep semantics bigStep :: Env -> [Nest] -> Stack -> Stack -- Base case. Nothing on execution stack. bigStep _ [] r = r -- BigStep semantics for literals. i.e integers, -- floats strings and nests evaluate to themselves. bigStep env (Nested n: xs) ys = bigStep env xs (Nested n: ys) bigStep env (I i: xs) ys = bigStep env xs (I i: ys) -- implement the same for Float, Boolean, and String bigStep env (F i: xs) ys = bigStep env xs (F i: ys) bigStep env (B i: xs) ys = bigStep env xs (B i: ys) bigStep env (S i: xs) ys = bigStep env xs (S i: ys) -- BigStep Semantics for addition. bigStep env (W "+": xs) (I i: I j: ys) = bigStep env xs (I (j+i): ys) bigStep env (W "*": xs) (I i: I j: ys) = bigStep env xs (I (j*i): ys) bigStep env (W "-": xs) (I i: I j: ys) = bigStep env xs (I (j-i): ys) bigStep env (W "/": xs) (I i: I j: ys) = bigStep env xs (F ((fromIntegral j)/(fromIntegral i)): ys) bigStep env (W ">": xs) (I i: I j: ys) = bigStep env xs (B (j > i): ys) bigStep env (W "<": xs) (I i: I j: ys) = bigStep env xs (B (j < i): ys) bigStep env (W "=?": xs) (I i: I j: ys) = bigStep env xs (B (j == i): ys) bigStep env (W "=?": xs) (S i: S j: ys) = bigStep env xs (B (j == i): ys) bigStep env (W "=?": xs) (B i: B j: ys) = bigStep env xs (B (j == i): ys) bigStep env (W "=?": xs) (F i: F j: ys) = bigStep env xs (B (j == i): ys) bigStep env (W "=?": xs) (Nested i: Nested j: ys) = bigStep env xs (B (j == i): ys) bigStep env (W "odd?": xs) (I i: ys) = bigStep env xs (B (odd i): ys) bigStep env (W "and": xs) (B a:B b:ys) = bigStep env xs (B (b && a):ys) bigStep env (W "or": xs) (B a:B b:ys) = bigStep env xs (B (b || a):ys) bigStep env (W "not": xs) (B a:ys) = bigStep env xs (B (not a):ys) -- implement the same for - : if you have - a b , then the result -- of (a - b) should be on the stack. -- same for *. Can you implement it for division? -- (hint, remember to use F Float for result) -- implement the same for dup : duplicate the topmost element. bigStep env (W "dup": xs) (y:ys) = bigStep env xs (y:y:ys) -- implement the same for swap : swap the two topmost elements. bigStep env (W "swap": xs) (y:y':ys) = bigStep env xs (y':y:ys) -- implement the same for pop : remove the topmost element. bigStep env (W "pop": xs) (y:ys) = bigStep env xs ys -- implement cons operator -- a:as in haskell bigStep env (W "cons": xs) (Nested y':y:ys) = bigStep env xs (Nested (y:y'):ys) -- implement concat operator -- ++ in haskell bigStep env (W "concat": xs) (Nested y':Nested y:ys) = bigStep env xs (Nested (y ++ y'):ys) -- implement empty? for a list. bigStep env (W "empty?": xs) (Nested y:ys) = bigStep env xs (B (length y == 0):ys) -- Another operator is nwrap that takes an integer and pulls out that many -- elements in the stack into -- a list. bigStep env (W "nwrap": xs) (I i:ys) = bigStep env xs ((Nested lst) : rest) where lst = reverse$ take i ys
rest = drop i ys

-- Remember the i combinator?  that is
[1 2] i + == 3
[1 2 +] i == 3

-- implement the i. - pull out the topmost nesting out of the stack and push it into the execution queue

bigStep env (W "i":xs) (Nested v:ys) = bigStep env (v ++ xs) ys

-- implement ! it executes the statement on the stack non destructively.
-- 1 2 3 [+ +] ! == 1 2 3 6
-- 1 2 3 [+] ! == 1 2 3 5

bigStep env (W "!":xs) ys = bigStep env xs $(head res):(tail ys) where res = bigStep env (W "i":xs) ys -- We also need something called "dip" - an operator that pulls out the last -- element from the stack, executes the current list on the remaining stack -- elements and puts the pulled element back. This is useful to provide a -- temporary place to store values. (see the example of if* to see how it is -- used.) bigStep env (W "dip":xs) (y:ys) = bigStep env xs$ y:lst
where lst = bigStep env [W "i"] ys

-- if then else
bigStep env (W "if":xs) (Nested v2:Nested v1:B c:ys) = bigStep env (res ++ xs) ys
where res = if c then v1 else v2

-- Implementing definitions.
bigStep env (W ".":xs) (Nested ((W w):as):ys) = bigStep ((w,as):env) xs ys

-- If not built in, look up in the environment.
bigStep env (W x :xs) ys = bigStep env (def ++ xs) ys
where def = case lookup x env of
Nothing -> error ("Definition not found or is not applicable for word  {" ++ x ++ "} with stack " ++ (show ys))
Just x -> x