Commit aaee498e01ba4edea3f096beeb54396c0bae59af - UampirNexol

+2

-1

build.sh less more

7	7
8	8	if command -v ghc >/dev/null 2>&1; then
9	9	echo "building $PROG.exe with ghc"
10		(cd src && ghc --make Main.hs -o ../bin/$PROG.exe)
	10	WARNS="-Wall -Wno-missing-signatures -Werror"
	11	(cd src && ghc $WARNS --make Main.hs -o ../bin/$PROG.exe)
11	12	else
12	13	echo "ghc not found, not building $PROG.exe"
13	14	fi

+3

-1

src/Language/UampirNexol/Eval.hs less more

9	9	-- meanings of (and can thus assign meanings to) UampirNexol expressions.
10	10	--
11	11
12		import Language.UampirNexol.Type
13	12	import Language.UampirNexol.State
14	13	import Language.UampirNexol.Expr
15	14

74	73	then eval thenP s
75	74	else eval elseP s
76	75
	76	eval other _ =
	77	error $ "unsupported for eval: " ++ show other
	78
77	79	evalCond :: Condition -> State -> Bool
78	80	evalCond (IsSet loc) s = (fetch loc s) /= 0
79	81	evalCond (IsUnset loc) s = (fetch loc s) == 0

+0

-2

src/Language/UampirNexol/Expr.hs less more

7	7	-- Data structures describing UampirNexol expressions
8	8	-- (which denote 6502 programs).
9	9	--
10
11		import qualified Data.Set as Set
12	10
13	11	import Language.UampirNexol.State
14	12

+6

-0

src/Language/UampirNexol/Extractor.hs less more

50	50	in
51	51	c1 ++ [offset1] ++ f ++ c2a ++ [offset2a] ++ c2b ++ [offset2b] ++ t
52	52
	53	extract other =
	54	error $ "unsupported for extraction: " ++ show other
	55
53	56	extractCond (IsSet Z) = [0xf0] -- BEQ
54	57	extractCond (IsSet N) = [0x30] -- BMI
55	58	extractCond (IsSet C) = [0xb0] -- BCS

57	60	extractCond (IsUnset Z) = [0xd0] -- BNE
58	61	extractCond (IsUnset N) = [0x10] -- BPL
59	62	extractCond (IsUnset C) = [0x90] -- BCC
	63
	64	extractCond other =
	65	error $ "unsupported for extraction: " ++ show other
60	66
61	67	computeOffset distance =
62	68	-- TODO check this offset is within range

+6

-8

src/Language/UampirNexol/Parser.hs less more

24	24	import Prelude hiding (sequence)
25	25	import Text.Parsec
26	26	import Text.Parsec.String (Parser)
27		import Text.Parsec.Char
28		import Text.Parsec.Combinator
29	27	import qualified Text.Parsec.Token as Token
30	28	import Text.Parsec.Language (emptyDef)
31	29

119	117	ifP = do
120	118	reserved "if"
121	119	whiteSpace
122		condition <- condition
	120	cond <- condition
123	121	whiteSpace
124	122	thenBranch <- expr
125	123	whiteSpace
126	124	reserved "else"
127	125	whiteSpace
128	126	elseBranch <- expr
129		return $ If condition thenBranch elseBranch
	127	return $ If cond thenBranch elseBranch
130	128
131	129	repeatP :: Parser Expr
132	130	repeatP = do

136	134	whiteSpace
137	135	reserved "until"
138	136	whiteSpace
139		condition <- condition
140		return $ Repeat body condition
	137	cond <- condition
	138	return $ Repeat body cond
141	139
142	140	whileP :: Parser Expr
143	141	whileP = do
144	142	reserved "while"
145	143	whiteSpace
146		condition <- condition
	144	cond <- condition
147	145	whiteSpace
148	146	reserved "do"
149	147	whiteSpace
150	148	body <- expr
151		return $ If condition (Repeat body (compCond condition)) Skip
	149	return $ If cond (Repeat body $ compCond cond) Skip
152	150
153	151	expr :: Parser Expr
154	152	expr = sequence <\|> expr1

+4

-5

src/Language/UampirNexol/Type.hs less more

55	55	typeOf (IntLit _) = Right TByte
56	56
57	57	typeOf LDA_i =
58		let
59		Right t = tprog [] [A, Z, N]
60		in
61		Right $ TFunction TByte t
	58	case tprog [] [A, Z, N] of
	59	Right t -> Right $ TFunction TByte t
	60	other -> other
62	61	typeOf TAX = tprog [A] [X, Z, N]
63	62	typeOf TAY = tprog [A] [Y, Z, N]
64	63	typeOf CLC = tprog [] [C]

72	71	(Right (TFunction tIn tOut), Right tArg) ->
73	72	if tcompat tIn tArg then Right tOut else Left "Unacceptable argument type"
74	73	(Right other, Right _) ->
75		Left "Application of non-function"
	74	Left $ "Application of non-function " ++ show other
76	75	(Left e, Right _) ->
77	76	Left e
78	77	(Right _, Left e) ->

+0

-1

src/Main.hs less more

62	62	putStrLn $ show $ typ
63	63	["run", fileName] -> do
64	64	programText <- readFile fileName
65		programText <- readFile fileName
66	65	case parseProgram programText of
67	66	Left e -> do
68	67	abortWith $ "error: " ++ show e