aboutsummaryrefslogtreecommitdiff
path: root/Sil/Syntax.icl
blob: c2baf706764cdfe72e3d53e2b0423d1934741e80 (plain) (blame)
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
implementation module Sil.Syntax

from StdFunc import o
import StdOverloaded
import StdString
import StdTuple

import Data.List
import Text

import Sil.Types
import Sil.Util.Parser
import Sil.Util.Printer

instance toString Statement
where
	toString (Declaration _ n a)  = n <+ " := " <+ a <+ ";"
	toString (Application _ e)    = toString e <+ ";"
	toString (Return _ ?None)     = "return;"
	toString (Return _ (?Just a)) = "return " <+ a <+ ";"
	toString (If _ bs e)          = "if ..."
	toString (MachineStm _ s)     = "|~" <+ s
	toString _                    = "<<unimplemented Statement>>"

instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name

instance toString Expression
where
	toString (Name _ n)               = n
	toString (Literal _ lit)          = toString lit
	toString (App _ n args)           = n <+ "(" <+ printersperse ", " args <+ ")"
	toString (BuiltinApp _ op e)      = op <+ "(" <+ e <+ ")"
	toString (BuiltinApp2 _ e1 op e2) = "(" <+ e1 <+ ") " <+ op <+ " (" <+ e2 <+ ")"
	toString (Tuple _ _ es)           = "(" <+ printersperse ", " es <+ ")"
	toString (List _ (?Just t) [])    = "[" <+ t <+ "]"
	toString (List _ (?Just t) es)    = "[" <+ t <+ ":" <+ printersperse ", " es <+ "]"
	toString (List _ ?None es)        = "[" <+ printersperse ", " es <+ "]"
	toString (Field _ f e)            = "(" <+ e <+ ")." <+ f

instance toString Op1
where
	toString Neg = "~"
	toString Not = "!"

instance toString Op2
where
	toString Add      = "+"
	toString Sub      = "-"
	toString Mul      = "*"
	toString Div      = "/"
	toString Rem      = "%"
	toString Equals   = "=="
	toString Unequals = "<>"
	toString CmpLe    = "<="
	toString CmpGe    = ">="
	toString CmpLt    = "<"
	toString CmpGt    = ">"
	toString LogOr    = "||"
	toString LogAnd   = "&&"
	toString Cons     = ":"

instance toString Literal
where
	toString (BLit b) = toString b
	toString (ILit i) = toString i

instance getPos Function where getPos f = f.f_pos
instance getPos Initialisation where getPos i = i.init_pos

instance getPos Statement
where
	getPos (Declaration p _ _) = p
	getPos (Application p _)   = p
	getPos (Return      p _)   = p
	getPos (If          p _ _) = p
	getPos (While       p _ _) = p
	getPos (MachineStm  p _)   = p

instance getPos Expression
where
	getPos (Name        p _)     = p
	getPos (Literal     p _)     = p
	getPos (App         p _ _)   = p
	getPos (BuiltinApp  p _ _)   = p
	getPos (BuiltinApp2 p _ _ _) = p
	getPos (Tuple       p _ _)   = p
	getPos (List        p _ _)   = p
	getPos (Field       p _ _)   = p

instance allStatements Program
where allStatements p = concatMap allStatements p.p_funs

instance allStatements Function
where allStatements f = allStatements f.f_code

instance allStatements CodeBlock
where allStatements cb = concatMap allStatements cb.cb_content

instance allStatements Statement
where
	allStatements st=:(Declaration _ _ _) = [st]
	allStatements st=:(Application _ _)   = [st]
	allStatements st=:(Return _ _)        = [st]
	allStatements st=:(If _ bs ?None)     = [st:concatMap (allStatements o snd) bs]
	allStatements st=:(If _ bs (?Just e)) = [st:allStatements e ++ concatMap (allStatements o snd) bs]
	allStatements st=:(While _ _ cb)      = [st:allStatements cb]
	allStatements st=:(MachineStm _ _)    = [st]

instance allCodeBlocks Function where allCodeBlocks f = allCodeBlocks f.f_code

instance allCodeBlocks CodeBlock
where allCodeBlocks cb = [cb:concatMap allCodeBlocks cb.cb_content]

instance allCodeBlocks Statement
where
	allCodeBlocks (If _ bs ?None)     = concatMap (allCodeBlocks o snd) bs
	allCodeBlocks (If _ bs (?Just e)) = [e:concatMap (allCodeBlocks o snd) bs]
	allCodeBlocks (While _ _ cb)      = [cb]
	allCodeBlocks _                   = []

instance allLocals Function
where
	allLocals f = [(a.arg_type, a.arg_name) \\ a <- f.f_args] ++
		allLocals f.f_code

instance allLocals CodeBlock
where allLocals cb = [(i.init_type, i.init_name) \\ i <- cb.cb_init]