Bug Summary

File:src/scobind.c
Warning:line 3539, column 26
Array access (via field 'uses') results in a null pointer dereference

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name scobind.c -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 2 -pic-is-pie -mframe-pointer=all -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fdebug-compilation-dir=/home/kfp/aldor/aldor/aldor/src -fcoverage-compilation-dir=/home/kfp/aldor/aldor/aldor/src -resource-dir /usr/local/lib/clang/18 -D PACKAGE_NAME="aldor" -D PACKAGE_TARNAME="aldor" -D PACKAGE_VERSION="1.4.0" -D PACKAGE_STRING="aldor 1.4.0" -D PACKAGE_BUGREPORT="aldor@xinutec.org" -D PACKAGE_URL="" -D PACKAGE="aldor" -D VERSION="1.4.0" -D YYTEXT_POINTER=1 -D HAVE_STDIO_H=1 -D HAVE_STDLIB_H=1 -D HAVE_STRING_H=1 -D HAVE_INTTYPES_H=1 -D HAVE_STDINT_H=1 -D HAVE_STRINGS_H=1 -D HAVE_SYS_STAT_H=1 -D HAVE_SYS_TYPES_H=1 -D HAVE_UNISTD_H=1 -D STDC_HEADERS=1 -D HAVE_LIBREADLINE=1 -D HAVE_READLINE_READLINE_H=1 -D HAVE_READLINE_HISTORY=1 -D HAVE_READLINE_HISTORY_H=1 -D USE_GLOOP_SHELL=1 -D GENERATOR_COROUTINES=0 -D HAVE_DLFCN_H=1 -D LT_OBJDIR=".libs/" -I . -D VCSVERSION="2c53e759f1e00e345f8b172e7139debda72fda13" -internal-isystem /usr/local/lib/clang/18/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/14/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O0 -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-sign-compare -Wno-error=shift-negative-value -Wno-error=clobbered -std=c99 -ferror-limit 19 -fgnuc-version=4.2.1 -fskip-odr-check-in-gmf -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2026-01-15-223856-845667-1 -x c scobind.c
1/******************************************************************************
2 *
3 * scobind.c: Deduce the scopes of identifiers.
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 *****************************************************************************/
8
9#include "abpretty.h"
10#include "abuse.h"
11#include "comsg.h"
12#include "debug.h"
13#include "doc.h"
14#include "fint.h"
15#include "format.h"
16#include "lib.h"
17#include "spesym.h"
18#include "stab.h"
19#include "store.h"
20#include "strops.h"
21#include "symcoinfo.h"
22#include "table.h"
23#include "tfcond.h"
24#include "tposs.h"
25#include "tqual.h"
26#include "util.h"
27
28
29#include "genstyle.h"
30
31Bool scoDebug = false((int) 0);
32Bool scoStabDebug = false((int) 0);
33Bool scoFluidDebug = false((int) 0);
34Bool scoUndoDebug = false((int) 0);
35
36#define scoDEBUGif (!scoDebug) { } else afprintf DEBUG_IF(sco)if (!scoDebug) { } else afprintf
37#define scoStabDEBUGif (!scoStabDebug) { } else afprintf DEBUG_IF(scoStab)if (!scoStabDebug) { } else afprintf
38#define scoFluidDEBUGif (!scoFluidDebug) { } else afprintf DEBUG_IF(scoFluid)if (!scoFluidDebug) { } else afprintf
39#define scoUndoDEBUGif (!scoUndoDebug) { } else afprintf DEBUG_IF(scoUndo)if (!scoUndoDebug) { } else afprintf
40
41/******************************************************************************
42 *
43 * :: Identifier contexts
44 *
45 *****************************************************************************/
46
47enum idContext {
48 SCO_Id_START,
49 SCO_Id_InType = SCO_Id_START,
50 SCO_Id_Label,
51 SCO_Id_Used,
52 SCO_Id_LIMIT
53};
54
55typedef Enum(idContext)enum idContext IdContext;
56
57static char *IdContextNames[] = {
58 "InType",
59 "Label",
60 "Used"
61};
62
63/******************************************************************************
64 *
65 * :: Declaration contexts
66 *
67 *****************************************************************************/
68
69enum declContext {
70 SCO_Sig_START,
71 SCO_Sig_Assign = SCO_Sig_START,
72 SCO_Sig_Builtin,
73 SCO_Sig_Declare,
74 SCO_Sig_Default,
75 SCO_Sig_Define,
76 SCO_Sig_DDefine,
77 SCO_Sig_Export,
78 SCO_Sig_Extend,
79 SCO_Sig_Fluid,
80 SCO_Sig_Foreign,
81 SCO_Sig_Free,
82 SCO_Sig_FreeRef,
83 SCO_Sig_ImplicitLocal,
84 SCO_Sig_Import,
85 SCO_Sig_Inline,
86 SCO_Sig_InType,
87 SCO_Sig_Local,
88 SCO_Sig_Loop,
89 SCO_Sig_Param,
90 SCO_Sig_Used,
91 SCO_Sig_Reference,
92 SCO_Sig_Value,
93 SCO_Sig_LIMIT
94};
95
96typedef Enum(declContext)enum declContext DeclContext;
97
98static char *DeclContextNames[] = {
99 "Assign",
100 "Builtin",
101 "Declare",
102 "Default",
103 "Define",
104 "DDefine",
105 "Export",
106 "Extend",
107 "Fluid",
108 "Foreign",
109 "Free",
110 "FreeReference",
111 "ImplicitLocal",
112 "Import",
113 "Inline",
114 "InType",
115 "Local",
116 "Loop",
117 "Param",
118 "Used",
119 "Referenced",
120 "Value"
121};
122
123/******************************************************************************
124 *
125 * :: Declaration information
126 *
127 *****************************************************************************/
128
129typedef AIntList DefnPos;
130
131DECLARE_LIST(DefnPos)typedef struct DefnPosListCons { DefnPos first; struct DefnPosListCons
*rest; } *DefnPosList; struct DefnPos_listOpsStruct { DefnPosList
(*Cons) (DefnPos, DefnPosList); DefnPosList (*Singleton) (DefnPos
); DefnPosList (*List) (int n, ...); DefnPosList (*Listv) (va_list
argp); DefnPosList (*ListNull) (DefnPos, ...); Bool (*Equal)
(DefnPosList, DefnPosList, Bool (*f) (DefnPos, DefnPos)); DefnPos
(*Find) (DefnPosList, DefnPos, Bool(*eq)(DefnPos,DefnPos) , int
*); DefnPos (*Match) (DefnPosList, void *, Bool(*match)(DefnPos
, void *), int *); DefnPosList (*MatchAll) (DefnPosList, void
*, Bool(*match)(DefnPos, void *)); DefnPosList (*FreeCons) (
DefnPosList); void (*Free) (DefnPosList); DefnPosList (*FreeTo
) (DefnPosList, DefnPosList); void (*FreeDeeply) (DefnPosList
, void (*f)(DefnPos)); DefnPosList (*FreeDeeplyTo) (DefnPosList
, DefnPosList, void (*f) (DefnPos) ); DefnPosList (*FreeIfSat
) (DefnPosList, void (*f)(DefnPos), Bool (*s)(DefnPos)); DefnPos
(*Elt) (DefnPosList, Length); DefnPosList (*Drop) (DefnPosList
, Length); DefnPosList (*LastCons) (DefnPosList); Length (*_Length
) (DefnPosList); Bool (*IsLength) (DefnPosList, Length); Bool
(*IsShorter) (DefnPosList, Length); Bool (*IsLonger) (DefnPosList
, Length); DefnPosList (*Copy) (DefnPosList); DefnPosList (*CopyTo
) (DefnPosList, DefnPosList); DefnPosList (*CopyDeeply) (DefnPosList
, DefnPos (*)(DefnPos)); DefnPosList (*CopyDeeplyTo) (DefnPosList
, DefnPosList, DefnPos (*)(DefnPos)); DefnPosList (*Map) (DefnPos
(*f)(DefnPos), DefnPosList); DefnPosList (*NMap) (DefnPos (*
f)(DefnPos), DefnPosList); DefnPosList (*Reverse) (DefnPosList
); DefnPosList (*NReverse) (DefnPosList); DefnPosList (*Concat
) (DefnPosList, DefnPosList); DefnPosList (*NConcat) (DefnPosList
, DefnPosList); Bool (*Memq) (DefnPosList, DefnPos); Bool (*Member
) (DefnPosList, DefnPos, Bool(*eq)(DefnPos,DefnPos) ); Bool (
*ContainsAllq) (DefnPosList, DefnPosList); Bool (*ContainsAnyq
) (DefnPosList, DefnPosList); Bool (*ContainsAll) (DefnPosList
, DefnPosList, Bool (*eq)(DefnPos, DefnPos)); Bool (*ContainsAny
) (DefnPosList, DefnPosList, Bool (*eq)(DefnPos, DefnPos)); int
(*Posq) (DefnPosList, DefnPos); int (*Position) (DefnPosList
, DefnPos, Bool(*eq)(DefnPos,DefnPos) ); DefnPosList (*NRemove
) (DefnPosList, DefnPos, Bool(*eq)(DefnPos,DefnPos) ); void (
*FillVector) (DefnPos *, DefnPosList); int (*Print) (FILE *, DefnPosList
, int (*pr)(FILE *, DefnPos) ); int (*GPrint) (FILE *, DefnPosList
, int (*pr)(FILE *, DefnPos), char *l,char *m,char *r); int (
*Format) (OStream, CString, DefnPosList); }; extern struct DefnPos_listOpsStruct
const *DefnPos_listPointer;
132CREATE_LIST(DefnPos)struct DefnPos_listOpsStruct const *DefnPos_listPointer = (struct
DefnPos_listOpsStruct const *) &ptrlistOps;
133
134typedef struct decl_info {
135 UShort intStepNo;
136 AbSyn id;
137 AbSyn type;
138 DefnPosList defpos;
139 Doc doc;
140 AbSyn uses[SCO_Sig_LIMIT];
141} *DeclInfo;
142
143DECLARE_LIST(DeclInfo)typedef struct DeclInfoListCons { DeclInfo first; struct DeclInfoListCons
*rest; } *DeclInfoList; struct DeclInfo_listOpsStruct { DeclInfoList
(*Cons) (DeclInfo, DeclInfoList); DeclInfoList (*Singleton) (
DeclInfo); DeclInfoList (*List) (int n, ...); DeclInfoList (*
Listv) (va_list argp); DeclInfoList (*ListNull) (DeclInfo, ...
); Bool (*Equal) (DeclInfoList, DeclInfoList, Bool (*f) (DeclInfo
, DeclInfo)); DeclInfo (*Find) (DeclInfoList, DeclInfo, Bool(
*eq)(DeclInfo,DeclInfo) , int *); DeclInfo (*Match) (DeclInfoList
, void *, Bool(*match)(DeclInfo, void *), int *); DeclInfoList
(*MatchAll) (DeclInfoList, void *, Bool(*match)(DeclInfo, void
*)); DeclInfoList (*FreeCons) (DeclInfoList); void (*Free) (
DeclInfoList); DeclInfoList (*FreeTo) (DeclInfoList, DeclInfoList
); void (*FreeDeeply) (DeclInfoList, void (*f)(DeclInfo)); DeclInfoList
(*FreeDeeplyTo) (DeclInfoList, DeclInfoList, void (*f) (DeclInfo
) ); DeclInfoList (*FreeIfSat) (DeclInfoList, void (*f)(DeclInfo
), Bool (*s)(DeclInfo)); DeclInfo (*Elt) (DeclInfoList, Length
); DeclInfoList (*Drop) (DeclInfoList, Length); DeclInfoList (
*LastCons) (DeclInfoList); Length (*_Length) (DeclInfoList); Bool
(*IsLength) (DeclInfoList, Length); Bool (*IsShorter) (DeclInfoList
, Length); Bool (*IsLonger) (DeclInfoList, Length); DeclInfoList
(*Copy) (DeclInfoList); DeclInfoList (*CopyTo) (DeclInfoList
, DeclInfoList); DeclInfoList (*CopyDeeply) (DeclInfoList, DeclInfo
(*)(DeclInfo)); DeclInfoList (*CopyDeeplyTo) (DeclInfoList, DeclInfoList
, DeclInfo (*)(DeclInfo)); DeclInfoList (*Map) (DeclInfo (*f)
(DeclInfo), DeclInfoList); DeclInfoList (*NMap) (DeclInfo (*f
)(DeclInfo), DeclInfoList); DeclInfoList (*Reverse) (DeclInfoList
); DeclInfoList (*NReverse) (DeclInfoList); DeclInfoList (*Concat
) (DeclInfoList, DeclInfoList); DeclInfoList (*NConcat) (DeclInfoList
, DeclInfoList); Bool (*Memq) (DeclInfoList, DeclInfo); Bool (
*Member) (DeclInfoList, DeclInfo, Bool(*eq)(DeclInfo,DeclInfo
) ); Bool (*ContainsAllq) (DeclInfoList, DeclInfoList); Bool (
*ContainsAnyq) (DeclInfoList, DeclInfoList); Bool (*ContainsAll
) (DeclInfoList, DeclInfoList, Bool (*eq)(DeclInfo, DeclInfo)
); Bool (*ContainsAny) (DeclInfoList, DeclInfoList, Bool (*eq
)(DeclInfo, DeclInfo)); int (*Posq) (DeclInfoList, DeclInfo);
int (*Position) (DeclInfoList, DeclInfo, Bool(*eq)(DeclInfo,
DeclInfo) ); DeclInfoList (*NRemove) (DeclInfoList, DeclInfo,
Bool(*eq)(DeclInfo,DeclInfo) ); void (*FillVector) (DeclInfo
*, DeclInfoList); int (*Print) (FILE *, DeclInfoList, int (*
pr)(FILE *, DeclInfo) ); int (*GPrint) (FILE *, DeclInfoList,
int (*pr)(FILE *, DeclInfo), char *l,char *m,char *r); int (
*Format) (OStream, CString, DeclInfoList); }; extern struct DeclInfo_listOpsStruct
const *DeclInfo_listPointer;
144CREATE_LIST(DeclInfo)struct DeclInfo_listOpsStruct const *DeclInfo_listPointer = (
struct DeclInfo_listOpsStruct const *) &ptrlistOps;
145
146/* A condition. We keep the stab information so its depth can be compared
147 * to the tform depth in tfFloat
148 */
149
150typedef struct ScoCondition {
151 Stab stab;
152 AbSyn absyn;
153 Bool negate;
154} *ScoCondition;
155
156DECLARE_LIST(ScoCondition)typedef struct ScoConditionListCons { ScoCondition first; struct
ScoConditionListCons *rest; } *ScoConditionList; struct ScoCondition_listOpsStruct
{ ScoConditionList (*Cons) (ScoCondition, ScoConditionList);
ScoConditionList (*Singleton) (ScoCondition); ScoConditionList
(*List) (int n, ...); ScoConditionList (*Listv) (va_list argp
); ScoConditionList (*ListNull) (ScoCondition, ...); Bool (*Equal
) (ScoConditionList, ScoConditionList, Bool (*f) (ScoCondition
, ScoCondition)); ScoCondition (*Find) (ScoConditionList, ScoCondition
, Bool(*eq)(ScoCondition,ScoCondition) , int *); ScoCondition
(*Match) (ScoConditionList, void *, Bool(*match)(ScoCondition
, void *), int *); ScoConditionList (*MatchAll) (ScoConditionList
, void *, Bool(*match)(ScoCondition, void *)); ScoConditionList
(*FreeCons) (ScoConditionList); void (*Free) (ScoConditionList
); ScoConditionList (*FreeTo) (ScoConditionList, ScoConditionList
); void (*FreeDeeply) (ScoConditionList, void (*f)(ScoCondition
)); ScoConditionList (*FreeDeeplyTo) (ScoConditionList, ScoConditionList
, void (*f) (ScoCondition) ); ScoConditionList (*FreeIfSat) (
ScoConditionList, void (*f)(ScoCondition), Bool (*s)(ScoCondition
)); ScoCondition (*Elt) (ScoConditionList, Length); ScoConditionList
(*Drop) (ScoConditionList, Length); ScoConditionList (*LastCons
) (ScoConditionList); Length (*_Length) (ScoConditionList); Bool
(*IsLength) (ScoConditionList, Length); Bool (*IsShorter) (ScoConditionList
, Length); Bool (*IsLonger) (ScoConditionList, Length); ScoConditionList
(*Copy) (ScoConditionList); ScoConditionList (*CopyTo) (ScoConditionList
, ScoConditionList); ScoConditionList (*CopyDeeply) (ScoConditionList
, ScoCondition (*)(ScoCondition)); ScoConditionList (*CopyDeeplyTo
) (ScoConditionList, ScoConditionList, ScoCondition (*)(ScoCondition
)); ScoConditionList (*Map) (ScoCondition (*f)(ScoCondition),
ScoConditionList); ScoConditionList (*NMap) (ScoCondition (*
f)(ScoCondition), ScoConditionList); ScoConditionList (*Reverse
) (ScoConditionList); ScoConditionList (*NReverse) (ScoConditionList
); ScoConditionList (*Concat) (ScoConditionList, ScoConditionList
); ScoConditionList (*NConcat) (ScoConditionList, ScoConditionList
); Bool (*Memq) (ScoConditionList, ScoCondition); Bool (*Member
) (ScoConditionList, ScoCondition, Bool(*eq)(ScoCondition,ScoCondition
) ); Bool (*ContainsAllq) (ScoConditionList, ScoConditionList
); Bool (*ContainsAnyq) (ScoConditionList, ScoConditionList);
Bool (*ContainsAll) (ScoConditionList, ScoConditionList, Bool
(*eq)(ScoCondition, ScoCondition)); Bool (*ContainsAny) (ScoConditionList
, ScoConditionList, Bool (*eq)(ScoCondition, ScoCondition)); int
(*Posq) (ScoConditionList, ScoCondition); int (*Position) (ScoConditionList
, ScoCondition, Bool(*eq)(ScoCondition,ScoCondition) ); ScoConditionList
(*NRemove) (ScoConditionList, ScoCondition, Bool(*eq)(ScoCondition
,ScoCondition) ); void (*FillVector) (ScoCondition *, ScoConditionList
); int (*Print) (FILE *, ScoConditionList, int (*pr)(FILE *, ScoCondition
) ); int (*GPrint) (FILE *, ScoConditionList, int (*pr)(FILE *
, ScoCondition), char *l,char *m,char *r); int (*Format) (OStream
, CString, ScoConditionList); }; extern struct ScoCondition_listOpsStruct
const *ScoCondition_listPointer;
157CREATE_LIST(ScoCondition)struct ScoCondition_listOpsStruct const *ScoCondition_listPointer
= (struct ScoCondition_listOpsStruct const *) &ptrlistOps;
158
159/******************************************************************************
160 *
161 * :: Identifier information
162 *
163 *****************************************************************************/
164
165typedef struct id_info {
166 BPack(Bool)UByte allFree;
167 BPack(Bool)UByte allLocal;
168 BPack(Bool)UByte allFluid;
169 ULong serialNo;
170 UShort intStepNo;
171 Symbol sym;
172 AbSyn uses[SCO_Id_LIMIT];
173 DeclInfoList declInfoList;
174 AbSyn defaultType;
175 AbSyn exampleId;
176 AbSynList usePreDef;
177} *IdInfo;
178
179DECLARE_LIST(IdInfo)typedef struct IdInfoListCons { IdInfo first; struct IdInfoListCons
*rest; } *IdInfoList; struct IdInfo_listOpsStruct { IdInfoList
(*Cons) (IdInfo, IdInfoList); IdInfoList (*Singleton) (IdInfo
); IdInfoList (*List) (int n, ...); IdInfoList (*Listv) (va_list
argp); IdInfoList (*ListNull) (IdInfo, ...); Bool (*Equal) (
IdInfoList, IdInfoList, Bool (*f) (IdInfo, IdInfo)); IdInfo (
*Find) (IdInfoList, IdInfo, Bool(*eq)(IdInfo,IdInfo) , int *)
; IdInfo (*Match) (IdInfoList, void *, Bool(*match)(IdInfo, void
*), int *); IdInfoList (*MatchAll) (IdInfoList, void *, Bool
(*match)(IdInfo, void *)); IdInfoList (*FreeCons) (IdInfoList
); void (*Free) (IdInfoList); IdInfoList (*FreeTo) (IdInfoList
, IdInfoList); void (*FreeDeeply) (IdInfoList, void (*f)(IdInfo
)); IdInfoList (*FreeDeeplyTo) (IdInfoList, IdInfoList, void (
*f) (IdInfo) ); IdInfoList (*FreeIfSat) (IdInfoList, void (*f
)(IdInfo), Bool (*s)(IdInfo)); IdInfo (*Elt) (IdInfoList, Length
); IdInfoList (*Drop) (IdInfoList, Length); IdInfoList (*LastCons
) (IdInfoList); Length (*_Length) (IdInfoList); Bool (*IsLength
) (IdInfoList, Length); Bool (*IsShorter) (IdInfoList, Length
); Bool (*IsLonger) (IdInfoList, Length); IdInfoList (*Copy) (
IdInfoList); IdInfoList (*CopyTo) (IdInfoList, IdInfoList); IdInfoList
(*CopyDeeply) (IdInfoList, IdInfo (*)(IdInfo)); IdInfoList (
*CopyDeeplyTo) (IdInfoList, IdInfoList, IdInfo (*)(IdInfo)); IdInfoList
(*Map) (IdInfo (*f)(IdInfo), IdInfoList); IdInfoList (*NMap)
(IdInfo (*f)(IdInfo), IdInfoList); IdInfoList (*Reverse) (IdInfoList
); IdInfoList (*NReverse) (IdInfoList); IdInfoList (*Concat) (
IdInfoList, IdInfoList); IdInfoList (*NConcat) (IdInfoList, IdInfoList
); Bool (*Memq) (IdInfoList, IdInfo); Bool (*Member) (IdInfoList
, IdInfo, Bool(*eq)(IdInfo,IdInfo) ); Bool (*ContainsAllq) (IdInfoList
, IdInfoList); Bool (*ContainsAnyq) (IdInfoList, IdInfoList);
Bool (*ContainsAll) (IdInfoList, IdInfoList, Bool (*eq)(IdInfo
, IdInfo)); Bool (*ContainsAny) (IdInfoList, IdInfoList, Bool
(*eq)(IdInfo, IdInfo)); int (*Posq) (IdInfoList, IdInfo); int
(*Position) (IdInfoList, IdInfo, Bool(*eq)(IdInfo,IdInfo) );
IdInfoList (*NRemove) (IdInfoList, IdInfo, Bool(*eq)(IdInfo,
IdInfo) ); void (*FillVector) (IdInfo *, IdInfoList); int (*Print
) (FILE *, IdInfoList, int (*pr)(FILE *, IdInfo) ); int (*GPrint
) (FILE *, IdInfoList, int (*pr)(FILE *, IdInfo), char *l,char
*m,char *r); int (*Format) (OStream, CString, IdInfoList); }
; extern struct IdInfo_listOpsStruct const *IdInfo_listPointer;
180CREATE_LIST(IdInfo)struct IdInfo_listOpsStruct const *IdInfo_listPointer = (struct
IdInfo_listOpsStruct const *) &ptrlistOps;
181
182typedef struct lambda_info {
183 AbSyn lhs;
184 AbSyn rhs;
185 ScoConditionList scoCondList;
186} *LambdaInfo;
187
188DECLARE_LIST(LambdaInfo)typedef struct LambdaInfoListCons { LambdaInfo first; struct LambdaInfoListCons
*rest; } *LambdaInfoList; struct LambdaInfo_listOpsStruct { LambdaInfoList
(*Cons) (LambdaInfo, LambdaInfoList); LambdaInfoList (*Singleton
) (LambdaInfo); LambdaInfoList (*List) (int n, ...); LambdaInfoList
(*Listv) (va_list argp); LambdaInfoList (*ListNull) (LambdaInfo
, ...); Bool (*Equal) (LambdaInfoList, LambdaInfoList, Bool (
*f) (LambdaInfo, LambdaInfo)); LambdaInfo (*Find) (LambdaInfoList
, LambdaInfo, Bool(*eq)(LambdaInfo,LambdaInfo) , int *); LambdaInfo
(*Match) (LambdaInfoList, void *, Bool(*match)(LambdaInfo, void
*), int *); LambdaInfoList (*MatchAll) (LambdaInfoList, void
*, Bool(*match)(LambdaInfo, void *)); LambdaInfoList (*FreeCons
) (LambdaInfoList); void (*Free) (LambdaInfoList); LambdaInfoList
(*FreeTo) (LambdaInfoList, LambdaInfoList); void (*FreeDeeply
) (LambdaInfoList, void (*f)(LambdaInfo)); LambdaInfoList (*FreeDeeplyTo
) (LambdaInfoList, LambdaInfoList, void (*f) (LambdaInfo) ); LambdaInfoList
(*FreeIfSat) (LambdaInfoList, void (*f)(LambdaInfo), Bool (*
s)(LambdaInfo)); LambdaInfo (*Elt) (LambdaInfoList, Length); LambdaInfoList
(*Drop) (LambdaInfoList, Length); LambdaInfoList (*LastCons)
(LambdaInfoList); Length (*_Length) (LambdaInfoList); Bool (
*IsLength) (LambdaInfoList, Length); Bool (*IsShorter) (LambdaInfoList
, Length); Bool (*IsLonger) (LambdaInfoList, Length); LambdaInfoList
(*Copy) (LambdaInfoList); LambdaInfoList (*CopyTo) (LambdaInfoList
, LambdaInfoList); LambdaInfoList (*CopyDeeply) (LambdaInfoList
, LambdaInfo (*)(LambdaInfo)); LambdaInfoList (*CopyDeeplyTo)
(LambdaInfoList, LambdaInfoList, LambdaInfo (*)(LambdaInfo))
; LambdaInfoList (*Map) (LambdaInfo (*f)(LambdaInfo), LambdaInfoList
); LambdaInfoList (*NMap) (LambdaInfo (*f)(LambdaInfo), LambdaInfoList
); LambdaInfoList (*Reverse) (LambdaInfoList); LambdaInfoList
(*NReverse) (LambdaInfoList); LambdaInfoList (*Concat) (LambdaInfoList
, LambdaInfoList); LambdaInfoList (*NConcat) (LambdaInfoList,
LambdaInfoList); Bool (*Memq) (LambdaInfoList, LambdaInfo); Bool
(*Member) (LambdaInfoList, LambdaInfo, Bool(*eq)(LambdaInfo,
LambdaInfo) ); Bool (*ContainsAllq) (LambdaInfoList, LambdaInfoList
); Bool (*ContainsAnyq) (LambdaInfoList, LambdaInfoList); Bool
(*ContainsAll) (LambdaInfoList, LambdaInfoList, Bool (*eq)(LambdaInfo
, LambdaInfo)); Bool (*ContainsAny) (LambdaInfoList, LambdaInfoList
, Bool (*eq)(LambdaInfo, LambdaInfo)); int (*Posq) (LambdaInfoList
, LambdaInfo); int (*Position) (LambdaInfoList, LambdaInfo, Bool
(*eq)(LambdaInfo,LambdaInfo) ); LambdaInfoList (*NRemove) (LambdaInfoList
, LambdaInfo, Bool(*eq)(LambdaInfo,LambdaInfo) ); void (*FillVector
) (LambdaInfo *, LambdaInfoList); int (*Print) (FILE *, LambdaInfoList
, int (*pr)(FILE *, LambdaInfo) ); int (*GPrint) (FILE *, LambdaInfoList
, int (*pr)(FILE *, LambdaInfo), char *l,char *m,char *r); int
(*Format) (OStream, CString, LambdaInfoList); }; extern struct
LambdaInfo_listOpsStruct const *LambdaInfo_listPointer;
189CREATE_LIST(LambdaInfo)struct LambdaInfo_listOpsStruct const *LambdaInfo_listPointer
= (struct LambdaInfo_listOpsStruct const *) &ptrlistOps;
190
191localstatic LambdaInfo lambdaInfoAlloc(AbSyn lhs, AbSyn rhs, ScoConditionList condition);
192localstatic void lambdaInfoFree(LambdaInfo info);
193
194/******************************************************************************
195 *
196 * :: Conditional Definitions
197 *
198 *****************************************************************************/
199
200localstatic DefnPos defposTail (DefnPos pos);
201localstatic Bool defposEqual (DefnPos a, DefnPos b);
202localstatic Bool defposIsRoot (DefnPos pos);
203localstatic void defposFree (DefnPos pos);
204localstatic AbSynList defposToAbSyn(AIntList defnPos);
205/* (ToDo: Rename above functions to defnposXXX) */
206
207/******************************************************************************
208 *
209 * :: Static variables
210 *
211 *****************************************************************************/
212
213static Stab scoStab;
214static Bool scoIsInType;
215static Bool scoIsInAdd;
216static Bool scoIsInExport;
217static Bool scoIsInExtend;
218static Bool scoIsInImport;
219static AbSynList scoDefineList;
220static LambdaInfoList scoLambdaList;
221static IdInfoList scoIdInfoList;
222static Bool scoUndoState;
223static SymeList scoUndoSymes;
224static TFormList scoUndoTForms;
225static ScoConditionList scoCondList;
226static int scoDefCounter;
227
228/******************************************************************************
229 *
230 * :: Local operations
231 *
232 *****************************************************************************/
233
234typedef void (*ScoBindFun) (AbSyn);
235
236localstatic void scobindValue (AbSyn);
237localstatic void scobindContext (AbSyn);
238localstatic void scobindType (AbSyn);
239localstatic void scobindLevel (AbSyn, ScoBindFun, ULong);
240
241localstatic void scobindLambdaList (void);
242localstatic void scobindPushDefine (AbSyn);
243localstatic void scobindPopDefine (AbSyn);
244localstatic void scobindSetStab (AbSyn, ULong);
245localstatic void scobindStabHash (AbSyn, Stab);
246
247localstatic void scobindApply (AbSyn);
248localstatic void scobindAssign (AbSyn);
249localstatic void scobindBuiltin (AbSyn);
250localstatic void scobindDeclare (AbSyn);
251localstatic void scobindDefault (AbSyn);
252localstatic void scobindDefine (AbSyn);
253localstatic void scobindDDefine (AbSyn);
254localstatic void scobindExport (AbSyn);
255localstatic void scobindExtend (AbSyn);
256localstatic void scobindFluid (AbSyn);
257localstatic void scobindFor (AbSyn);
258localstatic void scobindForeignImport (AbSyn);
259localstatic void scobindForeignExport (AbSyn);
260localstatic void scobindFree (AbSyn);
261localstatic void scobindImport (AbSyn);
262localstatic void scobindInline (AbSyn);
263localstatic void scobindLocal (AbSyn);
264localstatic void scobindReference (AbSyn);
265localstatic void scobindParam (AbSyn);
266localstatic void scobindTry (AbSyn);
267localstatic void scobindIf (AbSyn);
268localstatic void scobindAnd (AbSyn);
269
270localstatic void scobindApplySelf (AbSyn);
271localstatic Bool scobindApplyNeedsSelf (AbSyn);
272localstatic Bool scobindApplyNeedsScope (AbSyn);
273localstatic Bool scobindApplyArgNeedsScope(AbSyn);
274localstatic void scobindApplyScope (AbSyn);
275localstatic void scobindApplyParam (AbSyn);
276localstatic void scobindApplyComma (AbSyn);
277localstatic void scobindApplyArg (AbSyn);
278localstatic void scobindAssignDeclare (AbSyn);
279localstatic void scobindAssignId (AbSyn, AbSyn);
280localstatic void scobindBuiltinDeclare (AbSyn);
281localstatic void scobindBuiltinId (AbSyn, AbSyn);
282localstatic void scobindDefaultDeclare (AbSyn);
283localstatic void scobindDefaultId (AbSyn, AbSyn);
284localstatic void scobindDefineDeclare (AbSyn, AbSyn);
285localstatic void scobindDefineId (AbSyn, AbSyn, AbSyn);
286localstatic void scobindDefineRhs (AbSyn, AbSyn, DeclContext);
287localstatic void scobindDDefineComma (AbSyn);
288localstatic void scobindDDefineDeclare (AbSyn, AbSyn);
289localstatic void scobindDDefineId (AbSyn, AbSyn, AbSyn);
290localstatic void scobindExportTo (AbSyn, AbSyn);
291localstatic void scobindExportFrom (AbSyn, AbSyn);
292localstatic void scobindExportWhat (AbSyn);
293localstatic void scobindExportDeclare (AbSyn, AbSyn);
294localstatic void scobindExportId (AbSyn, AbSyn, AbSyn);
295localstatic void scobindExtendDeclare (AbSyn, AbSyn);
296localstatic void scobindExtendId (AbSyn, AbSyn, AbSyn);
297localstatic Syme scobindGetExtend (AbSyn, AbSyn);
298localstatic void scobindFluidComma (AbSyn);
299localstatic void scobindFluidDeclare (AbSyn);
300localstatic void scobindFluidId (AbSyn, AbSyn);
301localstatic void scobindFor0 (AbSyn, Bool);
302localstatic void scobindForDeclare (AbSyn, AbSyn);
303localstatic void scobindForId (AbSyn, AbSyn);
304localstatic void scobindForeignDeclare (AbSyn, ForeignOrigin);
305localstatic void scobindForeignId (AbSyn, AbSyn, ForeignOrigin);
306localstatic void scobindParamDefine (AbSyn, AbSyn);
307localstatic void scobindParamDeclare (AbSyn, AbSyn);
308localstatic void scobindParamId (AbSyn, AbSyn, AbSyn);
309localstatic Bool scoIsNewCollect (AbSyn ab);
310
311localstatic TForm scobindTfSyntaxFrAbSyn(Stab stab, AbSyn ab);
312
313/*
314 * scobindDeclare
315 */
316localstatic DeclInfo scobindDeclareId (AbSyn, AbSyn, AbSyn, DeclContext);
317localstatic TForm scobindDeclareTForm (Stab, AbSyn, AbSyn, AbSyn, DeclContext);
318localstatic void scobindUniqifyDecl (AbSyn, AbSyn);
319localstatic void scobindIntroduceId (AbSyn, AbSyn, DeclContext);
320localstatic AbSyn scobindGuessType (AbSyn);
321
322/*
323 * scobindFree
324 * scobindLocal
325 */
326localstatic void scobindLOF (AbSyn, DeclContext);
327localstatic void scobindLOFComma (AbSyn, AbSyn, DeclContext);
328localstatic void scobindLOFDeclare (AbSyn, AbSyn, DeclContext);
329localstatic void scobindLOFId (AbSyn, DeclContext);
330localstatic void scobindLOFType (AbSyn, AbSyn, AbSyn,
331 DeclContext);
332localstatic void scobindLOFDeclInfo (AbSyn, IdInfo, DeclInfo,
333 DeclContext);
334
335/*
336 * Properties of different lexical levels.
337 */
338#define scobindApplyFlags0 0
339#define scobindLambdaFlags0 0
340#define scobindAddFlags(1<<1) STAB_LEVEL_LARGE(1<<1)
341#define scobindWithFlags(1<<1) STAB_LEVEL_LARGE(1<<1)
342#define scobindWhereFlags(1<<3) STAB_LEVEL_WHERE(1<<3)
343#define scobindRepeatFlags(1<<2) STAB_LEVEL_LOOP(1<<2)
344#define scobindCollectFlags(1<<5) STAB_LEVEL_COLLECT(1<<5)
345#define scobindGenerateFlags(1<<2) STAB_LEVEL_LOOP(1<<2)
346#define scobindXGenerateFlags(1<<4) STAB_LEVEL_XGENERATE(1<<4)
347
348/*
349 * scobindIf (and conditions)
350 *
351 * FIXME: This really needs some cleanup
352 */
353localstatic void scobindIf (AbSyn);
354localstatic void scoCondPush (Stab, AbSyn, Bool);
355localstatic void scoCondPop (void);
356localstatic ScoConditionList scoConditions (void);
357localstatic DefnPos scoConditionToDefnPos(ScoConditionList);
358localstatic TfCondElt scoCondListCondElt();
359
360/*
361 * IdInfo
362 */
363localstatic IdInfo idInfoNew (Stab, AbSyn);
364localstatic void idInfoFree (IdInfo);
365localstatic Bool idInfoIsNew (IdInfo);
366localstatic void scobindFreeIdInfo (Stab);
367localstatic IdInfoList scobindSaveIdInfo (Stab);
368localstatic void scobindRestoreIdInfo (Stab, IdInfoList, Bool);
369localstatic IdInfo getIdInfoInAnyScope (Stab, AbSyn);
370localstatic IdInfo getIdInfoInThisScope (Stab, Symbol);
371localstatic void scobindSetIdUse (IdInfo, IdContext, AbSyn);
372localstatic AbSyn scobindDefaultType (Stab, Symbol);
373
374#define idInfoCell(x)((IdInfoList) (symCoInfo(x)->phaseVal.generic)) \
375 ((IdInfoList) (symCoInfo(x)->phaseVal.generic))
376
377#define setIdInfoCell(x,y)(symCoInfo(x)->phaseVal.generic = (Pointer) (y)) \
378 (symCoInfo(x)->phaseVal.generic = (Pointer) (y))
379
380/*
381 * DeclInfo
382 */
383localstatic DeclInfo declInfoNew (AbSyn, AbSyn, DefnPos);
384localstatic void declInfoFree (DeclInfo);
385localstatic Bool declInfoIsNew (DeclInfo);
386localstatic Bool declInfoUseIsNew (AbSyn);
387localstatic Bool declInfoIsImplicitLocal (DeclInfo);
388localstatic void scobindRestoreDeclInfo (IdInfo);
389localstatic DeclInfo idInfoHasType (IdInfo, AbSyn);
390localstatic DeclInfo idInfoAddType (IdInfo, AbSyn, AbSyn, AbSyn, ScoConditionList);
391localstatic void scobindSetSigUse (DeclInfo, DeclContext, AbSyn);
392localstatic Bool scobindCheckCondition (DeclInfo, ScoConditionList);
393localstatic Bool scobindCheckDefnPos (DeclInfo, DefnPos);
394
395/*
396 * scobindAddMeaning
397 */
398localstatic void scobindAddMeaning (AbSyn, Symbol, Stab,
399 SymeTag, TForm, AInt);
400localstatic Bool scobindNeedsMeaning (AbSyn, TForm);
401localstatic void scobindSetMeaning (AbSyn, Syme);
402localstatic Syme scobindDefMeaning (Stab, SymeTag, Symbol,
403 TForm, AInt);
404/*
405 * scobindReconcile
406 */
407localstatic void scobindReconcile (Stab,AbSynTag);
408localstatic void scobindReconcileId (Stab,AbSynTag,Symbol,IdInfo);
409localstatic void scobindReconcileDecls (Stab,AbSynTag,Symbol,IdInfo);
410localstatic void scobindReconcileDecl (Stab,AbSynTag,Symbol,IdInfo,
411 DeclInfo);
412
413/*
414 * scobindPrint
415 */
416extern void scobindPrint (Stab);
417localstatic void scobindPrintStab (Stab);
418localstatic void scobindPrintId (Symbol);
419localstatic void scobindPrintIdInfo (IdInfo);
420localstatic void scobindPrintDeclInfo (Length, DeclInfo);
421
422/*
423 * scobindUndo
424 */
425localstatic void scobindRestore (void);
426localstatic void scobindSave (void);
427localstatic void scobindUndo (void);
428localstatic void scoUndoStab (Stab);
429localstatic void scoUndoStabLevel (StabLevel);
430localstatic Bool scoUndoStabEntry (StabEntry);
431localstatic void scoUndoSyme (Syme);
432localstatic void scoUndoTForm (TForm);
433localstatic void scoUndoTFormUses (TFormUses);
434localstatic Bool isNewSyme (Syme);
435localstatic Bool isNewTForm (TForm);
436localstatic Bool isNewTFormUses (TFormUses);
437
438
439/*!! This needs to be cleaned up. */
440localstatic void markOuterInstanceOfFree (AbSyn, AbSyn, DeclContext);
441
442localstatic void checkOuterUseOfImplicitLocal (Stab, AbSyn, AbSyn);
443localstatic void checkOuterUseOfLexicalConstant (Stab, AbSyn);
444localstatic Bool scobindCheckOuterUseOfFluid (AbSyn, AbSyn);
445
446localstatic void scobindUsedType (Stab, AbSyn);
447localstatic void scobindImportType (Stab, AbSyn);
448
449localstatic void scobindMatchWiths (AbSyn, AbSyn, DeclContext);
450localstatic Bool scobindMatchParams (AbSyn, AbSyn);
451localstatic Bool scobindMatchParam (AbSyn, AbSyn);
452
453localstatic void scobindAdd (AbSyn);
454localstatic void scobindCollect (AbSyn);
455localstatic void scobindHas (AbSyn);
456localstatic void scobindId (AbSyn, IdContext);
457localstatic void scobindLabel (AbSyn);
458localstatic void scobindGenerate (AbSyn);
459localstatic void scobindXGenerate (AbSyn);
460localstatic void scobindLambda (AbSyn);
461localstatic void scobindRepeat (AbSyn);
462localstatic void scobindWhere (AbSyn);
463localstatic void scobindWith (AbSyn);
464
465localstatic Bool scobindTFormMustBeUnique (AbSyn ab);
466
467#define abSetTFormCond(a,t)if (! ((a)->abHdr.seman ? (a)->abHdr.seman->tform : 0
)) abSetTForm((a), (t)) if (! abTForm(a)((a)->abHdr.seman ? (a)->abHdr.seman->tform : 0)) abSetTForm((a), (t))
468
469#if 1
470#define scobindRetNeedsDefn(ab)((((ab)->abHdr.tag == (AB_Id)) && ((ab)->abId.sym
)==(ssymCategory)) || ((ab)->abHdr.tag == (AB_With))) \
471 (abIsTheId(ab, ssymCategory)(((ab)->abHdr.tag == (AB_Id)) && ((ab)->abId.sym
)==(ssymCategory)) || abHasTag(ab, AB_With)((ab)->abHdr.tag == (AB_With)))
472
473#define scobindMapNeedsDefn(ab)((((((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab)->
abHdr.argc)-1) == 2) || ((((ab)->abHdr.tag == (AB_Apply)) &&
(((((ab)->abApply.op))->abHdr.tag == (AB_Id)) &&
((((ab)->abApply.op))->abId.sym)==(ssymPackedArrow))) &&
(((ab)->abHdr.argc)-1) == 2)) && ((((((ab)->abApply
.argv[1]))->abHdr.tag == (AB_Id)) && ((((ab)->abApply
.argv[1]))->abId.sym)==(ssymCategory)) || ((((ab)->abApply
.argv[1]))->abHdr.tag == (AB_With)))) \
474 (abIsAnyMap(ab)(((((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab)->
abHdr.argc)-1) == 2) || ((((ab)->abHdr.tag == (AB_Apply)) &&
(((((ab)->abApply.op))->abHdr.tag == (AB_Id)) &&
((((ab)->abApply.op))->abId.sym)==(ssymPackedArrow))) &&
(((ab)->abHdr.argc)-1) == 2)) && scobindRetNeedsDefn(abMapRet(ab))((((((ab)->abApply.argv[1]))->abHdr.tag == (AB_Id)) &&
((((ab)->abApply.argv[1]))->abId.sym)==(ssymCategory))
|| ((((ab)->abApply.argv[1]))->abHdr.tag == (AB_With))
))
475#else
476localstatic Bool
477scobindRetNeedsDefn(AbSyn ab)((((AbSyn ab)->abHdr.tag == (AB_Id)) && ((AbSyn ab
)->abId.sym)==(ssymCategory)) || ((AbSyn ab)->abHdr.tag
== (AB_With)))
478{
479 if (abIsTheId(ab, ssymCategory)(((ab)->abHdr.tag == (AB_Id)) && ((ab)->abId.sym
)==(ssymCategory)) || abHasTag(ab, AB_With)((ab)->abHdr.tag == (AB_With)))
480 return true1;
481
482 return false((int) 0);
483}
484
485localstatic Bool
486scobindMapNeedsDefn(AbSyn ab)((((((AbSyn ab)->abHdr.tag == (AB_Apply)) && (((((
AbSyn ab)->abApply.op))->abHdr.tag == (AB_Id)) &&
((((AbSyn ab)->abApply.op))->abId.sym)==(ssymArrow))) &&
(((AbSyn ab)->abHdr.argc)-1) == 2) || ((((AbSyn ab)->abHdr
.tag == (AB_Apply)) && (((((AbSyn ab)->abApply.op)
)->abHdr.tag == (AB_Id)) && ((((AbSyn ab)->abApply
.op))->abId.sym)==(ssymPackedArrow))) && (((AbSyn ab
)->abHdr.argc)-1) == 2)) && ((((((AbSyn ab)->abApply
.argv[1]))->abHdr.tag == (AB_Id)) && ((((AbSyn ab)
->abApply.argv[1]))->abId.sym)==(ssymCategory)) || ((((
AbSyn ab)->abApply.argv[1]))->abHdr.tag == (AB_With))))
487{
488 AbSyn ret;
489 if (!abIsAnyMap(ab)(((((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab)->
abHdr.argc)-1) == 2) || ((((ab)->abHdr.tag == (AB_Apply)) &&
(((((ab)->abApply.op))->abHdr.tag == (AB_Id)) &&
((((ab)->abApply.op))->abId.sym)==(ssymPackedArrow))) &&
(((ab)->abHdr.argc)-1) == 2)))
490 return false((int) 0);
491 ret = abMapRet(ab)((ab)->abApply.argv[1]);
492
493 if (abIsAnyMap(ret)(((((ret)->abHdr.tag == (AB_Apply)) && (((((ret)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ret)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ret)->
abHdr.argc)-1) == 2) || ((((ret)->abHdr.tag == (AB_Apply))
&& (((((ret)->abApply.op))->abHdr.tag == (AB_Id
)) && ((((ret)->abApply.op))->abId.sym)==(ssymPackedArrow
))) && (((ret)->abHdr.argc)-1) == 2)))
494 return scobindMapNeedsDefn(ret)((((((ret)->abHdr.tag == (AB_Apply)) && (((((ret)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ret)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ret)->
abHdr.argc)-1) == 2) || ((((ret)->abHdr.tag == (AB_Apply))
&& (((((ret)->abApply.op))->abHdr.tag == (AB_Id
)) && ((((ret)->abApply.op))->abId.sym)==(ssymPackedArrow
))) && (((ret)->abHdr.argc)-1) == 2)) && (
(((((ret)->abApply.argv[1]))->abHdr.tag == (AB_Id)) &&
((((ret)->abApply.argv[1]))->abId.sym)==(ssymCategory)
) || ((((ret)->abApply.argv[1]))->abHdr.tag == (AB_With
))));
495
496 return scobindRetNeedsDefn(ret)((((ret)->abHdr.tag == (AB_Id)) && ((ret)->abId
.sym)==(ssymCategory)) || ((ret)->abHdr.tag == (AB_With)));
497
498}
499
500#endif
501localstatic Bool
502scobindTFormMustBeUnique(AbSyn ab)
503{
504 if (abIsAnyMap(ab)(((((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->
abApply.op))->abHdr.tag == (AB_Id)) && ((((ab)->
abApply.op))->abId.sym)==(ssymArrow))) && (((ab)->
abHdr.argc)-1) == 2) || ((((ab)->abHdr.tag == (AB_Apply)) &&
(((((ab)->abApply.op))->abHdr.tag == (AB_Id)) &&
((((ab)->abApply.op))->abId.sym)==(ssymPackedArrow))) &&
(((ab)->abHdr.argc)-1) == 2)))
505 return scobindTFormMustBeUnique(abMapRet(ab)((ab)->abApply.argv[1]));
506
507 return abIsTheId(ab,ssymCategory)(((ab)->abHdr.tag == (AB_Id)) && ((ab)->abId.sym
)==(ssymCategory));
508}
509
510
511/******************************************************************************
512 *
513 * :: scopeBind Top-level external entry points.
514 *
515 *****************************************************************************/
516
517void
518scobindInitFile(void)
519{
520 scoIdInfoList = listNil(IdInfo)((IdInfoList) 0);
521 scoUndoState = false((int) 0);
522 scoDefCounter = 1;
523}
524
525void
526scobindFiniFile(void)
527{
528 listFreeDeeply(IdInfo)(IdInfo_listPointer->FreeDeeply)(scoIdInfoList, idInfoFree);
529 scoIdInfoList = listNil(IdInfo)((IdInfoList) 0);
530 scoUndoState = false((int) 0);
531}
532
533int
534scobindMaxDef()
535{
536 return scoDefCounter;
537}
538
539void
540scoSetUndoState(void)
541{
542 scoUndoState = true1;
543}
544
545void
546scopeBind(Stab stab, AbSyn absyn)
547{
548 scoStab = stab;
549 scoIsInType = false((int) 0);
550 scoIsInAdd = false((int) 0);
551 scoIsInExtend = false((int) 0);
552 scoIsInExport = false((int) 0);
553 scoIsInImport = false((int) 0);
554 scoDefineList = listNil(AbSyn)((AbSynList) 0);
555 scoLambdaList = listNil(LambdaInfo)((LambdaInfoList) 0);
556
557 if (DEBUG(sco)scoDebug) {
558 fprintf(dbOut, "Top-level Scope Begin");
559 findent += 2;
560 fnewline(dbOut);
561 }
562
563 scobindRestore();
564
565 scobindValue(absyn);
566 scobindLambdaList();
567 scobindReconcile(scoStab, AB_Add);
568
569 scobindSave();
570
571 if (DEBUG(sco)scoDebug) {
572 findent -= 2;
573 fnewline(dbOut);
574 scobindPrint(scoStab);
575 if (DEBUG(scoStab)scoStabDebug) {
576 stabPrint(dbOut, scoStab);
577 }
578 fnewline(dbOut);
579 fprintf(dbOut, "Top-level Scope End\n\n");
580 fnewline(dbOut);
581 }
582}
583
584localstatic void
585scobindRestore()
586{
587 if (scoIdInfoList) {
588 scobindRestoreIdInfo(scoStab, scoIdInfoList, scoUndoState);
589 scoIdInfoList = listNil(IdInfo)((IdInfoList) 0);
590
591 if (scoUndoState) scobindUndo();
592 }
593}
594
595localstatic void
596scobindSave()
597{
598 if (fintMode == FINT_LOOP2)
599 scoIdInfoList = scobindSaveIdInfo(scoStab);
600 else
601 scobindFreeIdInfo(scoStab);
602}
603
604/******************************************************************************
605 *
606 * :: scobindValue Top-level recursive entry point.
607 *
608 *****************************************************************************/
609
610localstatic void
611scobindValue(AbSyn absyn)
612{
613 Bool isCoroutine;
614
615 switch (abTag(absyn)((absyn)->abHdr.tag)) {
616 case AB_Nothing:
617 break;
618
619 case AB_Assign:
620 case AB_Builtin:
621 case AB_Declare:
622 case AB_Default:
623 case AB_Define:
624 case AB_DDefine:
625 case AB_Export:
626 case AB_Extend:
627 case AB_Fluid:
628 case AB_For:
629 case AB_ForeignImport:
630 case AB_ForeignExport:
631 case AB_Free:
632 case AB_Import:
633 case AB_Inline:
634 case AB_Local:
635 scobindContext(absyn);
636 break;
637
638 case AB_Add:
639 scobindLevel(absyn, scobindAdd, scobindAddFlags(1<<1));
640 break;
641
642 case AB_Apply:
643 scobindApply(absyn);
644 break;
645
646 case AB_CoerceTo:
647 scobindValue(absyn->abCoerceTo.expr);
648 scobindUsedType(scoStab, absyn->abCoerceTo.type);
649 break;
650
651 case AB_Collect:
652 if (gfGenTypeDefault() == GENTYPE_Coroutine || scoIsNewCollect(absyn)) {
653 scobindLevel(absyn, scobindCollect, scobindXGenerateFlags(1<<4));
654 }
655 else {
656 scobindLevel(absyn, scobindCollect, scobindCollectFlags(1<<5));
657 }
658 break;
659
660 case AB_Generate:
661 isCoroutine = gfGenTypeGenerator(absyn) == GENTYPE_Coroutine;
662 if (isCoroutine) {
663 scobindLevel(absyn, scobindXGenerate, scobindXGenerateFlags(1<<4));
664 }
665 else {
666 scobindLevel(absyn, scobindGenerate, scobindGenerateFlags(1<<2));
667 }
668 break;
669
670 case AB_Fix:
671 bugUnimpl("scoBind")bug("Unimplemented %s (line %d in file %s).", "scoBind", 671,
"scobind.c");
672
673 case AB_Has:
674 scobindHas(absyn);
675 break;
676
677 case AB_Hide:
678 scobindUsedType(scoStab, absyn->abHide.type);
679 abSetTFormCond(absyn, abTForm(absyn->abHide.type))if (! ((absyn)->abHdr.seman ? (absyn)->abHdr.seman->
tform : 0)) abSetTForm((absyn), (((absyn->abHide.type)->
abHdr.seman ? (absyn->abHide.type)->abHdr.seman->tform
: 0)));
680 break;
681
682 case AB_Id:
683 scobindId(absyn, SCO_Id_Used);
684 break;
685
686 case AB_Label:
687 scobindLabel(absyn->abLabel.label);
688 scobindValue(absyn->abLabel.expr);
689 break;
690
691 case AB_Lambda:
692 case AB_PLambda:
693 scobindLevel(absyn, scobindLambda, scobindLambdaFlags0);
694 break;
695
696 case AB_PretendTo:
697 scobindValue(absyn->abPretendTo.expr);
698 scobindUsedType(scoStab, absyn->abPretendTo.type);
699 break;
700
701 case AB_Qualify:
702 scobindValue(absyn->abQualify.what);
703 scobindUsedType(scoStab, absyn->abQualify.origin);
704 break;
705
706 case AB_Reference:
707 scobindReference(absyn->abReference.body);
708 break;
709
710 case AB_Repeat:
711 scobindLevel(absyn, scobindRepeat, scobindRepeatFlags(1<<2));
712 break;
713
714 case AB_RestrictTo:
715 scobindValue(absyn->abRestrictTo.expr);
716 scobindUsedType(scoStab, absyn->abRestrictTo.type);
717 break;
718 case AB_Where:
719 scobindLevel(absyn, scobindWhere, scobindWhereFlags(1<<3));
720 break;
721 case AB_Try:
722 scobindTry(absyn);
723 break;
724
725 case AB_With:
726 if (!abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)) /* check if already done */
727 scobindLevel(absyn, scobindWith, scobindWithFlags(1<<1));
728 break;
729
730 case AB_If:
731 scobindIf(absyn);
732 break;
733
734 case AB_And:
735 scobindAnd(absyn);
736 break;
737
738 default:
739 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START)) {
740 Length i, argc = abArgc(absyn)((absyn)->abHdr.argc);
741 AbSyn *argv = abArgv(absyn)((absyn)->abGen.data.argv);
742
743 for (i = 0; i < argc; i += 1)
744 scobindValue(argv[i]);
745 }
746 break;
747 }
748}
749
750/******************************************************************************
751 *
752 * :: scobindContext Dispatch function for signature introducing contexts.
753 *
754 *****************************************************************************/
755
756localstatic void
757scobindContext(AbSyn absyn)
758{
759 switch (abTag(absyn)((absyn)->abHdr.tag)) {
760 case AB_Assign:
761 scobindAssign(absyn);
762 break;
763
764 case AB_Builtin:
765 scobindBuiltin(absyn);
766 break;
767
768 case AB_Declare:
769 scobindDeclare(absyn);
770 break;
771
772 case AB_Default:
773 scobindDefault(absyn);
774 break;
775
776 case AB_Define:
777 scobindDefine(absyn);
778 break;
779
780 case AB_DDefine:
781 scobindDDefine(absyn);
782 break;
783
784 case AB_Export:
785 scobindExport(absyn);
786 break;
787
788 case AB_Extend:
789 scobindExtend(absyn);
790 break;
791
792 case AB_Fluid:
793 scobindFluid(absyn);
794 break;
795
796 case AB_For:
797 scobindFor(absyn);
798 break;
799
800 case AB_ForeignImport:
801 scobindForeignImport(absyn);
802 break;
803
804 case AB_ForeignExport:
805 scobindForeignExport(absyn);
806 break;
807
808 case AB_Free:
809 scobindFree(absyn);
810 break;
811
812 case AB_Import:
813 scobindImport(absyn);
814 break;
815
816 case AB_Inline:
817 scobindInline(absyn);
818 break;
819
820 case AB_Local:
821 scobindLocal(absyn);
822 break;
823
824 default:
825 bugBadCase(abTag(absyn))bug("Bad case %d (line %d in file %s).", (int) ((absyn)->abHdr
.tag), 825, "scobind.c");
826 break;
827 }
828}
829
830/******************************************************************************
831 *
832 * :: scobindType Top-level entry point for types.
833 *
834 *****************************************************************************/
835
836localstatic void
837scobindType(AbSyn type)
838{
839 Bool save = scoIsInType;
840
841 scoIsInType = true1;
842 scobindValue(type);
843 scoIsInType = save;
844}
845
846/******************************************************************************
847 *
848 * :: scobindLevel Apply 'fun' within a new scope level.
849 *
850 *****************************************************************************/
851
852localstatic void
853scobindLevel(AbSyn absyn, ScoBindFun fun, ULong flags)
854{
855 LambdaInfoList savedLambdaList;
856 Bool saveInType = scoIsInType;
857
858
859 assert(absyn)do { if (!(absyn)) _do_assert(("absyn"),"scobind.c",859); } while
(0);
860
861 if (abIsNothing(absyn)((absyn)->abHdr.tag == (AB_Nothing)))
862 return;
863
864 savedLambdaList = scoLambdaList;
865
866 scoLambdaList = listNil(LambdaInfo)((LambdaInfoList) 0);
867
868 /*
869 * If we start a new scope level then we are no longer in a
870 * type. This fixes bugs such as bug 988 where we used to give
871 * spurious errors about variables being used in constants.
872 * However, this hides some instances where a variable is used
873 * in a type. The simplest example of this is as follows: given
874 * a domain constructor Foo(X:SingleInteger),
875 *
876 * local myVar:SingleInteger := 42;
877 * import from Foo(X == myVar);
878 *
879 * We compute the type Foo(X) before giving X the value of myVar.
880 * This is probably one area where variables can be used in a
881 * type because the definition nails the value into a constant.
882 */
883 scoIsInType = false((int) 0);
884
885 scobindSetStab(absyn, flags);
886 scoStab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0);
887
888 if (DEBUG(sco)scoDebug) {
889 fprintf(dbOut, "%s Scope Begin (# %lu) (lambda: %ld lex: %ld)",
890 abInfo(abTag(absyn))abInfoTable[(((absyn)->abHdr.tag)) - AB_START].str, car(scoStab)((scoStab)->first)->serialNo,
891 car(scoStab)((scoStab)->first)->lambdaLevel, car(scoStab)((scoStab)->first)->lexicalLevel);
892 findent += 2;
893 fnewline(dbOut);
894 }
895
896 fun(absyn);
897 scobindLambdaList();
898 scobindReconcile(scoStab, abTag(absyn)((absyn)->abHdr.tag));
899
900 if (DEBUG(sco)scoDebug) {
901 scobindPrint(scoStab);
902 if (DEBUG(scoStab)scoStabDebug) {
903 stabPrintTo(dbOut, scoStab, -1);
904 }
905 findent -= 2;
906 fnewline(dbOut);
907 fprintf(dbOut, "%s Scope End (# %lu)",
908 abInfo(abTag(absyn))abInfoTable[(((absyn)->abHdr.tag)) - AB_START].str, car(scoStab)((scoStab)->first)->serialNo);
909 fnewline(dbOut);
910 }
911
912 scobindFreeIdInfo(scoStab);
913
914 scoStab = stabPopLevel(scoStab);
915 scoLambdaList = savedLambdaList;
916 scoIsInType = saveInType;
917}
918
919localstatic void
920scobindLambdaList(void)
921{
922 ScoConditionList savedScoCondList = scoCondList;
923
924 scoLambdaList = listNReverse(LambdaInfo)(LambdaInfo_listPointer->NReverse)(scoLambdaList);
925 while (scoLambdaList) {
926 LambdaInfo info = car(scoLambdaList)((scoLambdaList)->first);
927 AbSyn lhs = info->lhs;
928 AbSyn rhs = info->rhs;
929
930 scoCondList = info->scoCondList;
931 scobindPushDefine(lhs);
932 scobindLevel(rhs, scobindLambda, scobindLambdaFlags0);
933 scobindPopDefine(lhs);
934
935 lambdaInfoFree(info);
936 scoLambdaList = listFreeCons(LambdaInfo)(LambdaInfo_listPointer->FreeCons)(scoLambdaList);
937 }
938
939 scoCondList = savedScoCondList;
940}
941
942localstatic void
943scobindPushDefine(AbSyn lhs)
944{
945 if (!abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma)))
946 listPush(AbSyn, abDefineeId(lhs), scoDefineList)(scoDefineList = (AbSyn_listPointer->Cons)(abDefineeId(lhs
), scoDefineList));
947}
948
949localstatic void
950scobindPopDefine(AbSyn lhs)
951{
952 if (!abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma)))
953 scoDefineList = listFreeCons(AbSyn)(AbSyn_listPointer->FreeCons)(scoDefineList);
954}
955
956localstatic void
957scobindSetStab(AbSyn absyn, ULong flags)
958{
959 Stab stab = stabPushLevel(scoStab, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)), flags);
960 scobindStabHash(absyn, stab);
961 abSetStab(absyn, stab);
962}
963
964localstatic Bool
965scobindStabHashIsUsed(Stab stab, Hash h)
966{
967 StabList l;
968
969 if (car(stab)((stab)->first)->hash == h)
970 return true1;
971
972 for (l = car(stab)((stab)->first)->children; l; l = cdr(l)((l)->rest))
973 if (scobindStabHashIsUsed(car(l)((l)->first), h))
974 return true1;
975
976 return false((int) 0);
977}
978
979localstatic void
980scobindStabHash(AbSyn absyn, Stab stab0)
981{
982 Hash h = abHashList(listCons(AbSyn)(AbSyn_listPointer->Cons)(absyn, scoDefineList));
983
984 if (h && !scobindStabHashIsUsed(stabFile(), h))
985 car(stab0)((stab0)->first)->hash = h;
986}
987
988/*
989 * scopeBind functions called through scobindLevel
990 */
991
992localstatic void
993scobindAdd(AbSyn absyn)
994{
995 AbSyn base = absyn->abAdd.base;
996 AbSyn capsule = absyn->abAdd.capsule;
997 Bool save = scoIsInAdd;
998
999 scoIsInAdd = true1;
1000 scobindValue(base);
1001 scobindValue(capsule);
1002 scoIsInAdd = save;
1003
1004 stabDefLexVar(scoStab, ssymSelf, tfType);
1005}
1006
1007localstatic void
1008scobindLambda(AbSyn absyn)
1009{
1010 TForm tf;
1011 AbSyn ret = absyn->abLambda.rtype;
1012 Bool save = scoIsInAdd;
1013
1014 scobindParam(absyn->abLambda.param);
1015 if (ret && abIsNotNothing(ret)!((ret)->abHdr.tag == (AB_Nothing))) {
1016 AbSyn *retv = abArgvAs(AB_Comma, ret)(((ret)->abHdr.tag == (AB_Comma)) ? ((ret)->abGen.data.
argv) : &(ret));
1017 Length i, retc = abArgcAs(AB_Comma, ret)(((ret)->abHdr.tag == (AB_Comma)) ? ((ret)->abHdr.argc)
: 1);
1018
1019 scobindType(ret);
1020
1021 /* Save the rhs on the return type if needed. */
1022 if (scobindRetNeedsDefn(ret)((((ret)->abHdr.tag == (AB_Id)) && ((ret)->abId
.sym)==(ssymCategory)) || ((ret)->abHdr.tag == (AB_With))))
1023 tf = tfSyntaxDefine(scoStab,ret,absyn->abLambda.body);
1024
1025 /* Import from each of the return types. */
1026 for (i = 0; i < retc; i += 1) {
1027 AbSyn reti = retv[i];
1028
1029 tf = abTForm(ret)((ret)->abHdr.seman ? (ret)->abHdr.seman->tform : 0);
1030 if (tf == NULL((void*)0)) {
1031 tf = scobindTfSyntaxFrAbSyn(scoStab, reti);
1032 abSetTForm(reti, tf);
1033 }
1034 if (!abHasTag(reti, AB_Hide)((reti)->abHdr.tag == (AB_Hide)))
1035 stabImportTForm(scoStab, tf);
1036 }
1037
1038 /* Make sure product types have a type form. */
1039 if (abTForm(ret)((ret)->abHdr.seman ? (ret)->abHdr.seman->tform : 0) == NULL((void*)0))
1040 abSetTForm(ret, scobindTfSyntaxFrAbSyn(scoStab, ret));
1041 }
1042#if RTYPE
1043 else
1044 comsgError(absyn, ALDOR_E_ChkMissingRetType95);
1045#endif
1046 scoIsInAdd = false((int) 0);
1047 scobindValue(absyn->abLambda.body);
1048 scoIsInAdd = save;
1049}
1050
1051localstatic void
1052scobindCollect(AbSyn absyn)
1053{
1054 int i, itc = abCollectIterc(absyn)(((absyn)->abHdr.argc)-1);
1055
1056 for (i = 0; i < itc; i++)
1057 scobindValue(absyn->abCollect.iterv[i]);
1058 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1);
1059 scobindValue(absyn->abCollect.body);
1060 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
1061}
1062
1063localstatic void
1064scobindGenerate(AbSyn absyn)
1065{
1066 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1);
1067 scobindValue(absyn->abGenerate.count);
1068 scobindValue(absyn->abGenerate.body);
1069 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
1070}
1071
1072localstatic void
1073scobindXGenerate(AbSyn absyn)
1074{
1075 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1);
1076 scobindValue(absyn->abGenerate.count);
1077 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
1078 scobindValue(absyn->abGenerate.body);
1079}
1080
1081
1082localstatic void
1083scobindRepeat(AbSyn absyn)
1084{
1085 int i, itc = abRepeatIterc(absyn)(((absyn)->abHdr.argc)-1);
1086
1087 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1);
1088 for (i = 0; i < itc; i++)
1089 scobindValue(absyn->abRepeat.iterv[i]);
1090 scobindValue(absyn->abRepeat.body);
1091 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
1092}
1093
1094localstatic void
1095scobindWhere(AbSyn absyn)
1096{
1097 scobindValue(absyn->abWhere.context);
1098 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1); /* 'for' does unlock locally */
1099 scobindValue(absyn->abWhere.expr);
1100 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
1101}
1102
1103localstatic void
1104scobindWith(AbSyn absyn)
1105{
1106 AbSyn base = absyn->abWith.base;
1107 AbSyn within = absyn->abWith.within;
1108 TForm tfbase, tf;
1109 Syme syme;
1110
1111 if (abIsNotNothing(base)!((base)->abHdr.tag == (AB_Nothing))) {
1112 tfbase = scobindTfSyntaxFrAbSyn(scoStab, base);
1113 stabCategoricallyImportTForm(scoStab, tfbase);
1114 }
1115 tf = stabMakeUsedTForm(cdr(scoStab)((scoStab)->rest), absyn, scoCondListCondElt());
1116 syme = stabDefLexVar(scoStab, ssymSelf, tf);
1117
1118 scobindValue(base);
1119 scobindExportWhat(within);
1120}
1121
1122localstatic void
1123scobindHas(AbSyn absyn)
1124{
1125 AbSyn cat = absyn->abHas.property;
1126 AbSyn dom = absyn->abHas.expr;
1127 TForm tfdom, tfcat;
1128
1129 scobindValue(cat);
1130 scobindValue(dom);
1131
1132 tfcat = stabMakeUsedTForm(scoStab, cat, scoCondListCondElt());
1133 tfdom = stabMakeUsedTForm(scoStab, dom, scoCondListCondElt());
1134
1135 stabAddTFormQuery(scoStab, tfdom, tfcat);
1136}
1137
1138localstatic void
1139scobindId(AbSyn id, IdContext context)
1140{
1141 if (id) {
1142 IdInfo idInfo;
1143 Bool okayContext;
1144
1145 assert(abHasTag(id, AB_Id))do { if (!(((id)->abHdr.tag == (AB_Id)))) _do_assert(("abHasTag(id, AB_Id)"
),"scobind.c",1145); } while (0);
1146
1147 idInfo = getIdInfoInAnyScope(scoStab, id);
1148 scobindSetIdUse(idInfo, context, id);
1149
1150 if (scoIsInType)
1151 scobindSetIdUse(idInfo, SCO_Id_InType, id);
1152
1153 /*
1154 * Note use-before-definitions. We ought to be doing
1155 * this using data-flow _after_ type inference (so
1156 * that we can ignore lazy values such as domains).
1157 * Until then we have to exclude certain contexts.
1158 */
1159 okayContext = scoIsInAdd || scoIsInExport || scoIsInImport ||
1160 scoIsInExtend;
1161 if (!idInfo->declInfoList && !okayContext) {
1162 AbSynList uses = idInfo->usePreDef;
1163 idInfo->usePreDef = listCons(AbSyn)(AbSyn_listPointer->Cons)(id, uses);
1164 }
1165 }
1166}
1167
1168localstatic void
1169scobindLabel(AbSyn lab)
1170{
1171 assert(lab)do { if (!(lab)) _do_assert(("lab"),"scobind.c",1171); } while
(0);
1172
1173 if (abIsNotNothing(lab)!((lab)->abHdr.tag == (AB_Nothing))) {
1174 IdInfo idInfo;
1175 assert(abHasTag(lab, AB_Id))do { if (!(((lab)->abHdr.tag == (AB_Id)))) _do_assert(("abHasTag(lab, AB_Id)"
),"scobind.c",1175); } while (0);
1176
1177 idInfo = getIdInfoInAnyScope(scoStab, lab);
1178 scobindSetIdUse(idInfo, SCO_Id_Label, lab);
1179 stabAddLabel(scoStab, lab);
1180 }
1181}
1182
1183/******************************************************************************
1184 *
1185 * :: scobind utility functions.
1186 *
1187 *****************************************************************************/
1188
1189/*
1190 * Try to match up symbol table of 'with' forms in abType with those in
1191 * abLamb. abType has already been analyzed.
1192 *
1193 * Future work: we need to be much better at detecting domains and
1194 * categories. We rely on finding a "with" for the type. This is
1195 * usually okay because abnorm tries hard to ensure that all domain
1196 * definitions get a "with" for their type. It fails when we have
1197 * non-obvious domain definitions such as:
1198 *
1199 * MyInteger:Ring == Integer;
1200 *
1201 * The problem is that we don't recognise Integer as being a domain
1202 * or Ring as being a category until after tinfer. By then it might
1203 * be too late.
1204 */
1205localstatic void
1206scobindMatchWiths(AbSyn abType, AbSyn abLamb, DeclContext context)
1207{
1208 AbSyn lparam = abLamb->abLambda.param,
1209 lrtype = abLamb->abLambda.rtype;
1210
1211 if (abIsAnyMap(abType)(((((abType)->abHdr.tag == (AB_Apply)) && (((((abType
)->abApply.op))->abHdr.tag == (AB_Id)) && ((((abType
)->abApply.op))->abId.sym)==(ssymArrow))) && ((
(abType)->abHdr.argc)-1) == 2) || ((((abType)->abHdr.tag
== (AB_Apply)) && (((((abType)->abApply.op))->
abHdr.tag == (AB_Id)) && ((((abType)->abApply.op))
->abId.sym)==(ssymPackedArrow))) && (((abType)->
abHdr.argc)-1) == 2)) &&
1212 (context == SCO_Sig_Extend ||
1213 context == SCO_Sig_DDefine ||
1214 scobindRetNeedsDefn(lrtype)((((lrtype)->abHdr.tag == (AB_Id)) && ((lrtype)->
abId.sym)==(ssymCategory)) || ((lrtype)->abHdr.tag == (AB_With
))))) {
1215 AbSyn aparam = abArgv(abType)((abType)->abGen.data.argv)[1],
1216 artype = abArgv(abType)((abType)->abGen.data.argv)[2];
1217
1218 if (!abEqual(lrtype, artype))
1219 return;
1220 if (abHasTag(aparam, AB_Comma)((aparam)->abHdr.tag == (AB_Comma)) && 1 == abArgc(aparam)((aparam)->abHdr.argc))
1221 aparam = abArgv(aparam)((aparam)->abGen.data.argv)[0];
1222 if (abHasTag(lparam, AB_Comma)((lparam)->abHdr.tag == (AB_Comma)) && 1 == abArgc(lparam)((lparam)->abHdr.argc))
1223 lparam = abArgv(lparam)((lparam)->abGen.data.argv)[0];
1224
1225 if (scobindMatchParams(aparam, lparam)) {
1226 abTransferSemantics(aparam, lparam);
1227 abTransferSemantics(artype, lrtype);
1228 }
1229 }
1230}
1231
1232/*
1233 * Do the map parameters from a type declaration match the
1234 * map parameters from the lambda definition?
1235 */
1236localstatic Bool
1237scobindMatchParams(AbSyn aparam, AbSyn lparam)
1238{
1239 AbSyn *parv = abArgvAs(AB_Comma, lparam)(((lparam)->abHdr.tag == (AB_Comma)) ? ((lparam)->abGen
.data.argv) : &(lparam));
1240 Length parc = abArgcAs(AB_Comma, lparam)(((lparam)->abHdr.tag == (AB_Comma)) ? ((lparam)->abHdr
.argc) : 1);
1241 AbSyn *argv = abArgvAs(AB_Comma, aparam)(((aparam)->abHdr.tag == (AB_Comma)) ? ((aparam)->abGen
.data.argv) : &(aparam));
1242 Length i, argc = abArgcAs(AB_Comma, aparam)(((aparam)->abHdr.tag == (AB_Comma)) ? ((aparam)->abHdr
.argc) : 1);
1243
1244 Bool result = (parc == argc);
1245
1246 for (i = 0; result && i < argc; i += 1) {
1247 AbSyn par = parv[i];
1248 AbSyn arg = argv[i];
1249
1250 result &= scobindMatchParam(arg, par);
1251 }
1252
1253 return result;
1254}
1255
1256/*
1257 * Does a parameter from a map type declaration match the corresponding
1258 * parameter from the lambda definition? Accepts declaration, definition
1259 * and identifier nodes as arguments.
1260 */
1261localstatic Bool
1262scobindMatchParam(AbSyn arg, AbSyn par)
1263{
1264 AbSynTag aTag = abTag(arg)((arg)->abHdr.tag);
1265 AbSynTag pTag = abTag(par)((par)->abHdr.tag);
1266 const char *err = "parameter is not an identifier or a declaration";
1267
1268 /* Safety check */
1269 assert(aTag == AB_Define || aTag == AB_Declare || aTag == AB_Id)do { if (!(aTag == AB_Define || aTag == AB_Declare || aTag ==
AB_Id)) _do_assert(("aTag == AB_Define || aTag == AB_Declare || aTag == AB_Id"
),"scobind.c",1269); } while (0);
1270 assert(pTag == AB_Define || pTag == AB_Declare || pTag == AB_Id)do { if (!(pTag == AB_Define || pTag == AB_Declare || pTag ==
AB_Id)) _do_assert(("pTag == AB_Define || pTag == AB_Declare || pTag == AB_Id"
),"scobind.c",1270); } while (0);
1271
1272 /* Extract declarations from default value definitions */
1273 if (aTag == AB_Define)
1274 return scobindMatchParam(arg->abDefine.lhs, par);
1275 if (pTag == AB_Define)
1276 return scobindMatchParam(arg, par->abDefine.lhs);
1277
1278 /*
1279 * Argument and parameter are declarations or identifiers.
1280 * If only one is a declaration then ignore that declaration.
1281 * We could simply return abEqual(arg->abDeclare.id, par) or
1282 * abEqual(arg, par->abDeclare.id) but we play safe.
1283 */
1284 if (aTag != pTag) {
1285 /* Which is the declaration node? */
1286 if (aTag == AB_Declare) /* && (pTag == AB_Id) */
1287 return scobindMatchParam(arg->abDeclare.id, par);
1288 if (pTag == AB_Declare) /* && (aTag == AB_Id) */
1289 return scobindMatchParam(arg, par->abDeclare.id);
1290
1291 /* Impossible */
1292 comsgFatal(arg, ALDOR_F_Bug365, err);
1293 NotReached(return false){(void)bug("Not supposed to reach line %d in file: %s\n",1293
, "scobind.c");};
1294 }
1295
1296 /* Either two declarations or two identifiers */
1297 if (aTag == AB_Id) /* && (pTag == AB_Id) */
1298 return abEqual(arg, par);
1299
1300 /* Must be two declarations */
1301 if (aTag != AB_Declare) {
1302 comsgFatal(arg, ALDOR_F_Bug365, err);
1303 NotReached(return false){(void)bug("Not supposed to reach line %d in file: %s\n",1303
, "scobind.c");};
1304 }
1305
1306 /* Compare identifiers */
1307 if (!abEqual(arg->abDeclare.id, par->abDeclare.id)) return false((int) 0);
1308
1309 /* Identifiers match: check the types */
1310 arg = arg->abDeclare.type;
1311 par = par->abDeclare.type;
1312
1313 /* Identifiers match: compare types if possible */
1314 if (abIsNothing(arg)((arg)->abHdr.tag == (AB_Nothing)) || abIsNothing(par)((par)->abHdr.tag == (AB_Nothing))) return true1;
1315
1316 /* Types are present: must be equal */
1317 return abEqual(arg, par);
1318}
1319
1320localstatic void
1321markOuterInstanceOfFree(AbSyn id, AbSyn type, DeclContext context)
1322{
1323 Stab stab;
1324 Symbol sym = id->abId.sym;
1325 Bool diffType = false((int) 0);
1326
1327 assert(type)do { if (!(type)) _do_assert(("type"),"scobind.c",1327); } while
(0);
1328
1329 for (stab = cdr(scoStab)((scoStab)->rest); stab; stab = cdr(stab)((stab)->rest)) {
1330 IdInfo idInfo = getIdInfoInThisScope(stab, sym);
1331 DeclInfo di;
1332
1333 if (!idInfo) continue;
1334
1335 if (idInfo->allFree || !idInfo->declInfoList)
1336 continue;
1337
1338 if (abIsUnknown(type)((type)->abHdr.tag == (AB_Blank)))
1339 di = car(idInfo->declInfoList)((idInfo->declInfoList)->first);
1340 else if ((di = idInfoHasType(idInfo, type)) != NULL((void*)0))
1341 ;
1342 else if ((di = idInfoHasType(idInfo, abUnknown)) != NULL((void*)0))
1343 di->type = type;
1344 else
1345 diffType = true1;
1346
1347 if (!di || di->uses[SCO_Sig_Free])
1348 continue;
1349
1350 scobindSetSigUse(di, context, id);
1351 return;
1352 }
1353
1354 if (diffType)
1355 comsgError(id, ALDOR_E_ScoBadTypeFree116, symString(sym)((sym)->str));
1356 else
1357 comsgError(id, ALDOR_E_ScoUnknownFree130, symString(sym)((sym)->str));
1358}
1359
1360localstatic void
1361scobindImportType(Stab stab, AbSyn type)
1362{
1363 if (abHasTag(type, AB_Hide)((type)->abHdr.tag == (AB_Hide))) {
1364 scobindUsedType(stab, type->abHide.type);
1365 abSetTFormCond(type, abTForm(type->abHide.type))if (! ((type)->abHdr.seman ? (type)->abHdr.seman->tform
: 0)) abSetTForm((type), (((type->abHide.type)->abHdr.
seman ? (type->abHide.type)->abHdr.seman->tform : 0)
));
1366 }
1367 else {
1368 scobindType(type);
1369 abSetTFormCond(type,if (! ((type)->abHdr.seman ? (type)->abHdr.seman->tform
: 0)) abSetTForm((type), (stabImportTForm(stab, scobindTfSyntaxFrAbSyn
(stab, type))))
1370 stabImportTForm(stab, scobindTfSyntaxFrAbSyn(stab, type)))if (! ((type)->abHdr.seman ? (type)->abHdr.seman->tform
: 0)) abSetTForm((type), (stabImportTForm(stab, scobindTfSyntaxFrAbSyn
(stab, type))));
1371 }
1372}
1373
1374localstatic void
1375scobindUsedType(Stab stab, AbSyn type)
1376{
1377 scobindType(type);
1378 stabMakeUsedTForm(stab, type, scoCondListCondElt());
1379}
1380
1381localstatic void
1382checkOuterUseOfImplicitLocal(Stab stab, AbSyn id, AbSyn type)
1383{
1384 /*
1385 * id is an implicit local. It is an error if it is local, free or a
1386 * parameter in an outer scope. If type != 0, the types must match
1387 * in an outer scope to generate the message.
1388 */
1389
1390 Symbol sym = id->abId.sym;
1391
1392 for (stab = cdr(stab)((stab)->rest); stab; stab = cdr(stab)((stab)->rest)) {
1393 IdInfo idInfo = getIdInfoInThisScope(stab, sym);
1394 DeclInfoList dil;
1395
1396 if (! idInfo)
1397 continue;
1398
1399 for (dil = idInfo->declInfoList; dil; dil = cdr(dil)((dil)->rest)) {
1400 DeclInfo outerDeclInfo = car(dil)((dil)->first);
1401
1402 if ((abIsUnknown(type)((type)->abHdr.tag == (AB_Blank)) ||
1403 abIsUnknown(outerDeclInfo->type)((outerDeclInfo->type)->abHdr.tag == (AB_Blank)) ||
1404 abEqualModDeclares(type, outerDeclInfo->type)) &&
1405 (outerDeclInfo->uses[SCO_Sig_ImplicitLocal] ||
1406 outerDeclInfo->uses[SCO_Sig_Local] ||
1407 outerDeclInfo->uses[SCO_Sig_Free] ||
1408 outerDeclInfo->uses[SCO_Sig_Param]))
1409 {
1410 comsgWarning(id, ALDOR_W_ScoBadLocal132,
1411 symString(sym)((sym)->str));
1412 return;
1413 }
1414 }
1415 }
1416}
1417
1418localstatic void
1419checkOuterUseOfLexicalConstant(Stab stab, AbSyn id)
1420{
1421 /*
1422 * id is an implicit or explicit lexical constant. It is illegal
1423 * to have a parameter or lexical variable in an outer scope with
1424 * the same name.
1425 */
1426
1427 Symbol sym = id->abId.sym;
1428
1429 for (stab = cdr(stab)((stab)->rest); stab; stab = cdr(stab)((stab)->rest)) {
1430 IdInfo idInfo = getIdInfoInThisScope(stab, sym);
1431 DeclInfoList dil;
1432
1433 if (! idInfo)
1434 continue;
1435
1436 for (dil = idInfo->declInfoList; dil; dil = cdr(dil)((dil)->rest)) {
1437 DeclInfo odi = car(dil)((dil)->first); /* outer decl info */
1438
1439 if (odi->uses[SCO_Sig_Assign] ||
1440 odi->uses[SCO_Sig_Param])
1441 {
1442 comsgNError(id,ALDOR_E_ScoBadLexConst112);
1443 if (odi->uses[SCO_Sig_Assign])
1444 comsgNote(odi->uses[SCO_Sig_Assign],
1445 ALDOR_N_Here3);
1446 else
1447 comsgNote(odi->uses[SCO_Sig_Param],
1448 ALDOR_N_Here3);
1449 return;
1450 }
1451 }
1452 }
1453}
1454
1455localstatic Bool
1456scobindCheckOuterUseOfFluid(AbSyn id, AbSyn type)
1457{
1458 Stab stab = scoStab;
1459 Symbol sym = id->abId.sym;
1460 Bool foundOuter = false((int) 0);
1461 for (stab = cdr(stab)((stab)->rest); stab; stab = cdr(stab)((stab)->rest)) {
1462 IdInfo idInfo = getIdInfoInThisScope(stab, sym);
1463 if (idInfo) {
1464 DeclInfo declInfo;
1465
1466 if (type)
1467 declInfo = idInfoHasType(idInfo, type);
1468 else
1469 declInfo = car(idInfo->declInfoList)((idInfo->declInfoList)->first);
1470 if (declInfo && !declInfo->uses[SCO_Sig_Fluid])
1471 comsgError(id, ALDOR_E_ScoFluidShadow113);
1472 foundOuter = true1;
1473 }
1474 }
1475 return foundOuter;
1476}
1477
1478/******************************************************************************
1479 *
1480 * :: scobindApply
1481 *
1482 *****************************************************************************/
1483
1484localstatic void
1485scobindApply(AbSyn ab)
1486{
1487 int i, argc = abArgc(ab)((ab)->abHdr.argc);
1488 AbSyn *argv = abArgv(ab)((ab)->abGen.data.argv);
1489
1490 if (scobindApplyNeedsSelf(ab))
1491 scobindApplySelf(ab);
1492
1493 if (scobindApplyNeedsScope(ab))
1494 scobindLevel(ab, scobindApplyScope, scobindApplyFlags0);
1495
1496 else
1497 for (i = 0; i < argc; i += 1)
1498 scobindValue(argv[i]);
1499}
1500
1501localstatic void
1502scobindApplySelf(AbSyn ab)
1503{
1504 TForm tf, tf0;
1505 Syme syme;
1506 SymeList self;
1507
1508 tf = stabMakeUsedTForm(scoStab, ab, scoCondListCondElt());
1509
1510 /* We don't want this self visible. */
1511 tf0 = abIsApplyOf(ab, ssymJoin)(((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->abApply
.op))->abHdr.tag == (AB_Id)) && ((((ab)->abApply
.op))->abId.sym)==(ssymJoin))) ? tf : tfType;
1512 syme = symeNewLexVar(ssymSelf, tf0, car(scoStab)((scoStab)->first));
1513 self = listCons(Syme)(Syme_listPointer->Cons)(syme, listNil(Syme)((SymeList) 0));
1514 tfSetSelf(tf, self)((tf)->self = (self));
1515}
1516
1517localstatic Bool
1518scobindApplyNeedsSelf(AbSyn ab)
1519{
1520 AbSyn op;
1521 Symbol sym;
1522
1523 assert(abIsApply(ab))do { if (!(((ab)->abHdr.tag == (AB_Apply)))) _do_assert(("abIsApply(ab)"
),"scobind.c",1523); } while (0);
1524 op = abApplyOp(ab)((ab)->abApply.op);
1525 sym = abIsId(op)((op)->abHdr.tag == (AB_Id)) ? abIdSym(op)((op)->abId.sym) : NULL((void*)0);
1526
1527 return sym == ssymJoin ||
1528 sym == ssymRawRecord ||
1529 sym == ssymRecord ||
1530 sym == ssymUnion ||
1531 sym == ssymTrailingArray;
1532}
1533
1534localstatic Bool
1535scobindApplyNeedsScope(AbSyn ab)
1536{
1537 int i, argc = abArgc(ab)((ab)->abHdr.argc);
1538 AbSyn *argv = abArgv(ab)((ab)->abGen.data.argv);
1539
1540 for (i = 0; i < argc; i++)
1541 if (scobindApplyArgNeedsScope(argv[i]))
1542 return true1;
1543 return false((int) 0);
1544}
1545
1546localstatic Bool
1547scobindApplyArgNeedsScope(AbSyn ab)
1548{
1549 AbSyn *argv = abArgvAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abGen.data.argv
) : &(ab));
1550 Length i, argc = abArgcAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abHdr.argc) :
1);
1551
1552 for (i = 0; i < argc; i += 1)
1553 switch (abTag(argv[i])((argv[i])->abHdr.tag)) {
1554 case AB_Declare:
1555 case AB_Define:
1556 case AB_With:
1557 return true1;
1558 default:
1559 break;
1560 }
1561
1562 return false((int) 0);
1563}
1564
1565/******************************************************************************
1566 *
1567 * :: scobindApplyScope
1568 *
1569 *****************************************************************************/
1570
1571localstatic void
1572scobindApplyScope(AbSyn absyn)
1573{
1574 AbSyn *argv = abArgv(absyn)((absyn)->abGen.data.argv);
1575 Length i, argc = abArgc(absyn)((absyn)->abHdr.argc);
1576
1577 for (i = 0; i < argc; i += 1) {
1578 AbSyn arg = argv[i];
1579 if (abIsAnyMap(absyn)(((((absyn)->abHdr.tag == (AB_Apply)) && (((((absyn
)->abApply.op))->abHdr.tag == (AB_Id)) && ((((absyn
)->abApply.op))->abId.sym)==(ssymArrow))) && ((
(absyn)->abHdr.argc)-1) == 2) || ((((absyn)->abHdr.tag ==
(AB_Apply)) && (((((absyn)->abApply.op))->abHdr
.tag == (AB_Id)) && ((((absyn)->abApply.op))->abId
.sym)==(ssymPackedArrow))) && (((absyn)->abHdr.argc
)-1) == 2)) && i == 1)
1580 scobindApplyParam(arg);
1581 else if (abHasTag(arg, AB_Comma)((arg)->abHdr.tag == (AB_Comma)))
1582 scobindApplyComma(arg);
1583 else
1584 scobindApplyArg(arg);
1585 }
1586}
1587
1588/*
1589 * Scobind the parameter list of a function declaration. This examines
1590 * the parameter list from left-to-right adding new declarations as they
1591 * are encountered. Unfortunately this means that dependent maps must be
1592 * defined in a specific order with earlier parameters being available
1593 * as arguments to the types of later parameters.
1594 *
1595 * Ideally parameter declarations ought to be considered simultaneously
1596 * so that a wider class of dependent maps are possible. This requires
1597 * extra work during code generation to ensure that all definitions take
1598 * place in the correct order. This might happen automatically.
1599 */
1600localstatic void
1601scobindApplyParam(AbSyn params)
1602{
1603 AbSyn *argv = abArgvAs(AB_Comma, params)(((params)->abHdr.tag == (AB_Comma)) ? ((params)->abGen
.data.argv) : &(params));
1604 Length i, argc = abArgcAs(AB_Comma, params)(((params)->abHdr.tag == (AB_Comma)) ? ((params)->abHdr
.argc) : 1);
1605
1606 for (i = 0; i < argc; i += 1) {
1607 AbSyn arg = argv[i];
1608 if (abHasTag(arg, AB_Declare)((arg)->abHdr.tag == (AB_Declare)) || abHasTag(arg, AB_Define)((arg)->abHdr.tag == (AB_Define)))
1609 scobindParam(arg);
1610 else
1611 scobindApplyArg(arg);
1612 }
1613}
1614
1615localstatic void
1616scobindApplyComma(AbSyn ab)
1617{
1618 AbSyn *argv = abArgvAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abGen.data.argv
) : &(ab));
1619 Length i, argc = abArgcAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abHdr.argc) :
1);
1620
1621 for (i = 0; i < argc; i += 1)
1622 scobindApplyArg(argv[i]);
1623}
1624
1625localstatic void
1626scobindApplyArg(AbSyn arg)
1627{
1628 if (abHasTag(arg, AB_Assign)((arg)->abHdr.tag == (AB_Assign))) {
1629 Stab ostab = scoStab;
1630 scoStab = cdr(scoStab)((scoStab)->rest);
1631 scobindValue(arg);
1632 scoStab = ostab;
1633 }
1634 else if (abHasTag(arg, AB_With)((arg)->abHdr.tag == (AB_With))) {
1635 scobindValue(arg);
1636 abSetTFormCond(arg, scobindTfSyntaxFrAbSyn(scoStab, arg))if (! ((arg)->abHdr.seman ? (arg)->abHdr.seman->tform
: 0)) abSetTForm((arg), (scobindTfSyntaxFrAbSyn(scoStab, arg
)));
1637 }
1638 else
1639 scobindValue(arg);
1640}
1641
1642/******************************************************************************
1643 *
1644 * :: scobindAssign
1645 *
1646 *****************************************************************************/
1647
1648localstatic void
1649scobindAssign(AbSyn ab)
1650{
1651 AbSyn lhs = ab->abAssign.lhs;
1652 AbSyn rhs = ab->abAssign.rhs;
1653 AbSyn *argv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data.
argv) : &(lhs));
1654 Length i, argc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc)
: 1);
1655 Bool isComma = abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma));
1656
1657 for (i = 0; i < argc; i += 1) {
1658 AbSyn arg = argv[i];
1659
1660 switch (abTag(arg)((arg)->abHdr.tag)) {
1661 case AB_Id:
1662 scobindIntroduceId(arg, (isComma ? NULL((void*)0) : rhs),
1663 SCO_Sig_Assign);
1664 break;
1665
1666 case AB_Declare:
1667 scobindAssignDeclare(arg);
1668 break;
1669
1670 case AB_Apply:
1671 scobindValue(arg);
1672 break;
1673
1674 default:
1675 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 1675, "scobind.c");
1676 break;
1677 }
1678 }
1679
1680 scobindValue(rhs);
1681}
1682
1683localstatic void
1684scobindAssignDeclare(AbSyn decl)
1685{
1686 AbSyn name = decl->abDeclare.id;
1687 AbSyn type = decl->abDeclare.type;
1688 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
1689 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
1690
1691 for (i = 0; i < argc; i += 1)
1692 scobindAssignId(argv[i], type);
1693}
1694
1695localstatic void
1696scobindAssignId(AbSyn id, AbSyn type)
1697{
1698 DeclInfo declInfo;
1699
1700 declInfo = scobindDeclareId(id, type, NULL((void*)0), SCO_Sig_Assign);
1701 scobindSetSigUse(declInfo, SCO_Sig_Assign, id);
1702
1703 if (declInfo->uses[SCO_Sig_Free])
1704 markOuterInstanceOfFree(id, type, SCO_Sig_Assign);
1705
1706 if (declInfoIsImplicitLocal(declInfo))
1707 scobindSetSigUse(declInfo, SCO_Sig_ImplicitLocal, id);
1708}
1709
1710/******************************************************************************
1711 *
1712 * :: scobindBuiltin
1713 *
1714 *****************************************************************************/
1715
1716localstatic void
1717scobindBuiltin(AbSyn ab)
1718{
1719 AbSyn what = ab->abBuiltin.what;
1720 AbSyn *argv = abArgvAs(AB_Sequence, what)(((what)->abHdr.tag == (AB_Sequence)) ? ((what)->abGen.
data.argv) : &(what));
1721 Length i, argc = abArgcAs(AB_Sequence, what)(((what)->abHdr.tag == (AB_Sequence)) ? ((what)->abHdr.
argc) : 1);
1722 Bool save = scoIsInImport;
1723
1724 scoIsInImport = true1;
1725 for (i = 0; i < argc; i += 1)
1726 scobindBuiltinDeclare(argv[i]);
1727 scoIsInImport = save;
1728}
1729
1730localstatic void
1731scobindBuiltinDeclare(AbSyn decl)
1732{
1733 AbSyn name = decl->abDeclare.id;
1734 AbSyn type = decl->abDeclare.type;
1735 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
1736 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
1737
1738 for (i = 0; i < argc; i += 1)
1739 scobindBuiltinId(argv[i], type);
1740}
1741
1742localstatic void
1743scobindBuiltinId(AbSyn id, AbSyn type)
1744{
1745 Symbol sym = id->abId.sym;
1746 AInt bv;
1747 DeclInfo declInfo;
1748
1749 if (!symInfo(sym)((sym)->info) || !symCoInfo(sym))
1750 symCoInfoInit(sym)(((sym)->info) = &(symCoInfoNew()->align));
1751
1752 bv = foamBValIdTag(sym)((FoamBValTag) symCoInfo(sym)->foamTagVal);
1753
1754 if (bv == FOAM_BVAL_LIMIT
1755 && sym != ssymArrNew
1756 && sym != ssymArrElt
1757 && sym != ssymArrSet
1758 && sym != ssymArrDispose
1759 && sym != ssymRecNew
1760 && sym != ssymRecElt
1761 && sym != ssymRecSet
1762 && sym != ssymRecDispose
1763 && sym != ssymBIntDispose)
1764 {
1765 comsgError(id, ALDOR_E_ScoNotBuiltin125);
1766 return;
1767 }
1768
1769 declInfo = scobindDeclareId(id, type, NULL((void*)0), SCO_Sig_Builtin);
1770 scobindSetSigUse(declInfo, SCO_Sig_Builtin, id);
1771 scobindAddMeaning(id, sym, scoStab, SYME_Builtin, abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
), bv);
1772}
1773
1774/******************************************************************************
1775 *
1776 * :: scobindDeclare
1777 *
1778 *****************************************************************************/
1779
1780localstatic void
1781scobindDeclare(AbSyn ab)
1782{
1783 AbSyn id = ab->abDeclare.id;
1784 AbSyn type = ab->abDeclare.type;
1785 AbSyn *argv = abArgvAs(AB_Comma, id)(((id)->abHdr.tag == (AB_Comma)) ? ((id)->abGen.data.argv
) : &(id));
1786 Length i, argc = abArgcAs(AB_Comma, id)(((id)->abHdr.tag == (AB_Comma)) ? ((id)->abHdr.argc) :
1);
1787
1788 for (i = 0; i < argc; i += 1)
1789 scobindDeclareId(argv[i], type, NULL((void*)0), SCO_Sig_Declare);
1790}
1791
1792localstatic DeclInfo
1793scobindDeclareId(AbSyn id, AbSyn type, AbSyn val, DeclContext context)
1794{
1795 Symbol sym = id->abId.sym;
1796 AbSyn dtype = scobindDefaultType(scoStab, sym);
1797 IdInfo info = getIdInfoInAnyScope(scoStab, id);
1798 DeclInfo di = idInfoAddType(info, id, type, val, scoConditions());
1799 AbSyn oval = di->uses[SCO_Sig_Value];
1800 TForm tform;
1801
1802 assert(abIsNotNothing(type))do { if (!(!((type)->abHdr.tag == (AB_Nothing)))) _do_assert
(("abIsNotNothing(type)"),"scobind.c",1802); } while (0);
1803
1804 /* Check the type against any default type which was given. */
1805 if (dtype && !abEqualModDeclares(type, dtype))
1806 comsgWarning(id, ALDOR_W_ScoVarDefault136, symString(sym)((sym)->str));
1807
1808 /* Check the value against any previous value which was given (extends get a free pass). */
1809 if (val && oval && !abEqual(val, oval)
1810 && context != SCO_Sig_Extend) {
1811 /*!! comsgError(id, ALDOR_E_ScoVal, symString(sym)); */
1812 return di;
1813 }
1814
1815 /* Mark the identifier as declared. */
1816 scobindSetSigUse(di, SCO_Sig_Declare, id);
1817 if (val) scobindSetSigUse(di, SCO_Sig_Value, val);
1818 if (scoIsInType) scobindSetSigUse(di, SCO_Sig_InType, id);
1819
1820 /* Construct the syntax type for the declaration. */
1821 scobindType(type);
1822 tform = scobindDeclareTForm(scoStab, id, type, val, context);
1823 tform = stabAddTFormDeclaree(scoStab, tform, id);
1824 if (!abHasTag(type, AB_Hide)((type)->abHdr.tag == (AB_Hide))) {
1825 stabImportTForm(scoStab, tform);
1826 if (context == SCO_Sig_Param)
1827 stabParameterImportTForm(scoStab, tform);
1828 }
1829
1830 abSetTForm(type, tform);
1831 return di;
1832}
1833
1834localstatic TForm
1835scobindDeclareTForm(Stab stab, AbSyn id, AbSyn type, AbSyn val, DeclContext context)
1836{
1837 TForm tf;
1838
1839 if (val == NULL((void*)0)) {
1840 if (abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
))
1841 return abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
);
1842 else
1843 return scobindTfSyntaxFrAbSyn(stab, type);
1844 }
1845 else if (abIsAnyLambda(val)(((val)->abHdr.tag == (AB_Lambda)) || ((val)->abHdr.tag
== (AB_PLambda))) &&
1846 (context == SCO_Sig_Extend ||
1847 context == SCO_Sig_DDefine ||
1848 scobindMapNeedsDefn(type)((((((type)->abHdr.tag == (AB_Apply)) && (((((type
)->abApply.op))->abHdr.tag == (AB_Id)) && ((((type
)->abApply.op))->abId.sym)==(ssymArrow))) && ((
(type)->abHdr.argc)-1) == 2) || ((((type)->abHdr.tag ==
(AB_Apply)) && (((((type)->abApply.op))->abHdr
.tag == (AB_Id)) && ((((type)->abApply.op))->abId
.sym)==(ssymPackedArrow))) && (((type)->abHdr.argc
)-1) == 2)) && ((((((type)->abApply.argv[1]))->
abHdr.tag == (AB_Id)) && ((((type)->abApply.argv[1
]))->abId.sym)==(ssymCategory)) || ((((type)->abApply.argv
[1]))->abHdr.tag == (AB_With))))))
1849 tf = tfSyntaxDefineMap(scoStab, type, val);
1850
1851 else if (context == SCO_Sig_Extend ||
1852 context == SCO_Sig_DDefine ||
1853 (context == SCO_Sig_Define && abIsUnknown(type)((type)->abHdr.tag == (AB_Blank))) ||
1854 scobindRetNeedsDefn(type)((((type)->abHdr.tag == (AB_Id)) && ((type)->abId
.sym)==(ssymCategory)) || ((type)->abHdr.tag == (AB_With))
))
1855 tf = tfSyntaxDefine(scoStab, type, val);
1856 else
1857 tf = scobindTfSyntaxFrAbSyn(stab, type);
1858
1859 if (scobindTFormMustBeUnique(type)) {
1860 scobindUniqifyDecl(tfExpr(tf)tfToAbSyn(tf), id);
1861 }
1862 return tf;
1863}
1864
1865localstatic void
1866scobindUniqifyDecl(AbSyn decl, AbSyn id)
1867{
1868
1869 while (abIsAnyMap(decl)(((((decl)->abHdr.tag == (AB_Apply)) && (((((decl)
->abApply.op))->abHdr.tag == (AB_Id)) && ((((decl
)->abApply.op))->abId.sym)==(ssymArrow))) && ((
(decl)->abHdr.argc)-1) == 2) || ((((decl)->abHdr.tag ==
(AB_Apply)) && (((((decl)->abApply.op))->abHdr
.tag == (AB_Id)) && ((((decl)->abApply.op))->abId
.sym)==(ssymPackedArrow))) && (((decl)->abHdr.argc
)-1) == 2)))
1870 decl = abMapRet(decl)((decl)->abApply.argv[1]);
1871
1872 assert(abTag(id) == AB_Id)do { if (!(((id)->abHdr.tag) == AB_Id)) _do_assert(("abTag(id) == AB_Id"
),"scobind.c",1872); } while (0);
1873 assert(abTag(decl) == AB_Define)do { if (!(((decl)->abHdr.tag) == AB_Define)) _do_assert((
"abTag(decl) == AB_Define"),"scobind.c",1873); } while (0);
1874 assert(abTag(decl->abDefine.lhs) == AB_Declare)do { if (!(((decl->abDefine.lhs)->abHdr.tag) == AB_Declare
)) _do_assert(("abTag(decl->abDefine.lhs) == AB_Declare"),
"scobind.c",1874); } while (0);
1875
1876 decl->abDefine.lhs->abDeclare.id = abNewLabel(sposNone,abNew(AB_Label, sposNone,2, id,abNew(AB_Nothing, sposNone,0 )
)
1877 id,abNew(AB_Label, sposNone,2, id,abNew(AB_Nothing, sposNone,0 )
)
1878 abNewNothing(sposNone))abNew(AB_Label, sposNone,2, id,abNew(AB_Nothing, sposNone,0 )
);
1879}
1880
1881localstatic void
1882scobindIntroduceId(AbSyn id, AbSyn val, DeclContext context)
1883{
1884 Symbol sym = id->abId.sym;
1885 AbSyn type;
1886 TForm tform;
1887 IdInfo idInfo;
1888 DeclInfo declInfo;
1889
1890 /* Compute a type expression for the identifier. */
1891
1892 idInfo = getIdInfoInAnyScope(scoStab, id);
1893
1894 /* Try the default type. */
1895 type = scobindDefaultType(scoStab, sym);
1896
1897 if (!type && val)
13
←
Assuming 'type' is non-null
→
1898 /* Try to take the type from the syntax of the val. */
1899 type = scobindGuessType(val);
1900
1901 if (!type
13.1
'type' is non-null
 && idInfo->declInfoList)
1902 /* Take the type from a previous declaration. */
1903 type = car(idInfo->declInfoList)((idInfo->declInfoList)->first)->type;
1904
1905 if (!type
13.2
'type' is non-null
) {
14
←
Taking false branch
→
1906 /* Give up. (Although later we may infer the type from val.) */
1907 type = abCopy(abUnknown);
1908 abSetTForm(type, tfUnknown);
1909 }
1910
1911 if (context
14.1
'context' is not equal to SCO_Sig_Assign
 == SCO_Sig_Assign) val = NULL((void*)0);
15
←
Taking false branch
→
1912 declInfo = idInfoAddType(idInfo, id, type, val, scoConditions());
16
←
Calling 'idInfoAddType'
→
25
←
Returning from 'idInfoAddType'
→
26
←
Value assigned to 'declInfo'
→
1913
1914 /* Construct the syntax type for the identifier. */
1915 scobindType(type);
1916 tform = scobindDeclareTForm(scoStab, id, type, val, context);
1917 tform = stabAddTFormDeclaree(scoStab, tform, id);
1918 if (abIsUnknown(type)((type)->abHdr.tag == (AB_Blank))) abSetTForm(type, tform);
27
←
Assuming field 'tag' is equal to AB_Blank
→
28
←
Taking true branch
→
1919 if (!abHasTag(type, AB_Hide)((type)->abHdr.tag == (AB_Hide))) stabImportTForm(scoStab, tform);
29
←
Assuming field 'tag' is equal to AB_Hide
→
1920
1921 /* Determine if the identifier is free. */
1922
1923 if (idInfo->allFree
29.1
Field 'allFree' is 0
 || (declInfo && declInfo->uses[SCO_Sig_Free])) {
30
←
Assuming 'declInfo' is null
→
1924 if (context == SCO_Sig_Define) {
1925 comsgNError(id, ALDOR_E_ScoFreeConst119, symString(sym)((sym)->str));
1926 if (declInfo && declInfo->uses[SCO_Sig_Free])
1927 comsgNote(declInfo->uses[SCO_Sig_Free],
1928 ALDOR_N_Here3);
1929 }
1930 else if (context == SCO_Sig_Assign)
1931 markOuterInstanceOfFree(id, type, context);
1932 }
1933
1934 scobindSetSigUse(declInfo, context, id);
31
←
Passing null pointer value via 1st parameter 'declInfo'
→
32
←
Calling 'scobindSetSigUse'
→
1935 if (val) scobindSetSigUse(declInfo, SCO_Sig_Value, val);
1936
1937 if (context == SCO_Sig_Default)
1938 scobindSetSigUse(declInfo, SCO_Sig_Define, id);
1939
1940 if (scoIsInType)
1941 scobindSetSigUse(declInfo, SCO_Sig_InType, id);
1942
1943 if (context == SCO_Sig_Loop)
1944 scobindSetSigUse(declInfo, SCO_Sig_Assign, id);
1945
1946 if (context != SCO_Sig_Define && declInfoIsImplicitLocal(declInfo))
1947 scobindSetSigUse(declInfo, SCO_Sig_ImplicitLocal, id);
1948}
1949
1950localstatic AbSyn
1951scobindGuessType(AbSyn val)
1952{
1953 AbSyn type, id, arg, ret;
1954
1955 switch (abTag(val)((val)->abHdr.tag)) {
1956 case AB_PretendTo:
1957 type = val->abPretendTo.type;
1958 break;
1959 case AB_CoerceTo:
1960 type = val->abCoerceTo.type;
1961 break;
1962 case AB_RestrictTo:
1963 type = val->abRestrictTo.type;
1964 break;
1965 case AB_Lambda:
1966 id = abNewId(abPos(val), ssymArrow)abNew(AB_Id, (spstackFirst((val)->abHdr.pos)),1, ssymArrow
);
1967 arg = val->abLambda.param;
1968 ret = val->abLambda.rtype;
1969 type = abNewApply2(abPos(val), id, arg, ret)abNew(AB_Apply, (spstackFirst((val)->abHdr.pos)),3, id,arg
,ret);
1970 break;
1971 case AB_PLambda:
1972 id = abNewId(abPos(val), ssymPackedArrow)abNew(AB_Id, (spstackFirst((val)->abHdr.pos)),1, ssymPackedArrow
);
1973 arg = val->abPLambda.param;
1974 ret = val->abPLambda.rtype;
1975 type = abNewApply2(abPos(val), id, arg, ret)abNew(AB_Apply, (spstackFirst((val)->abHdr.pos)),3, id,arg
,ret);
1976 break;
1977 default:
1978 type = NULL((void*)0);
1979 break;
1980 }
1981
1982 return type;
1983}
1984
1985/******************************************************************************
1986 *
1987 * :: scobindDefault
1988 *
1989 *****************************************************************************/
1990
1991localstatic void
1992scobindDefault(AbSyn ab)
1993{
1994 AbSyn body = ab->abDefault.body;
1995 AbSyn *argv = abArgvAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abGen.
data.argv) : &(body));
1996 Length i, argc = abArgcAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abHdr.
argc) : 1);
1997
1998 for (i = 0; i < argc; i += 1) {
1999 if (abHasTag(argv[i], AB_Declare)((argv[i])->abHdr.tag == (AB_Declare))) {
2000 scobindDefaultDeclare(argv[i]);
2001 /* argv[i] = abNewNothing(abPos(argv[i])); */
2002 }
2003 else
2004 scobindValue(argv[i]);
2005 }
2006 /* ab->abDefault.body = body; */
2007}
2008
2009localstatic void
2010scobindDefaultDeclare(AbSyn decl)
2011{
2012 AbSyn name = decl->abDeclare.id;
2013 AbSyn type = decl->abDeclare.type;
2014 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2015 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2016
2017 for (i = 0; i < argc; i += 1)
2018 scobindDefaultId(argv[i], type);
2019}
2020
2021localstatic void
2022scobindDefaultId(AbSyn id, AbSyn type)
2023{
2024 IdInfo idInfo = getIdInfoInAnyScope(scoStab, id);
2025 scobindImportType(scoStab, type);
2026 idInfo->defaultType = abCopy(type);
2027}
2028
2029/******************************************************************************
2030 *
2031 * :: scobindDefine
2032 *
2033 *****************************************************************************/
2034
2035localstatic void
2036scobindDefine(AbSyn ab)
2037{
2038 AbSyn lhs = ab->abDefine.lhs;
2039 AbSyn rhs = ab->abDefine.rhs;
2040 AbSyn *argv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data.
argv) : &(lhs));
2041 Length i, argc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc)
: 1);
2042 Bool isComma = abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma));
2043 Bool isKey = abUse(ab)((ab)->abHdr.use) == AB_Use_Value;
2044 AbSyn val = isComma ? NULL((void*)0) : rhs;
2045 DeclContext context = isKey ? SCO_Sig_Default : SCO_Sig_Define;
2046
2047 scobindPushDefine(lhs);
2048
2049 for (i = 0; i < argc; i += 1) {
2050 AbSyn arg = argv[i];
2051
2052 switch (abTag(arg)((arg)->abHdr.tag)) {
2053 case AB_Id:
2054 scobindIntroduceId(arg, val, context);
2055 break;
2056
2057 case AB_Declare:
2058 scobindDefineDeclare(arg, val);
2059 break;
2060
2061 default:
2062 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 2062, "scobind.c");
2063 break;
2064 }
2065 }
2066
2067 scobindDefineRhs(lhs, rhs, context);
2068 scobindPopDefine(lhs);
2069}
2070
2071localstatic void
2072scobindDefineDeclare(AbSyn decl, AbSyn val)
2073{
2074 AbSyn name = decl->abDeclare.id;
2075 AbSyn type = decl->abDeclare.type;
2076 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2077 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2078
2079 for (i = 0; i < argc; i += 1)
2080 scobindDefineId(argv[i], type, val);
2081}
2082
2083localstatic void
2084scobindDefineId(AbSyn id, AbSyn type, AbSyn val)
2085{
2086 DeclInfo declInfo;
2087
2088 declInfo = scobindDeclareId(id, type, val, SCO_Sig_Define);
2089 scobindSetSigUse(declInfo, SCO_Sig_Define, id);
2090
2091 abSetDefineIdx(id, scoDefCounter++);
2092
2093 if (declInfo->uses[SCO_Sig_Free])
2094 comsgError(id, ALDOR_E_ScoFreeConst119, symString(id->abId.sym)((id->abId.sym)->str));
2095}
2096
2097localstatic void
2098scobindDefineRhs(AbSyn lhs, AbSyn rhs, DeclContext context)
2099{
2100 if (abIsAnyLambda(rhs)(((rhs)->abHdr.tag == (AB_Lambda)) || ((rhs)->abHdr.tag
== (AB_PLambda)))) {
2101 LambdaInfo info = lambdaInfoAlloc(lhs, rhs,
2102 scoCondList);
2103 scoLambdaList = listCons(LambdaInfo)(LambdaInfo_listPointer->Cons)(info, scoLambdaList);
2104
2105 if (abHasTag(lhs, AB_Declare)((lhs)->abHdr.tag == (AB_Declare)))
2106 scobindMatchWiths(lhs->abDeclare.type, rhs, context);
2107 }
2108 else
2109 scobindValue(rhs);
2110}
2111
2112/******************************************************************************
2113 *
2114 * :: scobindDDefine
2115 *
2116 *****************************************************************************/
2117
2118localstatic void
2119scobindDDefine(AbSyn absyn)
2120{
2121 AbSyn body = absyn->abDDefine.body;
2122 AbSyn *argv = abArgvAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abGen.
data.argv) : &(body));
2123 Length i, argc = abArgcAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abHdr.
argc) : 1);
2124
2125 for (i = 0; i < argc; i += 1)
2126 scobindDDefineComma(argv[i]);
2127}
2128
2129localstatic void
2130scobindDDefineComma(AbSyn defn)
2131{
2132 AbSyn lhs = defn->abDefine.lhs;
2133 AbSyn rhs = defn->abDefine.rhs;
2134 AbSyn *argv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data.
argv) : &(lhs));
2135 Length i, argc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc)
: 1);
2136 Bool isComma = abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma));
2137
2138 scobindPushDefine(lhs);
2139
2140 for (i = 0; i < argc; i += 1) {
2141 AbSyn arg = argv[i];
2142
2143 switch (abTag(arg)((arg)->abHdr.tag)) {
2144 case AB_Id:
2145 scobindIntroduceId(arg, (isComma ? NULL((void*)0) : rhs),
2146 SCO_Sig_DDefine);
2147 break;
2148
2149 case AB_Declare:
2150 scobindDDefineDeclare(arg, rhs);
2151 break;
2152
2153 default:
2154 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 2154, "scobind.c");
2155 break;
2156 }
2157 }
2158
2159 scobindDefineRhs(lhs, rhs, SCO_Sig_DDefine);
2160 scobindPopDefine(lhs);
2161}
2162
2163localstatic void
2164scobindDDefineDeclare(AbSyn decl, AbSyn val)
2165{
2166 AbSyn name = decl->abDeclare.id;
2167 AbSyn type = decl->abDeclare.type;
2168 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2169 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2170
2171 for (i = 0; i < argc; i += 1)
2172 scobindDDefineId(argv[i], type, val);
2173}
2174
2175localstatic void
2176scobindDDefineId(AbSyn id, AbSyn type, AbSyn val)
2177{
2178 DeclInfo declInfo;
2179
2180 declInfo = scobindDeclareId(id, type, val, SCO_Sig_DDefine);
2181 scobindSetSigUse(declInfo, SCO_Sig_DDefine, id);
2182
2183 if (declInfo->uses[SCO_Sig_Free])
2184 comsgError(id, ALDOR_E_ScoFreeConst119, symString(id->abId.sym)((id->abId.sym)->str));
2185}
2186
2187/******************************************************************************
2188 *
2189 * :: scobindExtend
2190 *
2191 *****************************************************************************/
2192
2193localstatic void
2194scobindExtend(AbSyn absyn)
2195{
2196 AbSyn body = absyn->abExtend.body;
2197 AbSyn *argv = abArgvAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abGen.
data.argv) : &(body));
2198 Length i, argc = abArgcAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abHdr.
argc) : 1);
2199
2200 for (i = 0; i < argc; i += 1) {
2201 if (abHasTag(argv[i], AB_Define)((argv[i])->abHdr.tag == (AB_Define))) {
2202 AbSyn lhs = argv[i]->abDefine.lhs;
2203 AbSyn rhs = argv[i]->abDefine.rhs;
2204
2205 scobindExtendDeclare(lhs, rhs);
2206 scobindDefineRhs(lhs, rhs, SCO_Sig_Extend);
2207 }
2208 else
2209 scobindExtendDeclare(argv[i], NULL((void*)0));
2210 }
2211}
2212
2213localstatic void
2214scobindExtendDeclare(AbSyn lhs, AbSyn rhs)
2215{
2216 Bool save = scoIsInExtend;
2217
2218 scoIsInExtend = true1;
2219 switch (abTag(lhs)((lhs)->abHdr.tag)) {
2220 case AB_Declare:
2221 scobindExtendId(lhs->abDeclare.id, lhs->abDeclare.type, rhs);
2222 break;
2223
2224 case AB_Id:
2225 scobindExtendId(lhs, NULL((void*)0), rhs);
2226 break;
2227
2228 default:
2229 bugBadCase(abTag(lhs))bug("Bad case %d (line %d in file %s).", (int) ((lhs)->abHdr
.tag), 2229, "scobind.c");
2230 break;
2231 }
2232 scoIsInExtend = save;
2233}
2234
2235localstatic void
2236scobindExtendId(AbSyn id, AbSyn type, AbSyn val)
2237{
2238 Symbol sym = id->abId.sym;
2239 Doc doc = abComment(id)((id)->abHdr.seman ? (id)->abHdr.seman->comment : 0);
2240 DeclInfo declInfo;
2241 Syme syme, ext;
2242
2243 if (doc == NULL((void*)0)) doc = docNone;
2244
2245 /* Create the syme for the extendee. */
2246 declInfo = scobindDeclareId(id, type, val, SCO_Sig_Extend);
2247 scobindSetSigUse(declInfo, SCO_Sig_Extend, id);
2248 syme = stabDefExtendee(scoStab, sym, abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
), doc);
2249 abSetSyme(id, syme);
2250
2251 /* Create the syme for the extension. */
2252 ext = scobindGetExtend(id, type);
2253 if (ext == NULL((void*)0)) {
2254 TForm template = tfSyntaxExtend(scoStab, id, type);
2255 ext = symeNewExtend(sym, template, car(scoStab)((scoStab)->first));
2256 car(scoStab)((scoStab)->first)->extendSymes =
2257 listCons(Syme)(Syme_listPointer->Cons)(ext, car(scoStab)((scoStab)->first)->extendSymes);
2258 }
2259
2260 /* Associate the extendee with the extension. */
2261 symeSetExtension(syme, ext)symeXSetExtension(syme, (AInt) ext);
2262 symeAddExtendee(ext, syme);
2263 stabAddTFormDeclaree(scoStab, symeType(ext), id);
2264 stabAddTFormExtendees(scoStab, symeType(ext), id);
2265 stabAddTFormExtension(scoStab, abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
), id);
2266}
2267
2268localstatic Syme
2269scobindGetExtend(AbSyn id, AbSyn type)
2270{
2271 Stab stab;
2272 Symbol sym = id->abId.sym;
2273
2274 for (stab = scoStab; stab; stab = cdr(stab)((stab)->rest)) {
2275 IdInfo idInfo = getIdInfoInThisScope(stab, sym);
2276 DeclInfoList dil;
2277
2278 dil = idInfo ? idInfo->declInfoList : listNil(DeclInfo)((DeclInfoList) 0);
2279
2280 for (; dil; dil = cdr(dil)((dil)->rest)) {
2281 DeclInfo di = car(dil)((dil)->first);
2282 AbSyn abuse = di->uses[SCO_Sig_Extend];
2283 Syme ext;
2284
2285 ext = abuse ? symeExtension(abSyme(abuse)((abuse)->abHdr.seman ? (abuse)->abHdr.seman->syme :
0)) : NULL((void*)0);
2286 if (ext && tfCanExtend(abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
), symeType(ext)))
2287 return ext;
2288 }
2289 }
2290
2291 return NULL((void*)0);
2292}
2293
2294/******************************************************************************
2295 *
2296 * :: scobindExport
2297 *
2298 *****************************************************************************/
2299
2300localstatic void
2301scobindExport(AbSyn ab)
2302{
2303 AbSyn what = ab->abExport.what;
2304 AbSyn from = ab->abExport.origin;
2305 AbSyn dest = ab->abExport.destination;
2306 Bool save = scoIsInExport;
2307
2308 assert(abIsNothing(from) || abIsNothing(dest))do { if (!(((from)->abHdr.tag == (AB_Nothing)) || ((dest)->
abHdr.tag == (AB_Nothing)))) _do_assert(("abIsNothing(from) || abIsNothing(dest)"
),"scobind.c",2308); } while (0);
2309
2310 scoIsInExport = true1;
2311
2312 if (abIsNotNothing(dest)!((dest)->abHdr.tag == (AB_Nothing)))
2313 scobindExportTo(what, dest);
2314
2315 else if (abIsNotNothing(from)!((from)->abHdr.tag == (AB_Nothing)))
2316 scobindExportFrom(what, from);
2317
2318 else
2319 scobindExportWhat(what);
2320
2321 scoIsInExport = save;
2322}
2323
2324localstatic void
2325scobindExportTo(AbSyn what, AbSyn dest)
2326{
2327 scobindType(dest);
2328 abSetTFormCond(dest, scobindTfSyntaxFrAbSyn(scoStab, dest))if (! ((dest)->abHdr.seman ? (dest)->abHdr.seman->tform
: 0)) abSetTForm((dest), (scobindTfSyntaxFrAbSyn(scoStab, dest
)));
2329 scobindLOF(what, SCO_Sig_Local);
2330}
2331
2332localstatic void
2333scobindExportFrom(AbSyn what, AbSyn origin)
2334{
2335 TForm tf;
2336
2337 scobindType(origin);
2338 scobindValue(what);
2339
2340 tf = scobindTfSyntaxFrAbSyn(scoStab, origin);
2341 if (abIsNothing(what)((what)->abHdr.tag == (AB_Nothing)))
2342 tf = stabExportTForm(scoStab, tf);
2343 else
2344 tf = stabQualifiedExportTForm(scoStab, what, tf);
2345
2346 abSetTFormCond(origin, tf)if (! ((origin)->abHdr.seman ? (origin)->abHdr.seman->
tform : 0)) abSetTForm((origin), (tf));
2347}
2348
2349localstatic void
2350scobindExportWhat(AbSyn what)
2351{
2352 Length i;
2353
2354 switch (abTag(what)((what)->abHdr.tag)) {
2355 case AB_Nothing:
2356 break;
2357
2358 case AB_Comma:
2359 case AB_Sequence:
2360 for (i = 0; i < abArgc(what)((what)->abHdr.argc); i += 1)
2361 scobindExportWhat(abArgv(what)((what)->abGen.data.argv)[i]);
2362 break;
2363
2364 case AB_Define: {
2365 AbSyn lhs = what->abDefine.lhs;
2366 AbSyn rhs = what->abDefine.rhs;
2367
2368 scobindExportDeclare(lhs, rhs);
2369 scobindDefineRhs(lhs, rhs, SCO_Sig_Export);
2370 break;
2371 }
2372
2373 case AB_Declare:
2374 scobindExportDeclare(what, NULL((void*)0));
2375 break;
2376
2377 case AB_Default:
2378 /* 'default' statement within 'with' body */
2379
2380 scobindValue(what);
2381 break;
2382
2383 case AB_If:
2384 /* 'if' statement within 'with' body */
2385
2386 scobindValue(what->abIf.test);
2387 scoCondPush(scoStab, what->abIf.test, false((int) 0));
2388 scobindExportWhat(what->abIf.thenAlt);
2389 scoCondPop();
2390 scoCondPush(scoStab, what->abIf.test, true1);
2391 scobindExportWhat(what->abIf.elseAlt);
2392 scoCondPop();
2393 break;
2394
2395 case AB_Import:
2396 /* 'import' within 'with' body */
2397
2398 scobindValue(what);
2399 break;
2400
2401 default:
2402 scobindValue(what);
2403 break;
2404 }
2405}
2406
2407localstatic void
2408scobindExportDeclare(AbSyn decl, AbSyn val)
2409{
2410 AbSyn name = decl->abDeclare.id;
2411 AbSyn type = decl->abDeclare.type;
2412 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2413 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2414
2415 for (i = 0; i < argc; i += 1)
2416 scobindExportId(argv[i], type, val);
2417}
2418
2419localstatic void
2420scobindExportId(AbSyn id, AbSyn type, AbSyn val)
2421{
2422 Symbol sym = id->abId.sym;
2423 Doc doc = abComment(id)((id)->abHdr.seman ? (id)->abHdr.seman->comment : 0);
2424 DeclInfo declInfo;
2425
2426 if (doc == NULL((void*)0)) doc = docNone;
2427
2428 declInfo = scobindDeclareId(id, type, val, SCO_Sig_Export);
2429 scobindSetSigUse(declInfo, SCO_Sig_Export, id);
2430 scobindAddMeaning(id, sym, scoStab, SYME_Export, abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
),
2431 (AInt) doc);
2432}
2433
2434/******************************************************************************
2435 *
2436 * :: scobindForeignExport
2437 *
2438 *****************************************************************************/
2439
2440localstatic void
2441scobindForeignExport(AbSyn ab)
2442{
2443 AbSyn dest = ab->abForeignExport.dest;
2444 AbSyn what = ab->abForeignExport.what;
2445 ForeignOrigin forg = forgFrAbSyn(dest->abApply.argv[0]);
2446
2447 scoIsInExport = true1;
2448
2449 if (forg->protocol == FOAM_Proto_Java) {
2450 scobindValue(what);
2451 }
2452 else {
2453 scobindLOF(what, SCO_Sig_Local);
2454 }
2455
2456
2457 scoIsInExport = false((int) 0);
2458}
2459
2460/******************************************************************************
2461 *
2462 * :: scobindFluid
2463 *
2464 *****************************************************************************/
2465
2466localstatic void
2467scobindFluid(AbSyn ab)
2468{
2469 AbSyn body = ab->abFluid.argv[0];
2470 AbSyn *argv = abArgvAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abGen.
data.argv) : &(body));
2471 Length i, argc = abArgcAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abHdr.
argc) : 1);
2472
2473 for (i = 0; i < argc; i += 1) {
2474 if (abHasTag(argv[i], AB_Assign)((argv[i])->abHdr.tag == (AB_Assign))) {
2475 scobindAssign(argv[i]);
2476 scobindFluidComma(argv[i]->abAssign.lhs);
2477 }
2478 else
2479 scobindFluidComma(argv[i]);
2480 }
2481}
2482
2483localstatic void
2484scobindFluidComma(AbSyn lhs)
2485{
2486 AbSyn *argv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data.
argv) : &(lhs));
2487 Length i, argc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc)
: 1);
2488
2489 for (i = 0; i < argc; i += 1) {
2490 AbSyn arg = argv[i];
2491
2492 switch (abTag(arg)((arg)->abHdr.tag)) {
2493 case AB_Id:
2494 scobindFluidId(arg, NULL((void*)0));
2495 break;
2496
2497 case AB_Declare:
2498 scobindFluidDeclare(arg);
2499 break;
2500
2501 default:
2502 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 2502, "scobind.c");
2503 break;
2504 }
2505 }
2506}
2507
2508localstatic void
2509scobindFluidDeclare(AbSyn decl)
2510{
2511 AbSyn name = decl->abDeclare.id;
2512 AbSyn type = decl->abDeclare.type;
2513 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2514 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2515
2516 for (i = 0; i < argc; i += 1)
2517 scobindFluidId(argv[i], type);
2518}
2519
2520localstatic void
2521scobindFluidId(AbSyn id, AbSyn type)
2522{
2523 IdInfo idInfo = getIdInfoInAnyScope(scoStab, id);
2524
2525 if (type) {
2526 DeclInfo declInfo;
2527 declInfo = scobindDeclareId(id, type, NULL((void*)0), SCO_Sig_Fluid);
2528 scobindSetSigUse(declInfo, SCO_Sig_Fluid, id);
2529 }
2530 else {
2531 DeclInfoList dil;
2532 idInfo->allFluid = true1;
2533 for (dil = idInfo->declInfoList; dil; dil = cdr(dil)((dil)->rest))
2534 scobindSetSigUse(car(dil)((dil)->first), SCO_Sig_Fluid, id);
2535 }
2536}
2537
2538/******************************************************************************
2539 *
2540 * :: scobindFor
2541 *
2542 *****************************************************************************/
2543
2544localstatic void
2545scobindFor(AbSyn ab)
2546{
2547 AbSyn lhs = ab->abFor.lhs;
2548 AbSyn whole = ab->abFor.whole;
2549 AbSyn test = ab->abFor.test;
2550 Stab ostab = scoStab;
2551 Bool stabWasLocked = stabLevelIsLocked(scoStab)(((scoStab)->first)->isLocked);
2552
2553 /* whole should be analyzed in the enclosing symbol table. */
2554 scoStab = stabPopLevel(scoStab);
2555 scobindValue(whole);
2556 scoStab = ostab;
2557
2558 if (stabWasLocked)
2559 stabUnlockLevel(scoStab)(((scoStab)->first)->isLocked = ((int) 0));
2560
2561 scobindFor0(lhs, true1);
2562 scobindValue(test);
2563
2564 if (stabWasLocked)
2565 stabLockLevel(scoStab)(((scoStab)->first)->isLocked = 1);
2566}
2567
2568localstatic void
2569scobindFor0(AbSyn var, Bool check)
2570{
2571 Length i;
2572
2573 switch (abTag(var)((var)->abHdr.tag)) {
1
Control jumps to 'case AB_Comma:' at line 2574
→
5
←
Control jumps to 'case AB_Comma:' at line 2574
→
9
←
Control jumps to 'case AB_Id:' at line 2590
→
2574 case AB_Comma:
2575 case AB_Sequence:
2576 for (i = 0; i < abArgc(var)((var)->abHdr.argc); i += 1)
2
←
Assuming 'i' is < field 'argc'
→
3
←
Loop condition is true. Entering loop body
→
6
←
Assuming 'i' is < field 'argc'
→
7
←
Loop condition is true. Entering loop body
→
2577 scobindFor0(abArgv(var)((var)->abGen.data.argv)[i], check);
4
←
Calling 'scobindFor0'
→
8
←
Calling 'scobindFor0'
→
2578 break;
2579
2580 case AB_Free:
2581 scobindFree(var);
2582 scobindFor0(abArgv(var)((var)->abGen.data.argv)[0], false((int) 0));
2583 break;
2584
2585 case AB_Local:
2586 scobindLocal(var);
2587 scobindFor0(abArgv(var)((var)->abGen.data.argv)[0], false((int) 0));
2588 break;
2589
2590 case AB_Id:
2591 if (check) {
10
←
Assuming 'check' is 0
→
11
←
Taking false branch
→
2592 scobindLOF(var, SCO_Sig_Local);
2593 checkOuterUseOfImplicitLocal(scoStab, var, abUnknown);
2594 }
2595 scobindIntroduceId(var, NULL((void*)0), SCO_Sig_Loop);
12
←
Calling 'scobindIntroduceId'
→
2596 break;
2597
2598 case AB_Declare:
2599 if (check) {
2600 scobindLOF(var, SCO_Sig_Local);
2601 checkOuterUseOfImplicitLocal(scoStab, abDefineeId(var),
2602 var->abDeclare.type);
2603 }
2604 scobindForDeclare(var->abDeclare.id, var->abDeclare.type);
2605 break;
2606
2607 default:
2608 bugBadCase(abTag(var))bug("Bad case %d (line %d in file %s).", (int) ((var)->abHdr
.tag), 2608, "scobind.c");
2609 break;
2610 }
2611}
2612
2613localstatic void
2614scobindForDeclare(AbSyn name, AbSyn type)
2615{
2616 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2617 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2618
2619 for (i = 0; i < argc; i += 1)
2620 scobindForId(argv[i], type);
2621}
2622
2623localstatic void
2624scobindForId(AbSyn id, AbSyn type)
2625{
2626 DeclInfo declInfo;
2627
2628 declInfo = scobindDeclareId(id, type, NULL((void*)0), SCO_Sig_Loop);
2629 scobindSetSigUse(declInfo, SCO_Sig_Loop, id);
2630 scobindSetSigUse(declInfo, SCO_Sig_Assign, id);
2631
2632 if (declInfo->uses[SCO_Sig_Free])
2633 markOuterInstanceOfFree(id, type, SCO_Sig_Assign);
2634
2635 if (declInfoIsImplicitLocal(declInfo))
2636 scobindSetSigUse(declInfo, SCO_Sig_ImplicitLocal, id);
2637}
2638
2639/******************************************************************************
2640 *
2641 * :: scobindForeignImport
2642 *
2643 *****************************************************************************/
2644
2645localstatic void
2646scobindForeignImport(AbSyn ab)
2647{
2648 AbSyn origin = ab->abForeignImport.origin;
2649 AbSyn what = ab->abForeignImport.what;
2650 AbSyn *argv = abArgvAs(AB_Sequence, what)(((what)->abHdr.tag == (AB_Sequence)) ? ((what)->abGen.
data.argv) : &(what));
2651 Length i, argc = abArgcAs(AB_Sequence, what)(((what)->abHdr.tag == (AB_Sequence)) ? ((what)->abHdr.
argc) : 1);
2652
2653 if (abHasTag(what, AB_Id)((what)->abHdr.tag == (AB_Id)) || abHasTag(what, AB_With)((what)->abHdr.tag == (AB_With)))
2654 {
2655 TForm tf;
2656 AbSyn abTf;
2657 TFormUses tfu;
2658
2659 /* Treat as a traditional import */
2660 scobindType(origin);
2661 scobindValue(what);
2662 tf = scobindTfSyntaxFrAbSyn(scoStab, origin);
2663 tf = stabQualifiedImportTForm(scoStab, what, tf);
2664 abSetTFormCond(origin, tf)if (! ((origin)->abHdr.seman ? (origin)->abHdr.seman->
tform : 0)) abSetTForm((origin), (tf));
2665
2666
2667 /* Find the use of this tform */
2668 abTf = tfExpr(tf)tfToAbSyn(tf);
2669 tfu = stabFindTFormUses(scoStab, abTf);
2670
2671
2672 /* Mark as qualified foreign or builtin import */
2673 if (abIsTheId(origin, ssymBuiltin)(((origin)->abHdr.tag == (AB_Id)) && ((origin)->
abId.sym)==(ssymBuiltin)))
2674 tqSetStatus(tfu->imports, TQUAL_Builtin);
2675 else
2676 tqSetStatus(tfu->imports, TQUAL_Foreign);
2677 }
2678 else
2679 {
2680 Bool save = scoIsInImport;
2681 scoIsInImport = true1;
2682 for (i = 0; i < argc; i += 1)
2683 {
2684 AbSyn arg = argv[i];
2685
2686 if (abHasTag(argv[i], AB_Declare)((argv[i])->abHdr.tag == (AB_Declare)))
2687 {
2688 ForeignOrigin forg;
2689
2690 forg = forgFrAbSyn(origin);
2691 scobindForeignDeclare(arg, forg);
2692 }
2693 }
2694 scoIsInImport = save;
2695 }
2696}
2697
2698localstatic void
2699scobindForeignDeclare(AbSyn decl, ForeignOrigin forg)
2700{
2701 AbSyn name = decl->abDeclare.id;
2702 AbSyn type = decl->abDeclare.type;
2703 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2704 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2705
2706 for (i = 0; i < argc; i += 1)
2707 scobindForeignId(argv[i], type, forg);
2708}
2709
2710localstatic void
2711scobindForeignId(AbSyn id, AbSyn type, ForeignOrigin forg)
2712{
2713 Symbol sym = id->abId.sym;
2714 DeclInfo declInfo;
2715
2716 declInfo = scobindDeclareId(id, type, NULL((void*)0), SCO_Sig_Foreign);
2717 scobindSetSigUse(declInfo, SCO_Sig_Foreign, id);
2718 scobindAddMeaning(id, sym, scoStab,SYME_Foreign,abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
),
2719 (AInt) forg);
2720}
2721
2722/******************************************************************************
2723 *
2724 * :: scobindImport
2725 *
2726 *****************************************************************************/
2727
2728localstatic void
2729scobindImport(AbSyn ab)
2730{
2731 AbSyn what = ab->abImport.what;
2732 AbSyn from = ab->abImport.origin;
2733 TForm tf;
2734 Bool save = scoIsInImport;
2735
2736 scobindType(from);
2737
2738 scoIsInImport = true1;
2739 scobindValue(what);
2740 scoIsInImport = save;
2741
2742 tf = scobindTfSyntaxFrAbSyn(scoStab, from);
2743 if (abIsNothing(what)((what)->abHdr.tag == (AB_Nothing)))
2744 tf = stabExplicitlyImportTForm(scoStab, tf);
2745 else
2746 tf = stabQualifiedImportTForm(scoStab, what, tf);
2747
2748 abSetTFormCond(from, tf)if (! ((from)->abHdr.seman ? (from)->abHdr.seman->tform
: 0)) abSetTForm((from), (tf));
2749}
2750
2751/******************************************************************************
2752 *
2753 * :: scobindInline
2754 *
2755 *****************************************************************************/
2756
2757localstatic void
2758scobindInline(AbSyn ab)
2759{
2760 AbSyn what = ab->abInline.what;
2761 AbSyn from = ab->abInline.origin;
2762 TForm tf;
2763
2764 scobindType(from);
2765 scobindValue(what);
2766
2767 tf = scobindTfSyntaxFrAbSyn(scoStab, from);
2768 if (abIsNothing(what)((what)->abHdr.tag == (AB_Nothing)))
2769 tf = stabInlineTForm(scoStab, tf);
2770 else
2771 tf = stabQualifiedInlineTForm(scoStab, what, tf);
2772
2773 abSetTFormCond(from, tf)if (! ((from)->abHdr.seman ? (from)->abHdr.seman->tform
: 0)) abSetTForm((from), (tf));
2774}
2775
2776/******************************************************************************
2777 *
2778 * :: scobindParam
2779 *
2780 *****************************************************************************/
2781
2782localstatic void
2783scobindParam(AbSyn ab)
2784{
2785 AbSyn *argv = abArgvAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abGen.data.argv
) : &(ab));
2786 Length i, argc = abArgcAs(AB_Comma, ab)(((ab)->abHdr.tag == (AB_Comma)) ? ((ab)->abHdr.argc) :
1);
2787
2788 for (i = 0; i < argc; i += 1) {
2789 if (abHasTag(argv[i], AB_Define)((argv[i])->abHdr.tag == (AB_Define))) {
2790 AbSyn lhs = argv[i]->abDefine.lhs;
2791 AbSyn rhs = argv[i]->abDefine.rhs;
2792
2793 scobindParamDefine(lhs, rhs);
2794 scobindDefineRhs(lhs, rhs, SCO_Sig_Param);
2795 }
2796 else
2797 scobindParamDefine(argv[i], NULL((void*)0));
2798 }
2799}
2800
2801localstatic void
2802scobindParamDefine(AbSyn lhs, AbSyn rhs)
2803{
2804 switch (abTag(lhs)((lhs)->abHdr.tag)) {
2805 case AB_Declare:
2806 scobindParamDeclare(lhs, rhs);
2807 break;
2808
2809 default:
2810 /*!! abcheck */
2811 comsgError(lhs, ALDOR_E_ScoBadParameter115);
2812 break;
2813 }
2814}
2815
2816localstatic void
2817scobindParamDeclare(AbSyn decl, AbSyn val)
2818{
2819 AbSyn name = decl->abDeclare.id;
2820 AbSyn type = decl->abDeclare.type;
2821 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2822 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2823
2824 for (i = 0; i < argc; i += 1) {
2825 AbSyn id = argv[i];
2826
2827 /*!! This is almost certainly wrong. */
2828 Symbol sym = id->abId.sym;
2829 AbSyn idType = type;
2830 if (abIsNothing(idType)((idType)->abHdr.tag == (AB_Nothing))) {
2831 idType = scobindDefaultType(scoStab, id->abId.sym);
2832 if (idType) decl->abDeclare.type = abCopy(idType);
2833 }
2834 if (!idType) {
2835 comsgError(id, ALDOR_E_ScoParmType128, symString(sym)((sym)->str));
2836 continue;
2837 }
2838
2839 scobindParamId(id, idType, val);
2840 }
2841}
2842
2843localstatic void
2844scobindParamId(AbSyn id, AbSyn type, AbSyn val)
2845{
2846 Symbol sym = id->abId.sym;
2847 DeclInfo declInfo;
2848
2849 declInfo = scobindDeclareId(id, type, val, SCO_Sig_Param);
2850 scobindSetSigUse(declInfo, SCO_Sig_Param, id);
2851
2852 if (abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0))
2853 stabAddMeaning(scoStab, abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0));
2854 else
2855 scobindAddMeaning(id, sym, scoStab, SYME_Param, abTForm(type)((type)->abHdr.seman ? (type)->abHdr.seman->tform : 0
),
2856 (AInt) NULL((void*)0));
2857}
2858
2859/******************************************************************************
2860 *
2861 * :: scobindReference
2862 *
2863 *****************************************************************************/
2864
2865localstatic void
2866scobindReference(AbSyn ab)
2867{
2868 /* We ought to continue down the tree */
2869 scobindValue(ab);
2870
2871
2872 /* Ignore complicated things */
2873 if (!abHasTag(ab, AB_Id)((ab)->abHdr.tag == (AB_Id)))
2874 return;
2875
2876 /* Mark the thing being referenced */
2877 scobindIntroduceId(ab, NULL((void*)0), SCO_Sig_Reference);
2878}
2879
2880/******************************************************************************
2881 *
2882 * :: scobindFree
2883 * :: scobindLocal
2884 *
2885 *****************************************************************************/
2886
2887localstatic void
2888scobindFree(AbSyn ab)
2889{
2890 scobindLOF(ab->abFree.argv[0], SCO_Sig_Free);
2891}
2892
2893localstatic void
2894scobindLocal(AbSyn ab)
2895{
2896 scobindLOF(ab->abLocal.argv[0], SCO_Sig_Local);
2897}
2898
2899localstatic void
2900scobindLOF(AbSyn body, DeclContext context)
2901{
2902 AbSyn *argv = abArgvAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abGen.
data.argv) : &(body));
2903 Length i, argc = abArgcAs(AB_Sequence, body)(((body)->abHdr.tag == (AB_Sequence)) ? ((body)->abHdr.
argc) : 1);
2904
2905 for (i = 0; i < argc; i += 1) {
2906 AbSyn arg = argv[i];
2907
2908 switch (abTag(arg)((arg)->abHdr.tag)) {
2909 case AB_Id:
2910 case AB_Declare:
2911 case AB_Comma:
2912 scobindLOFComma(arg, NULL((void*)0), context);
2913 break;
2914
2915 case AB_Assign:
2916 scobindLOFComma(arg->abAssign.lhs, NULL((void*)0), context);
2917 scobindAssign(arg);
2918 break;
2919
2920 case AB_Define:
2921 scobindLOFComma(arg->abDefine.lhs,
2922 arg->abDefine.rhs, context);
2923 scobindDefine(arg);
2924 break;
2925
2926 default:
2927 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 2927, "scobind.c");
2928 break;
2929 }
2930 }
2931}
2932
2933localstatic void
2934scobindLOFComma(AbSyn lhs, AbSyn rhs, DeclContext context)
2935{
2936 AbSyn *argv = abArgvAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abGen.data.
argv) : &(lhs));
2937 Length i, argc = abArgcAs(AB_Comma, lhs)(((lhs)->abHdr.tag == (AB_Comma)) ? ((lhs)->abHdr.argc)
: 1);
2938 Bool isComma = abHasTag(lhs, AB_Comma)((lhs)->abHdr.tag == (AB_Comma));
2939 AbSyn val = isComma ? NULL((void*)0) : rhs;
2940
2941 for (i = 0; i < argc; i += 1) {
2942 AbSyn arg = argv[i];
2943
2944 switch (abTag(arg)((arg)->abHdr.tag)) {
2945 case AB_Id:
2946 scobindLOFId(arg, context);
2947 break;
2948
2949 case AB_Declare:
2950 scobindLOFDeclare(arg, val, context);
2951 break;
2952
2953 default:
2954 bugBadCase(abTag(arg))bug("Bad case %d (line %d in file %s).", (int) ((arg)->abHdr
.tag), 2954, "scobind.c");
2955 break;
2956 }
2957 }
2958}
2959
2960localstatic void
2961scobindLOFDeclare(AbSyn decl, AbSyn rhs, DeclContext context)
2962{
2963 AbSyn name = decl->abDeclare.id;
2964 AbSyn type = decl->abDeclare.type;
2965 AbSyn *argv = abArgvAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abGen.data
.argv) : &(name));
2966 Length i, argc = abArgcAs(AB_Comma, name)(((name)->abHdr.tag == (AB_Comma)) ? ((name)->abHdr.argc
) : 1);
2967 Bool isComma = abHasTag(name, AB_Comma)((name)->abHdr.tag == (AB_Comma));
2968 AbSyn val = isComma ? NULL((void*)0) : rhs;
2969
2970 for (i = 0; i < argc; i += 1)
2971 scobindLOFType(argv[i], type, val, context);
2972}
2973
2974localstatic void
2975scobindLOFId(AbSyn id, DeclContext context)
2976{
2977 IdInfo idInfo = getIdInfoInAnyScope(scoStab, id);
2978 DeclInfoList dil = idInfo->declInfoList;
2979
2980 if (context == SCO_Sig_Local)
2981 idInfo->allLocal = true1;
2982 else
2983 idInfo->allFree = true1;
2984
2985 if (!dil && context == SCO_Sig_Free)
2986 markOuterInstanceOfFree(id, abUnknown, SCO_Sig_FreeRef);
2987
2988 for (; dil; dil = cdr(dil)((dil)->rest))
2989 scobindLOFDeclInfo(id, idInfo, car(dil)((dil)->first), context);
2990}
2991
2992localstatic void
2993scobindLOFType(AbSyn id, AbSyn type, AbSyn val, DeclContext context)
2994{
2995 IdInfo idInfo = getIdInfoInAnyScope(scoStab, id);
2996 DeclInfo declInfo;
2997
2998 scobindDeclareId(id, type, val, context);
2999 declInfo = idInfoHasType(idInfo, type);
3000
3001 if (declInfo)
3002 scobindLOFDeclInfo(id, idInfo, declInfo, context);
3003 else if (context == SCO_Sig_Free)
3004 markOuterInstanceOfFree(id, type, SCO_Sig_FreeRef);
3005}
3006
3007localstatic void
3008scobindLOFDeclInfo(AbSyn id, IdInfo idInfo, DeclInfo di, DeclContext context)
3009{
3010 AbSyn abNote = NULL((void*)0);
3011
3012 if (idInfo->uses[SCO_Id_Used])
3013 abNote = idInfo->uses[SCO_Id_Used];
3014 else if (di->uses[SCO_Sig_Used])
3015 abNote = di->uses[SCO_Sig_Used];
3016 else if (di->uses[SCO_Sig_Assign])
3017 abNote = di->uses[SCO_Sig_Assign];
3018 else if (di->uses[SCO_Sig_Define])
3019 abNote = di->uses[SCO_Sig_Define];
3020
3021 if (abNote) {
3022 comsgNError(id, ALDOR_E_ScoLateFreeLocal120);
3023 comsgNote(abNote, ALDOR_N_Here3);
3024 }
3025
3026 scobindSetSigUse(di, context, id);
3027
3028 if (di->uses[SCO_Sig_Param])
3029 comsgError(id, ALDOR_E_ScoParmLocFree126);
3030
3031 if (di->uses[SCO_Sig_Free] && di->uses[SCO_Sig_Local])
3032 comsgError(id, ALDOR_E_ScoFreeAndLoc118, symString(id->abId.sym)((id->abId.sym)->str));
3033
3034 if (context == SCO_Sig_Free)
3035 markOuterInstanceOfFree(id, di->type, SCO_Sig_FreeRef);
3036}
3037
3038/******************************************************************************
3039 *
3040 * :: scobindTry
3041 *
3042 *****************************************************************************/
3043
3044localstatic void
3045scobindTry(AbSyn ab)
3046{
3047 AbSyn id = ab->abTry.id;
3048
3049 if (!abIsNothing(id)((id)->abHdr.tag == (AB_Nothing))) {
3050 AbSyn with, base, within;
3051 base = abNewNothing(abPos(id))abNew(AB_Nothing, (spstackFirst((id)->abHdr.pos)),0 );
3052 abPutUse(base, AB_Use_Type);
3053 within = abNewNothing(abPos(id))abNew(AB_Nothing, (spstackFirst((id)->abHdr.pos)),0 );
3054 abPutUse(within, AB_Use_Declaration);
3055 with = abNewWith(abPos(id), base, within)abNew(AB_With, (spstackFirst((id)->abHdr.pos)),2, base,within
);
3056
3057 id = abDefineeId(ab->abTry.id);
3058 scobindDeclareId(id, with,
3059 NULL((void*)0), SCO_Sig_Define);
3060 }
3061 scobindValue(ab->abTry.expr);
3062 scobindValue(ab->abTry.except);
3063 scobindValue(ab->abTry.always);
3064}
3065
3066/******************************************************************************
3067 *
3068 * :: scobindIf
3069 *
3070 *****************************************************************************/
3071
3072localstatic void
3073scobindIf(AbSyn ab)
3074{
3075 AbSyn test = ab->abIf.test;
3076 scobindValue(test);
3077 scoCondPush(scoStab, test, false((int) 0));
3078 scobindValue(ab->abIf.thenAlt);
3079 scoCondPop();
3080 scoCondPush(scoStab, test, true1);
3081 scobindValue(ab->abIf.elseAlt);
3082 scoCondPop();
3083}
3084
3085localstatic void
3086scobindAnd(AbSyn ab)
3087{
3088 int i;
3089 for (i=0; i<abArgc(ab)((ab)->abHdr.argc); i++) {
3090 AbSyn cond = ab->abAnd.argv[i];
3091 scobindValue(cond);
3092 scoCondPush(scoStab, cond, false((int) 0));
3093 }
3094 for (i=0; i<abArgc(ab)((ab)->abHdr.argc); i++) {
3095 scoCondPop();
3096 }
3097}
3098
3099
3100localstatic ScoCondition
3101scoConditionNew(Stab stab, AbSyn absyn, Bool isNegated)
3102{
3103 ScoCondition cond = (ScoCondition) stoAlloc(OB_Other0, sizeof(*cond));
3104 cond->stab = stab;
3105 cond->absyn = absyn;
3106 cond->negate = isNegated;
3107
3108 return cond;
3109}
3110
3111localstatic void
3112scoCondPush(Stab stab, AbSyn ab, Bool isNegated)
3113{
3114 scoCondList = listCons(ScoCondition)(ScoCondition_listPointer->Cons)(scoConditionNew(stab, ab, isNegated), scoCondList);
3115}
3116
3117localstatic void
3118scoCondPop()
3119{
3120 /* FIXME: Blatant memleak */
3121 scoCondList = cdr(scoCondList)((scoCondList)->rest);
3122}
3123
3124localstatic ScoConditionList
3125scoConditions()
3126{
3127 return scoCondList;
3128}
3129
3130localstatic AInt
3131defPosEltFromAbSyn(AbSyn ab, Bool isNegated)
3132{
3133 return isNegated ? (((AInt) ab) | 1) : (AInt) ab;
3134}
3135
3136localstatic DefnPos
3137defposTail(DefnPos pos)
3138{
3139 return cdr(pos)((pos)->rest);
3140}
3141
3142localstatic Bool
3143defposEqInner(AInt a, AInt b)
3144{
3145 return a == b;
3146}
3147
3148localstatic AbSynList
3149defposToAbSyn(AIntList defnPos)
3150{
3151 AbSynList list = listNil(AbSyn)((AbSynList) 0);
3152 while (defnPos != listNil(AInt)((AIntList) 0)) {
3153 AInt c = car(defnPos)((defnPos)->first);
3154 AbSyn elt = c & 1 ? abNewNot(sposNone, (AbSyn)(c & ~1))abNew(AB_Not, sposNone,1, (AbSyn)(c & ~1)): (AbSyn) c;
3155 list = listCons(AbSyn)(AbSyn_listPointer->Cons)(elt, list);
3156 defnPos = cdr(defnPos)((defnPos)->rest);
3157 }
3158
3159 return listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(list);
3160}
3161
3162localstatic Bool
3163defposEqual(DefnPos a, DefnPos b)
3164{
3165 Bool flg = listEqual(AInt)(AInt_listPointer->Equal)(a, b, defposEqInner);
3166#if 0
3167 afprintf(dbOut, "DefPosEqual: %pAbSynList %pAbSynList = %d\n", defposToAbSyn(a), defposToAbSyn(b), flg);
3168#endif
3169 return flg;
3170}
3171
3172localstatic Bool
3173defposIsRoot(DefnPos pos)
3174{
3175 return pos == listNil(AInt)((AIntList) 0);
3176}
3177
3178localstatic void
3179defposFree(DefnPos pos)
3180{
3181 listFree(AInt)(AInt_listPointer->Free)(pos);
3182}
3183
3184/******************************************************************************
3185 *
3186 * :: scobindCollect
3187 *
3188 *****************************************************************************/
3189
3190localstatic Bool scoCollectIsNewIter(AbSyn ab);
3191
3192localstatic Bool
3193scoIsNewCollect(AbSyn absyn)
3194{
3195 AbSyn *iterv = absyn->abCollect.iterv;
3196 Length i, iterc = abCollectIterc(absyn)(((absyn)->abHdr.argc)-1);
3197 int newIters = 0;
3198
3199 for (i=0; i<iterc; i++) {
3200 if (scoCollectIsNewIter(iterv[i])) {
3201 newIters++;
3202 }
3203 }
3204
3205 return iterc > 0 && newIters == iterc;
3206}
3207
3208localstatic Bool
3209scoCollectIsNewIter(AbSyn absyn)
3210{
3211 if (abTag(absyn)((absyn)->abHdr.tag) == AB_For && abFlag_IsNewIter(absyn)(((absyn)->abHdr.flags) == AB_Flag_NewIter)) {
3212 return true1;
3213 }
3214 return false((int) 0);
3215}
3216
3217
3218/******************************************************************************
3219 *
3220 * :: IdInfo
3221 *
3222 *****************************************************************************/
3223
3224localstatic IdInfo
3225idInfoNew(Stab stab, AbSyn id)
3226{
3227 Symbol sym = id->abId.sym;
3228 IdInfo idInfo;
3229 IdInfoList iil;
3230 Length c;
3231
3232 if (!symInfo(sym)((sym)->info) || !symCoInfo(sym))
3233 symCoInfoInit(sym)(((sym)->info) = &(symCoInfoNew()->align));
3234
3235 car(stab)((stab)->first)->idsInScope = listCons(Symbol)(Symbol_listPointer->Cons)(sym, car(stab)((stab)->first)->idsInScope);
3236
3237 idInfo = (IdInfo) stoAlloc(OB_Other0, sizeof(*idInfo));
3238
3239 idInfo->allFree = false((int) 0);
3240 idInfo->allLocal = false((int) 0);
3241 idInfo->allFluid = false((int) 0);
3242 idInfo->serialNo = car(stab)((stab)->first)->serialNo;
3243 idInfo->intStepNo = intStepNo;
3244 idInfo->sym = sym;
3245 idInfo->declInfoList = listNil(DeclInfo)((DeclInfoList) 0); /* NULL; */
3246 idInfo->defaultType = NULL((void*)0);
3247 idInfo->exampleId = id;
3248 idInfo->usePreDef = listNil(AbSyn)((AbSynList) 0);
3249
3250 for (c = 0; c < SCO_Id_LIMIT; c += 1)
3251 idInfo->uses[c] = NULL((void*)0);
3252
3253 /*
3254 * Insert the new id info so that the id info structures are sorted
3255 * from innermost to outermost. (Inner stabs have higher serialNo's.)
3256 */
3257
3258 iil = listCons(IdInfo)(IdInfo_listPointer->Cons)(idInfo, idInfoCell(sym)((IdInfoList) (symCoInfo(sym)->phaseVal.generic)));
3259 setIdInfoCell(sym, iil)(symCoInfo(sym)->phaseVal.generic = (Pointer) (iil));
3260
3261 while (cdr(iil)((iil)->rest) && idInfo->serialNo < car(cdr(iil))((((iil)->rest))->first)->serialNo) {
3262 car(iil)((iil)->first) = car(cdr(iil))((((iil)->rest))->first);
3263 iil = cdr(iil)((iil)->rest);
3264 }
3265 setcar(iil, idInfo)((iil)->first = (idInfo));
3266
3267 return idInfo;
3268}
3269
3270localstatic void
3271idInfoFree(IdInfo idInfo)
3272{
3273 listFreeDeeply(DeclInfo)(DeclInfo_listPointer->FreeDeeply)(idInfo->declInfoList, declInfoFree);
3274 listFree(AbSyn)(AbSyn_listPointer->Free)(idInfo->usePreDef);
3275 stoFree(idInfo);
3276}
3277
3278localstatic Bool
3279idInfoIsNew(IdInfo idInfo)
3280{
3281 return idInfo->intStepNo == intStepNo - 1;
3282}
3283
3284localstatic void
3285scobindFreeIdInfo(Stab stab)
3286{
3287 SymbolList ids = car(stab)((stab)->first)->idsInScope;
3288
3289 for (; ids; ids = listFreeCons(Symbol)(Symbol_listPointer->FreeCons)(ids)) {
3290 Symbol id = car(ids)((ids)->first);
3291 IdInfoList il = idInfoCell(id)((IdInfoList) (symCoInfo(id)->phaseVal.generic));
3292 IdInfo info = car(il)((il)->first);
3293
3294 idInfoFree(info);
3295 setIdInfoCell(id, listFreeCons(IdInfo)(il))(symCoInfo(id)->phaseVal.generic = (Pointer) ((IdInfo_listPointer
->FreeCons)(il)));
3296 }
3297 car(stab)((stab)->first)->idsInScope = ids;
3298}
3299
3300localstatic IdInfoList
3301scobindSaveIdInfo(Stab stab)
3302{
3303 SymbolList ids = car(stab)((stab)->first)->idsInScope;
3304 IdInfoList iil = listNil(IdInfo)((IdInfoList) 0);
3305
3306 for (; ids; ids = listFreeCons(Symbol)(Symbol_listPointer->FreeCons)(ids)) {
3307 Symbol id = car(ids)((ids)->first);
3308 IdInfoList il = idInfoCell(id)((IdInfoList) (symCoInfo(id)->phaseVal.generic));
3309 IdInfo info = car(il)((il)->first);
3310
3311 iil = listCons(IdInfo)(IdInfo_listPointer->Cons)(info, iil);
3312 setIdInfoCell(id, listFreeCons(IdInfo)(il))(symCoInfo(id)->phaseVal.generic = (Pointer) ((IdInfo_listPointer
->FreeCons)(il)));
3313 }
3314 car(stab)((stab)->first)->idsInScope = ids;
3315
3316 return iil;
3317}
3318
3319localstatic void
3320scobindRestoreIdInfo(Stab stab, IdInfoList iil, Bool undo)
3321{
3322 SymbolList ids = listNil(Symbol)((SymbolList) 0);
3323
3324 for (; iil; iil = listFreeCons(IdInfo)(IdInfo_listPointer->FreeCons)(iil)) {
3325 IdInfo info = car(iil)((iil)->first);
3326 Symbol id = info->sym;
3327 IdInfoList il = idInfoCell(id)((IdInfoList) (symCoInfo(id)->phaseVal.generic));
3328
3329 if (undo && idInfoIsNew(info))
3330 idInfoFree(info);
3331 else {
3332 ids = listCons(Symbol)(Symbol_listPointer->Cons)(id, ids);
3333 setIdInfoCell(id, listCons(IdInfo)(info, il))(symCoInfo(id)->phaseVal.generic = (Pointer) ((IdInfo_listPointer
->Cons)(info, il)));
3334 if (undo) scobindRestoreDeclInfo(info);
3335 }
3336 }
3337 car(stab)((stab)->first)->idsInScope = ids;
3338}
3339
3340/*
3341 * Get the id info from the innermost level which can have it.
3342 * A lexical level can have info for an id if the id is already present,
3343 * or if the level is unlocked.
3344 */
3345localstatic IdInfo
3346getIdInfoInAnyScope(Stab stab, AbSyn id)
3347{
3348 Symbol sym = id->abId.sym;
3349 IdInfo info = NULL((void*)0);
3350
3351 for (; stab && !info; stab = cdr(stab)((stab)->rest)) {
3352 info = getIdInfoInThisScope(stab, sym);
3353 if (!info && !stabLevelIsLocked(stab)(((stab)->first)->isLocked))
3354 info = idInfoNew(stab, id);
3355 }
3356
3357 assert(info)do { if (!(info)) _do_assert(("info"),"scobind.c",3357); } while
(0);
3358 return info;
3359}
3360
3361/*
3362 * Get the id info for sym if it exists in the given scope.
3363 * Return NULL if no id info exists for sym in the given scope.
3364 */
3365localstatic IdInfo
3366getIdInfoInThisScope(Stab stab, Symbol sym)
3367{
3368 ULong serialNo = car(stab)((stab)->first)->serialNo;
3369 IdInfoList info;
3370
3371 if (!symInfo(sym)((sym)->info) || !symCoInfo(sym))
3372 symCoInfoInit(sym)(((sym)->info) = &(symCoInfoNew()->align));
3373
3374 for (info = idInfoCell(sym)((IdInfoList) (symCoInfo(sym)->phaseVal.generic)); info; info = cdr(info)((info)->rest)) {
3375 if (car(info)((info)->first)->serialNo == serialNo)
3376 return car(info)((info)->first);
3377 else if (car(info)((info)->first)->serialNo < serialNo)
3378 return NULL((void*)0);
3379 }
3380 return NULL((void*)0);
3381}
3382
3383localstatic void
3384scobindSetIdUse(IdInfo idInfo, IdContext context, AbSyn use)
3385{
3386 idInfo->uses[context] = use;
3387}
3388
3389localstatic AbSyn
3390scobindDefaultType(Stab stab, Symbol sym)
3391{
3392 AbSyn dtype = NULL((void*)0);
3393
3394 for (; stab && !dtype; stab = cdr(stab)((stab)->rest)) {
3395 IdInfo info = getIdInfoInThisScope(stab, sym);
3396 dtype = info ? info->defaultType : NULL((void*)0);
3397 }
3398
3399 return dtype;
3400}
3401
3402/******************************************************************************
3403 *
3404 * :: DeclInfo
3405 *
3406 *****************************************************************************/
3407
3408localstatic DeclInfo
3409declInfoNew(AbSyn id, AbSyn type, DefnPos cond)
3410{
3411 DeclInfo di;
3412 Length c;
3413
3414 di = (DeclInfo) stoAlloc(OB_Other0, sizeof(*di));
3415
3416 di->intStepNo = intStepNo;
3417 di->id = id;
3418 di->type = type;
3419 di->defpos = listSingleton(DefnPos)(DefnPos_listPointer->Singleton)(cond);
3420 di->doc = id ? abComment(id)((id)->abHdr.seman ? (id)->abHdr.seman->comment : 0) : docNone;
3421
3422 for (c = 0; c < SCO_Sig_LIMIT; c += 1)
3423 di->uses[c] = NULL((void*)0);
3424
3425 return di;
3426}
3427
3428localstatic void
3429declInfoFree(DeclInfo di)
3430{
3431 stoFree(di);
3432}
3433
3434localstatic Bool
3435declInfoIsNew(DeclInfo di)
3436{
3437 return di->intStepNo == intStepNo - 1;
3438}
3439
3440localstatic Bool
3441declInfoUseIsNew(AbSyn ab)
3442{
3443 return ab && (!abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0) || isNewSyme(abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0)));
3444}
3445
3446localstatic Bool
3447declInfoIsImplicitLocal(DeclInfo di)
3448{
3449 return !(di->uses[SCO_Sig_Local] ||
3450 di->uses[SCO_Sig_Free] ||
3451 di->uses[SCO_Sig_Param] ||
3452 di->uses[SCO_Sig_Export]);
3453}
3454
3455localstatic void
3456scobindRestoreDeclInfo(IdInfo ido)
3457{
3458 DeclInfoList dil = ido->declInfoList;
3459 dil = listFreeIfSat(DeclInfo)(DeclInfo_listPointer->FreeIfSat)(dil, declInfoFree, declInfoIsNew);
3460 ido->declInfoList = dil;
3461
3462 for (; dil; dil = cdr(dil)((dil)->rest)) {
3463 DeclInfo di = car(dil)((dil)->first);
3464 Length i;
3465 for (i = SCO_Sig_START; i < SCO_Sig_LIMIT; i += 1)
3466 if (declInfoUseIsNew(di->uses[i]))
3467 di->uses[i] = NULL((void*)0);
3468 }
3469}
3470
3471localstatic DeclInfo
3472idInfoHasType(IdInfo ido, AbSyn type)
3473{
3474 DeclInfoList dil;
3475
3476 for (dil = ido->declInfoList; dil; dil = cdr(dil)((dil)->rest))
3477 if (abEqualModDeclares(car(dil)((dil)->first)->type, type))
3478 return car(dil)((dil)->first);
3479 return NULL((void*)0);
3480}
3481
3482/*
3483 * Augment list of types and symbol documentation.
3484 */
3485localstatic DeclInfo
3486idInfoAddType(IdInfo ido, AbSyn id, AbSyn type, AbSyn val, ScoConditionList cond)
3487{
3488 DeclInfo di;
3489
3490 /* If this id has been declared with this type,
3491 * use the old decl info.
3492 */
3493 if ((di = idInfoHasType(ido, type)) != NULL((void*)0))
17
←
Assuming the condition is false
→
3494 ;
3495
3496 /* If this id has been declared with type Unknown,
3497 * substitute the new type in the old decl info.
3498 */
3499 else if ((di = idInfoHasType(ido, abUnknown)) != NULL((void*)0) &&
18
←
Assuming the condition is false
→
3500 (val == NULL((void*)0) || di->uses[SCO_Sig_Value] == NULL((void*)0)))
3501 di->type = type;
3502
3503 /* Otherwise create a new decl info structure. */
3504 else {
3505 di = declInfoNew(id, type, scoConditionToDefnPos(cond));
19
←
Value assigned to 'di'
→
3506
3507 if (ido->allFree)
20
←
Assuming field 'allFree' is 0
→
21
←
Taking false branch
→
3508 scobindSetSigUse(di, SCO_Sig_Free, id);
3509 if (ido->allLocal)
22
←
Assuming field 'allLocal' is 0
→
23
←
Taking false branch
→
3510 scobindSetSigUse(di, SCO_Sig_Local, id);
3511
3512 ido->declInfoList = listCons(DeclInfo)(DeclInfo_listPointer->Cons)(di, ido->declInfoList);
3513 }
3514
3515 return di;
24
←
Returning pointer (loaded from 'di')
→
3516}
3517
3518localstatic void
3519scobindSetSigUse(DeclInfo declInfo, DeclContext context, AbSyn use)
3520{
3521 /* check for double definitions */
3522
3523 /*!! This shouldn't be here. */
3524 if (context
32.1
'context' is not equal to SCO_Sig_Define
 == SCO_Sig_Define && declInfo->uses[context]) {
3525 if (fintMode == FINT_LOOP2 &&
3526 fintYesOrNo("Redefine? (y/n): ")) {
3527 comsgFPrintf(stdoutstdout, ALDOR_M_FintRedefined246,
3528 use->abId.sym->str);
3529 }
3530 else if (!scobindCheckCondition(declInfo, scoCondList)) {
3531 comsgNError(use, ALDOR_E_ScoDupDefine117,
3532 symString(use->abId.sym)((use->abId.sym)->str));
3533 comsgNote(declInfo->uses[context], ALDOR_N_Here3);
3534 }
3535 declInfo->defpos = listCons(DefnPos)(DefnPos_listPointer->Cons)(scoConditionToDefnPos(scoCondList),
3536 declInfo->defpos);
3537 }
3538
3539 declInfo->uses[context] = use;
33
←
Array access (via field 'uses') results in a null pointer dereference
3540}
3541
3542localstatic TfCondElt scoConditionListToCondElt(ScoConditionList);
3543localstatic AbSynList scoConditionToAbSyn(ScoConditionList);
3544
3545localstatic Bool
3546scobindCheckCondition(DeclInfo declInfo, ScoConditionList conditionList)
3547{
3548 DefnPos defnPos = scoConditionToDefnPos(conditionList);
3549 Bool check = scobindCheckDefnPos(declInfo, defnPos);
3550 scoDEBUGif (!scoDebug) { } else afprintf(dbOut, "scobindCheckCondition: %pAbSynList %d\n",
3551 scoConditionToAbSyn(conditionList), check);
3552 defposFree(defnPos);
3553
3554 return check;
3555}
3556
3557localstatic DefnPos
3558scoConditionToDefnPos(ScoConditionList condition)
3559{
3560 AIntList list = listNil(AInt)((AIntList) 0);
3561 while (condition != listNil(ScoCondition)((ScoConditionList) 0)) {
3562 ScoCondition conditionElt = car(condition)((condition)->first);
3563 AInt elt = defPosEltFromAbSyn(conditionElt->absyn, conditionElt->negate);
3564 list = listCons(AInt)(AInt_listPointer->Cons)(elt, list);
3565 condition = cdr(condition)((condition)->rest);
3566 }
3567
3568 return listNReverse(AInt)(AInt_listPointer->NReverse)(list);
3569}
3570
3571localstatic AbSynList
3572scoConditionToAbSyn(ScoConditionList condition)
3573{
3574 AbSynList list = listNil(AbSyn)((AbSynList) 0);
3575 while (condition != listNil(ScoCondition)((ScoConditionList) 0)) {
3576 ScoCondition conditionElt = car(condition)((condition)->first);
3577 AbSyn elt = conditionElt->negate
3578 ? abNewNot(sposNone, conditionElt->absyn)abNew(AB_Not, sposNone,1, conditionElt->absyn)
3579 : conditionElt->absyn;
3580 list = listCons(AbSyn)(AbSyn_listPointer->Cons)(elt, list);
3581 condition = cdr(condition)((condition)->rest);
3582 }
3583
3584 return listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(list);
3585}
3586
3587localstatic TfCondElt
3588scoCondListCondElt()
3589{
3590 return scoConditionListToCondElt(scoCondList);
3591}
3592
3593localstatic TfCondElt
3594scoConditionListToCondElt(ScoConditionList conditionList)
3595{
3596 AbSynList list = listNil(AbSyn)((AbSynList) 0);
3597 ScoConditionList condition = conditionList;
3598 if (condition == listNil(ScoCondition)((ScoConditionList) 0))
3599 return NULL((void*)0);
3600
3601 while (condition != listNil(ScoCondition)((ScoConditionList) 0)) {
3602 ScoCondition conditionElt = car(condition)((condition)->first);
3603 AbSyn elt = conditionElt->negate
3604 ? abNewNot(sposNone, conditionElt->absyn)abNew(AB_Not, sposNone,1, conditionElt->absyn)
3605 : conditionElt->absyn;
3606 list = listCons(AbSyn)(AbSyn_listPointer->Cons)(elt, list);
3607 condition = cdr(condition)((condition)->rest);
3608 }
3609
3610 list = listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(list);
3611 return tfCondEltNew(conditionList->first->stab, list);
3612}
3613
3614
3615/*
3616 * Returns true iff a definition is found with the same
3617 * conditionalisation as the current symbol.
3618 */
3619localstatic Bool
3620scobindCheckDefnPos(DeclInfo declInfo, DefnPos posn)
3621{
3622 DefnPosList lpos = declInfo->defpos;
3623
3624 while (lpos) {
3625 if (defposEqual(car(lpos)((lpos)->first), posn))
3626 return false((int) 0);
3627 lpos = cdr(lpos)((lpos)->rest);
3628 }
3629
3630 if (defposIsRoot(posn)) return true1;
3631
3632 return scobindCheckDefnPos(declInfo, defposTail(posn));
3633}
3634
3635AbSynList
3636scobindDefnPosToList(DefnPosList defnPosList)
3637{
3638 AbSynList conditionList = listNil(AbSyn)((AbSynList) 0);
3639 while (defnPosList != listNil(DefnPos)((DefnPosList) 0)) {
3640 AbSynList absynList = defposToAbSyn(car(defnPosList)((defnPosList)->first));
3641 defnPosList = cdr(defnPosList)((defnPosList)->rest);
3642
3643 if (absynList == listNil(AbSyn)((AbSynList) 0))
3644 conditionList = listCons(AbSyn)(AbSyn_listPointer->Cons)(NULL((void*)0), conditionList);
3645 else {
3646 AbSyn absyn = (cdr(absynList)((absynList)->rest) == listNil(AbSyn)((AbSynList) 0))
3647 ? car(absynList)((absynList)->first) : abNewAndAll(sposNone, absynList);
3648 conditionList = listCons(AbSyn)(AbSyn_listPointer->Cons)(absyn, conditionList);
3649 }
3650 }
3651 return listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(conditionList);
3652}
3653
3654/******************************************************************************
3655 *
3656 * :: scobindAddMeaning
3657 *
3658 *****************************************************************************/
3659
3660localstatic void
3661scobindAddMeaning(AbSyn ab, Symbol sym, Stab stab, SymeTag kind,
3662 TForm tf, AInt data)
3663{
3664 if (scobindNeedsMeaning(ab, tf)) {
3665 Syme syme = scobindDefMeaning(stab,kind,sym,tf,data);
3666 scobindSetMeaning(ab, syme);
3667 symeSetSrcPos(syme, abPos(ab))(symeSetFieldVal = ((AInt) ((spstackFirst((ab)->abHdr.pos)
))), (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_SrcPos))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_SrcPos
)] = (symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_SrcPos].def) ? symeSetFieldVal : symeSetFieldFn
(syme,SYFI_SrcPos,symeSetFieldVal));
3668 }
3669}
3670
3671localstatic Bool
3672scobindNeedsMeaning(AbSyn ab, TForm tf)
3673{
3674 return ab == NULL((void*)0) || abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0) == NULL((void*)0) ||
3675 symeIsLazy(abSyme(ab))(((((((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0
))->kind == SYME_Trigger ? libGetAllSymes((((ab)->abHdr
.seman ? (ab)->abHdr.seman->syme : 0))->lib) : ((void
*)0)), (((ab)->abHdr.seman ? (ab)->abHdr.seman->syme
: 0)))->bits) & (0x0001)) || symeType(abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0)) != tf;
3676}
3677
3678localstatic void
3679scobindSetMeaning(AbSyn ab, Syme syme)
3680{
3681 if (ab) {
3682 if (abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0) == NULL((void*)0)) {
3683 String s = abPrettyClippedIn(tfExpr(symeType(syme))tfToAbSyn(symeType(syme)),
3684 60, ABPP_NOINDENT(-1));
3685
3686 comsgRemark(ab, ALDOR_R_ScoMeaning137,
3687 comsgString(symeTagToDescrMsgId(symeKind(syme))(symeInfo[((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind)].msgId)),
3688 symeString(syme)((((syme)->id))->str), s);
3689 strFree(s);
3690 }
3691 abSetSyme(ab, syme);
3692 }
3693}
3694
3695localstatic Syme
3696scobindDefMeaning(Stab stab, SymeTag kind, Symbol sym, TForm tf, AInt data)
3697{
3698 Syme syme = NULL((void*)0);
3699
3700 switch (kind) {
3701 case SYME_Param:
3702 syme = stabDefParam(stab, sym, tf);
3703 break;
3704 case SYME_LexVar:
3705 syme = stabDefLexVar(stab, sym, tf);
3706 break;
3707 case SYME_LexConst:
3708 syme = stabDefLexConst(stab, sym, tf);
3709 break;
3710 case SYME_Fluid:
3711 syme = stabDefFluid(stab, sym, tf);
3712 break;
3713 case SYME_Export:
3714 syme = stabDefExport(stab, sym, tf, (Doc) data);
3715 break;
3716 case SYME_Builtin:
3717 syme = stabDefBuiltin(stab, sym, tf, (FoamBValTag) data);
3718 break;
3719 case SYME_Foreign:
3720 syme = stabDefForeign(stab, sym, tf, (ForeignOrigin) data);
3721 break;
3722 default:
3723 bugBadCase(kind)bug("Bad case %d (line %d in file %s).", (int) kind, 3723, "scobind.c"
);
3724 break;
3725 }
3726
3727 return syme;
3728}
3729
3730/******************************************************************************
3731 *
3732 * :: scobindReconcile
3733 *
3734 *****************************************************************************/
3735
3736localstatic void
3737scobindReconcile(Stab stab, AbSynTag context)
3738{
3739 SymbolList ids = car(stab)((stab)->first)->idsInScope;
3740
3741 for (; ids; ids = cdr(ids)((ids)->rest)) {
3742 Symbol id = car(ids)((ids)->first);
3743 IdInfoList il = idInfoCell(id)((IdInfoList) (symCoInfo(id)->phaseVal.generic));
3744 IdInfo info = car(il)((il)->first);
3745
3746
3747 /* The standard checks */
3748 scobindReconcileId(stab, context, id, info);
3749 }
3750}
3751
3752localstatic void
3753scobindReconcileId(Stab stab, AbSynTag context, Symbol sym, IdInfo idInfo)
3754{
3755 AbSyn abuse;
3756
3757 if (idInfo->declInfoList)
3758 scobindReconcileDecls(stab, context, sym, idInfo);
3759
3760 /* Check for bad uses or non-uses of locals. */
3761 else if (idInfo->allLocal) {
3762 AbSyn ab = idInfo->exampleId;
3763 String str = symString(sym)((sym)->str);
3764
3765 if (idInfo->allFree)
3766 comsgError(ab, ALDOR_E_ScoFreeAndLoc118, str);
3767 else if ((abuse = idInfo->uses[SCO_Id_Used]) != NULL((void*)0))
3768 comsgWarning(abuse, ALDOR_W_ScoBadUse134, str);
3769 else
3770 comsgWarning(ab, ALDOR_W_ScoLocalNoUse135, str);
3771
3772 if (idInfo->allFluid)
3773 bug("local, free, fluid, wassa matta?");
3774 }
3775 else {
3776 /*
3777 * The identifier is not defined in this scope
3778 * level and so it must either be defined in an
3779 * outer level or it has been imported. Create
3780 * new usage information in the level outside
3781 * this one to allow the symbol meaning to be
3782 * bound in that level, if appropriate.
3783 */
3784 abuse = idInfo->uses[SCO_Id_InType];
3785 if (abuse && stab != stabFile()) {
3786 idInfo = getIdInfoInAnyScope(cdr(stab)((stab)->rest), abuse);
3787 idInfo->uses[SCO_Id_InType] = abuse;
3788 }
3789 abuse = idInfo->uses[SCO_Id_Used];
3790 if (abuse && stab != stabFile()) {
3791 idInfo = getIdInfoInAnyScope(cdr(stab)((stab)->rest), abuse);
3792 idInfo->uses[SCO_Id_Used] = abuse;
3793 }
3794 }
3795}
3796
3797localstatic void
3798scobindReconcileDecls(Stab stab, AbSynTag context, Symbol sym, IdInfo idInfo)
3799{
3800 Bool lazy = false((int) 0);
3801 AbSynList earlyUse;
3802 DeclInfoList declInfoList;
3803 AbSyn isAssigned = NULL((void*)0), isDefined = NULL((void*)0), isReffed = NULL((void*)0);
3804
3805 /* Reverse list so we see signatures in correct order. */
3806 idInfo->declInfoList = listNReverse(DeclInfo)(DeclInfo_listPointer->NReverse)(idInfo->declInfoList);
3807 declInfoList = idInfo->declInfoList;
3808
3809 for ( ; declInfoList; declInfoList = cdr(declInfoList)((declInfoList)->rest)) {
3810 DeclInfo declInfo = car(declInfoList)((declInfoList)->first);
3811 AbSyn abuse;
3812
3813 abuse = declInfo->uses[SCO_Sig_Assign];
3814 if (abuse) {
3815 if (isAssigned) {
3816 comsgNError(isAssigned, ALDOR_E_ScoVarOverload129);
3817 comsgNote(abuse, ALDOR_N_Here3);
3818 abState(declInfo->id)((declInfo->id)->abHdr.state) = AB_State_Error;
3819 }
3820 isAssigned = abuse;
3821 if (fintMode == FINT_LOOP2 && isDefined)
3822 abState(declInfo->id)((declInfo->id)->abHdr.state) = AB_State_Error;
3823 }
3824
3825 abuse = declInfo->uses[SCO_Sig_Define];
3826 if (abuse && !isDefined) {
3827 isDefined = abuse;
3828 if (fintMode == FINT_LOOP2 && isAssigned)
3829 abState(declInfo->id)((declInfo->id)->abHdr.state) = AB_State_Error;
3830 }
3831
3832 abuse = declInfo->uses[SCO_Sig_Reference];
3833 if (abuse)
3834 isReffed = abuse;
3835
3836
3837 /* Does it look like a lazy value? */
3838 if (!lazy && abIsAnyMap(declInfo->type)(((((declInfo->type)->abHdr.tag == (AB_Apply)) &&
(((((declInfo->type)->abApply.op))->abHdr.tag == (AB_Id
)) && ((((declInfo->type)->abApply.op))->abId
.sym)==(ssymArrow))) && (((declInfo->type)->abHdr
.argc)-1) == 2) || ((((declInfo->type)->abHdr.tag == (AB_Apply
)) && (((((declInfo->type)->abApply.op))->abHdr
.tag == (AB_Id)) && ((((declInfo->type)->abApply
.op))->abId.sym)==(ssymPackedArrow))) && (((declInfo
->type)->abHdr.argc)-1) == 2)))
3839 lazy = true1;
3840
3841 scobindReconcileDecl(stab, context, sym, idInfo, declInfo);
3842 }
3843
3844
3845 /* Ensure id is not assigned and defined. */
3846 if (isAssigned && isDefined) {
3847 comsgNError(isAssigned, ALDOR_E_ScoAssAndDef109, symString(sym)((sym)->str));
3848 comsgNote(isDefined, ALDOR_N_Here3);
3849 }
3850
3851
3852 /* Ensure id is not referenced and defined */
3853 if (isReffed && isDefined) {
3854 comsgNError(isReffed, ALDOR_E_ScoAssAndRef110, symString(sym)((sym)->str));
3855 comsgNote(isDefined, ALDOR_N_Here3);
3856 }
3857
3858
3859 /* Ensure id is not library or archive identifier and assigned */
3860 /* or defined. */
3861 if (isAssigned || isDefined) {
3862 AbSyn ab = isAssigned ? isAssigned : isDefined;
3863 if (stabGetLibrary(sym) || stabGetArchive(sym))
3864 comsgError(ab, ALDOR_E_ScoLibrary121, symString(sym)((sym)->str));
3865 }
3866
3867
3868 /*
3869 * Ensure that non-lazy constants aren't used before their
3870 * definition outside an `add'. We don't seem to need to
3871 * watch for domains and categories as they never seem to
3872 * generate use-before-definition errors. If we do, try
3873 * extending the range of cases in which `lazy' is true.
3874 */
3875 earlyUse = idInfo->usePreDef;
3876 if (!lazy && isDefined && earlyUse) {
3877 /*
3878 * Display an error for each use-before-definition of
3879 * non-lazy constants used outside and `add' body.
3880 * We don't need to reverse `earlyUse' because the
3881 * comsg system sorts messages by line number.
3882 */
3883 for (;earlyUse; earlyUse = cdr(earlyUse)((earlyUse)->rest)) {
3884 AbSyn id = car(earlyUse)((earlyUse)->first);
3885 comsgNError(id, ALDOR_E_ScoEarlyUse138, symString(sym)((sym)->str));
3886 comsgNote(isDefined, ALDOR_N_Here3);
3887 }
3888 }
3889}
3890
3891/*
3892 * This function processes the data for a given signature.
3893 */
3894localstatic void
3895scobindReconcileDecl(Stab stab, AbSynTag context, Symbol sym, IdInfo idInfo,
3896 DeclInfo declInfo)
3897{
3898 AbSyn assigned = declInfo->uses[SCO_Sig_Assign];
3899
3900 /* Error if name used in type is a variable. */
3901
3902 if ((idInfo->uses[SCO_Id_InType] || declInfo->uses[SCO_Sig_InType])
3903 && assigned)
3904 {
3905 comsgError(assigned, ALDOR_E_ScoAssTypeId111, symString(sym)((sym)->str));
3906 }
3907
3908 /*
3909 * Error if a loop variable is assigned to. The initial creation
3910 * of the loop variable will be an assignment, but if the use is
3911 * not the same then there has been a later assignment.
3912 */
3913
3914 if (declInfo->uses[SCO_Sig_Loop] &&
3915 declInfo->uses[SCO_Sig_Loop] != assigned)
3916 {
3917 comsgError(assigned, ALDOR_E_ScoBadLoopAss114);
3918 }
3919
3920 /* Leave early if we don't require symbol meaning generation */
3921
3922 if (declInfo->uses[SCO_Sig_Builtin] && declInfo->uses[SCO_Sig_Foreign])
3923 comsgError(declInfo->uses[SCO_Sig_Builtin],
3924 ALDOR_E_ScoSameSig127);
3925
3926 if (declInfo->uses[SCO_Sig_Builtin] || declInfo->uses[SCO_Sig_Foreign])
3927 {
3928 if (declInfo->uses[SCO_Sig_Free])
3929 comsgError(declInfo->uses[SCO_Sig_Free],ALDOR_E_ScoNoFree122);
3930 if (declInfo->uses[SCO_Sig_Local])
3931 comsgError(declInfo->uses[SCO_Sig_Local],ALDOR_E_ScoNoFree122);
3932 if (declInfo->uses[SCO_Sig_Param])
3933 comsgError(declInfo->uses[SCO_Sig_Free],ALDOR_E_ScoNoParm123);
3934 if (assigned)
3935 comsgError(assigned, ALDOR_E_ScoNoSet124);
3936 if (declInfo->uses[SCO_Sig_Define])
3937 comsgError(declInfo->uses[SCO_Sig_Define],ALDOR_E_ScoNoSet124);
3938 return;
3939 }
3940
3941 if (declInfo->uses[SCO_Sig_Free] || declInfo->uses[SCO_Sig_Param])
3942 return;
3943
3944 /* Process explicit locals */
3945
3946 if (declInfo->uses[SCO_Sig_Local]) {
3947 TForm tf = scobindTfSyntaxFrAbSyn(stab, declInfo->type);
3948
3949 if (declInfo->uses[SCO_Sig_Define]) {
3950 checkOuterUseOfLexicalConstant(stab, declInfo->id);
3951 scobindAddMeaning(declInfo->id,sym,stab,SYME_LexConst,
3952 tf, (AInt) NULL((void*)0));
3953 return;
3954 }
3955
3956 if (assigned) {
3957 scobindAddMeaning(declInfo->id,sym,stab,SYME_LexVar,
3958 tf, (AInt) NULL((void*)0));
3959 return;
3960 }
3961
3962 /* we seem to need to make the syme to keep tinfer happy */
3963
3964 scobindAddMeaning(declInfo->id,sym,stab,SYME_LexConst,
3965 tf, (AInt) NULL((void*)0));
3966
3967 /* check for use without assignment or definition */
3968
3969 if (idInfo->uses[SCO_Id_Used])
3970 comsgWarning(idInfo->uses[SCO_Id_Used],
3971 ALDOR_W_ScoBadUse134, symString(sym)((sym)->str));
3972 else if (declInfo->uses[SCO_Sig_Used])
3973 comsgWarning(declInfo->uses[SCO_Sig_Used],
3974 ALDOR_W_ScoBadUse134, symString(sym)((sym)->str));
3975 else if (! declInfo->uses[SCO_Sig_FreeRef])
3976 comsgWarning(declInfo->uses[SCO_Sig_Local],
3977 ALDOR_W_ScoLocalNoUse135, symString(sym)((sym)->str));
3978 return;
3979 }
3980 if (declInfo->uses[SCO_Sig_Fluid]) {
3981 TForm tf;
3982 if (abIsNothing(declInfo->type)((declInfo->type)->abHdr.tag == (AB_Nothing)))
3983 tf = tfUnknown;
3984 else
3985 tf = scobindTfSyntaxFrAbSyn(stab,declInfo->type);
3986
3987 scoFluidDEBUGif (!scoFluidDebug) { } else afprintf(dbOut, "Adding fluid: %s", symString(sym)((sym)->str));
3988 if (DEBUG(scoFluid)scoFluidDebug) {
3989 tfPrintDb(tf);
3990 }
3991
3992 if (!scobindCheckOuterUseOfFluid(declInfo->id, declInfo->type)) {
3993 scoFluidDEBUGif (!scoFluidDebug) { } else afprintf(dbOut, " New\n");
3994 scobindAddMeaning(declInfo->id, sym, stab, SYME_Fluid,
3995 tf, (AInt) NULL((void*)0));
3996 }
3997 else
3998 scoFluidDEBUGif (!scoFluidDebug) { } else afprintf(dbOut, " See'd it before.\n");
3999 return;
4000 }
4001
4002 /* Signature without 'local' declaration. */
4003
4004 if (assigned) {
4005 TForm tf;
4006
4007 if (context != AB_Apply)
4008 checkOuterUseOfImplicitLocal(stab,
4009 assigned,
4010 declInfo->type);
4011
4012 tf = scobindTfSyntaxFrAbSyn(stab, declInfo->type);
4013
4014 if (fintMode == FINT_LOOP2) {
4015 if (abSyme(declInfo->id)((declInfo->id)->abHdr.seman ? (declInfo->id)->abHdr
.seman->syme : 0))
4016 return;
4017 if (tfIsUnknown(tf)(((tf)->tag) == TF_Unknown) && stabGetLex(stab, sym))
4018 return;
4019 }
4020
4021 scobindAddMeaning(declInfo->id, sym, stab, SYME_LexVar,
4022 tf, (AInt) NULL((void*)0));
4023 return;
4024 }
4025
4026 if (declInfo->uses[SCO_Sig_Define]) {
4027 TForm tf = scobindTfSyntaxFrAbSyn(stab, declInfo->type);
4028 if (context == AB_Add || context == AB_With) {
4029 Syme syme;
4030 AbSynList defConditions;
4031 if (!abSyme(declInfo->id)((declInfo->id)->abHdr.seman ? (declInfo->id)->abHdr
.seman->syme : 0))
4032 scobindAddMeaning(declInfo->id,
4033 sym, stab, SYME_Export,
4034 tf, (AInt) declInfo->doc);
4035 assert(abSyme(declInfo->id))do { if (!(((declInfo->id)->abHdr.seman ? (declInfo->
id)->abHdr.seman->syme : 0))) _do_assert(("abSyme(declInfo->id)"
),"scobind.c",4035); } while (0);
4036 syme = abSyme(declInfo->id)((declInfo->id)->abHdr.seman ? (declInfo->id)->abHdr
.seman->syme : 0);
4037 defConditions = scobindDefnPosToList(declInfo->defpos);
4038 symeSetDefinitionConditions(syme, defConditions)(symeSetFieldVal = ((AInt) (defConditions)), (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_DefinitionConditions
))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_DefinitionConditions
)] = (symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_DefinitionConditions].def) ? symeSetFieldVal
: symeSetFieldFn(syme,SYFI_DefinitionConditions,symeSetFieldVal
));
4039 }
4040 else {
4041 checkOuterUseOfLexicalConstant(stab, declInfo->id);
4042 scobindAddMeaning(declInfo->id, sym, stab,
4043 SYME_LexConst, tf, (AInt) NULL((void*)0));
4044
4045 if (context != AB_Apply)
4046 checkOuterUseOfImplicitLocal(stab,
4047 declInfo->uses[SCO_Sig_Define],
4048 declInfo->type);
4049
4050 scobindSetSigUse(declInfo, SCO_Sig_ImplicitLocal,
4051 declInfo->uses[SCO_Sig_Define]);
4052 }
4053 return;
4054 }
4055
4056 if (abSyme(declInfo->id)((declInfo->id)->abHdr.seman ? (declInfo->id)->abHdr
.seman->syme : 0))
4057 return;
4058
4059 /* make anything else into a lexical constant */
4060
4061 scobindAddMeaning(declInfo->id, sym, stab, SYME_LexConst,
4062 scobindTfSyntaxFrAbSyn(stab, declInfo->type), (AInt) NULL((void*)0));
4063}
4064
4065/******************************************************************************
4066 *
4067 * :: scobindPrint
4068 *
4069 *****************************************************************************/
4070
4071void
4072scobindPrint(Stab stab)
4073{
4074 scobindPrintStab(stab);
4075}
4076
4077localstatic void
4078scobindPrintStab(Stab stab)
4079{
4080 SymbolList ids;
4081
4082 for (ids = car(stab)((stab)->first)->idsInScope; ids; ids = cdr(ids)((ids)->rest)) {
4083 scobindPrintId(car(ids)((ids)->first));
4084 if (cdr(ids)((ids)->rest)) fnewline(dbOut);
4085 }
4086}
4087
4088localstatic void
4089scobindPrintId(Symbol id)
4090{
4091 IdInfoList il = idInfoCell(id)((IdInfoList) (symCoInfo(id)->phaseVal.generic));
4092 IdInfo info = (il ? car(il)((il)->first) : NULL((void*)0));
4093 DeclInfoList dil;
4094 Length i;
4095
4096 if (!info) return;
4097
4098 fprintf(dbOut, " %-14s: ", symString(id)((id)->str));
4099 scobindPrintIdInfo(info);
4100 for (i = 1, dil = info->declInfoList; dil; i += 1, dil = cdr(dil)((dil)->rest))
4101 scobindPrintDeclInfo(i, car(dil)((dil)->first));
4102}
4103
4104localstatic void
4105scobindPrintIdInfo(IdInfo info)
4106{
4107 Length c;
4108
4109 if (info->allFree)
4110 fprintf(dbOut, "AllFree ");
4111 if (info->allLocal)
4112 fprintf(dbOut, "AllLocal ");
4113 if (info->allFluid)
4114 fprintf(dbOut, "AllFluid ");
4115
4116 for (c = SCO_Id_START; c < SCO_Id_LIMIT; c += 1)
4117 if (info->uses[c])
4118 fprintf(dbOut, "%s ", IdContextNames[c]);
4119
4120 if (info->defaultType) {
4121 fprintf(dbOut, "Default (");
4122 abPrettyPrintClippedIn(dbOut, info->defaultType,
4123 ABPP_UNCLIPPED(200000L), 1);
4124 fprintf(dbOut, ")");
4125 }
4126}
4127
4128localstatic void
4129scobindPrintDeclInfo(Length i, DeclInfo declInfo)
4130{
4131 Length c;
4132
4133 fnewline(dbOut);
4134 fprintf(dbOut, " %-14s: [%d] ", " ", (int) i);
4135
4136 if (declInfo->type) {
4137 fprintf(dbOut, "<");
4138 abPrettyPrintClippedIn(dbOut, declInfo->type,
4139 ABPP_UNCLIPPED(200000L), 1);
4140 fprintf(dbOut, "> ");
4141 }
4142
4143 for (c = SCO_Sig_START; c < SCO_Sig_LIMIT; c += 1)
4144 if (declInfo->uses[c])
4145 fprintf(dbOut, "%s ", DeclContextNames[c]);
4146}
4147
4148/******************************************************************************
4149 *
4150 * :: scobindUndo
4151 *
4152 *****************************************************************************/
4153
4154localstatic void
4155scobindUndo()
4156{
4157 scoUndoSymes = listNil(Syme)((SymeList) 0);
4158 scoUndoTForms = listNil(TForm)((TFormList) 0);
4159
4160 scoUndoStab(scoStab);
4161
4162 listFreeDeeply(Syme)(Syme_listPointer->FreeDeeply)(scoUndoSymes, symeFree);
4163 listFreeDeeply(TForm)(TForm_listPointer->FreeDeeply)(scoUndoTForms, tfFree);
4164
4165 scoUndoState = false((int) 0);
4166}
4167
4168localstatic void
4169scoUndoStab(Stab stab)
4170{
4171 StabLevel stabLev;
4172 StabList stabl;
4173
4174 for (stabLev = car(stab)((stab)->first); stab; stab = cdr(stab)((stab)->rest)) {
4175 scoUndoStabLevel(stabLev);
4176 for (stabl = stabLev->children; stabl; stabl = cdr(stabl)((stabl)->rest))
4177 scoUndoStab(car(stabl)((stabl)->first));
4178 }
4179}
4180
4181localstatic void
4182scoUndoStabLevel(StabLevel stabLev)
4183{
4184 tblRemoveIf(stabLev->tbl, (TblFreeEltFun) stoFree,
4185 (TblTestEltFun) scoUndoStabEntry);
4186
4187 stabLev->boundSymes= listFreeIfSat(Syme)(Syme_listPointer->FreeIfSat)
4188 (stabLev->boundSymes, scoUndoSyme, isNewSyme);
4189
4190 stabLev->tformsUsed.list = listFreeIfSat(TFormUses)(TFormUses_listPointer->FreeIfSat)
4191 (stabLev->tformsUsed.list, scoUndoTFormUses, isNewTFormUses);
4192
4193 if (stabLev->tformsUsed.table)
4194 tblRemoveIf(stabLev->tformsUsed.table,
4195 (TblFreeEltFun) scoUndoTFormUses,
4196 (TblTestEltFun) isNewTFormUses);
4197
4198 stabLev->tformsUnused = listFreeIfSat(TForm)(TForm_listPointer->FreeIfSat)
4199 (stabLev->tformsUnused, scoUndoTForm, isNewTForm);
4200}
4201
4202localstatic Bool
4203scoUndoStabEntry(StabEntry stent)
4204{
4205 SymeList osymes, nsymes;
4206 Length oldLength;
4207
4208 if (!stent) return false((int) 0);
4209
4210 osymes = stent->symev[0];
4211 oldLength = listLength(Syme)(Syme_listPointer->_Length)(osymes);
4212
4213 nsymes = listFreeIfSat(Syme)(Syme_listPointer->FreeIfSat)(osymes, scoUndoSyme, isNewSyme);
4214 stent->symev[0] = nsymes;
4215
4216 if (listLength(Syme)(Syme_listPointer->_Length)(nsymes) != oldLength) {
4217 tpossFree(stent->possv[0]);
4218 stent->possv[0] = NULL((void*)0);
4219 }
4220
4221 return (nsymes == listNil(Syme)((SymeList) 0));
4222}
4223
4224localstatic void
4225scoUndoSyme(Syme syme)
4226{
4227 if (!listMemq(Syme)(Syme_listPointer->Memq)(scoUndoSymes, syme))
4228 scoUndoSymes = listCons(Syme)(Syme_listPointer->Cons)(syme, scoUndoSymes);
4229}
4230
4231localstatic void
4232scoUndoTForm(TForm tf)
4233{
4234 if (!listMemq(TForm)(TForm_listPointer->Memq)(scoUndoTForms, tf))
4235 scoUndoTForms = listCons(TForm)(TForm_listPointer->Cons)(tf, scoUndoTForms);
4236}
4237
4238localstatic void
4239scoUndoTFormUses(TFormUses tfu)
4240{
4241 scoUndoTForm(tfu->tf);
4242 /* stoFree(tfu); $$ USE tfUsesPool or intStepNo or refCounter */
4243}
4244
4245localstatic Bool
4246isNewSyme(Syme syme)
4247{
4248 return symeIntStepNo(syme)((UShort) (SYFI_IntStepNo < (8 * sizeof(int)) && !
(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_IntStepNo
))) ? (symeFieldInfo[SYFI_IntStepNo].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_IntStepNo)))
? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_IntStepNo))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_IntStepNo
)] : (symeFieldInfo[SYFI_IntStepNo].def)) : symeGetFieldFn(syme
,SYFI_IntStepNo))) == intStepNo - 1;
4249}
4250
4251localstatic Bool
4252isNewTForm(TForm tf)
4253{
4254 return tf->intStepNo == intStepNo - 1;
4255}
4256
4257localstatic Bool
4258isNewTFormUses(TFormUses tfu)
4259{
4260 return tfu->tf->intStepNo == intStepNo - 1;
4261}
4262
4263
4264/******************************************************************************
4265 *
4266 * :: Setting conditions
4267 *
4268 *****************************************************************************/
4269
4270localstatic void scobindTfConditions(Stab stab, TForm tf, TfCondElt conditions);
4271
4272localstatic TForm
4273scobindTfSyntaxFrAbSyn(Stab stab, AbSyn ab)
4274{
4275 TForm tf = tfSyntaxFrAbSyn(stab, ab);
4276 scobindTfConditions(stab, tf, scoCondListCondElt());
4277 return tf;
4278}
4279
4280localstatic void
4281scobindTfConditions(Stab stab, TForm tf, TfCondElt conditions)
4282{
4283 if (!tfIsPending(tf)(((tf)->state)==TF_State_Pending))
4284 return;
4285
4286 if (conditions == NULL((void*)0))
4287 return;
4288
4289 tfSyntaxConditions(stab, tf, conditions);
4290}
4291
4292/******************************************************************************
4293 *
4294 * :: LambdaInfo
4295 *
4296 *****************************************************************************/
4297
4298localstatic LambdaInfo
4299lambdaInfoAlloc(AbSyn lhs, AbSyn rhs, ScoConditionList condition)
4300{
4301 LambdaInfo info = (LambdaInfo) stoAlloc(OB_Other0, sizeof(*info));
4302 info->lhs = lhs;
4303 info->rhs = rhs;
4304 info->scoCondList = condition;
4305
4306 return info;
4307}
4308
4309localstatic void
4310lambdaInfoFree(LambdaInfo info)
4311{
4312 stoFree(info);
4313}