Added programming language fundamentals code. More to come.

This commit is contained in:
2018-01-06 23:10:08 -08:00
parent 51b0102711
commit 7b18f6a807
13 changed files with 1248 additions and 0 deletions

View File

@@ -0,0 +1,172 @@
module Nat where
import Prelude hiding (Enum(..), sum)
--
-- * Part 2: Natural numbers
--
-- | The natural numbers.
data Nat = Zero
| Succ Nat
deriving (Eq,Show)
-- | The number 1.
one :: Nat
one = Succ Zero
-- | The number 2.
two :: Nat
two = Succ one
-- | The number 3.
three :: Nat
three = Succ two
-- | The number 4.
four :: Nat
four = Succ three
-- | The predecessor of a natural number.
--
-- >>> pred Zero
-- Zero
--
-- >>> pred three
-- Succ (Succ Zero)
--
pred :: Nat -> Nat
pred Zero = Zero
pred (Succ nat) = nat
-- | True if the given value is zero.
--
-- >>> isZero Zero
-- True
--
-- >>> isZero two
-- False
--
isZero :: Nat -> Bool
isZero x = x == Zero
-- | Convert a natural number to an integer.
--
-- >>> toInt Zero
-- 0
--
-- >>> toInt three
-- 3
--
toInt :: Nat -> Int
toInt Zero = 0
toInt (Succ nat) = (toInt nat) + 1
-- | Add two natural numbers.
--
-- >>> add one two
-- Succ (Succ (Succ Zero))
--
-- >>> add Zero one == one
-- True
--
-- >>> add two two == four
-- True
--
-- >>> add two three == add three two
-- True
--
add :: Nat -> Nat -> Nat
add Zero x = x
add (Succ nat) x = add nat (Succ x)
-- | Subtract the second natural number from the first. Return zero
-- if the second number is bigger.
--
-- >>> sub two one
-- Succ Zero
--
-- >>> sub three one
-- Succ (Succ Zero)
--
-- >>> sub one one
-- Zero
--
-- >>> sub one three
-- Zero
--
sub :: Nat -> Nat -> Nat
sub Zero _ = Zero
sub x Zero = x
sub (Succ x) (Succ y) = sub x y
-- | Is the left value greater than the right?
--
-- >>> gt one two
-- False
--
-- >>> gt two one
-- True
--
-- >>> gt two two
-- False
--
gt :: Nat -> Nat -> Bool
gt Zero Zero = False
gt Zero (Succ _) = False
gt (Succ _) Zero = True
gt (Succ x) (Succ y) = gt x y
-- | Multiply two natural numbers.
--
-- >>> mult two Zero
-- Zero
--
-- >>> mult Zero three
-- Zero
--
-- >>> toInt (mult two three)
-- 6
--
-- >>> toInt (mult three three)
-- 9
--
mult :: Nat -> Nat -> Nat
mult Zero _ = Zero
mult _ Zero = Zero
mult x (Succ y) = add x (mult x y)
-- | Compute the sum of a list of natural numbers.
--
-- >>> sum []
-- Zero
--
-- >>> sum [one,Zero,two]
-- Succ (Succ (Succ Zero))
--
-- >>> toInt (sum [one,two,three])
-- 6
--
sum :: [Nat] -> Nat
sum [] = Zero
sum (x:xs) = add x (sum xs)
-- | An infinite list of all of the *odd* natural numbers, in order.
--
-- >>> map toInt (take 5 odds)
-- [1,3,5,7,9]
--
-- >>> toInt (sum (take 100 odds))
-- 10000
--
odds :: [Nat]
odds = one : map (add two) odds

View File

