aboutsummaryrefslogtreecommitdiff
path: root/Sil/Syntax.icl
blob: e28d6166678694472dd517707576cb39d14a3959 (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
implementation module Sil.Syntax

from StdFunc import o
import StdOverloaded
import StdString
import StdTuple

import Data.List
import Data.Maybe
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 _ Nothing)  = "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 Nothing 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 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 Nothing)   = [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 Nothing)  = 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]