Com S 641 meeting -*- Outline -*- * semantics of the core language (Schmidt 1.6) why?: portability, formalizing intuition about meaning, allows tests (debugging) of language ** denotational semantics ------------------------------------------ SEMANTICS semantics = meaning : [annotated syntax trees] -> answers e.g., meaning :: ATree Expression -> (DStore -> ExpressibleValue) SEMANTIC DEFINITION STYLES denotational style: operational style: "structural operational" style: axiomatic style: ------------------------------------------ ... meaning ... directly defines meaning function ... define meaning by translating to another language, whose meaning is known. ... translate to "rewrite rule machine", i.e., give rewriting rules ... meaning (of commands) is given as functions from predicates to predicates we'll focus on the denotational style. ------------------------------------------ THE DENOTATIONAL APPROACH To define language semantics: a. define abstract syntax b. (optional) define type rules c. define domains (sets + operations) d. define functions from annotated syntax trees to domains - follows syntax - compositional = - referentially transparent = ------------------------------------------ we've already done the first two ... meaning of whole based on meaning of parts ... no side effects in description so when 2 descriptions have same meaning, they can be interchanged Q: Why is referential transparency a good idea in the specification of programming languages? allows clear reasoning, shows all that's happening ** semantic domains for core (Fig 1.6) see Figure 1.6 for usual formatting > module CoreSemantics where > import Tree > import CoreTypeAttributes > import CoreTypeHelpers > import CoreTyping > import CoreLangParser > import List -- from the Haskell library ------------------------------------------ SEMANTIC DOMAINS MODELED IN HASKELL The booleans > type DBool = Bool > true = True > false = False > -- Operations: > -- not is already in Haskell > equalbool :: (DBool, DBool) -> DBool > equalbool(m, n) = (m == n) The integers > type DInt = Integer > -- Operations: > plus :: (DInt,DInt) -> DInt > plus(m,n) = m + n > equalint :: (DInt,DInt) -> DBool > equalint(m,n) = (m == n) Locations > type DLocation = Integer ------------------------------------------ Q: How many DBool values are there? 3 actually, true, false, and bottom. this is unavoidable when using a programming lang, but should be noted as an approximation. no operations on locations it may seem odd to have a piece of syntax as part of the semantics, but that happens, and matches the book. ------------------------------------------ MODELING STORES IN HASKELL Stores > type DStore = [DInt] > -- Operations: > lookupStore :: (DLocation,DStore) > -> DInt > updateStore :: (DLocation,DInt,DStore) > -> DStore > -- if is already in Haskell ------------------------------------------ > lookupStore(Loc j, s) > | (0 < j) && (j <= genericLength s) = s !! (toInt (j-1)) > | otherwise = 0 need to use genericLength because j is a Haskell Integer, and length returns a Haskell Int (:-( > updateStore(Loc j, n, s) > | (0 < j) && (j <= genericLength s) = > (genericTake (j-1) s) ++ [n] ++ (genericDrop j s) > | otherwise = s ** semantic functions Q: Now how do we go about defining the meaning of each annotated syntax tree? by induction (I don't see how to avoid different names for the meaning functions, since they aren't parametric in their range like the annotate function...) ------------------------------------------ SEMANTIC FUNCTIONS > meaningN :: ATree Integer -> DInt > meaningN (( n ::: Node Aint _ )) = n > meaningL :: ATree Location -> DLocation > meaningL > (( (Loc i) ::: Node (Aloc Aint) _ )) = ------------------------------------------ notice the we really don't convert from syntax to semantics going from numerals to numbers, because the "syntax" is already coded as an integer > (Loc i) ------------------------------------------ MEANINGS FOR EXPRESSIONS data ExpressibleValue = meaningE :: ATree Expression -> ------------------------------------------ > data ExpressibleValue = InInt DInt > | InBool DBool > meaningE :: ATree Expression > -> DStore -> ExpressibleValue > meaningE (( Num n ::: Node (Aexp Aint) [atr] )) s = > InInt (meaningN ((n ::: atr ))) > meaningE (( Deref l ::: Node (Aexp Aint) [atr] )) s = > InInt (lookupStore (meaningL((l ::: atr)), s)) > meaningE (( (e1 `Plus` e2) ::: Node (Aexp Aint) [at1, at2] )) s = > (case (meaningE((e1 ::: at1)) s, meaningE((e2 ::: at2)) s) of > (InInt i1, InInt i2) -> InInt (plus (i1,i2))) > meaningE (( Not e ::: Node (Aexp Abool) [atr] )) s = > (case meaningE((e ::: atr)) s of > (InBool b) -> InBool (not b)) > meaningE (( (e1 `Equals` e2) > ::: Node (Aexp Abool) > [at1@(Node (Aexp t1) _), > at2@(Node (Aexp t2) _)] )) s = > (case (t1, t2) of > (Abool, Abool) -> > (case (meaningE((e1 ::: at1)) s, meaningE((e2 ::: at2)) s) of > (InBool b1, InBool b2) -> InBool (equalbool (b1,b2))) > (Aint, Aint) -> > (case (meaningE((e1 ::: at1)) s, meaningE((e2 ::: at2)) s) of > (InInt i1, InInt i2) -> InBool (equalint (i1,i2)))) ------------------------------------------ EXAMPLES OF EXPRESSION MEANINGS ? meaningE (annotate (Num 7)) [] ? meaningE (annotate (Deref (Loc 1))) [3] ? meaningE (annotate ((Num 3) `Equals` (Num 4))) [] > evalE e = show (meaningE (annotate e) > [1..20]) ? evalE (Num 3) "3" ------------------------------------------ ... InInt 7 ... InInt 3 ... InBool False Q: What happens if we leave off the store argument? we get back a closure Note: the above assumes that ExpressibleValue is an instance of the class Show > instance Show ExpressibleValue where > showsPrec p (InInt i) = showsPrec p i > showsPrec p (InBool b) = showsPrec p b ------------------------------------------ EXAMPLES OF COMMAND MEANINGS > evalC c = show (meaningC (annotate c) > [1..5]) ? evalC Skip ? evalC ((Loc 1) `Assign` (Num 4)) ? evalC (((Loc 1) `Assign` (Num 4)) `Semi` ((Loc 1) `Assign` ((Deref (Loc 1)) `Plus` (Deref (Loc 1))))) ------------------------------------------ ... "[1, 2, 3, 4, 5]" ... "[4, 2, 3, 4, 5]" ... "[8, 2, 3, 4, 5]" ------------------------------------------ MEANINGS FOR COMMANDS > meaningC :: ATree Command > -> DStore -> DStore > meaningC ((Skip ::: Node Acomm _)) s = s > meaningC (( (l `Assign` e) > ::: Node Acomm [atl, ate] )) s = > (case meaningE((e ::: ate)) s of > (InInt i) -> > updateStore(meaningL((l ::: atl)), > i, s)) > meaningC (( (c1 `Semi` c2) > ::: Node Acomm [at1, at2] )) s = > meaningC((c2 ::: at2)) > (meaningC((c1 ::: at1)) s) > meaningC (( (If e c1 c2) > ::: Node Acomm [ate, at1, at2] )) s = > (case meaningE((e ::: ate)) s of > (InBool b) -> > if b then meaningC((c1 ::: at1)) s > else meaningC((c2 ::: at2)) s) ------------------------------------------ ------------------------------------------ WHILE LOOP SEMANTICS > meaningC > (( (While e c) > ::: Node Acomm [ate, atc] )) s = > w(s) > where > w s' = > (case meaningE ((e:::ate)) s' of > (InBool b) -> > if b > then w(meaningC((c:::atc)) s') > else s') ------------------------------------------ Q: What's strange about this definition of while loops? it uses a recursive definition that's not inductive the method of assigning meaning to such defs is a key aspect of denotational semantics, which is based on a fixpoint combinator... ------------------------------------------ MEANING OF RECURSIVELY DEFINED FUNCTION w_0(s) = _ w_1(s) = if([[E: boolexp]](s), w_0([[C: comm]](s)), s) w_2(s) = if([[E: boolexp]](s), w_1([[C: comm]](s)), s) ... terminology: proper meaning improper meaning def: a function, f, is *strict* iff ------------------------------------------ the meaning of w is the limit of this sequence ... f(_) = _ we require that meaning of commands be a strict function. Q: Is meaningC a strict function as written in Haskell? no Q: Given that Haskell has an operator strict :: (a -> b) -> (a -> b) How would you make meaningC strict? Two ways: 1. rename it meaningC' define meaningC by meaningC c = strict (meaningC' c)? that doesn't really work for recursions! so don't change the recursive calls, then the recursions are through the strict version. 2. make each of the base cases strict in the store argument, e.g., skip would use s `seq` s ** using the semantics ------------------------------------------ CALCULATING THE MEANING OF A PHRASE [[loc_3 := @loc_3 + 1: comm]]([5,4,0]) = ------------------------------------------ ... work this out, with reasons ** summary Q: What's the use of this semantics? also: prove equalities between programs justify program transformations (like taking a not out of if test and swapping)