Alternate formatting experiment.
Chris Pressey
5 years ago
| 81 | 81 | What follows is `Pail.lhs`, the reference implementation of the Pail |
| 82 | 82 | programming language. |
| 83 | 83 | |
| 84 | > import Text.ParserCombinators.Parsec | |
| 85 | > import qualified Data.Map as Map | |
| 84 | > import Text.ParserCombinators.Parsec | |
| 85 | > import qualified Data.Map as Map | |
| 86 | 86 | |
| 87 | 87 | |
| 88 | 88 | Definitions |
| 90 | 90 | |
| 91 | 91 | An environment maps names (represented as strings) to expressions. |
| 92 | 92 | |
| 93 | > type Env = Map.Map String Expr | |
| 93 | > type Env = Map.Map String Expr | |
| 94 | 94 | |
| 95 | 95 | A symbol is an expression. |
| 96 | 96 | |
| 97 | > data Expr = Symbol String | |
| 97 | > data Expr = Symbol String | |
| 98 | 98 | |
| 99 | 99 | If a and b are expressions, then a pair of a and b is an expression. |
| 100 | 100 | |
| 101 | > | Pair Expr Expr | |
| 101 | > | Pair Expr Expr | |
| 102 | 102 | |
| 103 | 103 | If a is an expression, then the evaluation of a is an expression. |
| 104 | 104 | |
| 105 | > | Eval Expr | |
| 105 | > | Eval Expr | |
| 106 | 106 | |
| 107 | 107 | If f is a function that takes an environment and an expression |
| 108 | 108 | to an expression, then f is an expression. f may optionally |
| 110 | 110 | depiction of expressions more convenient, but there is no language- |
| 111 | 111 | level association between the function and its name. |
| 112 | 112 | |
| 113 | > | Fn String (Env -> Expr -> Expr) | |
| 113 | > | Fn String (Env -> Expr -> Expr) | |
| 114 | 114 | |
| 115 | 115 | Nothing else is an expression. |
| 116 | 116 | |
| 119 | 119 | convenience, functions with known names can be represented by `<foo>`, |
| 120 | 120 | where `foo` is the name of the function. |
| 121 | 121 | |
| 122 | > instance Show Expr where | |
| 123 | > show (Symbol s) = s | |
| 124 | > show (Pair a b) = "[" ++ (show a) ++ " " ++ (show b) ++ "]" | |
| 125 | > show (Eval x) = "*" ++ (show x) | |
| 126 | > show (Fn n _) = "<" ++ n ++ ">" | |
| 127 | ||
| 128 | > instance Eq Expr where | |
| 122 | > instance Show Expr where | |
| 123 | > show (Symbol s) = s | |
| 124 | > show (Pair a b) = "[" ++ (show a) ++ " " ++ (show b) ++ "]" | |
| 125 | > show (Eval x) = "*" ++ (show x) | |
| 126 | > show (Fn n _) = "<" ++ n ++ ">" | |
| 127 | ||
| 128 | > instance Eq Expr where | |
| 129 | 129 | |
| 130 | 130 | Two symbols are equal if the strings by which they are represented |
| 131 | 131 | are equal. |
| 132 | 132 | |
| 133 | > (Symbol s) == (Symbol t) = s == t | |
| 133 | > (Symbol s) == (Symbol t) = s == t | |
| 134 | 134 | |
| 135 | 135 | Two pairs are equal if their contents are pairwise equal. |
| 136 | 136 | |
| 137 | > (Pair a1 b1) == (Pair a2 b2) = (a1 == a2) && (b1 == b2) | |
| 137 | > (Pair a1 b1) == (Pair a2 b2) = (a1 == a2) && (b1 == b2) | |
| 138 | 138 | |
| 139 | 139 | Two evaluations are equal if their contents are equal. |
| 140 | 140 | |
| 141 | > (Eval x) == (Eval y) = x == y | |
| 141 | > (Eval x) == (Eval y) = x == y | |
| 142 | 142 | |
| 143 | 143 | Two functions are never considered equal. |
| 144 | 144 | |
| 145 | > (Fn n _) == (Fn m _) = False | |
| 145 | > (Fn n _) == (Fn m _) = False | |
| 146 | 146 | |
| 147 | 147 | |
| 148 | 148 | Parser |
| 155 | 155 | A symbol is denoted by a string which may contain only alphanumeric |
| 156 | 156 | characters, hyphens, underscores, and question marks. |
| 157 | 157 | |
| 158 | > symbol = do | |
| 159 | > c <- letter | |
| 160 | > cs <- many (alphaNum <|> char '-' <|> char '?' <|> char '_') | |
| 161 | > return (Symbol (c:cs)) | |
| 158 | > symbol = do | |
| 159 | > c <- letter | |
| 160 | > cs <- many (alphaNum <|> char '-' <|> char '?' <|> char '_') | |
| 161 | > return (Symbol (c:cs)) | |
| 162 | 162 | |
| 163 | 163 | A pair of expressions a and b is denoted |
| 164 | 164 | |
| 165 | 165 | [a b] |
| 166 | 166 | |
| 167 | > pair = do | |
| 168 | > string "[" | |
| 169 | > a <- expr | |
| 170 | > b <- expr | |
| 171 | > spaces | |
| 172 | > string "]" | |
| 173 | > return (Pair a b) | |
| 167 | > pair = do | |
| 168 | > string "[" | |
| 169 | > a <- expr | |
| 170 | > b <- expr | |
| 171 | > spaces | |
| 172 | > string "]" | |
| 173 | > return (Pair a b) | |
| 174 | 174 | |
| 175 | 175 | An evaluation of an expression a is denoted |
| 176 | 176 | |
| 177 | 177 | *a |
| 178 | 178 | |
| 179 | > eval = do | |
| 180 | > string "*" | |
| 181 | > a <- expr | |
| 182 | > return (Eval a) | |
| 179 | > eval = do | |
| 180 | > string "*" | |
| 181 | > a <- expr | |
| 182 | > return (Eval a) | |
| 183 | 183 | |
| 184 | 184 | As a bit of syntactic sugar, the denotation |
| 185 | 185 | |
| 189 | 189 | |
| 190 | 190 | **[*uneval a] |
| 191 | 191 | |
| 192 | > uneval = do | |
| 193 | > string "#" | |
| 194 | > a <- expr | |
| 195 | > return (Eval (Eval (Pair (Eval (Symbol "uneval")) a))) | |
| 192 | > uneval = do | |
| 193 | > string "#" | |
| 194 | > a <- expr | |
| 195 | > return (Eval (Eval (Pair (Eval (Symbol "uneval")) a))) | |
| 196 | 196 | |
| 197 | 197 | The top-level parsing function implements the overall grammar given above. |
| 198 | 198 | Note that we need to give the type of this parser here -- otherwise the |
| 199 | 199 | type inferencer freaks out for some reason. |
| 200 | 200 | |
| 201 | > expr :: Parser Expr | |
| 202 | > expr = do | |
| 203 | > spaces | |
| 204 | > r <- (eval <|> uneval <|> pair <|> symbol) | |
| 205 | > return r | |
| 201 | > expr :: Parser Expr | |
| 202 | > expr = do | |
| 203 | > spaces | |
| 204 | > r <- (eval <|> uneval <|> pair <|> symbol) | |
| 205 | > return r | |
| 206 | 206 | |
| 207 | 207 | A convenience function for parsing Pail programs. |
| 208 | 208 | |
| 209 | > parsePail program = parse expr "" program | |
| 209 | > parsePail program = parse expr "" program | |
| 210 | 210 | |
| 211 | 211 | |
| 212 | 212 | Evaluator |
| 226 | 226 | |
| 227 | 227 | An evaluation of an expression o-reduces to the i-reduction of its contents. |
| 228 | 228 | |
| 229 | > oReduce env (Eval x) = iReduce env x | |
| 229 | > oReduce env (Eval x) = iReduce env x | |
| 230 | 230 | |
| 231 | 231 | Everything else o-reduces to itself. |
| 232 | 232 | |
| 233 | > oReduce env x = x | |
| 233 | > oReduce env x = x | |
| 234 | 234 | |
| 235 | 235 | Inner Reduction |
| 236 | 236 | --------------- |
| 238 | 238 | A symbol i-reduces to the expression to which is it bound in the current |
| 239 | 239 | environment. If it is not bound to anything, it i-reduces to itself. |
| 240 | 240 | |
| 241 | > iReduce env (Symbol s) = Map.findWithDefault (Symbol s) s env | |
| 241 | > iReduce env (Symbol s) = Map.findWithDefault (Symbol s) s env | |
| 242 | 242 | |
| 243 | 243 | A pair where the LHS is a function i-reduces to the application of that |
| 244 | 244 | function to the RHS of the pair, in the current function. |
| 245 | 245 | |
| 246 | > iReduce env (Pair (Fn _ f) b) = f env b | |
| 246 | > iReduce env (Pair (Fn _ f) b) = f env b | |
| 247 | 247 | |
| 248 | 248 | Any other pair i-reduces to a pair with pairwise o-reduced contents. |
| 249 | 249 | |
| 250 | > iReduce env (Pair a b) = Pair (oReduce env a) (oReduce env b) | |
| 250 | > iReduce env (Pair a b) = Pair (oReduce env a) (oReduce env b) | |
| 251 | 251 | |
| 252 | 252 | The inner reduction of an evaluation of some expression x is the i-reduction |
| 253 | 253 | of x, i-reduced one more time. |
| 254 | 254 | |
| 255 | > iReduce env (Eval x) = iReduce env (iReduce env x) | |
| 255 | > iReduce env (Eval x) = iReduce env (iReduce env x) | |
| 256 | 256 | |
| 257 | 257 | |
| 258 | 258 | Standard Environment |
| 269 | 269 | Applying `fst` (resp. `snd`) to a pair returns the o-reduction of the |
| 270 | 270 | first (resp. second) element of that pair. |
| 271 | 271 | |
| 272 | > pFst env (Pair a _) = oReduce env a | |
| 273 | > pSnd env (Pair _ b) = oReduce env b | |
| 272 | > pFst env (Pair a _) = oReduce env a | |
| 273 | > pSnd env (Pair _ b) = oReduce env b | |
| 274 | 274 | |
| 275 | 275 | Applying `ifequal` to a pair of pairs proceeds as follows. The contents |
| 276 | 276 | of the first pair are compared for (deep) equality. If they are equal, |
| 277 | 277 | the o-reduction of the first element of the second pair is returned; if not, |
| 278 | 278 | the o-reduction of the second element of the second pair is returned. |
| 279 | 279 | |
| 280 | > pIfEqual env (Pair (Pair a b) (Pair yes no)) | |
| 281 | > | a == b = oReduce env yes | |
| 282 | > | otherwise = oReduce env no | |
| 280 | > pIfEqual env (Pair (Pair a b) (Pair yes no)) | |
| 281 | > | a == b = oReduce env yes | |
| 282 | > | otherwise = oReduce env no | |
| 283 | 283 | |
| 284 | 284 | Applying `typeof` to a value of any kind returns a symbol describing |
| 285 | 285 | the type of that value. For symbol, `symbol` is returned; for pairs, |
| 286 | 286 | `pair`; for evaluations, `eval`; and for functions, `function`. |
| 287 | 287 | |
| 288 | > pTypeOf env (Symbol _) = Symbol "symbol" | |
| 289 | > pTypeOf env (Pair _ _) = Symbol "pair" | |
| 290 | > pTypeOf env (Eval _) = Symbol "eval" | |
| 291 | > pTypeOf env (Fn _ _) = Symbol "function" | |
| 288 | > pTypeOf env (Symbol _) = Symbol "symbol" | |
| 289 | > pTypeOf env (Pair _ _) = Symbol "pair" | |
| 290 | > pTypeOf env (Eval _) = Symbol "eval" | |
| 291 | > pTypeOf env (Fn _ _) = Symbol "function" | |
| 292 | 292 | |
| 293 | 293 | Applying `uneval` to an expression returns the evaluation of that |
| 294 | 294 | expression. (Note that nothing is reduced in this process.) |
| 295 | 295 | |
| 296 | > pUnEval env x = Eval x | |
| 296 | > pUnEval env x = Eval x | |
| 297 | 297 | |
| 298 | 298 | Applying `let` to a pair of a pair (called the "binder") and an expression |
| 299 | 299 | returns the o-reduction of that expression in a new environment, constructed |
| 302 | 302 | A new environment is created; it is just like the current evironment except |
| 303 | 303 | with the obtained symbol bound to the obtained value. |
| 304 | 304 | |
| 305 | > pLet env (Pair (Pair name binding) expr) = | |
| 306 | > let | |
| 307 | > (Symbol sym) = oReduce env name | |
| 308 | > val = oReduce env binding | |
| 309 | > env' = Map.insert sym val env | |
| 310 | > in | |
| 311 | > oReduce env' expr | |
| 305 | > pLet env (Pair (Pair name binding) expr) = | |
| 306 | > let | |
| 307 | > (Symbol sym) = oReduce env name | |
| 308 | > val = oReduce env binding | |
| 309 | > env' = Map.insert sym val env | |
| 310 | > in | |
| 311 | > oReduce env' expr | |
| 312 | 312 | |
| 313 | 313 | And finally, we define the standard environment by associating each of the |
| 314 | 314 | above defined functions with a symbol. |
| 315 | 315 | |
| 316 | > stdEnv :: Env | |
| 317 | > stdEnv = Map.fromList $ map (\(name, fun) -> (name, (Fn name fun))) | |
| 318 | > [ | |
| 319 | > ("fst", pFst), | |
| 320 | > ("snd", pSnd), | |
| 321 | > ("if-equal?", pIfEqual), | |
| 322 | > ("type-of", pTypeOf), | |
| 323 | > ("uneval", pUnEval), | |
| 324 | > ("let", pLet) | |
| 325 | > ] | |
| 316 | > stdEnv :: Env | |
| 317 | > stdEnv = Map.fromList $ map (\(name, fun) -> (name, (Fn name fun))) | |
| 318 | > [ | |
| 319 | > ("fst", pFst), | |
| 320 | > ("snd", pSnd), | |
| 321 | > ("if-equal?", pIfEqual), | |
| 322 | > ("type-of", pTypeOf), | |
| 323 | > ("uneval", pUnEval), | |
| 324 | > ("let", pLet) | |
| 325 | > ] | |
| 326 | 326 | |
| 327 | 327 | |
| 328 | 328 | Top-Level Driver |
| 333 | 333 | begins with '%'. No Pail expression can begin with this character, so |
| 334 | 334 | parse errors can be detected unambiguously. |
| 335 | 335 | |
| 336 | > runPail line = | |
| 337 | > case (parse expr "" line) of | |
| 338 | > Left err -> "%" ++ (show err) | |
| 339 | > Right x -> show (oReduce stdEnv x) | |
| 336 | > runPail line = | |
| 337 | > case (parse expr "" line) of | |
| 338 | > Left err -> "%" ++ (show err) | |
| 339 | > Right x -> show (oReduce stdEnv x) | |
| 340 | 340 | |
| 341 | 341 | Happy bailing! |
| 342 | 342 | Chris Pressey |