@@ -0,0 +1,204 @@
module Tree where
--
-- * Part 1: Binary trees
--
-- | Integer-labeled binary trees.
data Tree = Node Int Tree Tree -- ^ Internal nodes
| Leaf Int -- ^ Leaf nodes
deriving (Eq,Show)
-- | An example binary tree, which will be used in tests.
t1 :: Tree
t1 = Node 1 (Node 2 (Node 3 (Leaf 4) (Leaf 5)) (Leaf 6)) (Node 7 (Leaf 8) (Leaf 9))
-- | Another example binary tree, used in tests.
t2 :: Tree
t2 = Node 6 (Node 2 (Leaf 1) (Node 4 (Leaf 3) (Leaf 5)))
(Node 8 (Leaf 7) (Leaf 9))
-- | The integer at the left-most node of a binary tree.
--
-- >>> leftmost (Leaf 3)
-- 3
--
-- >>> leftmost (Node 5 (Leaf 6) (Leaf 7))
-- 6
--
-- >>> leftmost t1
-- 4
--
-- >>> leftmost t2
-- 1
--
leftmost :: Tree -> Int
leftmost (Leaf i) = i
leftmost (Node _ l _) = leftmost l
-- | The integer at the right-most node of a binary tree.
--
-- >>> rightmost (Leaf 3)
-- 3
--
-- >>> rightmost (Node 5 (Leaf 6) (Leaf 7))
-- 7
--
-- >>> rightmost t1
-- 9
--
-- >>> rightmost t2
-- 9
--
rightmost :: Tree -> Int
rightmost (Leaf i) = i
rightmost (Node _ _ r) = rightmost r
-- | Get the maximum integer from a binary tree.
--
-- >>> maxInt (Leaf 3)
-- 3
--
-- >>> maxInt (Node 5 (Leaf 4) (Leaf 2))
-- 5
--
-- >>> maxInt (Node 5 (Leaf 7) (Leaf 2))
-- 7
--
-- >>> maxInt t1
-- 9
--
-- >>> maxInt t2
-- 9
--
maxInt :: Tree -> Int
maxInt (Leaf i) = i
maxInt (Node x l r) = max x (max (maxInt l) (maxInt r))
-- | Get the minimum integer from a binary tree.
--
-- >>> minInt (Leaf 3)
-- 3
--
-- >>> minInt (Node 2 (Leaf 5) (Leaf 4))
-- 2
--
-- >>> minInt (Node 5 (Leaf 4) (Leaf 7))
-- 4
--
-- >>> minInt t1
-- 1
--
-- >>> minInt t2
-- 1
--
minInt :: Tree -> Int
minInt (Leaf i) = i
minInt (Node x l r) = min x (min (minInt l) (minInt r))
-- | Get the sum of the integers in a binary tree.
--
-- >>> sumInts (Leaf 3)
-- 3
--
-- >>> sumInts (Node 2 (Leaf 5) (Leaf 4))
-- 11
--
-- >>> sumInts t1
-- 45
--
-- >>> sumInts (Node 10 t1 t2)
-- 100
--
sumInts :: Tree -> Int
sumInts (Leaf i) = i
sumInts (Node x l r) = sum ([x] ++ [sumInts l] ++ [sumInts r])
-- | The list of integers encountered by a pre-order traversal of the tree.
--
-- >>> preorder (Leaf 3)
-- [3]
--
-- >>> preorder (Node 5 (Leaf 6) (Leaf 7))
-- [5,6,7]
--
-- >>> preorder t1
-- [1,2,3,4,5,6,7,8,9]
--
-- >>> preorder t2
-- [6,2,1,4,3,5,8,7,9]
--
preorder :: Tree -> [Int]
preorder (Leaf i) = [i]
preorder (Node x l r) = [x] ++ preorder l ++ preorder r
-- | The list of integers encountered by an in-order traversal of the tree.
--
-- >>> inorder (Leaf 3)
-- [3]
--
-- >>> inorder (Node 5 (Leaf 6) (Leaf 7))
-- [6,5,7]
--
-- >>> inorder t1
-- [4,3,5,2,6,1,8,7,9]
--
-- >>> inorder t2
-- [1,2,3,4,5,6,7,8,9]
--
inorder :: Tree -> [Int]
inorder (Leaf i) = [i]
inorder (Node x l r) = inorder l ++ [x] ++ inorder r
-- | Check whether a binary tree is a binary search tree.
--
-- >>> isBST (Leaf 3)
-- True
--
-- >>> isBST (Node 5 (Leaf 6) (Leaf 7))
-- False
--
-- >>> isBST t1
-- False
--
-- >>> isBST t2
-- True
--
isBST :: Tree -> Bool
isBST (Leaf _) = True
isBST (Node x (Leaf l) (Leaf r))
| l > x = False
| r < x = False
| otherwise = True
isBST (Node x (Node l al ar) (Node r bl br))
| l > x = False
| r < x = False
| isBST al && isBST ar && isBST bl && isBST br == True = True
| otherwise = True
-- | Check whether a number is contained in a binary search tree.
-- (You may assume that the given tree is a binary search tree.)
--
-- >>> inBST 2 (Node 5 (Leaf 2) (Leaf 7))
-- True
--
-- >>> inBST 3 (Node 5 (Leaf 2) (Leaf 7))
-- False
--
-- >>> inBST 4 t2
-- True
--
-- >>> inBST 10 t2
-- False
--
inBST :: Int -> Tree -> Bool
inBST i (Leaf x) = x == i
inBST i (Node x l r) = elem True ([x == i] ++ [inBST i l] ++ [inBST i r])

View File

