Commit 7a3b3b1b25a6af0120992195aaea32a3418bad95 - SixtyPical

+5

-1

README.markdown less more

154	154	Falderal literate test suites. If you have Falderal installed, you can run
155	155	the tests with `./test.sh`.)
156	156
	157	* [Checking](https://github.com/catseye/SixtyPical/blob/master/doc/Checking.markdown)
	158	* [Analyzing](https://github.com/catseye/SixtyPical/blob/master/doc/Analyzing.markdown)
	159	* [Emitting](https://github.com/catseye/SixtyPical/blob/master/doc/Emitting.markdown)
	160	* [Instruction Support](https://github.com/catseye/SixtyPical/blob/master/doc/Instruction_Support.markdown)
	161
157	162	Internals
158	163	---------
159	164

205	210	TODO
206	211	----
207	212
208		* Initial values for reserved tables
209	213	* Character tables ("strings" to everybody else)
210	214	* Addressing modes — indexed mode on more instructions
211	215	* Rename and lift temporaries in nested blocks

+49

-0

doc/Checking.markdown less more

78	78	\| dec lives
79	79	\| }
80	80	= True
	81
	82	A byte table declared with `reserve` may be given an initial value consisting
	83	of a sequence of bytes.
	84
	85	\| reserve byte[4] table : (0 $40 $10 20)
	86	\| routine main {
	87	\| ldy #0
	88	\| lda table, y
	89	\| }
	90	\| routine died {
	91	\| sta table, y
	92	\| }
	93	= True
	94
	95	A byte table declared with `reserve` may be given an initial value consisting
	96	of a sequence of bytes represented as a character string.
	97
	98	\| reserve byte[4] table : "What"
	99	\| routine main {
	100	\| ldy #0
	101	\| lda table, y
	102	\| }
	103	\| routine died {
	104	\| sta table, y
	105	\| }
	106	= True
	107
	108	When a byte table declared with `reserve` is given an initial value consisting
	109	of a sequence of bytes, it must be the same length as the table is declared.
	110
	111	\| reserve byte[4] table : (0 $40 $10 20 60 70 90)
	112	\| routine main {
	113	\| ldy #0
	114	\| lda table, y
	115	\| }
	116	\| routine died {
	117	\| sta table, y
	118	\| }
	119	? initial table incorrect size
	120
	121	\| reserve byte[4] table : "Hello, world!"
	122	\| routine main {
	123	\| ldy #0
	124	\| lda table, y
	125	\| }
	126	\| routine died {
	127	\| sta table, y
	128	\| }
	129	? initial table incorrect size
81	130
82	131	An address may be declared with `locate`, which is like `.alias` in an
83	132	assembler, with the understanding that the value will be treated "like an

+15

-1

src/SixtyPical/Checker.hs less more

50	50	False -> error ("undeclared routine '" ++ routName ++ "'") -- acc + 1
51	51	checkInstr other acc = acc
52	52
	53	consistentInitialTableSizes p@(Program decls routines) =
	54	let
	55	inconsistentTableSizes = foldProgramDecls (checkDecl) 0 p
	56	in
	57	inconsistentTableSizes == 0
	58	where
	59	checkDecl (Reserve _ (ByteTable sz) []) acc = acc
	60	checkDecl (Reserve _ (ByteTable sz) vals) acc =
	61	case sz == (length vals) of
	62	True -> acc
	63	False -> acc + 1
	64	checkDecl _ acc = acc
	65
53	66	-- - - - - - -
54	67
55	68	checkAndTransformProgram :: Program -> Maybe Program

59	72	trueOrDie "duplicate location name" (noDuplicateDecls program) &&
60	73	trueOrDie "duplicate routine name" (noDuplicateRoutines program) &&
61	74	trueOrDie "undeclared routine" (noUseOfUndeclaredRoutines program) &&
62		trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program)
	75	trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program) &&
	76	trueOrDie "initial table incorrect size" (consistentInitialTableSizes program)
63	77	then
64	78	let
65	79	program' = numberProgramLoops program

+9

-3

src/SixtyPical/Emitter.hs less more

24	24	emitDecl p decl ++ "\n" ++ emitDecls p decls
25	25
26	26	emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
27		emitDecl p (Reserve name typ (Just val))
	27	emitDecl p (Reserve name typ [val])
28	28	\| typ == Byte = name ++ ": .byte " ++ (show val)
29	29	\| typ == Word = name ++ ": .word " ++ (show val)
30	30	\| typ == Vector = name ++ ": .word " ++ (show val)
31	31
32		emitDecl p (Reserve name (ByteTable size) Nothing) =
	32	emitDecl p (Reserve name (ByteTable size) []) =
33	33	".space " ++ name ++ " " ++ (show size)
34	34
35		emitDecl p (Reserve name typ Nothing)
	35	emitDecl p (Reserve name (ByteTable size) vals) =
	36	name ++ ": .byte " ++ (showList vals)
	37	where
	38	showList [] = ""
	39	showList (val:vals) = (show val) ++ " " ++ (showList vals)
	40
	41	emitDecl p (Reserve name typ [])
36	42	\| typ == Byte = ".space " ++ name ++ " 1"
37	43	\| typ == Word = ".space " ++ name ++ " 2"
38	44	\| typ == Vector = ".space " ++ name ++ " 2"

+10

-3

src/SixtyPical/Model.hs less more

46	46	-- -- -- -- program model -- -- -- --
47	47
48	48	data Decl = Assign LocationName StorageType Address -- .alias
49		\| Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte
	49	\| Reserve LocationName StorageType [DataValue] -- .word, .byte
50	50	\| External RoutineName Address
51	51	deriving (Show, Ord, Eq)
52	52

108	108	isLocationDecl _ = False
109	109
110	110	isInitializedDecl (Assign _ _ _) = False
111		isInitializedDecl (Reserve _ _ (Just _)) = True
112		isInitializedDecl (Reserve _ _ Nothing) = False
	111	isInitializedDecl (Reserve _ _ (v:vs)) = True
	112	isInitializedDecl (Reserve _ _ []) = False
113	113
114	114	declaredLocationNames (Program decls _) =
115	115	map (getDeclLocationName) (filter (isLocationDecl) decls)

176	176	foldProgramRoutines f a (Program decls routs) =
177	177	foldRoutines f a routs
178	178
	179	foldDecls :: (Decl -> a -> a) -> a -> [Decl] -> a
	180	foldDecls = foldr
	181
	182	foldProgramDecls :: (Decl -> a -> a) -> a -> Program -> a
	183	foldProgramDecls f a (Program decls routs) =
	184	foldDecls f a decls
	185
179	186	--
180	187
181	188	lookupDecl (Program decls _) name =

+33

-14

src/SixtyPical/Parser.hs less more

9	9
10	10	{-
11	11
12		Toplevel := {Decl} {Routine}.
13		Decl := "reserve" StorageType LocationName [":" Literal]
14		\| "assign" StorageType LocationName Literal
15		\| "external" RoutineName Address.
16		StorageType := "byte" ["[" Literal "]"] \| "word" \| "vector".
17		Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18		Block := "{" {Decl} {Command} "}".
19		Command := "if" Branch Block "else" Block
	12	Toplevel ::= {Decl} {Routine}.
	13	Decl ::= "reserve" StorageType LocationName [":" InitialValue]
	14	\| "assign" StorageType LocationName Literal
	15	\| "external" RoutineName Address.
	16	InitialValue ::= Literal \| StringLiteral \| "(" {Literal} ")".
	17	StorageType ::= "byte" ["[" Literal "]"] \| "word" \| "vector".
	18	Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
	19	Block ::= "{" {Decl} {Command} "}".
	20	Command ::= "if" Branch Block "else" Block
20	21	\| "lda" (LocationName \| Immediate)
21	22	\| "ldx" (LocationName \| Immediate)
22	23	\| "ldy" (LocationName \| Immediate)

30	31	\| "jmp" LocationName
31	32	\| "jsr" RoutineName
32	33	\| "nop".
33		Branch := "bcc" \| "bcs" \| "beq" \| "bmi" \| "bne" \| "bpl" \| "bvc" \| "bvs".
	34	Branch ::= "bcc" \| "bcs" \| "beq" \| "bmi" \| "bne" \| "bpl" \| "bvc" \| "bvs".
34	35
35	36	-}
36	37

67	68	nspaces
68	69	sz <- storage_type
69	70	name <- location_name
70		value <- option Nothing (do{ string ":";
71		nspaces;
72		x <- literal_data_value;
73		return $ Just x })
	71	value <- option [] (do{ string ":";
	72	nspaces;
	73	x <- initial_value;
	74	return x })
74	75	return $ Reserve name sz value
75	76
76	77	assign :: Parser Decl

110	111	storage_type :: Parser StorageType
111	112	storage_type = (try $ byte_table) <\|> (storage "byte" Byte) <\|>
112	113	(storage "word" Word) <\|> (storage "vector" Vector)
	114
	115	initial_value :: Parser [DataValue]
	116	initial_value =
	117	data_value_list <\|> single_literal_data_value
	118	where
	119	single_literal_data_value = do
	120	a <- literal_data_value
	121	return [a]
	122
	123	data_value_list = do
	124	string "("
	125	nspaces
	126	a <- many literal_data_value
	127	string ")"
	128	nspaces
	129	return a
	130
	131	-- -- --
113	132
114	133	routine :: Parser Routine
115	134	routine = do

624	643
625	644	decimal_literal :: Parser Int
626	645	decimal_literal = do
627		digits <- many digit
	646	digits <- many1 digit
628	647	nspaces
629	648	return $ read digits
630	649

+3

-3

src/SixtyPical/Transformer.hs less more

160	160	((Routine name outputs block'):rest)
161	161
162	162	foldDeclsRenaming [] id block = (id, block)
163		foldDeclsRenaming ((Reserve name typ Nothing):decls) id block =
	163	foldDeclsRenaming ((Reserve name typ []):decls) id block =
164	164	let
165	165	newName = "_temp_" ++ (show id)
166	166	id' = id + 1

175	175	substDeclName n1 n2 (Block decls instrs) =
176	176	Block (map (s) decls) instrs
177	177	where
178		s d@(Reserve name typ Nothing)
179		\| name == n1 = (Reserve n2 typ Nothing)
	178	s d@(Reserve name typ [])
	179	\| name == n1 = (Reserve n2 typ [])
180	180	\| otherwise = d
181	181
182	182