ABC machine instructions

4 files changed, 51 insertions, 38 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index fc9bc9b..c64079e 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -153,6 +153,7 @@ where
 	gen (Application app)   = comment "Application" *> gen app
 	gen (Return (Just app)) = comment "Return" *> gen app *> cleanup *> tell ['ABC'.Rtn]
 	gen (Return Nothing)    = comment "Return" *> cleanup *> tell ['ABC'.Rtn]
+	gen (MachineStm s)      = tell ['ABC'.Raw s]
 
 instance gen Application
 where
diff --git a/Sil/Parse.dcl b/Sil/Parse.dcl
index b48fdbc..a2f92cb 100644
--- a/Sil/Parse.dcl
+++ b/Sil/Parse.dcl
@@ -8,18 +8,19 @@ from Sil.Parse.Parser import class name
 from Sil.Syntax import :: Program, :: Literal
 
 :: Token
-	= TParenOpen   //* (
-	| TParenClose  //* )
-	| TBraceOpen   //* {
-	| TBraceClose  //* }
-	| TComma       //* ,
-	| TSemicolon   //* ;
-	| TAssign      //* :=
-	| TLit Literal //* True; False; integers
-	| TIf          //* if
-	| TWhile       //* while
-	| TReturn      //* return
-	| TName String //* a string
+	= TParenOpen          //* (
+	| TParenClose         //* )
+	| TBraceOpen          //* {
+	| TBraceClose         //* }
+	| TComma              //* ,
+	| TSemicolon          //* ;
+	| TAssign             //* :=
+	| TLit Literal        //* True; False; integers
+	| TIf                 //* if
+	| TWhile              //* while
+	| TReturn             //* return
+	| TMachineCode String //* |~ machine code
+	| TName String        //* a string
 
 instance == Token
 instance toString Token
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 5c13c48..925423c 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -2,7 +2,7 @@ implementation module Sil.Parse
 
 import StdBool
 import StdChar
-from StdFunc import o
+from StdFunc import flip, o
 import StdInt
 import StdList
 import StdString
@@ -13,8 +13,10 @@ import Control.Monad
 import Data.Error
 from Data.Func import $
 import Data.Functor
+import Data.List
 import Data.Maybe
-from Text import <+
+import qualified Text as T
+from Text import <+, class Text, instance Text String
 
 import GenEq
 
@@ -27,24 +29,26 @@ instance == Token where == a b = gEq{|*|} a b
 
 instance toString Token
 where
-	toString TParenOpen  = "("
-	toString TParenClose = ")"
-	toString TBraceOpen  = "{"
-	toString TBraceClose = "}"
-	toString TComma      = ","
-	toString TSemicolon  = ";"
-	toString TAssign     = ":="
-	toString (TLit l)    = toString l
-	toString TIf         = "if"
-	toString TWhile      = "while"
-	toString TReturn     = "return"
-	toString (TName s)   = s
+	toString TParenOpen       = "("
+	toString TParenClose      = ")"
+	toString TBraceOpen       = "{"
+	toString TBraceClose      = "}"
+	toString TComma           = ","
+	toString TSemicolon       = ";"
+	toString TAssign          = ":="
+	toString (TLit l)         = toString l
+	toString TIf              = "if"
+	toString TWhile           = "while"
+	toString TReturn          = "return"
+	toString (TMachineCode s) = "|~ " +++ s
+	toString (TName s)        = s
 
 instance name Token
 where
-	name (TLit _)  = "literal"
-	name (TName _) = "name"
-	name t         = toString t
+	name (TLit _)         = "literal"
+	name (TName _)        = "name"
+	name (TMachineCode _) = "machine code"
+	name t                = toString t
 
 instance toString ParseError
 where
@@ -67,8 +71,10 @@ where
 	tks ['i':'f'                :s:r] t | isSpace s = tks r [TIf    :t]
 	tks ['w':'h':'i':'l':'e'    :s:r] t | isSpace s = tks r [TWhile :t]
 	tks ['r':'e':'t':'u':'r':'n':s:r] t | isSpace s = tks r [TReturn:t]
-	tks ['T':'r':'u':'e'        :s:r] t | isSpace s = tks r [TLit $ BLit True:t]
+	tks ['T':'r':'u':'e'        :s:r] t | isSpace s = tks r [TLit $ BLit True :t]
 	tks ['F':'a':'l':'s':'e'    :s:r] t | isSpace s = tks r [TLit $ BLit False:t]
+	tks ['|':'~':r] t = tks r` [TMachineCode $ toString c:t]
+	where (c,r`) = span (not o flip isMember ['\r\n']) r
 	tks cs=:[h:_] t
 	| isSpace h          = tks (dropWhile isSpace cs) t
 	| isDigit h          = tks numrest [TLit $ ILit $ toInt $ toString num:t]
@@ -78,8 +84,8 @@ where
 		(name,namerest) = span isNameChar cs
 		(num,numrest)   = span isDigit cs
 
-	isNameChar :: (Char -> Bool)
-	isNameChar = isAlpha
+	isNameChar :: Char -> Bool
+	isNameChar c = isAlpha c || isMember c ['_\'']
 
 parse :: ([Token] -> MaybeError ParseError Program)
 parse = fst o runParser program
@@ -91,12 +97,12 @@ function :: Parser Token Function
 function =
 	type >>= \t ->
 	name >>= \n ->
-	item TParenOpen >>= \_ ->
+	item TParenOpen *>
 	seplist TComma arg >>= \args ->
-	item TParenClose >>= \_ ->
-	item TBraceOpen >>= \_ ->
+	item TParenClose *>
+	item TBraceOpen *>
 	codeblock >>= \cb ->
-	item TBraceClose >>= \_ -> pure
+	item TBraceClose *> pure
 		{ f_type = t
 		, f_name = n
 		, f_args = args
@@ -116,11 +122,11 @@ initialisation =
 	pure [{init_type=t, init_name=n} \\ n <- ns]
 
 statement :: Parser Token Statement
-statement = (declaration
+statement = ((declaration
 	<|> liftM Application application
 	<|> return
 /*	<|> if`
-	<|> while*/) <* item TSemicolon
+	<|> while*/) <* item TSemicolon) <|> machinecode
 where
 	declaration :: Parser Token Statement
 	declaration = liftM2 Declaration name (item TAssign *> application)
@@ -134,6 +140,10 @@ where
 	return :: Parser Token Statement
 	return = liftM Return (item TReturn *> optional application)
 
+	machinecode :: Parser Token Statement
+	machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode
+	where isMachineCode (TMachineCode _) = True; isMachineCode _ = False
+
 name :: Parser Token Name
 name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
 where
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index 01b7ff6..3fdb8f1 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -34,6 +34,7 @@ from Data.Maybe import :: Maybe
 	| Return (Maybe Application)
 	| If Application CodeBlock (Maybe CodeBlock)
 	| While Application CodeBlock
+	| MachineStm String
 
 :: Application
 	= Name Name