aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore6
-rw-r--r--.gitmodules2
m---------ABCMachine0
-rw-r--r--Makefile4
-rw-r--r--Sil/Check.dcl4
-rw-r--r--Sil/Check.icl36
-rw-r--r--Sil/Compile.dcl2
-rw-r--r--Sil/Compile.icl52
-rw-r--r--Sil/Error.dcl4
-rw-r--r--Sil/Error.icl57
-rw-r--r--Sil/Parse.icl4
-rw-r--r--Sil/Syntax.dcl10
-rw-r--r--Sil/Syntax.icl33
-rw-r--r--Sil/Types.dcl5
-rw-r--r--Sil/Types.icl48
-rw-r--r--Sil/Util/Parser.dcl1
-rw-r--r--Sil/Util/Parser.icl19
-rw-r--r--Sil/Util/Printer.icl9
-rw-r--r--silc.icl13
19 files changed, 148 insertions, 161 deletions
diff --git a/.gitignore b/.gitignore
index 75943a9..eb4e8fe 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,4 @@
-Clean System Files/
+*.abc
+*.o
+
silc
-examples/
-!examples/*.sil
diff --git a/.gitmodules b/.gitmodules
index b761d0f..d894e10 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,3 +1,3 @@
[submodule "ABCMachine"]
path = ABCMachine
- url = https://github.com/camilstaps/ABCMachine
+ url = https://git.camilstaps.nl/clone/archived/clean/abc-machine.git
diff --git a/ABCMachine b/ABCMachine
-Subproject 215d124c17dd08f4114204cd12c66a3659605ae
+Subproject 6084502fd84a6f427429966456a97c14691fc10
diff --git a/Makefile b/Makefile
index c9d5edb..806520f 100644
--- a/Makefile
+++ b/Makefile
@@ -1,9 +1,7 @@
BIN:=silc
CLM:=clm
CLMFLAGS:=-nt -nr\
- -l -no-pie\
- -I $$CLEAN_HOME/lib/Generics\
- -I $$CLEAN_HOME/lib/Platform\
+ -IL Platform\
-I ABCMachine
.PHONY: all clean
diff --git a/Sil/Check.dcl b/Sil/Check.dcl
index c2ba86f..306e7d5 100644
--- a/Sil/Check.dcl
+++ b/Sil/Check.dcl
@@ -2,9 +2,7 @@ definition module Sil.Check
from StdOverloaded import class toString
-from Data.Maybe import :: Maybe
-
from Sil.Error import :: Error
from Sil.Syntax import :: Program
-checkProgram :: *(Maybe *File) Program -> *([Error], *Maybe *File)
+checkProgram :: *(? *File) Program -> *([Error], * ? *File)
diff --git a/Sil/Check.icl b/Sil/Check.icl
index e17c378..b3ad1af 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -4,6 +4,7 @@ import StdBool
import StdFile
from StdFunc import flip, o
import StdList
+import StdMaybe
import StdOverloaded
import StdString
import StdTuple
@@ -11,7 +12,6 @@ import StdTuple
import Data.Error
from Data.Func import $, mapSt, seqSt
import Data.List
-import Data.Maybe
import Data.Tuple
from Text import <+
@@ -20,7 +20,7 @@ import Sil.Syntax
import Sil.Types
import Sil.Util.Parser
-checkProgram :: *(Maybe *File) Program -> *([Error], *Maybe *File)
+checkProgram :: *(? *File) Program -> *([Error], * ? *File)
checkProgram err prog
= checkErrors
[ checkFunctionNames
@@ -47,7 +47,7 @@ where
\\ g <- p.p_globals
| (typeSize g.init_type).bsize <> 0]
-checkFunction :: *(Maybe *File) Function -> *([Error], *Maybe *File)
+checkFunction :: *(? *File) Function -> *([Error], * ? *File)
checkFunction err f = checkErrors
[ checkLocals
, checkReturnAndVoid
@@ -57,19 +57,19 @@ checkFunction err f = checkErrors
where
checkReturnAndVoid :: Function -> [Error]
checkReturnAndVoid f = case f.f_type of
- TVoid -> [Ck_ReturnExpressionFromVoid (errpos st) f.f_name \\ st=:(Return _ (Just _)) <- allStatements f]
+ TVoid -> [Ck_ReturnExpressionFromVoid (errpos st) f.f_name \\ st=:(Return _ (?Just _)) <- allStatements f]
_ -> if (sureToReturn f.f_code) [] [Ck_NoReturnFromNonVoid (errpos f) f.f_name]
where
sureToReturn :: CodeBlock -> Bool
sureToReturn cb = case cb.cb_content of
[] -> False
sts -> case last sts of
- Return _ _ -> True
- While _ _ cb` -> sureToReturn cb`
- If _ bs (Just e) -> all sureToReturn [e:map snd bs]
- If _ bs Nothing -> all (sureToReturn o snd) bs
- MachineStm _ _ -> True // Let's assume the user is not stupid
- _ -> False
+ Return _ _ -> True
+ While _ _ cb` -> sureToReturn cb`
+ If _ bs (?Just e) -> all sureToReturn [e:map snd bs]
+ If _ bs ?None -> all (sureToReturn o snd) bs
+ MachineStm _ _ -> True // Let's assume the user is not stupid
+ _ -> False
checkMainFunctionType :: Function -> [Error]
checkMainFunctionType {f_name="main",f_args=[]}
@@ -96,8 +96,8 @@ where
findCBs (Declaration _ _ _) = []
findCBs (Application _ _) = []
findCBs (Return _ _) = []
- findCBs (If _ bs (Just e)) = [e:map snd bs]
- findCBs (If _ bs Nothing) = map snd bs
+ findCBs (If _ bs (?Just e)) = [e:map snd bs]
+ findCBs (If _ bs ?None) = map snd bs
findCBs (While _ _ cb) = [cb]
findCBs (MachineStm _ _) = []
@@ -105,15 +105,15 @@ where
checkVoid (TVoid, n) = [Ck_LocalVoid (errpos f) n]
checkVoid _ = []
-checkErrors :: [(a -> [Error])] a *([Error], Maybe *File) -> *([Error], *Maybe *File)
+checkErrors :: [(a -> [Error])] a *([Error], ? *File) -> *([Error], * ? *File)
checkErrors cks x st = seqSt error (concatMap (flip ($) x) cks) st
-error :: Error *([Error], *Maybe *File) -> *([Error], *Maybe *File)
+error :: Error *([Error], * ? *File) -> *([Error], * ? *File)
error e (es, err) = ([e:es], err <?< e)
-noErrors :: *(Maybe *File) -> *([Error], *Maybe *File)
+noErrors :: *(? *File) -> *([Error], * ? *File)
noErrors f = ([], f)
-(<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a
-(<?<) (Just f) x = Just (f <<< x)
-(<?<) Nothing _ = Nothing
+(<?<) infixl :: !*(? *File) !a -> * ? *File | <<< a
+(<?<) (?Just f) x = ?Just (f <<< x)
+(<?<) ?None _ = ?None
diff --git a/Sil/Compile.dcl b/Sil/Compile.dcl
index 61ee1b5..710101d 100644
--- a/Sil/Compile.dcl
+++ b/Sil/Compile.dcl
@@ -5,7 +5,7 @@ from StdOverloaded import class toString
from Data.Error import :: MaybeError
-from ABC.Assembler import :: Assembler, :: Statement, instance <<< Assembler
+from ABC.Assembler import :: Assembler, :: Statement, printAssembler
from Sil.Error import :: Error
from Sil.Syntax import :: Program
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 5e0aec1..41dad98 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -185,8 +185,8 @@ popTypeResolver = modify \cs -> {cs & typeresolvers=tl cs.typeresolvers}
getTypeResolver :: Gen TypeResolver
getTypeResolver = gets typeresolvers >>= \trs -> pure $ \n ->
case catMaybes $ map (flip ($) n) trs of
- [t:_] -> Just t
- [] -> Nothing
+ [t:_] -> ?Just t
+ [] -> ?None
reserveVar :: (Name, Type) -> Gen Address
reserveVar (n,t) = gets stackoffsets >>= put
@@ -204,9 +204,9 @@ where
findVar :: ParsePosition Name -> Gen Address
findVar p n = gets stackoffsets >>= \(aso, bso) ->
gets addresses >>= \addr -> case 'Data.Map'.get n addr of
- Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i)
- Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i)
- Nothing -> error $ C_UndefinedName (errpos p) n
+ ?Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i)
+ ?Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i)
+ ?None -> error $ C_UndefinedName (errpos p) n
addFunction :: Function -> Gen ()
addFunction f = modify (\cs -> {cs & symbols='Data.Map'.put f.f_name fs cs.symbols})
@@ -235,9 +235,9 @@ where
getType :: Expression -> Gen Type
getType e = getTypeResolver >>= \tr -> case type tr e of
- Nothing -> error $ C_CouldNotDeduceType e
- Just (Error err) -> error err
- Just (Ok t) -> pure $ t
+ ?None -> error $ C_CouldNotDeduceType e
+ ?Just (Error err) -> error err
+ ?Just (Ok t) -> pure $ t
checkType :: Type Expression -> Gen ()
checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ C_TypeMisMatch t e t`)
@@ -291,12 +291,12 @@ where
mapM_ gen p.p_funs *>
popTypeResolver
where
- typeresolver :: Name -> Maybe (MaybeError Error Type)
+ typeresolver :: Name -> ?(MaybeError Error Type)
typeresolver n = case [f \\ f <- p.p_funs | f.f_name == n] of
[f:_] -> type typeresolver f
[] -> case [g.init_type \\ g <- p.p_globals | g.init_name == n] of
- [t:_] -> Just $ Ok t
- [] -> Nothing
+ [t:_] -> ?Just $ Ok t
+ [] -> ?None
instance gen Function
where
@@ -329,7 +329,7 @@ where
]
retSize = typeSize f.f_type
- typeresolver :: Name -> Maybe (MaybeError Error Type)
+ typeresolver :: Name -> ?(MaybeError Error Type)
typeresolver n = listToMaybe [Ok a.arg_type \\ a <- f.f_args | a.arg_name == n]
mainBootstrap :: Gen ()
@@ -389,18 +389,18 @@ where
]
locals = foldr (+~) zero [typeSize i.init_type \\ i <- cb.cb_init]
- typeresolver :: Name -> Maybe (MaybeError Error Type)
+ typeresolver :: Name -> ?(MaybeError Error Type)
typeresolver n = listToMaybe [Ok i.init_type \\ i <- cb.cb_init | i.init_name == n]
instance gen Initialisation
where
gen init = case typeSize init.init_type of
s=:{bsize=0} -> case init.init_value of
- Nothing -> tell $ repeatn s.asize 'ABC'.Create
- Just v -> shrinkStack s *> gen v
+ ?None -> tell $ repeatn s.asize 'ABC'.Create
+ ?Just v -> shrinkStack s *> gen v
s=:{asize=0} -> case init.init_value of
- Nothing -> error $ C_BasicInitWithoutValue (errpos init) init.init_name
- Just v -> checkType init.init_type v *> shrinkStack s *> gen v
+ ?None -> error $ C_BasicInitWithoutValue (errpos init) init.init_name
+ ?Just v -> checkType init.init_type v *> shrinkStack s *> gen v
instance gen Statement
where
@@ -422,10 +422,10 @@ where
comment "Application" *>
gen e *>
getTypeResolver >>= \tr -> case fmap typeSize <$> type tr e of
- Just (Ok sz) -> tell ['ABC'.Pop_a sz.asize, 'ABC'.Pop_b sz.bsize] *> shrinkStack sz
- Just (Error err) -> error err
- Nothing -> error $ C_CouldNotDeduceType e
- gen (Return _ (Just e)) =
+ ?Just (Ok sz) -> tell ['ABC'.Pop_a sz.asize, 'ABC'.Pop_b sz.bsize] *> shrinkStack sz
+ ?Just (Error err) -> error err
+ ?None -> error $ C_CouldNotDeduceType e
+ gen (Return _ (?Just e)) =
comment "Return" *>
gen e *>
gets returnType >>= \rettype ->
@@ -441,7 +441,7 @@ where
updateReturnFrame {asize=0,bsize=0} _ = nop
updateReturnFrame {bsize=0} (aso, _) = tell ['ABC'.Update_a 0 (aso-1), 'ABC'.Pop_a 1] // TODO should depend on return type
updateReturnFrame _ (_, bso) = tell ['ABC'.Update_b 0 (bso-1)] // TODO should depend on return type
- gen (Return _ Nothing) =
+ gen (Return _ ?None) =
comment "Return" *>
cleanup *>
tell ['ABC'.Rtn]
@@ -464,9 +464,9 @@ where
tell [ 'ABC'.Jmp end
, 'ABC'.Label else ]
- genelse :: 'ABC'.Label (Maybe CodeBlock) -> Gen ()
- genelse end Nothing = tell ['ABC'.Label end]
- genelse end (Just cb) = gen cb *> tell ['ABC'.Label end]
+ genelse :: 'ABC'.Label (?CodeBlock) -> Gen ()
+ genelse end ?None = tell ['ABC'.Label end]
+ genelse end (?Just cb) = gen cb *> tell ['ABC'.Label end]
gen (While _ cond do) =
checkType TBool cond *>
fresh "while" >>= \loop -> fresh "whileend" >>= \end ->
@@ -492,7 +492,7 @@ where
tell ['ABC'.PushI i] *>
growStack {zero & bsize=1,btypes=['ABC'.BT_Int]}
gen (App p n args) = gets symbols >>= \syms -> case 'Data.Map'.get n syms of
- Just fs ->
+ ?Just fs ->
comment "Retrieve arguments" *>
mapM gen args *>
comment "Apply function" *>
diff --git a/Sil/Error.dcl b/Sil/Error.dcl
index 947ba9a..6bfcda9 100644
--- a/Sil/Error.dcl
+++ b/Sil/Error.dcl
@@ -3,8 +3,6 @@ definition module Sil.Error
from StdFile import class <<<
from StdOverloaded import class toString, class <
-from Data.Maybe import :: Maybe
-
from Sil.Syntax import :: Expression
from Sil.Types import :: Type
from Sil.Util.Parser import :: ParsePosition, class getPos
@@ -43,6 +41,6 @@ instance toString Error
instance <<< Error
instance < Error // Based on position in file, to choose the furthest error in the parser
-getErrorPosition :: Error -> Maybe ErrorPosition
+getErrorPosition :: Error -> ?ErrorPosition
errpos :: a -> ErrorPosition | getPos a
diff --git a/Sil/Error.icl b/Sil/Error.icl
index 66fb338..a58dd93 100644
--- a/Sil/Error.icl
+++ b/Sil/Error.icl
@@ -4,7 +4,6 @@ import StdFile
import StdInt
import StdString
-import Data.Maybe
import Text
import Sil.Syntax
@@ -16,7 +15,7 @@ import Sil.Util.Parser
, ep_token :: Int
}
-instance < ErrorPosition where < p1 p2 = p1.ep_token < p2.ep_token
+instance < ErrorPosition where (<) p1 p2 = p1.ep_token < p2.ep_token
instance toString ErrorPosition
where
@@ -44,37 +43,37 @@ where
toString (C_BasicInitWithoutValue p n) = p <+ "Basic value '" <+ n <+ "' must have an initial value."
toString (UnknownError e) = "\tUnknown error: " <+ e <+ "."
-instance <<< Error where <<< f e = f <<< toString e <<< "\r\n"
+instance <<< Error where (<<<) f e = f <<< toString e <<< "\r\n"
instance < Error
where
- < _ (UnknownError _) = False
- < (UnknownError _) _ = True
- < e1 e2 = case (getErrorPosition e1, getErrorPosition e2) of
- (Just p1, Just p2) -> p1 < p2
- (_ , Nothing) -> False
- (Nothing, _ ) -> True
+ (<) _ (UnknownError _) = False
+ (<) (UnknownError _) _ = True
+ (<) e1 e2 = case (getErrorPosition e1, getErrorPosition e2) of
+ (?Just p1, ?Just p2) -> p1 < p2
+ (_ , ?None ) -> False
+ (?None , _ ) -> True
-getErrorPosition :: Error -> Maybe ErrorPosition
-getErrorPosition (P_Invalid w tk) = Nothing
-getErrorPosition (P_Expected p s h) = Just p
-getErrorPosition (T_IllegalApplication p ft et) = Just p
-getErrorPosition (T_IllegalField p f t) = Just p
-getErrorPosition (T_TooHighTupleArity p i) = Just p
-getErrorPosition Ck_NoMainFunction = Nothing
-getErrorPosition (Ck_MainFunctionInvalidType p t) = Just p
-getErrorPosition (Ck_DuplicateFunctionName p n) = Just p
-getErrorPosition (Ck_DuplicateLocalName p f arg) = Just p
-getErrorPosition (Ck_ReturnExpressionFromVoid p f) = Just p
-getErrorPosition (Ck_NoReturnFromNonVoid p f) = Just p
-getErrorPosition (Ck_LocalVoid p l) = Just p
-getErrorPosition (Ck_BasicGlobal p g) = Just p
-getErrorPosition (C_UndefinedName p n) = Just p
-getErrorPosition (C_UndefinedField p f) = Just p
-getErrorPosition (C_CouldNotDeduceType e) = Just (errpos e)
-getErrorPosition (C_TypeMisMatch t e u) = Just (errpos e)
-getErrorPosition (C_BasicInitWithoutValue p n) = Just p
-getErrorPosition (UnknownError e) = Nothing
+getErrorPosition :: Error -> ?ErrorPosition
+getErrorPosition (P_Invalid w tk) = ?None
+getErrorPosition (P_Expected p s h) = ?Just p
+getErrorPosition (T_IllegalApplication p ft et) = ?Just p
+getErrorPosition (T_IllegalField p f t) = ?Just p
+getErrorPosition (T_TooHighTupleArity p i) = ?Just p
+getErrorPosition Ck_NoMainFunction = ?None
+getErrorPosition (Ck_MainFunctionInvalidType p t) = ?Just p
+getErrorPosition (Ck_DuplicateFunctionName p n) = ?Just p
+getErrorPosition (Ck_DuplicateLocalName p f arg) = ?Just p
+getErrorPosition (Ck_ReturnExpressionFromVoid p f) = ?Just p
+getErrorPosition (Ck_NoReturnFromNonVoid p f) = ?Just p
+getErrorPosition (Ck_LocalVoid p l) = ?Just p
+getErrorPosition (Ck_BasicGlobal p g) = ?Just p
+getErrorPosition (C_UndefinedName p n) = ?Just p
+getErrorPosition (C_UndefinedField p f) = ?Just p
+getErrorPosition (C_CouldNotDeduceType e) = ?Just (errpos e)
+getErrorPosition (C_TypeMisMatch t e u) = ?Just (errpos e)
+getErrorPosition (C_BasicInitWithoutValue p n) = ?Just p
+getErrorPosition (UnknownError e) = ?None
errpos :: a -> ErrorPosition | getPos a
errpos x = {ep_line=p.pp_line, ep_token=p.pp_token}
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index ed53d9e..c21b4cb 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -24,7 +24,7 @@ import Sil.Util.Parser
import Sil.Util.Printer
derive gEq Token, Literal
-instance == Token where == a b = gEq{|*|} a b
+instance == Token where (==) a b = gEq{|*|} a b
instance toString Token
where
@@ -261,7 +261,7 @@ where
= liftM2 Literal getPosition literal
<|> liftM2 Name getPosition name
<|> liftM3 List getPosition (pure <$> bracked type) (pure [])
- <|> liftM3 List getPosition (pure Nothing) (bracked $ seplist TComma expression)
+ <|> liftM3 List getPosition (pure ?None) (bracked $ seplist TComma expression)
<|> (item TParenOpen *> getPosition >>= \pos ->
seplistUntil TParenClose TComma expression >>= \es ->
pure $ case es of [x] -> x; _ -> Tuple pos (length es) es)
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index b99153e..632eb37 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -2,8 +2,6 @@ definition module Sil.Syntax
from StdOverloaded import class toString
-from Data.Maybe import :: Maybe
-
from Sil.Types import :: Type
from Sil.Util.Parser import :: ParsePosition, class getPos
@@ -33,15 +31,15 @@ from Sil.Util.Parser import :: ParsePosition, class getPos
:: Initialisation =
{ init_type :: Type
, init_name :: Name
- , init_value :: Maybe Expression
+ , init_value :: ?Expression
, init_pos :: ParsePosition
}
:: Statement
= Declaration ParsePosition Name Expression
| Application ParsePosition Expression
- | Return ParsePosition (Maybe Expression)
- | If ParsePosition [(Expression, CodeBlock)] (Maybe CodeBlock)
+ | Return ParsePosition (?Expression)
+ | If ParsePosition [(Expression, CodeBlock)] (?CodeBlock)
| While ParsePosition Expression CodeBlock
| MachineStm ParsePosition String
@@ -53,7 +51,7 @@ from Sil.Util.Parser import :: ParsePosition, class getPos
| BuiltinApp2 ParsePosition Expression Op2 Expression
| Field ParsePosition Name Expression
| Tuple ParsePosition Int [Expression]
- | List ParsePosition (Maybe Type) [Expression]
+ | List ParsePosition (?Type) [Expression]
:: Op1
= Neg //* ~
diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl
index ce69920..c2baf70 100644
--- a/Sil/Syntax.icl
+++ b/Sil/Syntax.icl
@@ -6,7 +6,6 @@ import StdString
import StdTuple
import Data.List
-import Data.Maybe
import Text
import Sil.Types
@@ -15,13 +14,13 @@ 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>>"
+ 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
@@ -33,9 +32,9 @@ where
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 (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
@@ -102,8 +101,8 @@ 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=:(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]
@@ -114,10 +113,10 @@ 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 _ = []
+ 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
diff --git a/Sil/Types.dcl b/Sil/Types.dcl
index 14602d3..f07c3e9 100644
--- a/Sil/Types.dcl
+++ b/Sil/Types.dcl
@@ -3,7 +3,6 @@ definition module Sil.Types
from StdOverloaded import class ==, class +, class toString, class zero
from Data.Error import :: MaybeError
-from Data.Maybe import :: Maybe
from ABC.Assembler import :: BasicType
@@ -38,11 +37,11 @@ typeSize :: Type -> TypeSize
(+~) infixl 6 :: TypeSize TypeSize -> TypeSize
(-~) infixl 6 :: TypeSize TypeSize -> TypeSize
-:: TypeResolver :== Name -> Maybe (MaybeError Error Type)
+:: TypeResolver :== Name -> ?(MaybeError Error Type)
instance zero TypeResolver
-class type a :: TypeResolver a -> Maybe (MaybeError Error Type)
+class type a :: TypeResolver a -> ?(MaybeError Error Type)
instance type Function
instance type Expression
instance type Name
diff --git a/Sil/Types.icl b/Sil/Types.icl
index 829b82d..083e3be 100644
--- a/Sil/Types.icl
+++ b/Sil/Types.icl
@@ -24,7 +24,7 @@ import Sil.Util.Parser
import Sil.Util.Printer
derive gEq Type
-instance == Type where == a b = gEq{|*|} a b
+instance == Type where (==) a b = gEq{|*|} a b
instance toString Type
where
@@ -58,18 +58,18 @@ typeSize (TList _) = {zero & asize=1}
, btypes = abort "btypes after -~\r\n"
}
-instance zero TypeResolver where zero = const Nothing
+instance zero TypeResolver where zero = const ?None
instance type Function
where
- type res f = Just $ Ok $ foldr (-->) f.f_type [a.arg_type \\ a <- f.f_args]
+ type res f = ?Just $ Ok $ foldr (-->) f.f_type [a.arg_type \\ a <- f.f_args]
instance type Expression
where
type res (Name _ n) = type res n
type res (Literal _ lit) = case lit of
- BLit _ -> Just $ Ok TBool
- ILit _ -> Just $ Ok TInt
+ BLit _ -> ?Just $ Ok TBool
+ ILit _ -> ?Just $ Ok TInt
type res (App p n args) =
mapM (type res) args >>= \ats ->
res n >>= \ft -> pure
@@ -94,19 +94,19 @@ where
( top >>= \top ->
te1 >>= \te1 ->
te2 >>= \te2 -> foldM (tryApply p) top [te1,te2])
- type res e=:(List _ (Just t) es) =
+ type res e=:(List _ (?Just t) es) =
mapM (type res) es >>= \tes -> pure
(sequence tes >>= \tes -> case [(e,t`) \\ e <- es & t` <- tes | t <> t`] of
[(e`,t`):_] -> Error $ C_TypeMisMatch t e` t`
[] -> Ok $ TList t)
- type res (List _ Nothing []) = Nothing
- type res e=:(List _ Nothing es) =
+ type res (List _ ?None []) = ?None
+ type res e=:(List _ ?None es) =
mapM (type res) es >>= \tes -> pure
(sequence tes >>= \tes -> case removeDup tes of
[t] -> Ok $ TList t
[_:_] -> Error $ C_CouldNotDeduceType e)
type res e=:(Tuple _ n es)
- | n > 32 = Just $ Error $ T_TooHighTupleArity (errpos e) n
+ | n > 32 = ?Just $ Error $ T_TooHighTupleArity (errpos e) n
| otherwise =
mapM (type res) es >>= \ats -> pure (sequence ats >>= pure o TTuple n)
type res fe=:(Field _ f e)
@@ -141,21 +141,21 @@ instance type Name where type res n = res n
instance type Op1
where
- type _ Neg = Just $ Ok $ TInt --> TInt
- type _ Not = Just $ Ok $ TBool --> TBool
+ type _ Neg = ?Just $ Ok $ TInt --> TInt
+ type _ Not = ?Just $ Ok $ TBool --> TBool
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 _ 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
+ 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/Parser.dcl b/Sil/Util/Parser.dcl
index 2c34d83..38ee921 100644
--- a/Sil/Util/Parser.dcl
+++ b/Sil/Util/Parser.dcl
@@ -7,7 +7,6 @@ from Control.Applicative import class pure, class <*>, class Applicative,
from Control.Monad import class Monad
from Data.Error import :: MaybeError
from Data.Functor import class Functor
-from Data.Maybe import :: Maybe
from Sil.Error import :: Error
diff --git a/Sil/Util/Parser.icl b/Sil/Util/Parser.icl
index 95b0813..3f32882 100644
--- a/Sil/Util/Parser.icl
+++ b/Sil/Util/Parser.icl
@@ -10,7 +10,6 @@ import Data.Error
from Data.Func import $
import Data.Functor
import Data.List
-import Data.Maybe
import Sil.Error
@@ -33,10 +32,10 @@ makeParseState i =
, ps_commits = []
}
-nextToken :: (ParseState a) -> (Maybe a, ParseState a)
-nextToken ps=:{ps_input=[]} = (Nothing, ps)
+nextToken :: (ParseState a) -> (?a, ParseState a)
+nextToken ps=:{ps_input=[]} = (?None, ps)
nextToken ps=:{ps_input=[i:is]} = case i of
- PI_Token t -> (Just t, {advance & ps_pos=ps.ps_pos + 1})
+ PI_Token t -> (?Just t, {advance & ps_pos=ps.ps_pos + 1})
PI_NewLine -> nextToken {advance & ps_line=ps.ps_line + 1}
where
advance = {ps & ps_read=[i:ps.ps_read], ps_input=is}
@@ -114,13 +113,13 @@ fail = empty
top :: Parser a a
top = Parser \st -> case nextToken st of
- (Nothing, st) -> (Error $ UnknownError "top in Parser failed", st)
- (Just x, st) -> (Ok x, st)
+ (?None, st) -> (Error $ UnknownError "top in Parser failed", st)
+ (?Just x, st) -> (Ok x, st)
peek :: Parser a a
peek = Parser \st -> case nextToken st of
- (Nothing, st) -> (Error $ UnknownError "peek in Parser failed", st)
- (Just x, st) -> (Ok x, tokenBack st)
+ (?None, st) -> (Error $ UnknownError "peek in Parser failed", st)
+ (?Just x, st) -> (Ok x, tokenBack st)
satisfy :: (a -> Bool) -> Parser a a
satisfy f = top >>= \r -> if (f r) (pure r) fail
@@ -170,5 +169,5 @@ where
eof :: Parser a () | toString a
eof = Parser \st=:{ps_line,ps_pos} -> case nextToken st of
- (Nothing, st) -> (Ok (), st)
- (Just t, st) -> (Error $ P_Expected (errpos {pp_line=ps_line,pp_token=ps_pos}) "eof" t, st)
+ (?None, st) -> (Ok (), st)
+ (?Just t, st) -> (Error $ P_Expected (errpos {pp_line=ps_line,pp_token=ps_pos}) "eof" t, st)
diff --git a/Sil/Util/Printer.icl b/Sil/Util/Printer.icl
index 283709d..1052a3e 100644
--- a/Sil/Util/Printer.icl
+++ b/Sil/Util/Printer.icl
@@ -10,7 +10,6 @@ import StdString
from Data.Func import $
import Data.List
-import Data.Maybe
import Text
import Sil.Parse
@@ -96,8 +95,8 @@ where
print st init = st <+ init.init_type <+ " " <+ init.init_name <+ val <+ ";"
where
val = case init.init_value of
- Nothing -> ""
- Just v -> " := " <+ v
+ ?None -> ""
+ ?Just v -> " := " <+ v
instance PrettyPrinter Statement
where
@@ -106,8 +105,8 @@ where
st` = incIndent st
oneblock (c,b) = "if (" <+ c <+ ") {\r\n" <+ print st` b <+ "\r\n" <+ st <+ "}"
else` = case else of
- Nothing -> ""
- Just e -> " else {\r\n" <+ print st` e <+ "\r\n" <+ st <+ "}"
+ ?None -> ""
+ ?Just e -> " else {\r\n" <+ print st` e <+ "\r\n" <+ st <+ "}"
print st (While _ c do) = st <+ "while (" <+ c <+ ") {\r\n" <+
print (incIndent st) do <+ "\r\n" <+ st <+ "}"
print st stm = st <+ stm
diff --git a/silc.icl b/silc.icl
index 4a5ceea..cd748fe 100644
--- a/silc.icl
+++ b/silc.icl
@@ -5,6 +5,7 @@ import StdChar
import StdFile
from StdFunc import o, seq
import StdList
+import StdMaybe
import StdOverloaded
import StdString
import StdTuple
@@ -38,7 +39,7 @@ from Sil.Util.Printer import :: PrintState, instance zero PrintState,
, compile :: Bool
, generate :: Bool
, help :: Bool
- , inputfile :: Maybe String
+ , inputfile :: ?String
}
instance zero CLI
@@ -49,7 +50,7 @@ where
, compile = True
, generate = True
, help = False
- , inputfile = Nothing
+ , inputfile = ?None
}
Start w
@@ -64,7 +65,7 @@ Start w
| args.help
# io = io <<< HELP
= finish 0 io err w
-| isNothing args.inputfile
+| isNone args.inputfile
# err = err <<< "No input file given.\r\n"
= finish 1 io err w
# infile = fromJust args.inputfile
@@ -112,11 +113,11 @@ Start w
| isError prog
# err = err <<< fromError prog
= finish 1 io err w
-#! f = f <<< fromOk prog
+#! f = printAssembler (fromOk prog) f
#! (_,w) = fclose f w
| not args.generate
= finish 0 io err w
-#! (p,w) = callProcess "/opt/clean/bin/clm" [module, "-o", module] (Just dir) w
+#! (p,w) = callProcess "/opt/clean/bin/clm" [module, "-o", module] (?Just dir) w
| isError p
# err = err <<< snd (fromError p) <<< "\r\n"
= finish 1 io err w
@@ -131,7 +132,7 @@ where
<|> (\ cli -> {cli & compile=False}) <$ item "--no-compile"
<|> (\ cli -> {cli & generate=False}) <$ item "--no-generate"
<|> (\ cli -> {cli & help=True}) <$ anyItem ["-h", "--help"]
- <|> (\name cli -> {cli & inputfile=Just name}) <$> satisfy isFilename
+ <|> (\name cli -> {cli & inputfile= ?Just name}) <$> satisfy isFilename
)
<?> P_Invalid "command line argument" opt
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 17:02:56 +0000