CS计算机代考程序代写 Java \begin{code}

\begin{code}
{-# OPTIONS_GHC -Wall #-}
module Jan25 where

import Prelude hiding (lookup)
\end{code}

Admin: MSAF policy – 3 day extension for assignments.

Learning objectives:
\begin{itemize}
\item extensionality / intensionality
\item more on type classes
\item a first embedded language (regular expressions)
\end{itemize}

Concept: “extensionality”, answers the question “when are two functions equal?”
– (forall x. f x = g x) -> f = g
opposite idea: “intensionality”. Roughly: syntax matters.

Original ‘idea’: contracts “morning star” “evening star” “venus”
‘extension’ of 3 names == planet venus

\newpage

Typeclasses: mechanism for overloading
– reusability of \textbf{concepts}

– parametric polymorphism is good for re-using \emph{code}.

Ex: |Eq| class – express that you \emph{may} have an equality.
– contrast Java which has an equals method in Java.Lang.Object
– counter-example: functions! In general, undecidable.

Approximate meaning of typeclasses:
\begin{enumerate}
\item re-usable concept
\item interface
\item relation on a type
\end{enumerate}

lookup all things that match first arg in list, return 2nd part of pair
\begin{code}
lookup :: Eq a => a -> [(a, b)] -> [b]
lookup _ [] = []
lookup x ((a, b) : ys) =
if x == a then b : lookup x ys else lookup x ys

lookup’ :: Eq a => a -> [(a, b)] -> [b]
lookup’ x l = map snd $ filter (\y -> fst y == x) l
\end{code}
Note: the type | [(a, b)] | is known as ‘association lists’

Relation on a type:
\begin{code}
class X a where
foo :: a -> a -> Int
\end{code}
‘means’ things of type |a| ‘have’ an associated function |foo|

\begin{spec}
class T a => S a where
— concept S only makes sense if you already know T is valid for a
— can be read as “instances of S imply existence of instances of T”

instance X a => Y a where
— given a dictionary for X, it is possible to implement the methods of Y
— i.e. very generic code

\end{spec}
\newpage

A recognizer for languages. True if in, False if not.
\begin{code}
type RegExp = String -> Bool

eps :: RegExp
— eps s = s == “”
eps = (== “”)

char :: Char -> RegExp
char c = \s -> s == [c]

(|||) :: RegExp -> RegExp -> RegExp
e1 ||| e2 = \s -> e1 s || e2 s

\end{code}
Q: recursion in type synonyms?
A: no — try |type Foo = Bool -> Foo|