hw2: tmp init

hw1/BigNum.hs

@@ -0,0 +1,120 @@
+{-
+  Name: Yuri Tatishchev
+  Class: CS 252
+  Assigment: HW1
+  Date: 2/16/2026
+  Description: Big numbers in Haskell
+-}
+
+module BigNum (
+  BigNum,
+  bigAdd,
+  bigSubtract,
+  bigMultiply,
+  bigEq,
+  bigDec,
+  bigPowerOf,
+  prettyPrint,
+  stringToBigNum,
+) where
+
+type Block = Int -- An Int from 0-999
+
+type BigNum = [Block]
+
+maxblock = 1000
+
+bigAdd :: BigNum -> BigNum -> BigNum
+bigAdd x y = bigAdd' x y 0
+
+bigAdd' :: BigNum -> BigNum -> Block -> BigNum
+bigAdd' [] [] 0 = []
+bigAdd' [] [] c = [c]
+bigAdd' (x:xs) (y:ys) c = let s = x + y + c
+                          in (s `mod` maxblock) : bigAdd' xs ys (s `div` maxblock)
+bigAdd' (x:xs) [] c = let s = x + c
+                          in (s `mod` maxblock) : bigAdd' xs [] (s `div` maxblock)
+bigAdd' [] (y:ys) c = let s = y + c
+                          in (s `mod` maxblock) : bigAdd' [] ys (s `div` maxblock)
+
+bigSubtract :: BigNum -> BigNum -> BigNum
+bigSubtract x y =
+  if length x < length y
+    then error "Negative numbers not supported"
+    else reverse $ stripLeadingZeroes $ reverse result
+      where result = bigSubtract' x y 0
+
+stripLeadingZeroes :: BigNum -> BigNum
+stripLeadingZeroes (0:[]) = [0]
+stripLeadingZeroes (0:xs) = stripLeadingZeroes xs
+stripLeadingZeroes xs = xs
+
+-- Negative numbers are not supported, so you may throw an error in these cases
+bigSubtract' :: BigNum -> BigNum -> Block -> BigNum
+bigSubtract' [] [] 0 = []
+bigSubtract' [] _ _ = error "Negative numbers not supported"
+bigSubtract' (x:xs) (y:ys) b = let d = x - y - b
+                               in if d < 0
+                                  then (d + maxblock) : bigSubtract' xs ys 1
+                                  else d : bigSubtract' xs ys 0
+bigSubtract' (x:xs) [] b = let d = x - b
+                               in if d < 0
+                                  then (d + maxblock) : bigSubtract' xs [] 1
+                                  else d : bigSubtract' xs [] 0
+
+bigEq :: BigNum -> BigNum -> Bool
+bigEq x y = stripLeadingZeroes (reverse x) == stripLeadingZeroes (reverse y)
+
+bigDec :: BigNum -> BigNum
+bigDec x = bigSubtract x [1]
+
+-- Handle multiplication following the same approach you learned in grade
+-- school, except dealing with blocks of 3 digits rather than single digits.
+-- If you are having trouble finding a solution, write a helper method that
+-- multiplies a BigNum by an Int.
+bigMultiply :: BigNum -> BigNum -> BigNum
+bigMultiply x y = reverse $ stripLeadingZeroes $ reverse $ bigMultiply' x y
+
+bigMultiply' :: BigNum -> BigNum -> BigNum
+bigMultiply' _ [] = []
+bigMultiply' x (y:ys) = bigAdd (bigMultiplyBlock x y) (bigMultiply (0:x) ys)
+
+bigMultiplyBlock :: BigNum -> Block -> BigNum
+bigMultiplyBlock x y = bigMultiplyBlock' x y 0
+
+bigMultiplyBlock' :: BigNum -> Block -> Block -> BigNum
+bigMultiplyBlock' [] _ 0 = []
+bigMultiplyBlock' [] _ c = [c]
+bigMultiplyBlock' (x:xs) y c = let p = x * y + c
+                               in (p `mod` maxblock) : bigMultiplyBlock' xs y (p `div` maxblock)
+
+bigPowerOf :: BigNum -> BigNum -> BigNum
+bigPowerOf x [0] = [1]
+bigPowerOf x [1] = x
+bigPowerOf x y = bigMultiply x (bigPowerOf x (bigDec y))
+
+prettyPrint :: BigNum -> String
+prettyPrint [] = ""
+prettyPrint xs = show first ++ prettyPrint' rest
+  where (first:rest) = reverse xs
+
+prettyPrint' :: BigNum -> String
+prettyPrint' [] = ""
+prettyPrint' (x:xs) = prettyPrintBlock x ++ prettyPrint' xs
+
+prettyPrintBlock :: Int -> String
+prettyPrintBlock x | x < 10     = ",00" ++ show x
+                   | x < 100    = ",0" ++ show x
+                   | otherwise  = "," ++ show x
+
+stringToBigNum :: String -> BigNum
+stringToBigNum "0" = [0]
+stringToBigNum s = stringToBigNum' $ reverse s
+
+stringToBigNum' :: String -> BigNum
+stringToBigNum' [] = []
+stringToBigNum' s | length s <= 3 = read (reverse s) : []
+stringToBigNum' (a:b:c:rest) = block : stringToBigNum' rest
+  where block = read $ c:b:a:[]
+
+sig = "9102llaf"

hw1/Calculator.hs

