aboutsummaryrefslogtreecommitdiff
path: root/Sil
diff options
context:
space:
mode:
Diffstat (limited to 'Sil')
-rw-r--r--Sil/Compile.icl8
-rw-r--r--Sil/Parse.dcl7
-rw-r--r--Sil/Parse.icl53
-rw-r--r--Sil/Syntax.dcl23
-rw-r--r--Sil/Syntax.icl23
-rw-r--r--Sil/Types.icl21
-rw-r--r--Sil/Util/Printer.icl16
7 files changed, 100 insertions, 51 deletions
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index fab7643..d20eff1 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -56,6 +56,9 @@ where
// Remove needless moves between A and B stacks
opt ['ABC'.PushI_a 0:'ABC'.Pop_a 1:'ABC'.Create:'ABC'.FillI_b 0 0:'ABC'.Pop_b 1:ss] = opt ss
opt ['ABC'.PushB_a 0:'ABC'.Pop_a 1:'ABC'.Create:'ABC'.FillB_b 0 0:'ABC'.Pop_b 1:ss] = opt ss
+ // Optimise negations
+ opt ['ABC'.NotB:'ABC'.JmpFalse l:ss] = ['ABC'.JmpTrue l:opt ss]
+ opt ['ABC'.NotB:'ABC'.JmpTrue l:ss] = ['ABC'.JmpFalse l:opt ss]
// Base cases
opt [s:ss] = [s:opt ss]
opt [] = []
@@ -610,6 +613,9 @@ where
instance gen Op2
where
+ gen Unequals = gen Equals *> tell ['ABC'.NotB]
+ gen CmpLe = gen CmpGt *> tell ['ABC'.NotB]
+ gen CmpGe = gen CmpLt *> tell ['ABC'.NotB]
gen op = tell [instr] *> shrinkStack {zero & bsize=1}
where
instr = case op of
@@ -619,6 +625,8 @@ where
Div -> 'ABC'.DivI
Rem -> 'ABC'.RemI
Equals -> 'ABC'.EqI
+ CmpLt -> 'ABC'.LtI
+ CmpGt -> 'ABC'.GtI
rettype = case op of
Equals -> 'ABC'.BT_Bool
_ -> 'ABC'.BT_Int
diff --git a/Sil/Parse.dcl b/Sil/Parse.dcl
index 378586a..74a2ff2 100644
--- a/Sil/Parse.dcl
+++ b/Sil/Parse.dcl
@@ -27,7 +27,12 @@ from Sil.Util.Parser import class name
| TStar //* *
| TSlash //* /
| TPercent //* %
- | TDoubleEquals //* ==
+ | TEquals //* ==
+ | TUnequals //* <>
+ | TLe //* <=
+ | TGe //* >=
+ | TLt //* <
+ | TGt //* >
| TDoubleBar //* ||
| TDoubleAmpersand //* &&
| TLit Literal //* True; False; integers
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 7325826..16f3fca 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -48,6 +48,13 @@ where
toString TStar = "*"
toString TSlash = "/"
toString TPercent = "%"
+ toString TEquals = "=="
+ toString TLe = "<="
+ toString TGe = ">="
+ toString TLt = "<"
+ toString TGt = ">"
+ toString TDoubleBar = "||"
+ toString TDoubleAmpersand = "&&"
toString (TLit l) = toString l
toString TIf = "if"
toString TWhile = "while"
@@ -76,25 +83,30 @@ where
tks ['.':r=:[c:_]] t | isNameChar c = tks r` [TField $ toString f:t]
where (f,r`) = span isNameChar r
tks [':':'=':r] t = tks r [TAssign :t]
- tks ['=':'=':r] t = tks r [TDoubleEquals :t]
+ tks ['=':'=':r] t = tks r [TEquals :t]
+ tks ['<':'>':r] t = tks r [TUnequals :t]
+ tks ['<':'=':r] t = tks r [TLe :t]
+ tks ['>':'=':r] t = tks r [TGe :t]
+ tks ['<' :r] t = tks r [TLt :t]
+ tks ['>' :r] t = tks r [TGt :t]
tks ['|':'|':r] t = tks r [TDoubleBar :t]
tks ['&':'&':r] t = tks r [TDoubleAmpersand:t]
- tks ['(':r] t = tks r [TParenOpen :t]
- tks [')':r] t = tks r [TParenClose :t]
- tks ['[':r] t = tks r [TBrackOpen :t]
- tks [']':r] t = tks r [TBrackClose :t]
- tks ['{':r] t = tks r [TBraceOpen :t]
- tks ['}':r] t = tks r [TBraceClose :t]
- tks [',':r] t = tks r [TComma :t]
- tks [':':r] t = tks r [TColon :t]
- tks [';':r] t = tks r [TSemicolon :t]
- tks ['!':r] t = tks r [TExclamation:t]
- tks ['~':r] t = tks r [TTilde :t]
- tks ['+':r] t = tks r [TPlus :t]
- tks ['-':r] t = tks r [TMinus :t]
- tks ['*':r] t = tks r [TStar :t]
- tks ['/':r] t = tks r [TSlash :t]
- tks ['%':r] t = tks r [TPercent :t]
+ tks ['(' :r] t = tks r [TParenOpen :t]
+ tks [')' :r] t = tks r [TParenClose :t]
+ tks ['[' :r] t = tks r [TBrackOpen :t]
+ tks [']' :r] t = tks r [TBrackClose :t]
+ tks ['{' :r] t = tks r [TBraceOpen :t]
+ tks ['}' :r] t = tks r [TBraceClose :t]
+ tks [',' :r] t = tks r [TComma :t]
+ tks [':' :r] t = tks r [TColon :t]
+ tks [';' :r] t = tks r [TSemicolon :t]
+ tks ['!' :r] t = tks r [TExclamation :t]
+ tks ['~' :r] t = tks r [TTilde :t]
+ tks ['+' :r] t = tks r [TPlus :t]
+ tks ['-' :r] t = tks r [TMinus :t]
+ tks ['*' :r] t = tks r [TStar :t]
+ tks ['/' :r] t = tks r [TSlash :t]
+ tks ['%' :r] t = tks r [TPercent :t]
tks ['i':'f' :r=:[n:_]] t | isNotNameChar n = tks r [TIf :t]
tks ['e':'l':'s':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TElse :t]
tks ['w':'h':'i':'l':'e' :r=:[n:_]] t | isNotNameChar n = tks r [TWhile :t]
@@ -201,7 +213,12 @@ expression :: Parser Token Expression
expression
= rightAssoc (op TDoubleBar LogOr)
$ rightAssoc (op TDoubleAmpersand LogAnd)
- $ rightAssoc (op TDoubleEquals Equals)
+ $ rightAssoc (op TEquals Equals
+ <|> op TUnequals Unequals
+ <|> op TLe CmpLe
+ <|> op TGe CmpGe
+ <|> op TLt CmpLt
+ <|> op TGt CmpGt)
$ rightAssoc (op TColon Cons)
$ leftAssoc (op TPlus Add
<|> op TMinus Sub)
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index c76eb13..7c983eb 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -57,15 +57,20 @@ from Sil.Types import :: Type
| Not //* !
:: Op2
- = Add //* +
- | Sub //* -
- | Mul //* *
- | Div //* /
- | Rem //* %
- | Equals //* ==
- | LogOr //* ||
- | LogAnd //* &&
- | Cons //* :
+ = Add //* +
+ | Sub //* -
+ | Mul //* *
+ | Div //* /
+ | Rem //* %
+ | Equals //* ==
+ | Unequals //* <>
+ | CmpLe //* <=
+ | CmpGe //* >=
+ | CmpLt //* <
+ | CmpGt //* >
+ | LogOr //* ||
+ | LogAnd //* &&
+ | Cons //* :
:: Literal
= BLit Bool
diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl
index 53384b3..65cb5c5 100644
--- a/Sil/Syntax.icl
+++ b/Sil/Syntax.icl
@@ -44,15 +44,20 @@ where
instance toString Op2
where
- toString Add = "+"
- toString Sub = "-"
- toString Mul = "*"
- toString Div = "/"
- toString Rem = "%"
- toString Equals = "=="
- toString LogOr = "||"
- toString LogAnd = "&&"
- toString Cons = ":"
+ 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
diff --git a/Sil/Types.icl b/Sil/Types.icl
index ba13cba..6f802d3 100644
--- a/Sil/Types.icl
+++ b/Sil/Types.icl
@@ -146,11 +146,16 @@ where
instance type Op2
where
- type _ Add = Just $ Ok $ TInt --> TInt --> TInt
- type _ Sub = Just $ Ok $ TInt --> TInt --> TInt
- type _ Mul = Just $ Ok $ TInt --> TInt --> TInt
- type _ Div = Just $ Ok $ TInt --> TInt --> TInt
- type _ Rem = Just $ Ok $ TInt --> TInt --> TInt
- type _ Equals = Just $ Ok $ TInt --> TInt --> TBool
- type _ LogOr = Just $ Ok $ TBool --> TBool --> TBool
- type _ LogAnd = Just $ Ok $ TBool --> TBool --> TBool
+ type _ Add = Just $ Ok $ TInt --> TInt --> TInt
+ type _ Sub = Just $ Ok $ TInt --> TInt --> TInt
+ type _ Mul = Just $ Ok $ TInt --> TInt --> TInt
+ type _ Div = Just $ Ok $ TInt --> TInt --> TInt
+ type _ Rem = Just $ Ok $ TInt --> TInt --> TInt
+ type _ Equals = Just $ Ok $ TInt --> TInt --> TBool
+ type _ Unequals = Just $ Ok $ TInt --> TInt --> TBool
+ type _ CmpLe = Just $ Ok $ TInt --> TInt --> TBool
+ type _ CmpGe = Just $ Ok $ TInt --> TInt --> TBool
+ type _ CmpLt = Just $ Ok $ TInt --> TInt --> TBool
+ type _ CmpGt = Just $ Ok $ TInt --> TInt --> TBool
+ type _ LogOr = Just $ Ok $ TBool --> TBool --> TBool
+ type _ LogAnd = Just $ Ok $ TBool --> TBool --> TBool
diff --git a/Sil/Util/Printer.icl b/Sil/Util/Printer.icl
index 55c2498..979e478 100644
--- a/Sil/Util/Printer.icl
+++ b/Sil/Util/Printer.icl
@@ -31,6 +31,8 @@ decIndent ps = {ps & indent=dec ps.indent}
instance toString PrintState where toString st = {'\t' \\ _ <- [1..st.indent]}
+instance PrettyPrinter String where print _ s = s
+
instance PrettyPrinter [Token]
where
print st [] = ""
@@ -68,12 +70,14 @@ where
instance PrettyPrinter Program
where
- print st prog = p st prog.p_globals <+ "\r\n" <+ p st prog.p_funs
- where
- p :: PrintState [a] -> String | PrettyPrinter a
- p _ [] = ""
- p st [f] = print st f
- p st [f:fs] = print st f <+ "\r\n\r\n" <+ p st fs
+ print st prog=:{p_globals=gs=:[_:_]}
+ = stprintersperse st "\r\n" gs <+ "\r\n\r\n" <+ print st {prog & p_globals=[]}
+ print st prog = stprintersperse st "\r\n\r\n" prog.p_funs
+
+stprintersperse :: PrintState a [b] -> String | PrettyPrinter a & PrettyPrinter b
+stprintersperse st _ [] = ""
+stprintersperse st _ [x] = print st x
+stprintersperse st g [x:xs] = print st x +++ print st g +++ stprintersperse st g xs
instance PrettyPrinter Function
where
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 16:08:32 +0000