blob: dbe8e349d344e958f3c16c9059af6917f3a9ed91 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
module AST where
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.List
data Program = Program [Value]
type Name = String
data Value
= VList [Value]
| VNum Int
| VString String
| VName Name
| VQuoted Value
| VDeclare Name
| VDefine Name Value
| VLambda [Name] Value
| VLambdaRec Name [Name] Value
| VLet [(Name, Value)] Value
| VBuiltin String
| VEllipsis
deriving (Eq, Ord)
instance Show Program where
show (Program l) = intercalate "\n" $ map show l
instance Show Value where
show (VList es) = '(' : intercalate " " (map show es) ++ ")"
show (VNum i) = show i
show (VString s) = show s
show (VName n) = n
show (VQuoted e) = '\'' : show e
show (VDeclare n) = "(declare " ++ n ++ ")"
show (VDefine n v) = "(define " ++ n ++ " " ++ show v ++ ")"
show (VLambda as v) = "(lambda (" ++ intercalate " " as ++ ") " ++ show v ++ ")"
show (VLambdaRec rn as v) = "(lambdarec " ++ rn ++ " (" ++ intercalate " " as ++ ") " ++ show v ++ ")"
show (VLet ps v) = "(let (" ++ intercalate " " ["(" ++ n ++ " " ++ show w ++ ")" | (n, w) <- ps] ++ ") " ++ show v ++ ")"
show (VBuiltin str) = "[[builtin " ++ str ++ "]]"
show VEllipsis = "..."
fromVName :: Value -> Maybe Name
fromVName (VName s) = Just s
fromVName _ = Nothing
fromVNum :: Value -> Maybe Int
fromVNum (VNum i) = Just i
fromVNum _ = Nothing
fromVString :: Value -> Maybe String
fromVString (VString s) = Just s
fromVString _ = Nothing
replaceNames :: Map.Map Name Value -> Value -> Value
replaceNames mp origValue =
case origValue of
VList vs -> VList (map (replaceNames mp) vs)
VName n -> fromMaybe origValue (Map.lookup n mp)
VDefine n v -> VDefine n (replaceNames mp v)
VLambda as v -> VLambda as (replaceNames (foldr Map.delete mp as) v)
VLambdaRec rn as v -> VLambdaRec rn as (replaceNames (foldr Map.delete mp (rn : as)) v)
VLet [] v -> VLet [] (replaceNames mp v)
VLet ((n, d) : pairs) v ->
let VLet pairs' v' = replaceNames (Map.delete n mp) (VLet pairs v)
in VLet ((n, replaceNames mp d) : pairs') v'
VNum _ -> origValue
VString _ -> origValue
VQuoted _ -> origValue
VDeclare _ -> origValue
VBuiltin _ -> origValue
VEllipsis -> origValue
|
