diff options
Diffstat (limited to 'Sil')
| -rw-r--r-- | Sil/Compile.icl | 19 | ||||
| -rw-r--r-- | Sil/Parse.dcl | 1 | ||||
| -rw-r--r-- | Sil/Parse.icl | 40 | ||||
| -rw-r--r-- | Sil/Syntax.dcl | 1 |
4 files changed, 44 insertions, 17 deletions
diff --git a/Sil/Compile.icl b/Sil/Compile.icl index b4854ba..ca375b1 100644 --- a/Sil/Compile.icl +++ b/Sil/Compile.icl @@ -184,7 +184,7 @@ instance gen Statement where gen st=:(Declaration n app) = gets addresses >>= \addrs -> case 'M'.get n addrs of Just i -> comment (toString st) *> gen app *> - tell ['ABC'.Update_a 0 $ i+1, 'ABC'.Pop_a 1] + tell ['ABC'.Update_a 0 $ i+1, 'ABC'.Pop_a 1] *> shrinkStack 1 _ -> liftT $ Error $ UndefinedName n gen (Application e) = comment "Application" *> gen e *> tell ['ABC'.Pop_a 1] gen (Return (Just e)) = comment "Return" *> gen e *> cleanup *> tell ['ABC'.Rtn] @@ -208,6 +208,15 @@ where genelse :: 'ABC'.Label (Maybe CodeBlock) -> Gen () genelse end Nothing = tell ['ABC'.Label end] genelse end (Just cb) = gen cb *> tell ['ABC'.Label end] + gen (While cond do) = + fresh "while" >>= \loop -> fresh "whileend" >>= \end -> + tell [ 'ABC'.Label loop ] *> + gen cond *> + toBStack 'ABC'.BT_Bool 1 *> + tell [ 'ABC'.JmpFalse end ] *> + gen do *> + tell [ 'ABC'.Jmp loop + , 'ABC'.Label end ] instance gen Expression where @@ -237,12 +246,16 @@ where instance gen Op1 where gen op = - toBStack 'ABC'.BT_Int 1 *> + toBStack type 1 *> tell [instr] *> - BtoAStack 'ABC'.BT_Int + BtoAStack type where instr = case op of Neg -> 'ABC'.NegI + Not -> 'ABC'.NotB + type = case op of + Neg -> 'ABC'.BT_Int + Not -> 'ABC'.BT_Bool instance gen Op2 where diff --git a/Sil/Parse.dcl b/Sil/Parse.dcl index 73f9ad3..0db10e6 100644 --- a/Sil/Parse.dcl +++ b/Sil/Parse.dcl @@ -16,6 +16,7 @@ from Sil.Util.Parser import class name | TSemicolon //* ; | TAssign //* := | TTilde //* ~ + | TExclamation //* ! | TPlus //* + | TMinus //* - | TStar //* * diff --git a/Sil/Parse.icl b/Sil/Parse.icl index 2ee2bc1..806ac69 100644 --- a/Sil/Parse.icl +++ b/Sil/Parse.icl @@ -71,18 +71,19 @@ where tks ['=':'=':r] t = tks r [TDoubleEquals :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 [TBraceOpen :t] - tks ['}':r] t = tks r [TBraceClose:t] - tks [',':r] t = tks r [TComma :t] - tks [';':r] t = tks r [TSemicolon :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 [TBraceOpen :t] + tks ['}':r] t = tks r [TBraceClose :t] + tks [',':r] t = tks r [TComma :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' :s:r] t | isSpace s = tks r [TIf :t] tks ['e':'l':'s':'e' :s:r] t | isSpace s = tks r [TElse :t] tks ['w':'h':'i':'l':'e' :s:r] t | isSpace s = tks r [TWhile :t] @@ -142,7 +143,7 @@ statement = declaration <|> liftM Application (expression <* item TSemicolon) <|> return <|> if` - //<|> while + <|> while <|> machinecode where declaration :: Parser Token Statement @@ -168,6 +169,12 @@ where braced codeblock >>= \block -> pure (cond, block) + while :: Parser Token Statement + while = item TWhile *> + parenthised expression >>= \cond -> + braced codeblock >>= \do -> + pure $ While cond do + expression :: Parser Token Expression expression = rightAssoc (op TDoubleBar LogOr) @@ -198,9 +205,14 @@ where noInfix :: Parser Token Expression noInfix = liftM2 App name (item TParenOpen *> seplist TComma expression <* item TParenClose) - <|> liftM (BuiltinApp Neg) (item TTilde *> noInfix) + <|> op TTilde Neg + <|> op TExclamation Not <|> liftM Literal literal <|> liftM Name name + <|> parenthised expression + where + op :: Token Op1 -> Parser Token Expression + op token operator = liftM (BuiltinApp operator) (item token *> noInfix) name :: Parser Token Name name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name" diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl index 58515fe..aebe32c 100644 --- a/Sil/Syntax.dcl +++ b/Sil/Syntax.dcl @@ -47,6 +47,7 @@ from Data.Maybe import :: Maybe :: Op1 = Neg //* ~ + | Not //* ! :: Op2 = Add //* + |