@@ -0,0 +1,36 @@
+-- This is a simple parser for testing out BigNum.
+-- Note that there are much better parsers, which
+-- we will explore in another class.
+
+import BigNum
+
+-- Crude way of handling whitespace: make sure
+-- that all ops are surrounded by whitespace.
+addSpace :: String -> String
+addSpace []       = ""
+addSpace ('+':xs) = " + " ++ addSpace xs
+addSpace ('-':xs) = " - " ++ addSpace xs
+addSpace ('*':xs) = " * " ++ addSpace xs
+addSpace ('^':xs) = " ^ " ++ addSpace xs
+addSpace (x:xs)   = x : addSpace xs
+
+calculate :: String -> BigNum -> BigNum -> BigNum
+calculate "+" b1 b2 = bigAdd b1 b2
+calculate "-" b1 b2 = bigSubtract b1 b2
+calculate "*" b1 b2 = bigMultiply b1 b2
+calculate "^" b1 b2 = bigPowerOf b1 b2
+
+main :: IO ()
+main = do
+  line <- getLine
+  if null line
+    then return ()
+    else do
+      case words $ addSpace line of
+          exp1:op:exp2:[] -> putStrLn $ prettyPrint $ calculate op big1 big2
+              where big1 = stringToBigNum exp1
+                    big2 = stringToBigNum exp2
+          exp:[] -> putStrLn $ show $ stringToBigNum exp
+          _ -> putStrLn "Only simply binary expressions are supported"
+      main
+

hw1/Test.java

@@ -0,0 +1,5 @@
+public class Test {
+  public void main(String[] args) {
+    System.out.println(999999999999999999999 * 2);
+  }
+}

hw1/hw1.txt

@@ -0,0 +1,63 @@
+For the first assignment, we will look at how Haskell handles big numbers.
+
+***NOTE: YOU MAY NOT CHANGE ANY TYPE SIGNATURES***
+***IF YOU DO, YOU WILL GET A ZERO FOR THE ASSIGNMENT***
+
+Consider the following Java program (available in Test.java).
+
+  public class Test {
+    public void main(String[] args) {
+      System.out.println(999999999999999999999 * 2);
+    }
+  }
+
+You could easily calculate 999999999999999999999 * 2 with pencil and paper;
+Java cannot handle it.
+
+  $ javac Test.java
+  Test.java:3: error: integer number too large: 999999999999999999999
+      System.out.println(999999999999999999999 * 2);
+                         ^
+  1 error
+
+With Haskell, there is no problem:
+
+  $ ghci
+  GHCi, version 7.6.3: http://www.haskell.org/ghc/  :? for help
+  Loading package ghc-prim ... linking ... done.
+  Loading package integer-gmp ... linking ... done.
+  Loading package base ... linking ... done.
+  Prelude> 999999999999999999999 * 2
+  1999999999999999999998
+  Prelude>
+
+So how does Haskell handle these numbers?
+We will implement a simplified BigNum module to understand it better.
+
+In our implementation, a number will be a list of "blocks" of numbers from 0-999,
+stored with the least significant "block" first. So 9,073,201 will be
+stored as:
+
+  [201,73,9]
+
+Your job is to complete BigNum.hs.  The breakdown of points is as follows:
+* 10 points -- Complete bigAdd'
+*  5 points -- Complete bigSubtract'
+*  3 points -- Complete bigMultiply
+*  2 points -- Complete bigPowerOf
+
+
+Starter code is available on the course website.
+The files include:
+* BigNum.hs -- You will modify this file (only).
+* Calculator.hs -- A (very) simple calculator that relies on your BigNum module.
+* test.hs -- A number of test cases that use BigNum.
+* input -- A number of cases that Calculator.hs should handle correctly.
+* output_EXPECTED -- the expected results of calling (from the command line):
+  $runhaskell test.hs
+  $runhaskell Calculator.hs < input
+
+Note that negative numbers are not supported, and should raise an error.
+
+Submit BigNum.hs through Canvas.
+

hw1/input

@@ -0,0 +1,7 @@
+3 + 4
+9 * 7
+2 ^ 8
+400000000000000000001 * 2
+999999999999999999999 - 999999999999999999998
+483971285601 * 123448796045
+

hw1/output

@@ -0,0 +1,26 @@
+Addition
+[455,1]
+[455,3]
+[455,235,681]
+[455,235,681]
+[455,1,681]
+Subtraction
+[999]
+[962,634,9]
+[1]
+[0]
+Multiplication
+[12]
+[0]
+[392,296,4,12]
+[518,250,645,161,37,915,479,1]
+Power Of
+[256]
+[1]
+Others
+7
+63
+256
+800,000,000,000,000,000,002
+1
+59,745,672,527,794,294,248,045

hw1/output_EXPECTED

@@ -0,0 +1,26 @@
+Addition
+[455,1]
+[455,3]
+[455,235,681]
+[455,235,681]
+[455,1,681]
+Subtraction
+[999]
+[962,634,9]
+[1]
+[0]
+Multiplication
+[12]
+[0]
+[392,296,4,12]
+[518,250,645,161,37,915,479,1]
+Power Of
+[256]
+[1]
+Others
+7
+63
+256
+800,000,000,000,000,000,002
+1
+59,745,672,527,794,294,248,045

hw1/test.hs

@@ -0,0 +1,50 @@
+import BigNum
+
+main :: IO ()
+main = do
+  putStrLn "Addition"
+  --999 + 456
+  putStrLn $ show $ bigAdd [999] [456]
+  --1999 + 1456
+  putStrLn $ show $ bigAdd [999,1] [456,1]
+  --681234999 + 456
+  putStrLn $ show $ bigAdd [999,234,681] [456]
+  --456 + 681234999
+  putStrLn $ show $ bigAdd [456] [999,234,681]
+  --681000999 + 456
+  putStrLn $ show $ bigAdd [999,0,681] [456]
+
+  putStrLn "Subtraction"
+  --1000 - 1
+  putStrLn $ show $ bigSubtract [0,1] [1]
+  --9643291 - 8329
+  putStrLn $ show $ bigSubtract [291,643,9] [329,8]
+  --999999 - 999998
+  putStrLn $ show $ bigSubtract [999,999] [998,999]
+  --10009 - 10009
+  putStrLn $ show $ bigSubtract [9,10] [9,10]
+
+  ----Error cases
+  --putStrLn $ show $ bigSubtract [987] [0,1]
+  --putStrLn $ show $ bigSubtract [9] [456]
+  --putStrLn $ show $ bigSubtract [9] [10]
+  --putStrLn $ show $ bigSubtract [9,999,999,999] [10,999,999,999]
+
+  putStrLn "Multiplication"
+  --3 * 4
+  putStrLn $ show $ bigMultiply [3] [4]
+  --1987 * 0
+  putStrLn $ show $ bigMultiply [987,1] [0]
+  --3001074098 * 4
+  putStrLn $ show $ bigMultiply [98,74,1,3] [4]
+  --3001074098 * 493128456291
+  putStrLn $ show $ bigMultiply [98,74,1,3] [291,456,128,493]
+
+  putStrLn "Power Of"
+  --2^8
+  putStrLn $ show $ bigPowerOf [2] [8]
+  --1832^0
+  putStrLn $ show $ bigPowerOf [832,1] [0]
+
+  putStrLn "Others"
+