@@ -0,0 +1,130 @@
module MiniLogo where
import Data.List
--
-- * MiniLogo
--
-- | The grammar:
-- num ::= (any natural number)
-- var ::= (any variable name)
-- macro ::= (any macro name)
--
-- prog ::= ε | cmd; prog sequence of commands
--
-- mode ::= up | down pen status
--
-- expr ::= var variable reference
-- | num literal number
-- | expr + expr addition expression
--
-- cmd ::= pen mode change pen status
-- | move (expr, expr) move pen to a new position
-- | define macro (var*) {prog} define a macro
-- | call macro (expr*) invoke a macro
-- | 1. Define the abstract syntax as a set of Haskell data types.
type Var = String
type Macro = String
type Prog = [Cmd]
data Mode = Up
| Down
deriving (Show, Eq)
data Expr = VarRef Var
| LitNum Int
| Add Expr Expr
deriving (Show, Eq)
data Cmd = Pen Mode
| Move (Expr, Expr)
| Define Macro [Var] Prog
| Call Macro [Expr]
deriving (Show, Eq)
-- | 2. Define a MiniLogo macro "line."
--
-- Concrete syntax in a comment:
--
-- define line(x1, y1, x2, y2) {
-- pen up;
-- move (x1, y1);
-- pen down;
-- move (x2, y2);
-- pen up;
-- }
--
-- Abstract syntax in code (include correct type header):
--
line :: Cmd
line = Define "line" ["x1", "y1", "x2", "y2"] [Pen Up, Move (VarRef "x1", VarRef "y1"), Pen Down, Move (VarRef "x2", VarRef "y2"), Pen Up]
-- | 3. Define a MiniLogo macro "nix" using "line" defined above.
--
-- Concrete syntax in a comment:
--
-- define nix(x, y, w, h) {
-- line(x, y, x + w, y + h);
-- line(x + w, y, x, y + h);
-- }
--
-- Abstract syntax in code (include correct type header):
--
nix :: Cmd
nix = Define "nix" ["x", "y", "w", "h"]
[Call "line" [VarRef "x", VarRef "y", Add (VarRef "x") (VarRef "w"), Add (VarRef "y") (VarRef "h")],
Call "line" [Add (VarRef "x") (VarRef "w"), VarRef "y", VarRef "x", Add (VarRef "y") (VarRef "h")]]
-- | 4. Define a Haskell function "steps" (steps :: Int -> Prog) that draws
-- a staircase of n steps starting from (0,0).
--
steps :: Int -> Prog
steps 0 = []
steps i = [Call "line" [LitNum i, LitNum i, LitNum (i - 1), LitNum i], Call "line" [LitNum i, LitNum i, LitNum i, LitNum (i - 1)]] ++ steps (i-1)
-- | 5. Define a Haskell function "macros" (macros :: Prog -> [Macro] that
-- returns a list of the names of all the macros that are defined anywhere
-- in a given MiniLogo program.
--
macros :: Prog -> [Macro]
macros [] = []
macros (h:t) = case h of
Define m _ _ -> m : macros t
otherwise -> macros t
-- | 6. Define a Haskell function "pretty" (pretty :: Prog -> String) that
-- "pretty-prints" a MiniLogo program.
--
pretty :: Prog -> String
pretty [] = ""
pretty (Pen Up:t) = "pen up;\n" ++ pretty t
pretty (Pen Down:t) = "pen down;\n" ++ pretty t
pretty (Move (x, y):t) = "move (" ++ exprString x ++ ", " ++ exprString y ++ ");\n" ++ pretty t
pretty (Call n h:t) = n ++ "(" ++ intercalate ", " (map exprString h) ++ ");\n" ++ pretty t
pretty (Define m h p:ps) = "define " ++ m ++ "(" ++ intercalate ", " h ++ ") {\n" ++ pretty p ++ "}\n" ++ pretty ps
exprString :: Expr -> String
exprString (Add x y) = exprString x ++ " + " ++ exprString y
exprString (LitNum n) = show n
exprString (VarRef s) = s
--
-- * Bonus Problems
--
-- | 7. Define a Haskell function "optE" (optE :: Expr -> Expr) that partially
-- evaluates expressions by replacing additions of literals with the
-- result.
--
optE = undefined
-- | 8. Define a Haskell function "optP" (optP :: Prog -> Prog) that optimizes
-- all of the expressions contained in a given program using optE.
--
optP = undefined

View File

@@ -0,0 +1,63 @@
-- | This module defines the syntax of MiniMiniLogo. It also provides
-- functions to generate programs that draw some basic shapes.
--
-- NOTE: You should not change the definitions in this file!
--
module MiniMiniLogo where
--
-- * Syntax
--
-- | A program is a sequence of commands.
type Prog = [Cmd]
-- | The mode of the pen.
data Mode = Down | Up
deriving (Eq,Show)
-- | Abstract syntax of commands.
data Cmd = Pen Mode
| Move Int Int
deriving (Eq,Show)
-- | Generate a MiniMiniLogo program that draws a 2x2 box starting from the
-- specified point. Conceptually, this program looks like the following, but
-- the additions are carried out in Haskell rather than in MiniMiniLogo.
--
-- pen up; move (x,y);
-- pen down; move (x+2,y); move (x+2,y+2);
-- move (x,y+2); move (x,y);
--
-- >>> box 7 3
-- [Pen Up,Move 7 3,Pen Down,Move 9 3,Move 9 5,Move 7 5,Move 7 3]
--
box :: Int -> Int -> Prog
box x y = [Pen Up, Move x y, Pen Down,
Move (x+2) y, Move (x+2) (y+2), Move x (y+2), Move x y]
-- | Generate an 'X' from (x,y) to (x+w,y+h).
--
-- >>> nix 10 10 5 7
-- [Pen Up,Move 10 10,Pen Down,Move 15 17,Pen Up,Move 10 17,Pen Down,Move 15 10]
--
nix :: Int -> Int -> Int -> Int -> Prog
nix x y w h = [Pen Up, Move x y, Pen Down, Move (x+w) (y+h),
Pen Up, Move x (y+h), Pen Down, Move (x+w) y]
-- | Generate a MiniMiniLogo program that draws n steps starting from
-- point (x,y).
--
-- >>> steps 3 2 4
-- [Pen Up,Move 2 4,Pen Down,Move 2 5,Move 3 5,Move 3 6,Move 4 6,Move 4 7,Move 5 7]
--
steps :: Int -> Int -> Int -> Prog
steps n x y = [Pen Up, Move x y, Pen Down] ++ step n
where
step 0 = []
step n = step (n-1) ++ [Move (x+n-1) (y+n), Move (x+n) (y+n)]
-- | Draw an example picture. The expected output is given on the HW4
-- description page.
demo :: Prog
demo = box 7 3 ++ nix 6 6 4 3 ++ steps 3 2 4

View File

@@ -0,0 +1,13 @@
<!DOCTYPE html>
<html>
<head><title>MiniLogo Semantics Viewer</title></head>
<body>
<svg width='100%' viewBox='0 0 820 420'>
<rect x='7' y='7' width='806' height='405' style='fill:none;stroke:black;stroke-width:2'/>
<polyline points='80,380 100,380 100,360 80,360 80,380' style='fill:white;stroke:red;stroke-width:2'/>
<polyline points='70,350 110,320' style='fill:white;stroke:red;stroke-width:2'/>
<polyline points='70,320 110,350' style='fill:white;stroke:red;stroke-width:2'/>
<polyline points='30,370 30,360 40,360 40,350 50,350 50,340 60,340' style='fill:white;stroke:red;stroke-width:2'/>
</svg>
</body>
</html>

View File

@@ -0,0 +1,120 @@
module MiniMiniLogoSem where
import MiniMiniLogo
import Render
--NOTES -----------------------------------------------
-- -- | A program is a sequence of commands.
-- type Prog = [Cmd]
-- -- | The mode of the pen.
-- data Mode = Down | Up
-- deriving (Eq,Show)
-- -- | Abstract syntax of commands.
-- data Cmd = Pen Mode
-- | Move Int Int
-- deriving (Eq,Show)
-- -- | A point is a cartesian pair (x,y).
-- type Point = (Int,Int)
-- -- | A line is defined by its endpoints.
-- type Line = (Point,Point)
-------------------------------------------------------
--
-- * Semantics of MiniMiniLogo
--
-- NOTE:
-- * MiniMiniLogo.hs defines the abstract syntax of MiniMiniLogo and some
-- functions for generating MiniMiniLogo programs. It contains the type
-- definitions for Mode, Cmd, and Prog.
-- * Render.hs contains code for rendering the output of a MiniMiniLogo
-- program in HTML5. It contains the types definitions for Point and Line.
-- | A type to represent the current state of the pen.
type State = (Mode,Point)
-- | The initial state of the pen.
start :: State
start = (Up,(0,0))
-- | A function that renders the image to HTML. Only works after you have
-- implemented `prog`. Applying `draw` to a MiniMiniLogo program will
-- produce an HTML file named MiniMiniLogo.html, which you can load in
-- your browswer to view the rendered image.
draw :: Prog -> IO ()
draw p = let (_,ls) = prog p start in toHTML ls
-- Semantic domains:
-- * Cmd: State -> (State, Maybe Line)
-- * Prog: State -> (State, [Line])
-- | Semantic function for Cmd.
--
-- >>> cmd (Pen Down) (Up,(2,3))
-- ((Down,(2,3)),Nothing)
--
-- >>> cmd (Pen Up) (Down,(2,3))
-- ((Up,(2,3)),Nothing)
--
-- >>> cmd (Move 4 5) (Up,(2,3))
-- ((Up,(4,5)),Nothing)
--
-- >>> cmd (Move 4 5) (Down,(2,3))
-- ((Down,(4,5)),Just ((2,3),(4,5)))
--
cmd :: Cmd -> State -> (State, Maybe Line)
cmd (Pen x) (_,pt) = ( (x,pt) , Nothing)
cmd (Move m1 m2) (Down,pt) = ( (Down, (m1,m2)) , Just((pt),(m1,m2)) )
cmd (Move m1 m2) (Up,pt) = ( (Up, (m1,m2)) , Nothing)
-- | Semantic function for Prog.
--
-- >>> prog (nix 10 10 5 7) start
-- ((Down,(15,10)),[((10,10),(15,17)),((10,17),(15,10))])
--
-- >>> prog (steps 2 0 0) start
-- ((Down,(2,2)),[((0,0),(0,1)),((0,1),(1,1)),((1,1),(1,2)),((1,2),(2,2))])
prog :: Prog -> State -> (State, [Line])
prog prgs st = (progHelper prgs (st,[]) )
progHelper :: Prog -> (State, [Line]) -> (State, [Line])
progHelper [] x = x
progHelper (prg:prgs) (st,ls) =
let (nexst,nexln) = cmd prg st in
case nexln of
Just nexln -> progHelper prgs (nexst,ls ++ [nexln])
Nothing -> progHelper prgs (nexst,ls)
-- | Makes life ez
-- How to run 101
-- ezRander (prog (nix 10 10 5 7) start)
ezRender :: (State,[Line]) -> IO ()
ezRender (_,xs) = toHTML xs
--
-- * Extra credit
--
-- | This should be a MiniMiniLogo program that draws an amazing picture.
-- Add as many helper functions as you want.
-- ezRender(prog amazing start)
amazing :: Prog
amazing = [Pen Up, Move 5 5,Pen Down, Move 20 5, Move 20 10, Move 5 10, Move 5 5, Pen Up] ++ (steps 5 20 10)
++ [Pen Up, Move 5 10, Pen Down, Move 3 13, Pen Up] ++ (bigbox 0 13)
++ [Pen Up, Move 0 17, Pen Down, Move 1 19,Move 2 17, Move 3 19, Move 4 17, Pen Up]
++ [Pen Up, Move 7 5, Pen Down, Move 7 0, Pen Up]
++ [Pen Up, Move 17 5, Pen Down, Move 17 0, Pen Up]
bigbox :: Int -> Int -> Prog
bigbox x y = [Pen Up, Move x y, Pen Down,
Move (x+4) y, Move (x+4) (y+4), Move x (y+4), Move x y]

View File

@@ -0,0 +1,80 @@
module MiniMiniLogoSem where
import MiniMiniLogo
import Render
--
-- * Semantics of MiniMiniLogo
--
-- NOTE:
-- * MiniMiniLogo.hs defines the abstract syntax of MiniMiniLogo and some
-- functions for generating MiniMiniLogo programs. It contains the type
-- definitions for Mode, Cmd, and Prog.
-- * Render.hs contains code for rendering the output of a MiniMiniLogo
-- program in HTML5. It contains the types definitions for Point and Line.
-- | A type to represent the current state of the pen.
type State = (Mode,Point)
-- | The initial state of the pen.
start :: State
start = (Up,(0,0))
-- | A function that renders the image to HTML. Only works after you have
-- implemented `prog`. Applying `draw` to a MiniMiniLogo program will
-- produce an HTML file named MiniMiniLogo.html, which you can load in
-- your browswer to view the rendered image.
draw :: Prog -> IO ()
draw p = let (_,ls) = prog p start in toHTML ls
-- Semantic domains:
-- * Cmd: State -> (State, Maybe Line)
-- * Prog: State -> (State, [Line])
-- | Semantic function for Cmd.
--
-- >>> cmd (Pen Down) (Up,(2,3))
-- ((Down,(2,3)),Nothing)
--
-- >>> cmd (Pen Up) (Down,(2,3))
-- ((Up,(2,3)),Nothing)
--
-- >>> cmd (Move 4 5) (Up,(2,3))
-- ((Up,(4,5)),Nothing)
--
-- >>> cmd (Move 4 5) (Down,(2,3))
-- ((Down,(4,5)),Just ((2,3),(4,5)))
--
-- Done
cmd :: Cmd -> State -> (State, Maybe Line)
cmd (Pen s) (m, p) = ((s, p), Nothing)
cmd (Move x1 y1) (s, (x2, y2)) = case s of
Down -> ((s,(x1, y1)),Just ((x2,y2),(x1,y1)))
Up -> ((s,(x1, y1)),Nothing)
-- | Semantic function for Prog.
--
-- >>> prog (nix 10 10 5 7) start
-- ((Down,(15,10)),[((10,10),(15,17)),((10,17),(15,10))])
--
-- >>> prog (steps 2 0 0) start
-- ((Down,(2,2)),[((0,0),(0,1)),((0,1),(1,1)),((1,1),(1,2)),((1,2),(2,2))])
--
--
prog :: Prog -> State -> (State, [Line])
prog p (s, (x,y)) = ((s,(x,y)), prog p)
--
-- * Extra credit
--
-- | This should be a MiniMiniLogo program that draws an amazing picture.
-- Add as many helper functions as you want.
amazing :: Prog
amazing = undefined

View File

@@ -0,0 +1,86 @@
module MiniMiniLogoSem where
import MiniMiniLogo
import Render
--
-- * Semantics of MiniMiniLogo
--
-- NOTE:
-- * MiniMiniLogo.hs defines the abstract syntax of MiniMiniLogo and some
-- functions for generating MiniMiniLogo programs. It contains the type
-- definitions for Mode, Cmd, and Prog.
-- * Render.hs contains code for rendering the output of a MiniMiniLogo
-- program in HTML5. It contains the types definitions for Point and Line.
-- | A type to represent the current state of the pen.
type State = (Mode,Point)
-- | The initial state of the pen.
start :: State
start = (Up,(0,0))
-- | A function that renders the image to HTML. Only works after you have
-- implemented `prog`. Applying `draw` to a MiniMiniLogo program will
-- produce an HTML file named MiniMiniLogo.html, which you can load in
-- your browswer to view the rendered image.
draw :: Prog -> IO ()
draw p = let (_,ls) = prog p start in toHTML ls
-- Semantic domains:
-- * Cmd: State -> (State, Maybe Line)
-- * Prog: State -> (State, [Line])
-- | Semantic function for Cmd.
--
-- >>> cmd (Pen Down) (Up,(2,3))
-- ((Down,(2,3)),Nothing)
--
-- >>> cmd (Pen Up) (Down,(2,3))
-- ((Up,(2,3)),Nothing)
--
-- >>> cmd (Move 4 5) (Up,(2,3))
-- ((Up,(4,5)),Nothing)
--
-- >>> cmd (Move 4 5) (Down,(2,3))
-- ((Down,(4,5)),Just ((2,3),(4,5)))
--
cmd :: Cmd -> State -> (State, Maybe Line)
cmd (Pen pen_state) (_, new_point) = ((pen_state, new_point), Nothing)
cmd (Move mx my) (Up, (start_point)) = ((Up, (mx, my)), Nothing)
cmd (Move mx my) (Down, (start_x, start_y)) = ((Down, (mx, my)), Just ((start_x, start_y),(mx, my)))
-- | Semantic function for Prog.
--
-- >>> prog (nix 10 10 5 7) start
-- ((Down,(15,10)),[((10,10),(15,17)),((10,17),(15,10))])
--
-- >>> prog (steps 2 0 0) start
-- ((Down,(2,2)),[((0,0),(0,1)),((0,1),(1,1)),((1,1),(1,2)),((1,2),(2,2))])
prog :: Prog -> State -> (State, [Line])
prog [] prog_state = (prog_state, [])
prog prog_list start_state = progLineListHelper prog_list (start_state, [])
-- Helper function to handle keeping track of the line list as we move through the program elements
progLineListHelper :: Prog -> (State, [Line]) -> (State, [Line])
progLineListHelper [] state_and_line_list = state_and_line_list
progLineListHelper (progs_head:progs_tail) (initial_state, initial_line_list) =
let (new_state, new_line_list) = cmd progs_head initial_state in
case new_line_list of
Just new_line_list -> progLineListHelper progs_tail (new_state, initial_line_list ++ [new_line_list])
Nothing -> progLineListHelper progs_tail (new_state, initial_line_list)
--
-- * Extra credit
--
-- | This should be a MiniMiniLogo program that draws an amazing picture.
-- Add as many helper functions as you want.
amazing :: Prog
amazing = undefined

View File

@@ -0,0 +1,71 @@
-- | A module for rendering lines as an HTML5 file containing an SVG image.
-- This can be used to visualize the denotational semantics of a MiniLogo
-- program.
--
-- NOTE: You should not change the definitions in this file!
--
module Render (Point,Line,toHTML) where
import Data.List (intercalate)
-- | A point is a cartesian pair (x,y).
type Point = (Int,Int)
-- | A line is defined by its endpoints.
type Line = (Point,Point)
-- | Output a list of lines as an HTML5 file containing an SVG image.
toHTML :: [Line] -> IO ()
toHTML ls = writeFile "MiniMiniLogo.html" (header ++ content ls ++ footer)
--
-- Private definitions. All definitions below this point will not be visible
-- from within a module that imports this module.
--
scale, margin, width, height :: Int
scale = 10
margin = 10
width = 800
height = 400
style = "fill:white;stroke:red;stroke-width:2"
title = "<head><title>MiniLogo Semantics Viewer</title></head>"
view = "<svg width='100%' viewBox='0 0 "
++ show (width + 2*margin) ++ " "
++ show (height + 2*margin) ++ "'>"
border = "<rect x='" ++ show (margin-3) ++
"' y='" ++ show (margin-3) ++
"' width='" ++ show (width +6) ++
"' height='" ++ show (height+5) ++
"' style='fill:none;stroke:black;stroke-width:2'/>"
header = unlines ["<!DOCTYPE html>", "<html>", title, "<body>", view, border]
footer = unlines ["</svg>","</body>","</html>"]
content :: [Line] -> String
content = unlines . map poly . chunk
-- | A canvas-adjusted point as a string.
point :: Point -> String
point (x,y) = show xp ++ "," ++ show yp
where xp = x*scale + margin
yp = height - y*scale + margin
-- | Chunk a bunch of lines into sequences of connected points.
chunk :: [Line] -> [[Point]]
chunk [] = []
chunk [(p,q)] = [[p,q]]
chunk ((p,q):ls) | q == head ps = (p:ps) : pss
| otherwise = [p,q] : ps : pss
where (ps:pss) = chunk ls
-- | Draw a sequence of connected points.
poly :: [Point] -> String
poly ps = "<polyline points='"
++ intercalate " " (map point ps)
++ "' style='" ++ style ++ "'/>"

View File

@@ -0,0 +1,95 @@
module StackTypes where
--
-- * Part 1: A Rank-Based Type System for the Stack Language
--
-- ** The abstract syntax
--
type Prog = [Cmd]
data Cmd = Push Int
| Pop Int
| Add
| Mul
| Dup
| Inc
| Swap
deriving(Eq,Show)
type Stack = [Int]
type Rank = Int
-- NOTES: (popsnum on stack,pushes on stack)
type CmdRank = (Int,Int)
-- ** The semantic function that yields the semantics of a program
--
prog :: Prog -> Stack -> Maybe Stack
prog [] s = Just s
prog (c:cs) s = cmd c s >>= prog cs
-- ** The semantics function that yields the semantics of a command
--
cmd :: Cmd -> Stack -> Maybe Stack
cmd (Push n) s = Just (n:s)
cmd (Pop k) s = Just (drop k s)
cmd Add (n:k:s) = Just (n + k:s)
cmd Mul (n:k:s) = Just (n * k:s)
cmd Dup (n:s) = Just (n:n:s)
cmd Inc (n:s) = Just (n + 1:s)
cmd Swap (n:k:s) = Just (k:n:s)
cmd _ _ = Nothing
-- | 1. Define the function rankC that maps each stack operation to its rank
--
rankC :: Cmd -> CmdRank
rankC (Push _) = (0,1)
rankC (Pop x) = (x,0)
rankC (Add) = (2,1)
rankC (Mul) = (2,1)
rankC (Dup) = (1,2)
rankC (Inc) = (1,1)
rankC (Swap) = (2,2)
-- | 2. Define the auxiliary function rankP that computes the rank of programs
--
rankP :: Prog -> Rank -> Maybe Rank
rankP [] x = Just x
rankP cmds x = rank cmds x
rank :: Prog -> Rank -> Maybe Rank
rank [] x = Just x
rank (x:xs) r = let (popsnum,pushsnum) = rankC x in
if (popsnum < r) then rank xs (r - popsnum + pushsnum)
else Nothing
rankPMapper :: Prog -> [CmdRank]
rankPMapper [] = []
rankPMapper cmds = map rankC cmds
-- | 3. Define the semantic function semStatTC for evaluating stack programs
--
semStatTC :: Prog -> Stack -> Maybe Stack
semStatTC prg stk = if (rankP prg (length stk)) == Nothing then Nothing
else prog prg stk
-- | EXTRA CREDIT
--
-- prog' = undefined
-- * Part 2: Runtime Stack
--
-- * Part 3: Static and Dynamic Scope
--

View File

@@ -0,0 +1,93 @@
module StackTypes where
--
-- * Part 1: A Rank-Based Type System for the Stack Language
--
-- ** The abstract syntax
--
type Prog = [Cmd]
data Cmd = Push Int
| Pop Int
| Add
| Mul
| Dup
| Inc
| Swap
deriving(Eq,Show)
type Stack = [Int]
type Rank = Int
type CmdRank = (Int,Int)
-- ** The semantic function that yields the semantics of a program
--
prog :: Prog -> Stack -> Maybe Stack
prog [] s = Just s
prog (c:cs) s = cmd c s >>= prog cs
-- ** The semantics function that yields the semantics of a command
--
cmd :: Cmd -> Stack -> Maybe Stack
cmd (Push n) s = Just (n:s)
cmd (Pop k) s = Just (drop k s)
cmd Add (n:k:s) = Just (n + k:s)
cmd Mul (n:k:s) = Just (n * k:s)
cmd Dup (n:s) = Just (n:n:s)
cmd Inc (n:s) = Just (n + 1:s)
cmd Swap (n:k:s) = Just (k:n:s)
cmd _ _ = Nothing
-- | 1. Define the function rankC that maps each stack operation to its rank
--
rankC :: Cmd -> CmdRank
rankC (Push _) = (0, 1)
rankC (Pop i) = (i, 0)
rankC (Add) = (2, 1)
rankC (Mul) = (2, 1)
rankC (Dup) = (1, 2)
rankC (Inc) = (1, 1)
rankC (Swap) = (2, 2)
-- | 2. Define the auxiliary function rankP that computes the rank of programs
--
rankP :: Prog -> Maybe Rank
rankP [] = Just 0
rankP progs = rankProgramHelper progs 0
rankProgramHelper :: Prog -> Rank -> Maybe Rank
rankProgramHelper [] progs_rank = Just progs_rank
rankProgramHelper (progs_head:progs_tail) progs_rank =
let (current_pops, curent_pushes) = rankC progs_head in
if current_pops <= progs_rank then rankProgramHelper progs_tail (progs_rank + curent_pushes - current_pops)
else Nothing
-- | 3. Define the semantic function semStatTC for evaluating stack programs
--
semStatTC :: Prog -> Maybe Stack
semStatTC prog_list =
if (rankP prog_list) /= Nothing then prog prog_list []
else Nothing
-- | EXTRA CREDIT
--
prog' = undefined
-- * Part 2: Runtime Stack
--
-- * Part 3: Static and Dynamic Scope
--

View File

@@ -0,0 +1,20 @@
PART 2
[]
[x:?]
[y:?, x:?]
[y:1, x:?]
[f:{}, y:1, x:?]
[x:2, f:{}, y:1, x:?]
[x:1, x:2, f:{}, y:1, x:?]
[x:0, x:1, x:2, f:{}, y:1, x:?]
[x:1, x:2, f:{}, y:2, x:?]
[x:2, f:{}, y:5, x:?]
[f:{}, y:5, x:5]
[y:5, x:5]
[]
PART 3
1. 33
2. 26

View File

@@ -0,0 +1,101 @@
% Here are our initial facts describing the Griffin's family tree.
female(thelma).
female(babs).
female(lois).
female(carol).
female(meg).
male(frances).
male(mickey).
male(carter).
male(peter).
male(patrick).
male(adam).
male(stewie).
male(chris).
male(carolBaby).
married(frances, thelma).
married(carter, babs).
married(peter, lois).
married(adam, carol).
% a predicate that defines an inverse relationship between people who are
% married.
marriedI(X,Y) :- married(X,Y).
marriedI(X,Y) :- married(Y,X).
parent(frances, peter).
parent(thelma, peter).
parent(mickey, peter).
parent(babs, lois).
parent(carter, lois).
parent(babs, patrick).
parent(carter, patrick).
parent(babs, carol).
parent(carter, carol).
parent(lois, stewie).
parent(peter, stewie).
parent(lois, meg).
parent(peter, meg).
parent(lois, chris).
parent(peter, chris).
parent(carol, carolBaby).
parent(adam, carolBaby).
% Part 1. Family relations.
% 1. Define a predicate `child/2` that inverts the parent relationship.
child(X, Y) :- parent(Y, X).
% 2. Define two predicates `isMother/1` and `isFather/1`.
isMother(X) :- parent(X, _), female(X).
isFather(X) :- parent(X, _), male(X).
% 3. Define a predicate `grandparent/2`.
grandparent(X, Y) :- parent(X, Z), parent(Z, Y).
% 4. Define a predicate `sibling/2`, where siblings share ar least one parent.
sibling(X, Y) :- parent(Z, X), parent(Z, Y), X \= Y.
% 5. Define two predicates `sister/2` and `brother/2`.
sister(X, Y) :- sibling(X, Y), female(X), X \= Y.
brother(X, Y) :- sibling(X, Y), male(X), X \= Y.
% 6. Define a predicate `siblingsInLaw/2`, where a sibling-in-law is either
% married to a sibling or the sibling of a spouse.
siblingsInLaw(X, Y) :- marriedI(Y, Z), sibling(X, Z) ; marriedI(X, Z), sibling(Y, Z).
% 7. Define two predicates `aunt/2` and `uncle/2` (these should include aunts and
% uncles who are related by marriage).
aunt(X, Y) :- female(X), parent(Z, Y), sibling(X, Z) ; female(X), parent(Z, Y), siblingsInLaw(X, Z).
uncle(X, Y) :- male(X), parent(Z, Y), sibling(X, Z) ; male(X), parent(Z, Y), siblingsInLaw(X, Z).
% 8. Define the predicate `cousin/2`.
cousin(X, Y) :- parent(Z, X), sibling(Z, A), parent(A, Y).
% 9. Define the predicate `ancestor/2`.
ancestor(X, Y) :- parent(X, Y) ; parent(Z, Y), ancestor(X, Z).
% Extra credit: define the predicate `related/2`.
related(X, Y) :- marriedI(X, Y) ;
sibling(X, Y) ;
siblingsInLaw(X, Y);
aunt(X, Y) ;
aunt(Y, X) ;
uncle(X, Y) ;
uncle( Y, X) ;
cousin(X, Y) ;
ancestor(X, Y) ;
ancestor( Y, X).