mirror of
https://github.com/caperren/school_archives.git
synced 2025-11-09 13:41:13 +00:00
Added programming language fundamentals code. More to come.
This commit is contained in:
@@ -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
|
||||||
@@ -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])
|
||||||
@@ -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
|
||||||
@@ -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
|
||||||
@@ -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>
|
||||||
@@ -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]
|
||||||
|
|
||||||
@@ -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
|
||||||
@@ -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
|
||||||
@@ -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 ++ "'/>"
|
||||||
@@ -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
|
||||||
|
--
|
||||||
@@ -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
|
||||||
|
--
|
||||||
@@ -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
|
||||||
|
|
||||||
|
|
||||||
@@ -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).
|
||||||
Reference in New Issue
Block a user