-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathTypeChecker.hs
More file actions
3240 lines (2984 loc) · 470 KB
/
TypeChecker.hs
File metadata and controls
3240 lines (2984 loc) · 470 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
-- Progetto Linguaggi e Compilatori parte 3 - UNIUD 2021
-- Andrea Mansi & Christian Cagnoni
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module TypeChecker where
import Type
import LexProgettoPar (Posn(..))
import AbsProgettoPar as Abs
import Data.Map
import Prelude
import Data.List
import PrintProgettoPar
-------------------------------------------------------------------------------------
--- ENVIRONMENT DATA TYPES ----------------------------------------------------------
-------------------------------------------------------------------------------------
type Env = Map Prelude.String [EnvEntry]
-- chiave, valore
data EnvEntry
= Variable {varType::Type, varPosition::LexProgettoPar.Posn, varMode::Prelude.String, canOverride::Prelude.Bool, size::[Prelude.Integer],checked::Prelude.Bool}
| Function {funType::Type, funPosition::LexProgettoPar.Posn, funParameters::[Parameter], canOverride::Prelude.Bool}
data Parameter
= Parameter {paramType::Type, paramPosition::LexProgettoPar.Posn, paramMode::Prelude.String, identifier::Prelude.String}
deriving(Eq, Ord)
data TCheckResult
= TResult {environment::Env, t_type::Type, t_position::LexProgettoPar.Posn}
| TError {errors::[Prelude.String]}
-------------------------------------------------------------------------------------------------
--- SHOW ISTANCES FOR ENV DATA TYPES ------------------------------------------------------------
-------------------------------------------------------------------------------------------------
-- Starting env: it includes the 8 pre-defined functions/procedures required
startEnv = fromList [("readChar",[Function {funType = (B_type Type_Char), funPosition = (Pn 0 0 0), funParameters = [], canOverride = False}]),
("readInt",[Function {funType = (B_type Type_Integer), funPosition = (Pn 0 0 0), funParameters = [], canOverride = False}]),
("readReal",[Function {funType = (B_type Type_Real), funPosition = (Pn 0 0 0), funParameters = [], canOverride = False}]),
("readString",[Function {funType = (B_type Type_String), funPosition = (Pn 0 0 0), funParameters = [], canOverride = False}]),
("writeChar",[Function {funType = (B_type Type_Void), funPosition = (Pn 0 0 0), funParameters = [TypeChecker.Parameter {paramType = (B_type Type_Char), paramPosition = (Pn 0 0 0), paramMode = "_mode_", identifier = "input"}], canOverride = False}]),
("writeInt",[Function {funType = (B_type Type_Void), funPosition = (Pn 0 0 0), funParameters = [TypeChecker.Parameter {paramType = (B_type Type_Integer), paramPosition = (Pn 0 0 0), paramMode = "_mode_", identifier = "input"}], canOverride = False}]),
("writeReal",[Function {funType = (B_type Type_Void), funPosition = (Pn 0 0 0), funParameters = [TypeChecker.Parameter {paramType = (B_type Type_Real), paramPosition = (Pn 0 0 0), paramMode = "_mode_", identifier = "input"}], canOverride = False}]),
("writeString",[Function {funType = (B_type Type_Void), funPosition = (Pn 0 0 0), funParameters = [TypeChecker.Parameter {paramType = (B_type Type_String), paramPosition = (Pn 0 0 0), paramMode = "_mode_", identifier = "input"}], canOverride = False}])]
instance Show EnvEntry where
show entry = case entry of
TypeChecker.Variable ty pos varMode canOverride s checked -> "EnvEntry: [" ++ "var:" ++ show ty ++ "|" ++ show pos ++ "|mode:" ++ show varMode ++ "|canOverride:" ++ show canOverride ++ show s++show checked++"]"
TypeChecker.Function ty pos params canOverride -> "EnvEntry: [" ++ "fun:" ++ show ty ++ "|" ++ show pos ++ "|params:" ++ show params ++ "|canOverride:" ++ show canOverride ++ "]"
instance Show Parameter where
show param = case param of
TypeChecker.Parameter ty pos mode id -> "(" ++ show id ++ ":" ++ show ty ++ "|" ++ show pos ++ "|mode:" ++ show mode ++ ")"
instance Show TCheckResult where
show tres = case tres of
TypeChecker.TResult env ty pos -> show env ++ "|" ++ show ty ++ "|" ++ show pos
TypeChecker.TError errs -> "Errors: " ++ show errs
--------------------------------------------------------------------------------------------------
--- GENERIC FUNCTIONS FOR TYPE-CHECKING ---------------------------------------------------------
--------------------------------------------------------------------------------------------------
-- Checks if type A is compatible with type B
-- Semantic: can A be where type B is required?
-- Examples: int int -> true
-- int real -> true (because 1 can be seen as 1.0)
-- real int -> false
checkCompatibility :: TCheckResult -> TCheckResult -> Bool
checkCompatibility (TError _) _ = False
checkCompatibility _ (TError _) = False
checkCompatibility (TResult env t pos) (TResult envC tC posC) = case t of
B_type Type_Void -> case tC of
B_type Type_Void -> True
_ -> False
B_type Type_Integer -> case tC of
B_type Type_Integer -> True
B_type Type_Real -> True -- int can be put where real is required
_ -> False
B_type Type_Real -> case tC of
B_type Type_Real -> True
_ -> False
B_type Type_Boolean -> case tC of
B_type Type_Boolean -> True
B_type Type_Integer -> True -- boolean can be put where int is required
B_type Type_Real -> True
_ -> False
B_type Type_Char -> case tC of
B_type Type_Char -> True
_ -> False
B_type Type_String -> case tC of
B_type Type_String -> True
_ -> False
Pointer t depth -> case tC of
Pointer ts depths -> case t of
B_type Type_Integer -> if (ts==(B_type Type_Real) || ts==(B_type Type_Integer)) && depth==depths then True else False
_ -> if t==ts && depth==depths then True else False
_ -> False
Array t dim -> case tC of
Array ts dims -> case t of
B_type Type_Integer -> if (ts==(B_type Type_Real) || ts==(B_type Type_Integer) || ts==(Pointer (B_type Type_Real) 1) || ts==(Pointer (B_type Type_Integer) 1)) then True else False
Pointer pt pl -> if (ts == (Pointer pt (pl+1))) then True else False
_ -> if ((checkCompatibility (TResult env t pos) (TResult env ts pos)) || (ts==(Pointer t 1))) then True else False
_ -> False
-- Checks if type A is compatible with type B during explicit casting operations
-- Semantic: can A be casted to type B is required?
checkCastCompatibility :: TCheckResult -> TCheckResult -> Bool
checkCastCompatibility (TResult env t pos) (TResult envs ts poss) = case t of
B_type Type_Integer -> case ts of
B_type Type_Boolean -> False
Array _ _ -> False
Pointer _ _ -> False
_ -> True
B_type Type_Real -> case ts of
B_type Type_Boolean -> False
Array _ _ -> False
Pointer _ _ -> False
_ -> True
B_type Type_Char -> case ts of
B_type Type_Boolean -> False
Array _ _ -> False
Pointer _ _ -> False
_ -> True
B_type Type_String -> case ts of
B_type Type_Boolean -> False
Array _ _ -> False
Pointer _ _ -> False
_ -> True
B_type Type_Boolean -> case ts of
B_type Type_Integer -> True
B_type Type_Real -> True
B_type Type_Boolean -> True
_ -> False
Array _ _ -> False
Pointer _ _ -> False
-- Given Type A and B (from TCheckResults) it returns the one which is more generic.
-- Semantic: Which type is more generic; A or B?
-- Examples: int int -> int
-- int real -> real
-- real int -> real
returnSuperType :: TCheckResult -> TCheckResult -> TCheckResult
returnSuperType (TError errs) _ = (TError errs)
returnSuperType _ (TError errs) = (TError errs)
returnSuperType (TResult env t pos) (TResult envC tC posC) = case t of
B_type Type_Void -> case tC of
B_type Type_Void -> (TResult env t pos)
B_type Type_Integer -> case tC of
B_type Type_Integer -> (TResult env t pos)
B_type Type_Real -> (TResult envC tC posC) -- real > int
B_type Type_Boolean -> (TResult env t pos) -- int > boolean
B_type Type_Real -> case tC of
B_type Type_Real -> (TResult env t pos)
B_type Type_Integer -> (TResult env t pos) -- real > int
B_type Type_Boolean -> (TResult env t posC) -- int > boolean
B_type Type_Boolean -> case tC of
B_type Type_Integer -> (TResult env tC posC) -- int > boolean
B_type Type_Real -> (TResult env tC posC) -- int > boolean
B_type Type_Boolean -> (TResult env t pos)
B_type Type_Char -> case tC of
B_type Type_Char -> (TResult env t pos)
B_type Type_String -> case tC of
B_type Type_String -> (TResult env t pos)
Pointer tp depth -> case tC of
Pointer ts depths -> (TResult env t pos)
_ -> TResult env tC pos
---------------------------------------------------------------------------------------------------
--- ENV DATA TYPES FUNCTIONS ----------------------------------------------------------------------
---------------------------------------------------------------------------------------------------
-- Merge two given TErrors
mergeErrors :: TCheckResult -> TCheckResult -> TCheckResult
mergeErrors (TError e1) (TError e2) = TError (e1++e2)
mergeErrors (TError e1) _ = TError e1
mergeErrors _ (TError e2) = TError e2
-- Returns the type of an EnvEntry of the Environment -> Variable or Function entry
getTypeEnvEntry :: [EnvEntry] -> Type
getTypeEnvEntry [] = B_type Type_Void
getTypeEnvEntry (x:xs) = case x of
(Variable t pos mode canOverride s check) -> t
(Function t pos parameters canOverride) -> t
-- Called when an environment update is needed.
-- It creates the right new env-entry when called with different types of statements.
-- Example: if called with an "Abs node of type funciton statements" it creates a new env-entry for that function,
-- this is done by calling the required functions for getting the required infos for the entry: id, type, etc.
updateEnv :: (Abs.STATEMENTS Posn) -> Env -> Env
updateEnv node@(Abs.ListStatements pos stat stats) env = case stat of
-- Variables
Abs.VariableDeclarationStatement pos varType vardec -> let ty = getVarType vardec in -- getting variable type (int etc.)
let varMode = getVarMode varType in -- getting variable mode (const etc.)
let ids = (getVariableDeclStatNames vardec) in -- getting id or ids of declared variables
let posns = getVariableDeclStatPos vardec in
let sizes = getListDimFromType (vardecid_typepart (vardeclist_vardecid vardec)) (vardecid_initpart (vardeclist_vardecid vardec)) env in
let checker = getCheck vardec in
updateEnvFromListOfVarIds ids env posns varMode ty sizes checker -- updating env for each declared var. (override check is done inside updateEnvFromListOfVarIds)
-- Functions and Procedures
Abs.ProcedureStatement posf id params stats -> let parameters = getParamList params in
let fid = getIdFromIdent id in
let fpos = getPosFromIdent id in
if (checkIfCanOverride [fid] env "func") -- check if the func can be overrided (treu if defined inside a new block)
then insertWith (++) fid [Function (B_type Type_Void) fpos parameters False] env
else env -- it was already defined
Abs.FunctionStatement posf id params ty stats -> let parameters = getParamList params in
let fty = getTypeFromTypeExpF ty in
let fid = getIdFromIdent id in
let fpos = getPosFromIdent id in
if (checkIfCanOverride [fid] env "func") -- check if the func can be overrided (true if defined inside a new block)
then insertWith (++) fid [Function fty fpos parameters False] env
else env -- it was already defined
-- generic case
_ -> env
updateEnv node@(Abs.EmptyStatement pos) env = env
-- Update the env for Conditional if-then-else-statement
updateEnvCondStat :: (Abs.CONDITIONALSTATE Posn) -> Env -> Env
updateEnvCondStat (Abs.ConditionalStatementCtrlThen pos ctrlState state elseState) env = case ctrlState of
Abs.CtrlDecStateVar cpos id typepart exp -> insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "var" False [] False] env
Abs.CtrlDecStateConst cpos id typepart exp -> insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "const" False [] False] env
updateEnvCondStat (Abs.ConditionalStatementCtrlWThen pos ctrlState b elseState) env = case ctrlState of
Abs.CtrlDecStateVar cpos id typepart exp -> insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "var" False [] False] env
Abs.CtrlDecStateConst cpos id typepart exp -> insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "const" False [] False] env
updateEnvCondStat _ env = env
-- Update the env for while-statement
updateEnvWhileStat :: (Abs.WHILESTATEMENT Posn) -> Env -> Env
updateEnvWhileStat (Abs.WhileStateCtrlDo pos ctrl state) env = case ctrl of
Abs.CtrlDecStateVar cpos id typepart exp -> let newEnv = insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "var" False [] False] env in insertWith (++) "while" [] newEnv
Abs.CtrlDecStateConst cpos id typepart exp -> let newEnv = insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "const" False [] False] env in insertWith (++) "while" [] newEnv
updateEnvWhileStat (Abs.WhileStateCtrlWDo pos ctrl b) env = case ctrl of
Abs.CtrlDecStateVar cpos id typepart exp -> let newEnv = insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "var" False [] False] env in insertWith (++) "while" [] newEnv
Abs.CtrlDecStateConst cpos id typepart exp -> let newEnv = insertWith (++) (getIdFromIdent id) [Variable (getTypePart typepart) (getPosFromIdent id) "const" False [] False] env in insertWith (++) "while" [] newEnv
updateEnvWhileStat (Abs.WhileStateSimpleDo pos expr state) env = insertWith (++) "while" [] env
updateEnvWhileStat (Abs.WhileStateSimpleWDo pos expr b) env = insertWith (++) "while" [] env
-- Update the env for for-statement
updateEnvForStat :: Abs.FORSTATEMENT Posn -> Env -> Env
updateEnvForStat (Abs.ForStateIndexDo pos indexVar@(Abs.IndexVarDeclaration posv ident@(Abs.Ident id posi)) rangeexp state) env = let newEnv = insertWith (++) id [Variable (B_type Type_Integer) posi "param" False [] False] env in insertWith (++) "for" [] newEnv
updateEnvForStat (Abs.ForStateIndexWDo pos indexVar@(Abs.IndexVarDeclaration posv ident@(Abs.Ident id posi)) rangeexp state) env = let newEnv = insertWith (++) id [Variable (B_type Type_Integer) posi "param" False [] False] env in insertWith (++) "for" [] newEnv
updateEnvForStat _ env = insertWith (++) "for" [] env
-- Update the env for do-while-statement
updateEnvDoWhileStat :: Abs.DOSTATEMENT Posn -> Env -> Env
updateEnvDoWhileStat (Abs.DoWhileState _ _ _) env = insertWith (++) "dowhile" [] env
-- Given a list of Params, it creates an envEntry of type param for each of them
createEnvEntryForParams :: [TypeChecker.Parameter] -> Env -> Env
createEnvEntryForParams ((TypeChecker.Parameter ty pos mode id):xs) env = createEnvEntryForParams xs (insertWith (++) id [Variable ty pos mode False [] False] env)
createEnvEntryForParams [] env = env
-- Given a list of var IDS and an Env, it update that env adding the variable enventries for each var id.
updateEnvFromListOfVarIds :: [Prelude.String] -> Env -> [Posn ] -> Prelude.String -> Type -> [Prelude.Integer] -> Prelude.Bool -> Env
updateEnvFromListOfVarIds [] env [] varMode ty s check = env
updateEnvFromListOfVarIds (x:xs) env (p:ps) varMode ty s check = case Data.Map.lookup x env of
Just (entry:entries) -> case findEntryOfType (entry:entries) "var" of
[] -> updateEnvFromListOfVarIds xs (insertWith (++) x [Variable ty p varMode False s check] env) ps varMode ty s check
((Variable typ posv varMv override sv check):ys) -> if override
then updateEnvFromListOfVarIds xs (insertWith (++) x [Variable ty p varMode False s check] env) ps varMode ty s check
else updateEnvFromListOfVarIds xs env ps varMode ty s check
Nothing -> updateEnvFromListOfVarIds xs (insertWith (++) x [Variable ty p varMode False s check] env) ps varMode ty s check
-- Given an Env set to TRUE in CanOverride for each variable and func!
-- Used at the beginning of a new block (for example, after declaring a function, inside it is possible to override previous variable declaration (those outside))
updateIfCanOverride :: Env -> Env
updateIfCanOverride env = Data.Map.fromList (updateIfCanOverride_ (Data.Map.toList env))
-- Implementation of the previous function
updateIfCanOverride_ :: [(Prelude.String, [EnvEntry])] -> [(Prelude.String, [EnvEntry])]
updateIfCanOverride_ ((str,entry:entries):xs) = case entry of
Variable ty pos varMode canOverride s check-> [(str,(Variable ty pos varMode True s check):entries)] ++ updateIfCanOverride_ xs
Function ty pos param canOverride -> [(str,(Function ty pos param True):entries)] ++ updateIfCanOverride_ xs
updateIfCanOverride_ ((str,[]):xs) = ((str,[]):xs)
updateIfCanOverride_ [] = []
-- Given a list of variable or functions ids, returns true if they can be overrided (false if at least one of them CANNOT be overrided)
-- The string ("var" or "func") specifies if vars or funcs are checked!
checkIfCanOverride :: [Prelude.String] -> Env -> Prelude.String -> Bool
checkIfCanOverride (x:xs) env t = case Data.Map.lookup x env of
Just (entry:entries) -> case findEntryOfType (entry:entries) t of
[] -> True && checkIfCanOverride xs env t
((Variable _ _ _ override _ _):ys) -> override && checkIfCanOverride xs env t
((Function _ _ _ override):ys) -> override && checkIfCanOverride xs env t
Nothing -> True && (checkIfCanOverride xs env t)
checkIfCanOverride [] env _ = True
-- Check if function can be overrided
checkFuncOverride :: Abs.Ident Posn -> Env -> TCheckResult
checkFuncOverride (Abs.Ident id pos) env = if (checkIfCanOverride [id] env "func")
then TResult env (B_type Type_Void) pos
else TError ["Cannot redefine function " ++ id ++ "! Position: " ++ show pos]
------------------------------------------------------------------------------------------------------
--- GENERIC FUNCTIONS --------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------------
isArray :: Abs.TYPEPART a -> Prelude.Bool
isArray (Abs.TypePart _ typeexp) = isArray_ typeexp
isArray_ :: Abs.TYPEEXPRESSION a -> Prelude.Bool
isArray_ (Abs.TypeExpressionArraySimple _ _ typeexpf) = True
isArray_ (Abs.TypeExpressionArray _ _ typeexpf) = True
isArray_ (Abs.TypeExpressionPointerOfArray _ typeexpf _) = isArray__ typeexpf
isArray_ (Abs.TypeExpressionPointer _ prim _) = isArrayPrim prim
isArray_ (Abs.TypeExpression _ prim ) = isArrayPrim prim
isArray__ :: Abs.TYPEEXPRESSIONFUNC a -> Prelude.Bool
isArray__ (Abs.TypeExpressionArrayOfPointer _ typeexpf) = True
isArray__ (Abs.TypeExpressionFunction _ typeexp) = isArray_ typeexp
isArrayPrim :: Abs.PRIMITIVETYPE a -> Prelude.Bool
isArrayPrim (Abs.TypeArray _ _) = True
isArrayPrim _ = False
isArrayOfFunc :: Abs.TYPEPART a -> Prelude.Bool
isArrayOfFunc (Abs.TypePart _ typeexp) = isArrayOfFunc_ typeexp
isArrayOfFunc_ :: Abs.TYPEEXPRESSION a -> Prelude.Bool
isArrayOfFunc_ (Abs.TypeExpressionArraySimple _ _ typeexpf) = isArrayOfFunc__ typeexpf
isArrayOfFunc_ (Abs.TypeExpressionArray _ _ typeexpf) = isArrayOfFunc__ typeexpf
isArrayOfFunc_ (Abs.TypeExpressionPointerOfArray _ typeexpf _) = isArrayOfFunc__ typeexpf
isArrayOfFunc_ _ = False
isArrayOfFunc__ :: Abs.TYPEEXPRESSIONFUNC a -> Prelude.Bool
isArrayOfFunc__ (Abs.TypeExpressionArrayOfPointer _ typeexpf) = True
isArrayOfFunc__ (Abs.TypeExpressionFunction _ typeexp) = isArrayOfFunc_ typeexp
-- Given an Ident node of the ABS, returns the string of the identifier
getIdFromIdent :: Abs.Ident Posn -> Prelude.String
getIdFromIdent (Abs.Ident s _) = s
-- Given an Ident node of the ABS, returns the position (Posn)
getPosFromIdent :: Abs.Ident Posn -> Posn
getPosFromIdent (Abs.Ident s pos) = pos
-- Given a List of ids, returns the string with the list of identifier
getIdsFromIdentList :: Abs.IDENTLIST Posn -> Prelude.String
getIdsFromIdentList node@(Abs.IdentifierList pos ident@(Abs.Ident id posI) idents) = id ++ "," ++ getIdsFromIdentList idents
getIdsFromIdentList node@(Abs.IdentifierSingle pos ident@(Abs.Ident id posI)) = id
-- Given a Parameters node of the ABS, returns a list of Parameters (constructor for the ENV)
getParamList :: Abs.PARAMETERS Posn -> [Parameter]
getParamList (Abs.ParameterList pos param params) = let p = buildParam param "val" in [p] ++ getParamList params
getParamList (Abs.ParameterListValRes pos param params) = let p = buildParam param "valres" in [p] ++ getParamList params
getParamList (Abs.ParameterListSingle pos param) = let p = buildParam param "val" in [p]
getParamList (Abs.ParameterListSingleValRes pos param) = let p = buildParam param "valres" in [p]
getParamList (Abs.ParameterListEmpty pos) = []
-- Given a Parameter node of the ABS, return a single built Parameter data type (constructor for the ENV)
buildParam :: Abs.PARAMETER Posn -> Prelude.String -> Parameter
buildParam (Abs.Parameter pos id ty) mode = (TypeChecker.Parameter (getTypeFromTypeExpF ty) (getPosFromIdent id) mode (getIdFromIdent id))
-- Given a list of parameters (from a func env entry) returns the list of types of each parameter
getTypeListFromFuncParams :: [Parameter] -> [Type]
getTypeListFromFuncParams ((TypeChecker.Parameter ty _ _ _):xs) = [ty] ++ getTypeListFromFuncParams xs
getTypeListFromFuncParams [] = []
-- Given a parameter list, return the list of ids
getListOfIdsFromParamList :: [TypeChecker.Parameter] -> [Prelude.String]
getListOfIdsFromParamList ((TypeChecker.Parameter ty pos mode id):xs) = [id] ++ getListOfIdsFromParamList xs
getListOfIdsFromParamList [] = []
-- Return true if there is a dups in the list (of parameters ids)
checkDuplicatedParametersInFunDecl :: [Prelude.String] -> Prelude.Bool
checkDuplicatedParametersInFunDecl (x:xs) = isInList x xs || checkDuplicatedParametersInFunDecl xs
checkDuplicatedParametersInFunDecl [] = False
-- Return true if the given string is in the given string list
isInList :: Prelude.String -> [Prelude.String] -> Prelude.Bool
isInList id (x:xs) = id == x || isInList id xs
isInList id [] = False
-- Pretty printer of the array initialization part (used in errors strings)
showInit :: Abs.INITPART Posn -> Prelude.String
showInit (Abs.InitializzationPartArray _ arrayInit) = let p = Pn 0 0 0 in
getInitPart (PrintProgettoPar.printTree (Abs.StartCode p (Abs.ListStatements p
(Abs.VariableDeclarationStatement p (Abs.VariableTypeVar p) (Abs.VariableDeclarationSingle p (Abs.VariableDeclaration p (Abs.IdentifierSingle p (Abs.Ident "" p)) (Abs.TypePart p (Abs.TypeExpression p (Abs.PrimitiveTypeVoid p))) (Abs.InitializzationPartArray p arrayInit))))
(Abs.EmptyStatement p)
)
)
) [] []
showInit _ = ""
getCheck :: Abs.VARDECLIST a -> Prelude.Bool
getCheck (Abs.VariableDeclarationSingle _ vardecid) = case vardecid of
Abs.VariableDeclaration {} -> False
_ -> True
getListDimFromType :: Abs.TYPEPART a -> Abs.INITPART a -> Env -> [Prelude.Integer]
getListDimFromType (Abs.TypePart _ typeexp) init env = getListDimFromTypeExp typeexp init env
getListDimFromExpF :: Abs.TYPEEXPRESSIONFUNC a -> Abs.INITPART a -> Env -> [Prelude.Integer]
getListDimFromExpF (Abs.TypeExpressionArrayOfPointer _ _) init env = []
getListDimFromExpF (Abs.TypeExpressionFunction _ typeexp) init env = getListDimFromTypeExp typeexp init env
getListDimFromTypeExp :: Abs.TYPEEXPRESSION a -> Abs.INITPART a -> Env-> [Prelude.Integer]
getListDimFromTypeExp (Abs.TypeExpressionArraySimple _ range expf) init env = getListDimFromRange range ++ getListDimFromExpF expf init env
getListDimFromTypeExp (Abs.TypeExpressionArray _ range expf) init env = getListDimFromRange range ++ getListDimFromExpF expf init env
getListDimFromTypeExp (Abs.TypeExpressionPointer _ prim _) init env = getListDimFromPrimitive prim init env
getListDimFromTypeExp (Abs.TypeExpressionPointerOfArray _ typeexpf _) init env = getListDimFromExpF typeexpf init env
getListDimFromTypeExp (Abs.TypeExpression _ prim) init env = getListDimFromPrimitive prim init env
getListDimFromPrimitive :: Abs.PRIMITIVETYPE a -> Abs.INITPART a -> Env -> [Prelude.Integer]
getListDimFromPrimitive (Abs.TypeArray _ prim) init env = case prim of
Abs.TypeArray _ primp -> case init of
Abs.InitializzationPartEmpty _ -> [1] ++ getListDimFromPrimitive prim init env
Abs.InitializzationPart _ exp -> []
Abs.InitializzationPartArray _ arrayInit -> getArrayInitDim arrayInit
_ -> case init of
Abs.InitializzationPartEmpty _ -> [1]
Abs.InitializzationPart _ exp -> getExpDim exp env
Abs.InitializzationPartArray _ arrayInit -> getArrayInitDim arrayInit
getListDimFromPrimitive _ init env = []
getArrayInitDim :: Abs.ARRAYINIT a -> [Prelude.Integer]
getArrayInitDim (Abs.ArrayInitElems _ listelem) = [countListElem listelem]
getArrayInitDim (Abs.ArrayInitSingle _ arrayInit) = [1]++getArrayInitDim arrayInit
getArrayInitDim node@(Abs.ArrayInit _ arrayInit1 arrayInit2) = let dim = [countListInit node] in
dim ++ getArrayInitDim arrayInit1 ++ getArrayInitDim arrayInit2
countListElem :: Abs.LISTELEMENTARRAY a -> Prelude.Integer
countListElem (Abs.ListElementOfArray _ exp) = 1
countListElem (Abs.ListElementsOfArray _ exp listEl) = 1 + countListElem listEl
getExpDim :: Abs.EXPRESSION a -> Env -> [Prelude.Integer]
getExpDim (Abs.ExpressionBracket _ exp) env = getExpDim exp env
getExpDim (Abs.ExpressionIdent _ ident@(Abs.Ident id _) index) env = case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "var" of
[] -> [1]
[Variable (Array t dim) _ _ _ s check] -> case index of
Abs.ArrayIndexElementEmpty _ -> s
Abs.ArrayIndexElement _ exp -> [head s]
Abs.ArrayIndexElements _ exps exp -> getNElemsDim s (1+(countSquares exps))
_ -> [1]
Nothing -> [1]
getNElemsDim :: [Prelude.Integer] -> Prelude.Integer -> [Prelude.Integer]
getNElemsDim [] n = []
getNElemsDim (x:xs) 0 = (x:xs)
getNElemsDim (x:xs) n = getNElemsDim xs (n-1)
getListDimFromRange :: Abs.RANGEEXP a -> [Prelude.Integer]
getListDimFromRange (Abs.RangeExpression _ exp1 exp2 range) = case exp1 of
Abs.ExpressionInteger _ (Abs.Integer val _) -> case exp2 of
Abs.ExpressionInteger _ (Abs.Integer vals _) -> let rangeDim = getListDimFromRange range in
if rangeDim==[] then [] else [((vals - val)+1)] ++ rangeDim
_ -> []
_ -> []
getListDimFromRange (Abs.RangeExpressionSingle _ exp1 exp2) = case exp1 of
Abs.ExpressionInteger _ (Abs.Integer val _) -> case exp2 of
Abs.ExpressionInteger _ (Abs.Integer vals _) -> [(vals - val)+1]
_ -> []
_ -> []
getDimFromType :: Abs.TYPEPART a -> Prelude.Integer
getDimFromType (Abs.TypePart _ typeexp) = getDimFromTypeExp typeexp
getDimFromExpF :: Abs.TYPEEXPRESSIONFUNC a -> Prelude.Integer
getDimFromExpF (Abs.TypeExpressionArrayOfPointer _ _) = 0
getDimFromExpF (Abs.TypeExpressionFunction _ typeexp) = getDimFromTypeExp typeexp
getDimFromTypeExp :: Abs.TYPEEXPRESSION a -> Prelude.Integer
getDimFromTypeExp (Abs.TypeExpressionArraySimple _ range expf) = let next = getDimFromExpF expf in
if next==0
then getDimFromRange range
else getDimFromRange range * getDimFromExpF expf
getDimFromTypeExp (Abs.TypeExpressionArray _ range expf) = let next = getDimFromExpF expf in
if next==0
then getDimFromRange range
else getDimFromRange range * getDimFromExpF expf
getDimFromTypeExp _ = 0
getDimFromRange :: Abs.RANGEEXP a -> Prelude.Integer
getDimFromRange (Abs.RangeExpression _ exp1 exp2 range) = case exp1 of
Abs.ExpressionInteger _ (Abs.Integer val _) -> case exp2 of
Abs.ExpressionInteger _ (Abs.Integer vals _) -> let rangeDim = getDimFromRange range in
if rangeDim==0 then 0 else ((vals - val)+1) * rangeDim
_ -> 0
_ -> 0
getDimFromRange (Abs.RangeExpressionSingle _ exp1 exp2) = case exp1 of
Abs.ExpressionInteger _ (Abs.Integer val _) -> case exp2 of
Abs.ExpressionInteger _ (Abs.Integer vals _) -> (vals - val)+1
_ -> 0
_ -> 0
getDimFromInit :: Abs.INITPART a -> Env -> Prelude.Integer
getDimFromInit (Abs.InitializzationPartArray _ arrayInit) env = getDimFromArrayInit arrayInit env
getDimFromInit (Abs.InitializzationPart _ exp) env = getDimFromInit_ exp env
getDimFromInit _ env = 0
getNElems :: [Prelude.Integer] -> Prelude.Integer -> Prelude.Integer
getNElems (s:sizes) 0 = 1
getNElems [] 0 = 1
getNElems (s:sizes) d = s*(getNElems sizes (d-1))
getDimFromInit_ :: Abs.EXPRESSION a -> Env -> Prelude.Integer
getDimFromInit_ (Abs.ExpressionIdent _ (Abs.Ident id _) index) env = case index of
Abs.ArrayIndexElementEmpty _ -> case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "var" of
[] -> 0
[Variable tv@(Array t dim) posv modev override sv check] -> getNElems sv (toInteger (length sv))
[Variable tv posv modev override sv check] -> 0
Nothing -> 0
Abs.ArrayIndexElement _ exp -> case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "var" of
[] -> 0
[Variable tv@(Array t dim) posv modev override sv check] -> if (toInteger (length sv))==1
then 0
else getNElems sv 1
[Variable tv posv modev override sv check] -> 0
Nothing -> 0
Abs.ArrayIndexElements _ exps exp -> case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "var" of
[] -> 0
[Variable tv@(Array t dim) posv modev override sv check] -> if (1+(countSquares exps)) == (toInteger (length sv))
then 0
else getNElems sv (1+(countSquares exps))
[Variable tv posv modev override sv check] -> 0
Nothing -> 0
getDimFromInit_ _ env = 0
countSquares :: Abs.ARRAYINDEXELEMENTS a -> Prelude.Integer
countSquares (Abs.ArrayIndexElementsMultiple _ exps exp) = 1 + countSquares exps
countSquares (Abs.ArrayIndexElementsSingle _ exp) = 1
getDimFromArrayInit :: Abs.ARRAYINIT a -> Env -> Prelude.Integer
getDimFromArrayInit (Abs.ArrayInitElems _ listelement) env = getDimFromListElement listelement env
getDimFromArrayInit (Abs.ArrayInitSingle _ arrayInit) env = getDimFromArrayInit arrayInit env
getDimFromArrayInit (Abs.ArrayInit _ arrayInit1 arrayInit2) env = getDimFromArrayInit arrayInit1 env + getDimFromArrayInit arrayInit2 env
getDimFromListElement :: Abs.LISTELEMENTARRAY a -> Env -> Prelude.Integer
getDimFromListElement (Abs.ListElementsOfArray _ exp listelement) env = let trueDim = getDimFromInit_ exp env in
case trueDim of
0 -> 1 + getDimFromListElement listelement env
_ -> trueDim + getDimFromListElement listelement env
getDimFromListElement (Abs.ListElementOfArray _ exp) env = let trueDim = getDimFromInit_ exp env in
case trueDim of
0 -> 1
_ -> trueDim
countListEl :: Abs.ARRAYINIT a -> Prelude.Integer
countListEl (Abs.ArrayInitElems _ listelement) = 1
countListEl (Abs.ArrayInitSingle _ arrayInit) = countListEl arrayInit
countListEl (Abs.ArrayInit _ arrayInit1 arrayInit2) = countListEl arrayInit1 + countListEl arrayInit2
countListEl_ :: Abs.LISTELEMENTARRAY a -> Env -> Prelude.Integer
countListEl_ (Abs.ListElementsOfArray _ el elems) env = let trueDim = getDimFromInit_ el env in
case trueDim of
0 -> 1 + countListEl_ elems env
_ -> trueDim + countListEl_ elems env
countListEl_ (Abs.ListElementOfArray _ el) env = let trueDim = getDimFromInit_ el env in
case trueDim of
0 -> 1
_ -> trueDim
countListInit :: Abs.ARRAYINIT a -> Prelude.Integer
countListInit (Abs.ArrayInit _ arrayInit1 arrayInit2) = countListInit arrayInit1 + 1
countListInit (Abs.ArrayInitSingle _ arrayInit) = 1
countListInit _ = 0
getChild :: Abs.TYPEEXPRESSIONFUNC a -> Abs.TYPEEXPRESSION a
getChild (Abs.TypeExpressionArrayOfPointer _ expf) = getChild expf
getChild (Abs.TypeExpressionFunction _ exp) = exp
executeInitCheck :: Abs.ARRAYINIT a -> Abs.TYPEEXPRESSION a -> Env -> Prelude.Bool
executeInitCheck (Abs.ArrayInitSingle _ arrayInit) (Abs.TypeExpressionArraySimple _ range expf) env = dimIsOk_ (getChild expf) arrayInit env
executeInitCheck (Abs.ArrayInit _ arrayInit1 arrayInit2) ty@(Abs.TypeExpressionArraySimple _ range expf) env = (executeInitCheck arrayInit1 ty env) && dimIsOk_ (getChild expf) arrayInit2 env
executeInitCheck (Abs.ArrayInitSingle _ arrayInit) (Abs.TypeExpressionArray _ range expf) env = dimIsOk_ (getChild expf) arrayInit env
executeInitCheck (Abs.ArrayInit _ arrayInit1 arrayInit2) ty@(Abs.TypeExpressionArray _ range expf) env = (executeInitCheck arrayInit1 ty env) && dimIsOk_ (getChild expf) arrayInit2 env
executeInitCheck _ _ env = False
checkSquares :: Abs.TYPEPART a -> Abs.INITPART a -> Env -> Prelude.Bool
checkSquares (Abs.TypePart _ typeexp) (Abs.InitializzationPartArray _ arrayInit) env = case typeexp of
Abs.TypeExpression _ prim -> checkSquares_ prim arrayInit env
_ -> False
checkSquares _ _ env = True
checkSquares_ :: Abs.PRIMITIVETYPE a -> Abs.ARRAYINIT a -> Env -> Prelude.Bool
checkSquares_ (Abs.TypeArray _ prim) init@(Abs.ArrayInitElems _ listelement) env = case prim of
Abs.TypeArray {} -> False
_ -> True
checkSquares_ (Abs.TypeArray _ prim) init@(Abs.ArrayInitSingle _ arrayInit) env = case prim of
Abs.TypeArray _ primm -> checkSquares_ prim arrayInit env
_ -> False
checkSquares_ (Abs.TypeArray _ prim) init@(Abs.ArrayInit _ arrayInit1 arrayInit2) env = case prim of
Abs.TypeArray {} -> checkSquares_ prim arrayInit1 env && checkSquares_ prim arrayInit2 env
_ -> False
isInitPrim :: Abs.INITPART a -> Env -> Prelude.Bool
isInitPrim (Abs.InitializzationPartArray _ _) env = False
isInitPrim (Abs.InitializzationPart _ exp) env = isInitExp exp env
isInitPrim _ _ = True
completeIndex :: Type -> Abs.ARRAYINDEXELEMENTS a -> Prelude.Bool
completeIndex (Array t dim) (Abs.ArrayIndexElementsSingle _ _) = case t of
Array {} -> False
_ -> True
completeIndex (Array t dim) (Abs.ArrayIndexElementsMultiple _ exps _) = case t of
Array {} -> False
_ -> True && completeIndex t exps
completeIndex _ _ = False
isInitExp :: Abs.EXPRESSION a -> Env -> Prelude.Bool
isInitExp (Abs.ExpressionIdent _ (Abs.Ident id _) index) env = case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "var" of
[] -> True
[Variable t _ _ _ _ check] -> case t of
Array ta dim -> case index of
Abs.ArrayIndexElementEmpty _ -> False
Abs.ArrayIndexElement _ exp -> case ta of
Array {} -> False
_ -> True
Abs.ArrayIndexElements _ exps exp -> completeIndex ta exps
_ -> True
Nothing -> True
isInitExp (Abs.ExpressionCall _ (Abs.Ident id _) _) env = case Data.Map.lookup id env of
Just (e:es) -> case findEntryOfType (e:es) "func" of
[] -> True
[Function t _ _ _] -> case t of
Array _ _ -> False
_ -> True
Nothing -> True
isInitExp _ env = True
dimIsOk :: Abs.TYPEPART a -> Abs.INITPART a -> Env -> Prelude.Bool
dimIsOk (Abs.TypePart _ typeexp) (Abs.InitializzationPartArray _ arrayInit) env = dimIsOk_ typeexp arrayInit env
dimIsOk _ _ env = True
dimIsOk_ :: Abs.TYPEEXPRESSION a -> Abs.ARRAYINIT a -> Env -> Prelude.Bool
dimIsOk_ (Abs.TypeExpressionArraySimple _ range expf) init@(Abs.ArrayInitElems _ listelement) env = let next = getDimFromExpF expf in
let rangeDim = getDimFromRange range in
let listEl = countListEl_ listelement env in
if next==0
then
if rangeDim == listEl
then True
else False
else
if rangeDim*next == listEl
then True
else False
dimIsOk_ ty@(Abs.TypeExpressionArraySimple _ range expf) init@(Abs.ArrayInit _ arrayInit1 arrayInit2) env = let listEl = countListInit init in
let rangeDim = getDimFromRange range in
if listEl==rangeDim
then let isOkInit1 = executeInitCheck arrayInit1 ty env in
isOkInit1 && dimIsOk_ (getChild expf) arrayInit2 env
else False
dimIsOk_ ty@(Abs.TypeExpressionArraySimple _ range expf) init@(Abs.ArrayInitSingle _ arrayInit) env = let next = getDimFromExpF expf in
if next==0
then dimIsOk_ (getChild expf) arrayInit env
else let listEl = countListInit init in
let rangeDim = getDimFromRange range in
if listEl==rangeDim
then dimIsOk_ (getChild expf) arrayInit env
else False
dimIsOk_ (Abs.TypeExpressionArray _ range expf) init@(Abs.ArrayInitElems _ listelement) env = let next = getDimFromExpF expf in
let rangeDim = getDimFromRange range in
let listEl = countListEl_ listelement env in
if next==0
then
if rangeDim == listEl
then True
else False
else
False
dimIsOk_ ty@(Abs.TypeExpressionArray _ range expf) init@(Abs.ArrayInit _ arrayInit1 arrayInit2) env = let listEl = countListInit init in
let rangeDim = getDimFromRange range in
if listEl==rangeDim
then let isOkInit1 = executeInitCheck arrayInit1 ty env in
isOkInit1 && dimIsOk_ (getChild expf) arrayInit2 env
else False
dimIsOk_ ty@(Abs.TypeExpressionArray _ range expf) init@(Abs.ArrayInitSingle _ arrayInit) env = let next = getDimFromExpF expf in
if next==0
then dimIsOk_ (getChild expf) arrayInit env
else let listEl = countListInit init in
let rangeDim = getDimFromRange range in
if listEl==rangeDim
then dimIsOk_ (getChild expf) arrayInit env
else False
dimIsOk_ _ _ env = False
getInitPart :: Prelude.String -> Prelude.String -> Prelude.String -> Prelude.String
getInitPart (x:xs) zs result = case x of
'=' -> getInitPart xs "=" result
';' -> result
_ -> if zs=="="
then getInitPart xs zs (result++[x])
else getInitPart xs zs result
isVoid :: Abs.TYPEPART Posn -> Prelude.Bool
isVoid typepart = isVoid_ (getTypePart typepart)
isVoid_ :: Type -> Prelude.Bool
isVoid_ (B_type Type_Void) = True
isVoid_ (Array t _) = isVoid_ t
isVoid_ (Pointer t _) = isVoid_ t
isVoid_ _ = False
isVoidF :: Abs.TYPEEXPRESSIONFUNC Posn -> Prelude.Bool
isVoidF (Abs.TypeExpressionArrayOfPointer _ ty) = isArrayDef ty
isVoidF (Abs.TypeExpressionFunction _ ty) = isArrayDef_ ty
isVoidF_ :: Abs.TYPEEXPRESSION Posn -> Prelude.Bool
isVoidF_ (Abs.TypeExpressionArraySimple _ _ ty) = isVoidF ty
isVoidF_ (Abs.TypeExpressionArray _ _ ty) = isVoidF ty
isVoidF_ (Abs.TypeExpressionPointerOfArray _ ty _) = isVoidF ty
isVoidF_ (Abs.TypeExpressionPointer _ ty _) = isVoidF__ ty
isVoidF_ (Abs.TypeExpression _ ty) = isVoidF__ ty
isVoidF__ :: Abs.PRIMITIVETYPE Posn -> Prelude.Bool
isVoidF__ (Abs.PrimitiveTypeVoid _) = True
isVoidF__ _ = False
isPointerWArray :: Abs.TYPEPART Posn -> Prelude.Bool
isPointerWArray (Abs.TypePart _ typeexp) = isPointerWArray_ typeexp
isPointerWArray_ :: Abs.TYPEEXPRESSION Posn -> Prelude.Bool
isPointerWArray_ (Abs.TypeExpressionPointer _ ty _) = True
isPointerWArray_ (Abs.TypeExpressionPointerOfArray _ ty _) = True
isPointerWArray_ _ = False
isPrimitiveArray :: Abs.TYPEPART Posn -> Prelude.Bool
isPrimitiveArray (Abs.TypePart _ typeexp) = isPrimitiveArray_ typeexp
isPrimitiveArray_ :: Abs.TYPEEXPRESSION Posn -> Prelude.Bool
isPrimitiveArray_ (Abs.TypeExpression _ ty) = isPrimitiveArray__ ty
isPrimitiveArray_ _ = False
isPrimitiveArray__ :: Abs.PRIMITIVETYPE Posn -> Prelude.Bool
isPrimitiveArray__ (Abs.TypeArray _ ty) = True
isPrimitiveArray__ _ = False
isArrayDef :: Abs.TYPEEXPRESSIONFUNC Posn -> Prelude.Bool
isArrayDef (Abs.TypeExpressionArrayOfPointer _ ty) = isArrayDef ty
isArrayDef (Abs.TypeExpressionFunction _ ty) = isArrayDef_ ty
isArrayDef_ :: Abs.TYPEEXPRESSION Posn -> Prelude.Bool
isArrayDef_ (Abs.TypeExpressionArraySimple _ _ ty) = True
isArrayDef_ (Abs.TypeExpressionArray _ _ ty) = True
isArrayDef_ (Abs.TypeExpressionPointerOfArray _ ty _) = isArrayDef ty
isArrayDef_ _ = False
getRealType :: TCheckResult -> TCheckResult
getRealType tcheck = case tcheck of
TResult env (Pointer t depth) pos -> TResult env t pos
TResult env (Array t dim) pos -> TResult env t pos
_ -> tcheck
-- Given a VariableType node of the ABS, returns a string indicating the type of variable
getVarMode :: Abs.VARIABLETYPE Posn -> Prelude.String
getVarMode (Abs.VariableTypeParam _) = "param"
getVarMode (Abs.VariableTypeConst _) = "const"
getVarMode (Abs.VariableTypeVar _) = "var"
getVarType :: Abs.VARDECLIST Posn -> Type
getVarType (Abs.VariableDeclarationSingle _ (Abs.VariableDeclaration _ _ ty _)) = getTypePart ty
getVarType (Abs.VariableDeclarationSingle _ (Abs.VariableDeclarationChecked _ _ ty _)) = getTypePart ty
getTypePart :: Abs.TYPEPART Posn -> Type
getTypePart (Abs.TypePart _ typeExpr) = getTypeExpr typeExpr
getTypeExprF :: Abs.TYPEEXPRESSIONFUNC Posn -> Type
getTypeExprF (Abs.TypeExpressionArrayOfPointer pos typeexpressionfunc) = Array (getTypeExprF typeexpressionfunc) 0
getTypeExprF (Abs.TypeExpressionFunction pos typeexpression) = (getTypeFromTypeExp typeexpression)
getDepthSon :: Abs.TYPEEXPRESSIONFUNC Posn -> Prelude.Integer
getDepthSon (Abs.TypeExpressionArrayOfPointer pos typeexpressionfunc) = 0
getDepthSon (Abs.TypeExpressionFunction pos typeexpression) = getDepthSon_ typeexpression
getDepthSon_ :: Abs.TYPEEXPRESSION Posn -> Prelude.Integer
getDepthSon_ (Abs.TypeExpression _ primitive) = 0
getDepthSon_ (Abs.TypeExpressionArraySimple _ rangeexp typeexpression) = 0
getDepthSon_ (Abs.TypeExpressionArray _ rangeexp typeexpression) = 0
getDepthSon_ (Abs.TypeExpressionPointer _ primitive pointer) = checkPointerDepth pointer
getDepthSon_ (Abs.TypeExpressionPointerOfArray pos typeexpression pointer) = getDepthSon typeexpression + (checkPointerDepth pointer)
getTypeFromSon :: Type -> Type
getTypeFromSon t@(Array _ _) = t
getTypeFromSon t@(Pointer ts _) = getTypeFromSon ts
getTypeFromSon t = t
-- Given a TypeExpression node of the abs, execute the right getType function for obtaining the Type
getTypeExpr :: Abs.TYPEEXPRESSION Posn -> Type
getTypeExpr (Abs.TypeExpression _ primitive) = getTypeFromPrimitive primitive
getTypeExpr (Abs.TypeExpressionArraySimple _ rangeexp typeexpression) = Array (getTypeFromTypeExpF typeexpression) (getArrayLength rangeexp)
getTypeExpr (Abs.TypeExpressionArray _ rangeexp typeexpression) = Array (getTypeFromTypeExpF typeexpression) (getArrayLength rangeexp)
getTypeExpr (Abs.TypeExpressionPointer p primitive pointer) = case primitive of
Abs.TypeArray _ prim -> Array (getTypeExpr (Abs.TypeExpressionPointer p prim pointer)) 1
_ -> Pointer (getTypeFromPrimitive primitive) (checkPointerDepth pointer)
getTypeExpr (Abs.TypeExpressionPointerOfArray pos typeexpression pointer) = Pointer (getTypeFromSon (getTypeFromTypeExpF typeexpression)) ((getDepthSon typeexpression)+(checkPointerDepth pointer))
-- Given a Pointer node of the ABS, it counts the depth (how much pointers '*' there are) of that pointer
-- Example: var x:int***** -> depth: 5
checkPointerDepth :: Abs.POINTER Posn -> Prelude.Integer
checkPointerDepth (Abs.PointerSymbol _ p) = 1 + checkPointerDepth p
checkPointerDepth (Abs.PointerSymbolSingle _) = 1
getTypeFromTypeExpF :: Abs.TYPEEXPRESSIONFUNC Posn -> Type
getTypeFromTypeExpF (Abs.TypeExpressionArrayOfPointer pos typeexpressionfunc) = Array (getTypeExprF typeexpressionfunc) 0
getTypeFromTypeExpF (Abs.TypeExpressionFunction pos typeexpression) = (getTypeFromTypeExp typeexpression)
-- Given a typeexpression returns the type
getTypeFromTypeExp :: Abs.TYPEEXPRESSION Posn -> Type
getTypeFromTypeExp (Abs.TypeExpression _ primitive) = getTypeFromPrimitive primitive
getTypeFromTypeExp (Abs.TypeExpressionArraySimple _ rangeexp typeexpression) = Array (getTypeFromTypeExpF typeexpression) (getArrayLength rangeexp)
getTypeFromTypeExp (Abs.TypeExpressionArray _ rangeexp typeexpression) = Array (getTypeFromTypeExpF typeexpression) (getArrayLength rangeexp)
getTypeFromTypeExp (Abs.TypeExpressionPointer p primitive pointer) = case primitive of
Abs.TypeArray _ prim -> Array (getTypeFromTypeExp (Abs.TypeExpressionPointer p prim pointer)) 1
_ -> Pointer (getTypeFromPrimitive primitive) (checkPointerDepth pointer)
getTypeFromTypeExp (Abs.TypeExpressionPointerOfArray pos typeexpression pointer) = Pointer (getTypeFromTypeExpF typeexpression) (checkPointerDepth pointer)
-- Get a PrimitiveType node of the ABS, returns the correct Type
getTypeFromPrimitive :: Abs.PRIMITIVETYPE Posn -> Type
getTypeFromPrimitive (Abs.PrimitiveTypeVoid _) = (B_type Type_Void)
getTypeFromPrimitive (Abs.PrimitiveTypeBool _) = (B_type Type_Boolean)
getTypeFromPrimitive (Abs.PrimitiveTypeInt _) = (B_type Type_Integer)
getTypeFromPrimitive (Abs.PrimitiveTypeReal _) = (B_type Type_Real)
getTypeFromPrimitive (Abs.PrimitiveTypeString _) = (B_type Type_String)
getTypeFromPrimitive (Abs.PrimitiveTypeChar _) = (B_type Type_Char)
getTypeFromPrimitive (Abs.TypeArray _ prim) = (Type.Array (getTypeFromPrimitive prim) (getArrayDimFunc prim))
-- Returns array dimension
getArrayDimFunc :: Abs.PRIMITIVETYPE Posn -> Prelude.Integer
getArrayDimFunc (Abs.TypeArray _ ty) = 1
getArrayDimFunc _ = 1
-- Counts array length from rangeexpression
getArrayLength :: Abs.RANGEEXP Posn -> Prelude.Integer
getArrayLength (Abs.RangeExpression pos exp1 exp2 rangeexp) = 1 + getArrayLength rangeexp
getArrayLength _ = 1
-- Get a PrimitiveType node of an array abs node, it returns the primitive type
-- Example: var x:[][][]int -> int
getArrayPrimitiveType :: Abs.PRIMITIVETYPE Posn -> Type
getArrayPrimitiveType (Abs.PrimitiveTypeVoid _) = (B_type Type_Void)
getArrayPrimitiveType (Abs.PrimitiveTypeBool _) = (B_type Type_Boolean)
getArrayPrimitiveType (Abs.PrimitiveTypeInt _) = (B_type Type_Integer)
getArrayPrimitiveType (Abs.PrimitiveTypeReal _) = (B_type Type_Real)
getArrayPrimitiveType (Abs.PrimitiveTypeString _) = (B_type Type_String)
getArrayPrimitiveType (Abs.PrimitiveTypeChar _) = (B_type Type_Char)
getArrayPrimitiveType (Abs.TypeArray _ prim) = getArrayPrimitiveType prim
-- Get a VarDecList (list of vars declarations) of the ABS, returns a list of strings, where each element is the id of the vars
getVariableDeclStatNames :: Abs.VARDECLIST Posn -> [Prelude.String]
getVariableDeclStatNames (Abs.VariableDeclarationSingle _ (Abs.VariableDeclaration _ id _ _)) = getIdList id
getVariableDeclStatNames (Abs.VariableDeclarationSingle _ (Abs.VariableDeclarationChecked _ id _ _)) = getIdList id
-- Get a VarDecList (list of vars declarations) of the ABS, returns a list of Posn, where each element is the posn of the vars
getVariableDeclStatPos :: Abs.VARDECLIST Posn -> [Posn]
getVariableDeclStatPos (Abs.VariableDeclarationSingle _ (Abs.VariableDeclaration _ id _ _)) = getPosList id
getVariableDeclStatPos (Abs.VariableDeclarationSingle _ (Abs.VariableDeclarationChecked _ id _ _)) = getPosList id
-- Given an IdentList node, return a list of string containing all the ids
getIdList :: Abs.IDENTLIST Posn -> [Prelude.String]
getIdList (Abs.IdentifierList _ (Abs.Ident s _) identlist) = [s] ++ getIdList identlist
getIdList (Abs.IdentifierSingle _ (Abs.Ident s _)) = [s]
-- Given an IdentList node, return a list of posn containing all the posns
getPosList :: Abs.IDENTLIST Posn -> [Posn]
getPosList (Abs.IdentifierList _ (Abs.Ident s pos) identlist) = [pos] ++ getPosList identlist
getPosList (Abs.IdentifierSingle _ (Abs.Ident s pos)) = [pos]
first :: (Abs.ARRAYINDEXELEMENTS Posn,Abs.TYPEINDEX Posn) -> Abs.ARRAYINDEXELEMENTS Posn
first (a,b) = a
second :: (Abs.ARRAYINDEXELEMENTS Posn,Abs.TYPEINDEX Posn) -> Abs.TYPEINDEX Posn
second (a,b) = b
reverseIndexTree :: Abs.ARRAYINDEXELEMENT Posn -> Abs.ARRAYINDEXELEMENT Posn
reverseIndexTree (Abs.ArrayIndexElement pos ti) = Abs.ArrayIndexElement pos ti
reverseIndexTree (Abs.ArrayIndexElements pos elements ti) = let rev = reverseIndexTree_ elements ti in
Abs.ArrayIndexElements pos (first rev) (second rev)
reverseIndexTree (Abs.ArrayIndexElementEmpty pos) = Abs.ArrayIndexElementEmpty pos
reverseIndexTree_ :: Abs.ARRAYINDEXELEMENTS Posn -> Abs.TYPEINDEX Posn -> (Abs.ARRAYINDEXELEMENTS Posn,Abs.TYPEINDEX Posn)
reverseIndexTree_ (Abs.ArrayIndexElementsSingle pos ti) typeIndex = (Abs.ArrayIndexElementsSingle pos typeIndex,ti)
reverseIndexTree_ (Abs.ArrayIndexElementsMultiple pos elems ti) typeIndex = let rev = reverseIndexTree_ elems ti in
(Abs.ArrayIndexElementsMultiple pos (first rev) (second rev),typeIndex)
-- counts number of indexed dimension on a indexed array call
countIndex :: Abs.ARRAYINDEXELEMENT Posn -> Prelude.Integer
countIndex (Abs.ArrayIndexElement pos ti) = countIndex_ ti
countIndex (Abs.ArrayIndexElements pos elements ti) = countIndex_ ti
countIndex (Abs.ArrayIndexElementEmpty pos) = 0
-- implements the previous func
countIndex_ :: Abs.TYPEINDEX a -> Prelude.Integer
countIndex_ (Abs.TypeOfIndexInt pos ti val) = 1 + countIndex_ ti
countIndex_ (Abs.TypeOfIndexIntSingle pos val) = 1
countIndex_ (Abs.TypeOfIndexVar pos ti val index) = 1 + countIndex_ ti
countIndex_ (Abs.TypeOfIndexVarSingle pos val index) = 1
countIndex_ node@(Abs.TypeOfIndexPointer pos typeindex unaryop def) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexPointerSingle pos unaryop def) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryPlus pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryPlusSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryMinus pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryMinusSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryProduct pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryProductSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryDivision pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryDivisionSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryModule pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryModuleSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexBinaryPower pos typeindex exp1 exp2) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexBinaryPowerSingle pos exp1 exp2 ) = 1
countIndex_ node@(Abs.TypeOfIndexExpressionCall pos typeindex id exps ) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexExpressionCallSingle pos id exps ) = 1
countIndex_ node@(Abs.TypeOfIndexExpressionBracket pos typeindex exp ) = 1 + countIndex_ typeindex
countIndex_ node@(Abs.TypeOfIndexExpressionBracketSingle pos exp ) = 1
-- Checks if array is being indexed
-- if it is: return primitive type
-- if it isn't: return array type
indexing :: TCheckResult -> Abs.ARRAYINDEXELEMENT Posn -> TCheckResult
indexing (TResult env (Array t dim) pos) index = case index of
Abs.ArrayIndexElementEmpty posIn -> TResult env (Array t dim) pos
_ -> TResult env t pos
indexing t index = t
---------------------------------------------------------------------------------------------------
--- GENERIC FUNCTIONS used for RETURN KEYS CHECKS -------------------------------------------------
---------------------------------------------------------------------------------------------------
addPointerString :: Prelude.Integer -> Prelude.String
addPointerString x = if x-1>0 then "pointer"++addPointerString (x-1) else "pointer"
showTypeComplete :: Type -> Prelude.String
showTypeComplete (Array t dim) = "array"++showTypeComplete t
showTypeComplete (Pointer t depth) = (addPointerString depth)++showTypeComplete t
showTypeComplete t = show t
countPoString :: Abs.POINTER Posn -> Prelude.String
countPoString (Abs.PointerSymbol pos po) = "pointer"++countPoString po
countPoString (Abs.PointerSymbolSingle pos) = "pointer"
showTypeExpComplete :: Abs.TYPEEXPRESSIONFUNC Posn -> Prelude.String
showTypeExpComplete (Abs.TypeExpressionArrayOfPointer pos typeexpfunc) = "array"++showTypeExpComplete typeexpfunc
showTypeExpComplete (Abs.TypeExpressionFunction pos typeexp) = showTypeExpCompleteIn typeexp
showTypeExpCompleteIn :: Abs.TYPEEXPRESSION Posn -> Prelude.String
showTypeExpCompleteIn (Abs.TypeExpression pos prim) = showTypePrimitive prim
showTypeExpCompleteIn (Abs.TypeExpressionPointer pos prim po) = countPoString po++showTypePrimitive prim
showTypeExpCompleteIn (Abs.TypeExpressionArraySimple _ rangeexp typeexpression) = "array"++showTypeExpComplete typeexpression
showTypeExpCompleteIn (Abs.TypeExpressionArray _ rangeexp typeexpression) = "array"++showTypeExpComplete typeexpression
showTypeExpCompleteIn (Abs.TypeExpressionPointerOfArray pos typeexp po) = countPoString po++showTypeExpComplete typeexp
showTypePrimitive :: Abs.PRIMITIVETYPE Posn -> Prelude.String
showTypePrimitive (Abs.PrimitiveTypeVoid pos) = "void"
showTypePrimitive (Abs.PrimitiveTypeBool pos) = "bool"
showTypePrimitive (Abs.PrimitiveTypeInt pos) = "int"
showTypePrimitive (Abs.PrimitiveTypeReal pos) = "real"
showTypePrimitive (Abs.PrimitiveTypeString pos) = "string"
showTypePrimitive (Abs.PrimitiveTypeChar pos) = "char"
showTypePrimitive (Abs.TypeArray pos primitivetype) = "array"++showTypePrimitive primitivetype
getTypeFromExpressionTResult :: Abs.EXPRESSION TCheckResult -> Type
getTypeFromExpressionTResult (Abs.ExpressionInteger res@(TResult _ ty _) value) = ty
getTypeFromExpressionTResult (Abs.ExpressionBoolean res@(TResult _ ty _) value) = ty
getTypeFromExpressionTResult (Abs.ExpressionChar res@(TResult _ ty _) value) = ty
getTypeFromExpressionTResult (Abs.ExpressionString res@(TResult _ ty _) value) = ty
getTypeFromExpressionTResult (Abs.ExpressionReal res@(TResult _ ty _) value) = ty
getTypeFromExpressionTResult (Abs.ExpressionBracket res@(TResult _ ty _) exp) = ty
getTypeFromExpressionTResult (Abs.ExpressionCast res@(TResult _ ty _) def tipo) = ty
getTypeFromExpressionTResult (Abs.ExpressionUnary res@(TResult _ ty _) unary def) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryPlus res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryMinus res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryProduct res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryDivision res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryModule res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryPower res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryAnd res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryOr res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryEq res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryNotEq res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryGratherEq res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryGrather res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryLessEq res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionBinaryLess res@(TResult _ ty _) exp1 exp2) = ty
getTypeFromExpressionTResult (Abs.ExpressionIdent res@(TResult _ ty _) id index) = ty
getTypeFromExpressionTResult (Abs.ExpressionCall res@(TResult _ ty _) id exps) = ty
getTypeFromExpressionTResult _ = (B_type Type_Void) -- when err
getTypeFromLvalTResult :: Abs.LVALUEEXPRESSION TCheckResult -> Type
getTypeFromLvalTResult (Abs.LvalueExpression res@(TResult _ ty _) id ident) = ty
getTypeFromLvalTResult (Abs.LvalueExpressions res@(TResult _ ty _) id ident next) = ty
getTypeFromLvalTResult _ = (B_type Type_Void) -- when err
solverDefInd :: EnvEntry -> Abs.ARRAYINDEXELEMENT Posn -> Posn -> Env -> TCheckResult
solverDefInd (Variable ty@(Pointer t depth) posd mode override s check ) index p env = case index of
Abs.ArrayIndexElementEmpty posIn -> TResult env ty p
_ -> TError ["Indexing cannot be applied to a pointer! Position: "++ show p]
solverDefInd (Variable ty@(Array t dim) posd mode override s check ) index p env = case index of
Abs.ArrayIndexElementEmpty posIn -> TResult env ty p