diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Nat.perrenc.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Nat.perrenc.hs new file mode 100644 index 0000000..b9c63e4 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Nat.perrenc.hs @@ -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 diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Tree.perrenc.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Tree.perrenc.hs new file mode 100644 index 0000000..10467be --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 1/Tree.perrenc.hs @@ -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]) \ No newline at end of file diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 2/MiniLogo.perrenc.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 2/MiniLogo.perrenc.hs new file mode 100644 index 0000000..8290a98 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 2/MiniLogo.perrenc.hs @@ -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 diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.hs new file mode 100644 index 0000000..9a9a184 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.hs @@ -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 diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.html b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.html new file mode 100644 index 0000000..7283510 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogo.html @@ -0,0 +1,13 @@ + + +MiniLogo Semantics Viewer + + + + + + + + + + diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.Turkingk.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.Turkingk.hs new file mode 100644 index 0000000..6f12a60 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.Turkingk.hs @@ -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] + diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.other.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.other.hs new file mode 100644 index 0000000..c0ce420 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.other.hs @@ -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 diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.perrenc.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.perrenc.hs new file mode 100644 index 0000000..a5cae3d --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/MiniMiniLogoSem.perrenc.hs @@ -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 diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/Render.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/Render.hs new file mode 100644 index 0000000..b7416c9 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 3/Render.hs @@ -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 = "MiniLogo Semantics Viewer" +view = "" +border = "" + +header = unlines ["", "", title, "", view, border] +footer = unlines ["","",""] + +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 = "" diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.Turkingk.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.Turkingk.hs new file mode 100644 index 0000000..68b5425 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.Turkingk.hs @@ -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 +-- \ No newline at end of file diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.perrenc.hs b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.perrenc.hs new file mode 100644 index 0000000..acc06c9 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/StackRank.perrenc.hs @@ -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 +-- diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/part 2 and 3.txt b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/part 2 and 3.txt new file mode 100644 index 0000000..fafdeba --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 4/part 2 and 3.txt @@ -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 + + diff --git a/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 5/familyTree.perrenc.pl b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 5/familyTree.perrenc.pl new file mode 100644 index 0000000..bc56381 --- /dev/null +++ b/OSU Coursework/CS 381 - Programming Language Fundamentals/Homework 5/familyTree.perrenc.pl @@ -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).