hw1/test.sh

@@ -0,0 +1,5 @@
+#!/bin/sh
+runhaskell test.hs > output
+runhaskell Calculator.hs < input >> output
+diff output output_EXPECTED
+

hw2/hs/WhileInterp.hs

@@ -0,0 +1,81 @@
+{-
+  Name: Yuri Tatishchev
+  Class: CS 252
+  Assigment: HW2
+  Date: 2026-03-06
+  Description: Implements the big-step operational semantics for
+    the WHILE language described in `while-semantics.pdf`
+-}
+
+
+module WhileInterp (
+  Expression(..),
+  Binop(..),
+  Value(..),
+  testProgram,
+  run
+) where
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+-- We represent variables as strings.
+type Variable = String
+
+-- The store is an associative map from variables to values.
+-- (The store roughly corresponds with the heap in a language like Java).
+type Store = Map Variable Value
+
+data Expression =
+    Var Variable                            -- x
+  | Val Value                               -- v
+  | Assign Variable Expression              -- x := e
+  | Sequence Expression Expression          -- e1; e2
+  | Op Binop Expression Expression
+  | If Expression Expression Expression     -- if e1 then e2 else e3
+  | While Expression Expression             -- while (e1) e2
+  deriving (Show)
+
+data Binop =
+    Plus     -- +  :: Int  -> Int  -> Int
+  | Minus    -- -  :: Int  -> Int  -> Int
+  | Times    -- *  :: Int  -> Int  -> Int
+  | Divide   -- /  :: Int  -> Int  -> Int
+  | Gt       -- >  :: Int -> Int -> Bool
+  | Ge       -- >= :: Int -> Int -> Bool
+  | Lt       -- <  :: Int -> Int -> Bool
+  | Le       -- <= :: Int -> Int -> Bool
+  deriving (Show)
+
+data Value =
+    IntVal Int
+  | BoolVal Bool
+  deriving (Show)
+
+
+-- This function will be useful for defining binary operations.
+-- The first case is done for you.
+-- Be sure to explicitly check for a divide by 0 and throw an error.
+applyOp :: Binop -> Value -> Value -> Value
+applyOp Plus (IntVal i) (IntVal j) = IntVal $ i + j
+applyOp _ _ _ = error "TBD"
+
+
+-- Implement this function according to the specified semantics
+evaluate :: Expression -> Store -> (Value, Store)
+evaluate (Op o e1 e2) s =
+  let (v1,s1) = evaluate e1 s
+      (v2,s') = evaluate e2 s1
+  in (applyOp o v1 v2, s')
+evaluate _ _ = error "TBD"
+
+
+-- Evaluates a program with an initially empty state
+run :: Expression -> (Value, Store)
+run prog = evaluate prog Map.empty
+
+-- The same as run, but only returns the Store
+testProgram :: Expression -> Store
+testProgram prog = snd $ run prog
+
+

hw2/hs/mapExample.hs

@@ -0,0 +1,12 @@
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+m = Map.empty
+
+m' = Map.insert "a" 42 m
+
+main = do
+  case (Map.lookup "a" m') of
+    Just i -> putStrLn $ show i
+    _      -> error "Key is not in the map"
+

hw2/hs/test.hs

@@ -0,0 +1,36 @@
+import WhileInterp
+
+-- Here are a few tests that you can use to check your implementation.
+w_test = (Sequence (Assign "X" (Op Plus (Op Minus (Op Plus (Val (IntVal 1)) (Val (IntVal 2))) (Val (IntVal 3))) (Op Plus (Val (IntVal 1)) (Val (IntVal 3))))) (Sequence (Assign "Y" (Val (IntVal 0))) (While (Op Gt (Var "X") (Val (IntVal 0))) (Sequence (Assign "Y" (Op Plus (Var "Y") (Var "X"))) (Assign "X" (Op Minus (Var "X") (Val (IntVal 1))))))))
+
+w_fact = (Sequence (Assign "N" (Val (IntVal 2))) (Sequence (Assign "F" (Val (IntVal 1))) (While (Op Gt (Var "N") (Val (IntVal 0))) (Sequence (Assign "X" (Var "N")) (Sequence (Assign "Z" (Var "F")) (Sequence (While (Op Gt (Var "X") (Val (IntVal 1))) (Sequence (Assign "F" (Op Plus (Var "Z") (Var "F"))) (Assign "X" (Op Minus (Var "X") (Val (IntVal 1)))))) (Assign "N" (Op Minus (Var "N") (Val (IntVal 1))))))))))
+
+testUnit :: IO ()
+testUnit = do
+  -- Should be: (IntVal 1,fromList [])
+  putStrLn $ show $ WhileInterp.run (Val (IntVal 1))
+  -- Should be: (BoolVal True,fromList [("X",BoolVal True)])
+  putStrLn $ show $ WhileInterp.run (Assign "X" (Val (BoolVal True)))
+  -- Should be: (IntVal 2,fromList [])
+  putStrLn $ show $ WhileInterp.run (Sequence (Val (IntVal 1)) (Val (IntVal 2)))
+  -- Should be: (IntVal 11,fromList [])
+  putStrLn $ show $ WhileInterp.run (Op Plus (Val (IntVal 9)) (Val (IntVal 2)))
+  -- Should be: (IntVal 1,fromList [])
+  putStrLn $ show $ WhileInterp.run (If (Val (BoolVal True)) (Val (IntVal 1)) (Val (IntVal 2)))
+  -- Should be: (IntVal 2,fromList [])
+  putStrLn $ show $ WhileInterp.run (If (Val (BoolVal False)) (Val (IntVal 1)) (Val (IntVal 2)))
+  -- Should be: (BoolVal False,fromList [])
+  putStrLn $ show $ WhileInterp.run (While (Val (BoolVal False)) (Val (IntVal 42)))
+  -- Should be: (IntVal 666,fromList [("X",IntVal 666)])
+  putStrLn $ show $ WhileInterp.run (Sequence
+                                        (Assign "X" (Val (IntVal 666)))
+                                        (Var "X"))
+
+main :: IO ()
+main = do
+  testUnit
+  -- Should be: fromList [("X",IntVal 0),("Y",IntVal 10)]
+  putStrLn $ show $ WhileInterp.testProgram w_test
+  -- Should be: fromList [("F",IntVal 2),("N",IntVal 0),("X",IntVal 1),("Z",IntVal 2)]
+  putStrLn $ show $ WhileInterp.testProgram w_fact
+

hw2/while-semantics.tex

@@ -0,0 +1,292 @@
+\documentclass{article}
+
+\usepackage{fullpage}
+\usepackage{listings}
+\usepackage{amsmath}
+\usepackage{amsthm}
+\usepackage{amssymb}
+%\usepackagen{url}
+\usepackage{float}
+\usepackage{paralist}
+
+\floatstyle{boxed}
+\restylefloat{figure}
+
+
+
+\newcommand{\rel}[1]{ \mbox{\sc [#1]} }
+
+\title{Homework 2: Operational Semantics for WHILE}
+
+\author{
+  CS 252: Advanced Programming Languages \\
+  Prof. Thomas H. Austin \\
+  San Jos\'{e} State University \\
+  }
+\date{}
+
+\begin{document}
+\maketitle
+
+\section{Introduction}
+
+For this assignment,
+you will implement the semantics for a small imperative language, named WHILE.
+
+% Commands for formatting figure
+\newcommand{\mydefhead}[2]{\multicolumn{2}{l}{{#1}}&\mbox{\emph{#2}}\\}
+\newcommand{\mydefcase}[2]{\qquad\qquad& #1 &\mbox{#2}\\}
+
+% Commands for language format
+\newcommand{\assign}[2]{#1~{:=}~#2}
+\newcommand{\ife}[3]{\mbox{\tt if}~{#1}~\mbox{\tt then}~{#2}~\mbox{\tt else}~{#3}}
+\newcommand{\whilee}[2]{\mbox{\tt while}~(#1)~#2}
+\newcommand{\true}{\mbox{\tt true}}
+\newcommand{\false}{\mbox{\tt false}}
+
+\begin{figure}\label{fig:lang}
+\caption{The WHILE language}
+\[
+\begin{array}{llr}
+  \mydefhead{e ::=\qquad\qquad\qquad\qquad}{Expressions}
+  \mydefcase{x}{variables/addresses}
+  \mydefcase{v}{values}
+  \mydefcase{\assign x e}{assignment}
+  \mydefcase{e; e}{sequential expressions}
+  \mydefcase{e ~op~ e}{binary operations}
+  \mydefcase{\ife e e e}{conditional expressions}
+  \mydefcase{\whilee e e}{while expressions}
+  \\
+  \mydefhead{v ::=\qquad\qquad\qquad\qquad}{Values}
+  \mydefcase{i}{integer values}
+  \mydefcase{b}{boolean values}
+  \\
+  op ::= & + ~|~ - ~|~ * ~|~ / ~|~ > ~|~ >= ~|~ < ~|~ <=  & \mbox{\emph{Binary operators}} \\
+\end{array}
+\]
+\end{figure}
+
+The language for WHILE is given in Figure~\ref{fig:lang}.
+Unlike the Bool* language we discussed previously,
+WHILE supports \emph{mutable references}.
+The state of these references is maintained in a \emph{store},
+a mapping of references to values.
+(``Store'' can be thought of as a synonym for heap.)
+Once we have mutable references, other language constructs become more useful,
+such as sequencing operations ($e_1;e_2$).
+
+
+
+%---------
+\section{Small-step semantics}
+
+\newcommand{\ssrule}[3]{
+  \rel{#1} &
+  \frac{\strut\begin{array}{@{}c@{}} #2 \end{array}}
+       {\strut\begin{array}{@{}c@{}} #3 \end{array}}
+   \\~\\
+}
+%\newcommand{\sstep}[4]{\ctxt[{#1}],{#2} \rightarrow \ctxt[{#3}],{#4}}
+%\newcommand{\sstepraw}[4]{{#1},{#2} \rightarrow {#3},{#4}}
+\newcommand{\sstep}[4]{{#1},{#2} \rightarrow {#3},{#4}}
+\newcommand{\ctxt}{C}
+
+The small-step semantics for WHILE are given in Figure~\ref{fig:smallstep}.
+%For the sake of brevity, these rules use \emph{evaluation contexts} ($\ctxt$),
+%which specify which \emph{redex} will be evaluated next.
+%The evaluation rules then apply to the ``hole'' ($\bullet$) in this context.
+%
+Most of these rules are fairly straightforward, but there are a couple of points
+to note with the $\rel{ss-while}$ rule.
+First of all, this is the only rule that makes a more complex expression
+when it has finished.
+(This rule is much cleaner when specified with the big-step operational semantics.)
+
+Secondly, note the final value of this expression once the while loop completes.
+It will \emph{always} be {\false} when it completes.
+We could have created a special value, such as {\tt null},
+or we could have made the while loop a statement that returns no value.
+Both choices, however, would complicate our language needlessly.
+
+
+%--------------
+\section{YOUR ASSIGNMENT}
+\newcommand{\bstep}[4]{{#1},{#2} \Downarrow {#3},{#4}}
+
+\noindent
+{\bf Part 1:}
+Rewrite the operational semantic rules for WHILE in \LaTeX\
+to use big-step operational semantics instead.
+Submit both your \LaTeX\ source and the generated PDF file.
+
+Extend your semantics with features to handle boolean values.
+{\bf Do not treat these a binary operators.}
+Specifically, add support for:
+\begin{compactitem}
+  \item {\tt and}
+  \item {\tt or}
+  \item {\tt not}
+\end{compactitem}
+
+The exact behavior of these new features is up to you,
+but should seem reasonable to most programmers.
+
+\bigskip
+\noindent
+{\bf Part 2:}
+Once you have your semantics defined,
+download {\tt WhileInterp.hs} and implement the {\tt evaluate} function,
+as well as any additional functions you need.
+Your implementation must be consistent with your operational semantics,
+{\it including your extensions for {\tt and}, {\tt or}, and {\tt not}}.
+Also, you may not change any type signatures provided in the file.
+
+Finally, implement the interpreter to match your semantics.
+
+\bigskip
+\noindent
+{\bf Zip all files together into {\tt hw2.zip} and submit to Canvas.}
+
+
+
+
+
+%\begin{figure}[H]\label{fig:smallstep}
+%\caption{Small-step semantics for WHILE}
+%{\bf Runtime Syntax:}
+%\[
+%\begin{array}{rclcl}
+%  \ctxt & \in & {Context} \quad & ::= & \quad \ctxt; e
+%        ~|~ \ctxt ~op~ e
+%        ~|~ v ~op~ \ctxt
+%        ~|~ \assign{x}{\ctxt}
+%        ~|~ \ife{\ctxt}{e_1}{e_2}
+%        ~|~ \bullet \\
+%  \sigma & \in & {Store} \quad  & = & \quad {variable} ~\rightarrow ~v \\
+%  \\
+%\end{array}
+%\]
+%{\bf Evaluation Rules:~~~ \fbox{$\sstepraw{e}{\sigma}{e'}{\sigma'}$}} \\
+%\[
+%\begin{array}{cc}
+%\begin{array}{r@{\qquad}l}
+%\ssrule{ss-var}{
+%  x \in domain(\sigma) \qquad \sigma(x)=v
+%}{
+%  \sstep{x}{\sigma}{v}{\sigma}
+%}
+%\ssrule{ss-assign}{
+%}{
+%  \sstep{\assign{x}{v}}{\sigma}{v}{\sigma[x:=v]}
+%}
+%\ssrule{ss-op}{
+%  v = v_1 ~op~ v_2
+%}{
+%  \sstep{v_1~op~v_2}{\sigma}{v}{\sigma}
+%}
+%\end{array}
+%  &
+%\begin{array}{r@{\qquad}l}
+%\ssrule{ss-seq}{
+%}{
+%  \sstep{v;e}{\sigma}{e}{\sigma}
+%}
+%\ssrule{ss-iftrue}{
+%}{
+%  \sstep{\ife{\true}{e_1}{e_2}}{\sigma}{e_1}{\sigma}
+%}
+%\ssrule{ss-iffalse}{
+%}{
+%  \sstep{\ife{\false}{e_1}{e_2}}{\sigma}{e_2}{\sigma}
+%}
+%\ssrule{ss-while}{
+%}{
+%  \sstep{\whilee{e_1}{e_2}}{\sigma}{\ife{e_1}{e_2;\whilee{e_1}{e_2}}{\false}}{\sigma}
+%}
+%\end{array}
+%\end{array}
+%\]
+%\end{figure}
+%
+
+\begin{figure}[H]\label{fig:smallstep}
+\caption{Small-step semantics for WHILE}
+{\bf Runtime Syntax:}
+\[
+\begin{array}{rclcl}
+  \sigma & \in & {Store} \quad  & = & \quad {variable} ~\rightarrow ~v \\
+  \\
+\end{array}
+\]
+{\bf Evaluation Rules:~~~ \fbox{$\sstep{e}{\sigma}{e'}{\sigma'}$}} \\
+\[
+%\begin{array}{cc}
+\begin{array}{r@{\qquad}l}
+\ssrule{ss-seqctx}{
+  \sstep{e_1}{\sigma}{e_1'}{\sigma'}
+}{
+  \sstep{e_1;e_2}{\sigma}{e_1';e_2}{\sigma'}
+}
+\ssrule{ss-seq}{
+}{
+  \sstep{v;e}{\sigma}{e}{\sigma}
+}
+\ssrule{ss-opctx1}{
+  \sstep{e_1}{\sigma}{e_1'}{\sigma'}
+}{
+  \sstep{e_1~op~e_2}{\sigma}{e_1'~op~e_2}{\sigma'}
+}
+\ssrule{ss-opctx2}{
+  \sstep{e_2}{\sigma}{e_2'}{\sigma'}
+}{
+  \sstep{v_1~op~e_2}{\sigma}{v_1~op~e_2'}{\sigma'}
+}
+\ssrule{ss-op}{
+  v = v_1 ~op~ v_2
+}{
+  \sstep{v_1~op~v_2}{\sigma}{v}{\sigma}
+}
+\end{array}
+\begin{array}{r@{\qquad}l}
+\ssrule{ss-var}{
+  x \in domain(\sigma) \qquad \sigma(x)=v
+}{
+  \sstep{x}{\sigma}{v}{\sigma}
+}
+\ssrule{ss-assignctx}{
+  \sstep{e_1}{\sigma}{e_1'}{\sigma'}
+}{
+  \sstep{\assign{x}{e}}{\sigma}{\assign{x}{e'}}{\sigma'}
+}
+\ssrule{ss-assign}{
+}{
+  \sstep{\assign{x}{v}}{\sigma}{v}{\sigma[x:=v]}
+}
+\ssrule{ss-iftrue}{
+}{
+  \sstep{\ife{\true}{e_1}{e_2}}{\sigma}{e_1}{\sigma}
+}
+\ssrule{ss-iffalse}{
+}{
+  \sstep{\ife{\false}{e_1}{e_2}}{\sigma}{e_2}{\sigma}
+}
+\end{array}
+\]
+\[
+\begin{array}{r@{\qquad}l}
+\ssrule{ss-ifctx}{
+  \sstep{e_1}{\sigma}{e_1'}{\sigma'}
+}{
+  \sstep{\ife{e_1}{e_2}{e_3}}{\sigma}{\ife{e_1'}{e_2}{e_3}}{\sigma'}
+}
+\ssrule{ss-while}{
+}{
+  \sstep{\whilee{e_1}{e_2}}{\sigma}{\ife{e_1}{e_2;\whilee{e_1}{e_2}}{\false}}{\sigma}
+}
+\end{array}
+\]
+\end{figure}
+
+
+\end{document}
+

lab04/lab.lhs

@@ -6,28 +6,33 @@ First, implement your own version of the foldl function,
 defined as myFoldl
 
 > myFoldl :: (a -> b -> a) -> a -> [b] -> a
-> myFoldl _ _ _ = error "TBD"
+> myFoldl f acc [] = acc
+> myFoldl f acc (x:xs) = myFoldl f (f acc x) xs
 
 
 Next, define a function to reverse a list using foldl.
 
 > myReverse :: [a] -> [a]
-> myReverse _ = error "TBD"
+> myReverse = foldl (\acc x -> x : acc) []
 
 
 Now define your own version of foldr, named myFoldr
 
 > myFoldr :: (a -> b -> b) -> b -> [a] -> b
-> myFoldr _ _ _ = error "TBD"
+> myFoldr f acc [] = acc
+> myFoldr f acc (x:xs) = f x $ myFoldr f acc xs
 
 
 Now try using foldl (the library version, not yours) to sum up the numbers of a large list.
 Why is it so slow?
 
+foldl is slow because it repeatedly pushes unevaluated expressions on the stack
+
 Instead of foldl, try using foldl'.
 Why is it faster?
 (Read http://www.haskell.org/haskellwiki/Foldr_Foldl_Foldl%27 for some hints)
 
+foldl' evaluates the accumulator at each step, preventing the build up of unevaluated expressions
 
 For an extra challenge, try to implement foldl in terms of foldr.
 See http://www.haskell.org/haskellwiki/Foldl_as_foldr for details.
@@ -36,11 +41,20 @@ See http://www.haskell.org/haskellwiki/Foldl_as_foldr for details.
 Next, using the map function, convert every item in a list to its absolute value
 
 > listAbs :: [Integer] -> [Integer]
-> listAbs _ = error "TBD"
+> listAbs = map abs
 
 Finally, write a function that takes a list of Integers and returns the sum of
 their absolute values.
 
 > sumAbs :: [Integer] -> Integer
-> sumAbs _ = error "TBD"
+> sumAbs = sum . listAbs
 
+> main :: IO ()
+> main = do
+>   putStrLn $ "myFoldl (+) 0 [1..10] = " ++ show (myFoldl (+) 0 [1..10])
+>   putStrLn $ "myReverse [1..5] = " ++ show (myReverse [1..5])
+>   putStrLn $ "myFoldr (+) 0 [1..10] = " ++ show (myFoldr (+) 0 [1..10])
+>   putStrLn $ "listAbs [-1, -2, 3, -4] = " ++ show (listAbs [-1, -2, 3, -4])
+>   putStrLn $ "sumAbs [-1, -2, 3, -4] = " ++ show (sumAbs [-1, -2, 3, -4])
+>   putStrLn $ "foldl (+) 0 [1..10000000] = " ++ show (foldl (+) 0 [1..10000000])
+>   putStrLn $ "foldl' (+) 0 [1..10000000] = " ++ show (foldl' (+) 0 [1..10000000])

lab05/maybeEither.hs

@@ -0,0 +1,25 @@
+getMax :: [Int] -> Maybe Int
+getMax [] = Nothing
+getMax x = Just (maximum x)
+
+reciprocal :: (Eq a, Fractional a) => a -> Maybe a
+reciprocal 0 = Nothing
+reciprocal x = Just (1/x)
+
+rectangleArea :: Int -> Int -> Either String Int
+rectangleArea x y
+  | x < 0 = Left "Width is not positive"
+  | y < 0 = Left "Height is not positive"
+  | otherwise = Right (x * y)
+
+main :: IO ()
+main = do
+  print $ getMax []
+  print $ getMax [99,12,37]
+  print $ getMax [-99,-12,-37]
+  print $ reciprocal 4
+  print $ reciprocal 2
+  print $ reciprocal 0
+  print $ rectangleArea 5 10
+  print $ rectangleArea (-5) 10
+  print $ rectangleArea 5 (-10)

lab06/functors.lhs

@@ -0,0 +1,24 @@
+> data Tree v =
+>     Empty
+>   | Node v (Tree v) (Tree v)
+>   deriving (Show)
+
+> instance Functor Tree where
+>   fmap f (Node v left right) = Node (f v) (fmap f left) (fmap f right)
+>   fmap f Empty = Empty
+
+The findT method shows how we may search through the tree to find a value.
+
+> findT :: Ord v => v -> Tree v -> Maybe v
+> findT _ Empty = Nothing
+> findT v (Node val left right) =
+>   if val == v then
+>     Just val
+>   else if v < val then
+>     findT v left
+>   else
+>     findT v right
+
+Your job is to add support for fmap to this tree, so that the call to fmap below works:
+
+> main = print $ fmap (+1) (Node 3 (Node 1 Empty Empty) (Node 7 (Node 4 Empty Empty) Empty))

lab07/facetedValues.lhs

@@ -0,0 +1,89 @@
+> import Control.Applicative
+> import qualified Data.Set as Set
+
+Faceted values are an **information flow mechanism**.  Specifically, they are
+designed to store differing views of data.  For more technical details, see
+"Multiple Facets for Dynamic Information Flow", available at
+https://users.soe.ucsc.edu/~cormac/papers/popl12b.pdf.
+
+Authorized viewers should see the real value, and other viewers should see
+dummy data instead.  To do this, we need to represent the security level
+of a piece of data.  We'll define labels to encapsulate this information,
+represented as strings.
+
+> type Label = String
+
+A user may have many security privileges, so a "view" of a faceted value can
+be represented as a set of labels.
+
+> type View = Set.Set Label
+
+A faceted value can be either a raw (that is, unfaceted) value, or it can
+be node containing two nested faceted values, with a label tracking who is
+allowed to view the contents.
+
+> data FacetedValue a = Raw a
+>                     | Facet Label (FacetedValue a) (FacetedValue a)
+
+Note that we do **not** derive Show.  Instead, code must pass its
+authorizations to a view function, which will return a non-faceted value.
+If any label is not in the set, it is assumed that the view is not authorized.
+
+> view :: View -> FacetedValue a -> a
+> view _ (Raw x) = x
+> view labels (Facet k auth unauth) =
+>     if Set.member k labels then
+>       view labels auth
+>     else
+>       view labels unauth
+
+We can apply operations to a faceted value, in which case the action should
+be applied to every element of the tree.  As a review of the last lab, define
+fmap for FacetedValues.
+
+> instance Functor FacetedValue where
+>   fmap f (Raw x) = Raw (f x)
+>   fmap f (Facet label auth unauth) = Facet label (fmap f auth) (fmap f unauth)
+
+
+The following function gives an example of how a FacetedValue can be used.
+In this case, a customer's Visa credit card is hidden from other viewers.
+If someone with other permissions, say with the ability to view details
+about the customer's Mastercard, they will instead be presented with the
+default view of 0.  Even if someone tries to do some calculations on the
+credit card in the hope of revealing information, a consistent view will be
+presented to the observer.
+
+> testFmap = do
+>   let creditCard = Facet "visa" (Raw 4111111111111111) (Raw 0)
+>       ccPlusOne = fmap (+1) creditCard
+>   putStrLn "Credit card views:"
+>   print $ view (Set.fromList ["visa"]) ccPlusOne -- Should print 4111111111111112
+>   print $ view (Set.fromList ["mastercard"]) ccPlusOne -- Should print 1
+
+
+
+While this works, what happens if we want two faceted values to be combined?
+In order to make that work, we need need to add support for Applicative Functors.
+Define the behavior of the Functor below
+
+> instance Applicative FacetedValue where
+>   pure = Raw
+>   Raw f <*> fv2 = fmap f fv2
+>   Facet label auth unauth <*> fv2 = Facet label (auth <*> fv2) (unauth <*> fv2)
+
+
+The code below gives an example of how this might come up.  If code authorized
+to read your Bank of America account details runs on the same machine as code
+to read your Wells Fargo details, **neither** will be allowed to read your
+combined balance.  However, you as the customer can see the true values.
+
+> testApplicative = do
+>   let bofaBalance = Facet "Bank of America" (Raw 44) (Raw 0)
+>       wellsFargoBalance = Facet "Wells Fargo" (Raw 122) (Raw 0)
+>       combinedBalance = (+) <$> bofaBalance <*> wellsFargoBalance
+>   print $ view (Set.fromList []) combinedBalance -- Should print 0
+>   print $ view (Set.fromList ["Bank of America"]) combinedBalance -- Should print 44
+>   print $ view (Set.fromList ["Wells Fargo"]) combinedBalance -- Should print 122
+>   print $ view (Set.fromList ["Bank of America", "Wells Fargo"]) combinedBalance -- Should print 166
+

lab08/applyMaybe.hs

@@ -0,0 +1,8 @@
+applyMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b  
+applyMaybe Nothing f  = Nothing  
+applyMaybe (Just x) f = f x
+
+test1 = Just 3 `applyMaybe` (\x -> Just $ x * 2) `applyMaybe` (\x -> Just $ x - 1)
+
+test2 = Just 3 `applyMaybe` (\_ -> Nothing) `applyMaybe` (\x -> Just $ x - 1)
+

lab08/bender.hs

@@ -0,0 +1,15 @@
+type Pos = (Int, Int)
+
+start = (0,0)
+
+up (x, y)    = (x, y+1)
+down (x, y)  = (x, y-1)
+left (x, y)  = (x-1, y)
+right (x, y) = (x+1, y)
+
+x -: f = f x
+
+-- Using the "-:" operator, we can chain movements together
+test1 = start -: up -: right
+test2 = start -: up -: left -: left -: right -: down
+

lab08/benderPerhaps.hs

@@ -0,0 +1,34 @@
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+-- In this code, we model bender moving around, but
+-- if he finds beer, he will stop responding to commands.
+type Pos = (Integer, Integer)
+
+x -: f = f x
+
+start = (0,0)
+
+badPos = Map.empty
+  -: Map.insert (0,2) True
+  -: Map.insert (-1,3) True
+  -: Map.insert (-3,-8) True
+
+
+moveTo :: Pos -> Maybe Pos
+moveTo p =
+  if Map.member p badPos
+    then Nothing
+    else Just p
+
+up (x, y)    = moveTo (x, y+1)
+down (x, y)  = moveTo (x, y-1)
+left (x, y)  = moveTo (x-1, y)
+right (x, y) = moveTo (x+1, y)
+
+-- Our directions now result in Maybe Pos values, so we can't chain them with "-:" anymore.
+test1 = return start >>= up >>= right
+test2 = return start >>= up >>= left >>= left >>= right >>= down
+test3 = return start >>= left >>= left >>= up >>= up >>= right >>= up >>= right >>= right >>= down
+
+

lab08/doit.hs

@@ -0,0 +1,21 @@
+mydiv x y =
+  x >>= (\numer ->
+  y >>= (\denom ->
+    if denom > 0
+      then Just $ numer `div` denom
+      else Nothing))
+
+mydiv' x y = do
+  numer <- x
+  denom <- y
+  if denom > 0
+    then return $ numer `div` denom
+    else Nothing
+
+test1 = (Just 99) `mydiv` (Just 11)
+test1' = (Just 99) `mydiv'` (Just 11)
+
+test2 = (Just 9) `mydiv` (Just 0)
+test2' = (Just 9) `mydiv'` (Just 0)
+
+

lab08/monadLab.lhs

@@ -0,0 +1,120 @@
+Below we have some mathematical binary arguments that you may recognize from homework 2.
+
+> data Binop =
+>     Plus     -- +  :: Int  -> Int  -> Int
+>   | Minus    -- -  :: Int  -> Int  -> Int
+>   | Times    -- *  :: Int  -> Int  -> Int
+>   | Divide   -- /  :: Int  -> Int  -> Int
+>   deriving (Show)
+
+applyOp performs these operations, but unlike in the homework,
+you now must consider errors (represented by 'Nothing').
+
+> applyOp :: Binop -> Maybe Int -> Maybe Int -> Maybe Int
+
+Plus is done for you.  Notice how code must check for 'Nothing'
+for each operand.
+
+> applyOp Plus mi mj =
+>   case mi of
+>     Nothing -> Nothing
+>     Just i ->
+>       case mj of
+>         Nothing -> Nothing
+>         Just j -> Just $ i + j
+
+Minus is also done for you.  This case **does** use monads,
+but without the do syntax.
+
+> applyOp Minus mi mj =
+>   mi >>= (\i -> mj >>= (\j -> Just $ i - j))
+
+Implement Times and Divide.  Try the Times case without monads (as we did with
+the Plus case).
+
+> applyOp Times mi mj = 
+>   case mi of
+>     Nothing -> Nothing
+>     Just i ->
+>       case mj of
+>         Nothing -> Nothing
+>         Just j -> Just $ i * j
+
+For the Divide case, use bind (>>=) as we did for Minus.
+On an attempt to divide by 0, return Nothing as the answer.
+
+> applyOp Divide mi mj =
+>   mi >>= (\i -> mj >>= (\j -> if j == 0 then Nothing else Just $ i `div` j))
+
+The following test cases will help you verify your changes.
+
+> testapp1 = applyOp Minus (applyOp Times (Just 3) (Just 4)) $ applyOp Divide (Just 8) (Just 2)
+> testapp2 = applyOp Minus (applyOp Times (Just 3) (Just 4)) $ applyOp Divide (Just 8) (applyOp Plus (Just 3) (Just (-3)))
+
+
+Now implement applyOp', which implements all methods using the do syntax.
+The Plus case is done for you once again.  Be sure to check for zero with Divide.
+
+> applyOp' :: Binop -> Maybe Int -> Maybe Int -> Maybe Int
+> applyOp' Plus mi mj = do
+>   i <- mi
+>   j <- mj
+>   return $ i + j
+> applyOp' Minus mi mj = do
+>   i <- mi
+>   j <- mj
+>   return $ i - j
+> applyOp' Times mi mj = do
+>   i <- mi
+>   j <- mj
+>   return $ i * j
+> applyOp' Divide mi mj  = do
+>   i <- mi
+>   j <- mj
+>   if j == 0
+>     then Nothing
+>     else return $ i `div` j
+
+More test cases:
+
+> testapp1' = applyOp' Minus (applyOp' Times (Just 3) (Just 4)) $ applyOp' Divide (Just 8) (Just 2)
+> testapp2' = applyOp' Minus (applyOp' Times (Just 3) (Just 4)) $ applyOp' Divide (Just 8) (applyOp' Plus (Just 3) (Just (-3)))
+
+
+Finally, note the following function for incrementing and decrementing ints.
+
+> mincr :: Int -> Maybe Int
+> mincr i = Just $ i + 1
+
+> mdecr :: Int -> Maybe Int
+> mdecr i = Just $ i - 1
+
+Experiment with these functions and the >>= syntax.
+Here is one example:
+
+> testIncDec = Just 7 >>= mincr >>= mincr >>= mincr >>= mdecr
+> testIncDec' = do
+>   i <- Just 7
+>   i <- mincr i
+>   i <- mincr i
+>   i <- mincr i
+>   i <- mdecr i
+>   return i
+
+Does bind seem more natural in this case than using do?  Why or why not?
+
+The bind behaves sort of like an upgraded pipe `|` from shell, 
+where the output of one function is piped into the next function,
+but with the added benefit of error handling
+
+The do syntax is a bit more explicit in this case, as it requires unwrapping the value,
+performing the operation, and then wrapping the value back up
+
+> main :: IO ()
+> main = do
+>   print testapp1
+>   print testapp2
+>   print testapp1'
+>   print testapp2'
+>   print testIncDec
+>   print testIncDec'

lab08/stack.hs

@@ -0,0 +1,29 @@
+import Control.Monad.State
+
+type Stack = [Int]
+
+pop :: Stack -> (Int,Stack)
+pop (x:xs) = (x,xs)
+
+push :: Int -> Stack -> ((),Stack)
+push a xs = ((),a:xs)
+
+stackManip :: Stack -> (Int, Stack)  
+stackManip stack = let  
+    ((),newStack1) = push 3 stack  
+    (a ,newStack2) = pop newStack1  
+    in pop newStack2 
+
+
+pop' :: State Stack Int
+pop' = State $ \(x:xs) -> (x,xs)
+
+push' :: Int -> State Stack ()
+push' a = State $ \xs -> ((),a:xs)
+
+stackManip' :: State Stack Int
+stackManip' = do
+  push' 3
+  a <- pop'
+  pop'
+