001 #include "Parser.HC";
002 #define SHLONG_TALKP_NUM 'Number'
003 #define SHLONG_TALKP_STR 'String'
004 #define SHLONG_TALKP_CHR 'Char'
005 #define SHLONG_TALKP_CLASS 'Class'
006 #define SHLONG_TALKP_ARRAY 'Array'
007 class CShlongPrim {
008   U64 type;
009   CShlongPrim *cls;
010   I32 sz,ref_cnt; //-1 for stack
011 };
012 class CShlongNum:CShlongPrim {
013   F64 value;
014 };
015 class CShlongChar:CShlongPrim {
016   U64 ch;
017 };
018 class CShlongString:CShlongPrim {
019   U8 *str; //Nul terminated
020 };
021 class CShlongArray:CShlongPrim {
022   I64 len;
023   CShlongPrim **items;
024 };
025 
026 
027 
028 #define MEMT_METHOD 1
029 #define MEMT_CLASS_METHOD 2
030 #define MEMT_SHARED_VAR 3
031 #define MEMT_MEMBER 4
032 #define MEMT_NATIVE_METHOD 5
033 class CShlongClass:CShlongPrim {
034   CHashTable *members;
035   CShlongPrim *parent_cls;
036 };
037 union CShlong {
038   CShlongPrim prim;
039   CShlongNum num;
040   CShlongChar char;
041   CShlongString string;
042   CShlongArray array;
043   CShlongClass cls;
044 };
045 U0 PrintShlong(CShlong *s) {
046   if(s->prim.type==SHLONG_TALKP_NUM)
047     "%n\n",s->num.value;
048   else if(s->prim.type==SHLONG_TALKP_STR)
049     "\"%s\"\n",s->string.str;
050   else if(s->prim.type==SHLONG_TALKP_CHR)
051     "'%c'\n",s->char.ch;
052   else
053     "TODO\n";
054 }
055 
056 CHashTable *universe=HashTableNew(0x1000);
057 
058 CShlong *ClsNew(U8 *name,CShlong *parent=NULL) {
059   CHashGeneric *gh;
060   CShlong *s=CAlloc(sizeof CShlong);
061   s->cls.members=HashTableNew(0x100);
062   s->cls.parent_cls=parent;
063   s->cls.type=SHLONG_TALKP_CLASS;
064   s->cls.ref_cnt=1;
065   gh=CAlloc(sizeof CHashGeneric);
066   gh->type=HTT_FRAME_PTR;
067   gh->str=StrNew(name);
068   gh->user_data0=s;
069   HashAdd(gh,universe);
070   return s;
071 }
072 
073 U8 *SkipWhitespace(U8 *s) {
074   while(Bt(char_bmp_white_space,*s))
075     s++;
076   return s;
077 }
078 
079 U0 AddVarToScope(U8 *n) {
080   U8 buf[STR_LEN];
081   StrPrint(buf,"VAR.%s",n);
082   FramePtrAdd(buf,1);
083 }
084 Bool HasVar(U8 *n) {
085   U8 buf[STR_LEN];
086   StrPrint(buf,"VAR.%s",n);
087   return FramePtr(buf);
088 }
089 U0 RemVarFromScope(U8 *n) {
090   U8 buf[STR_LEN];
091   StrPrint(buf,"VAR.%s",n);
092   FramePtrDel(buf);
093 }
094 
095 
096 
097 U0 PrsVarsFromString(U8 *vars,CHashTable *t,Bool add=FALSE) {
098   I64 ptr;
099   U8 cname[STR_LEN];
100   CHashGeneric *gh;
101 again:
102   ptr=0;
103   vars=SkipWhitespace(vars);
104   while(*vars&&!Bt(char_bmp_white_space,*vars)) {
105     cname[ptr++]=*vars;
106     vars++;
107   }
108   if(ptr) {
109     cname[ptr]=0;
110     gh=CAlloc(sizeof CHashGeneric);
111     gh->type=HTT_FRAME_PTR;
112     gh->str=StrNew(cname);
113     gh->user_data0=MEMT_MEMBER;
114     HashAdd(gh,t);
115     goto again;
116   }
117 }
118 
119 
120 
121 U0 AddNativeMethod(U8 *fptr,U8 *name,CShlong *sh) {
122   if(!sh||sh->prim.type!=SHLONG_TALKP_CLASS)
123     throw('Prim');
124   CHashTable *t=sh->cls.members;
125   CHashGeneric *gh;
126   gh=CAlloc(sizeof CHashGeneric);
127   gh->type=HTT_FRAME_PTR;
128   gh->str=StrNew(name);
129   gh->user_data0=MEMT_NATIVE_METHOD;
130   gh->user_data1=fptr;
131   HashAdd(gh,t);
132 }
133 U0 AddMethod(U8 *fptr,U8 *name,CShlong *sh) {
134   if(!sh||sh->prim.type!=SHLONG_TALKP_CLASS)
135     throw('Prim');
136   CHashTable *t=sh->cls.members;
137   CHashGeneric *gh;
138   gh=CAlloc(sizeof CHashGeneric);
139   gh->type=HTT_FRAME_PTR;
140   gh->str=StrNew(name);
141   gh->user_data0=MEMT_METHOD;
142   gh->user_data1=fptr;
143   HashAdd(gh,t);
144 }
145 U0 AddClsMethod(U8 *fptr,U8 *name,CShlong *sh) {
146   if(!sh||sh->prim.type!=SHLONG_TALKP_CLASS)
147     throw('Prim');
148   CHashTable *t=sh->cls.members;
149   CHashGeneric *gh;
150   gh=CAlloc(sizeof CHashGeneric);
151   gh->type=HTT_FRAME_PTR;
152   gh->str=StrNew(name);
153   gh->user_data0=MEMT_CLASS_METHOD;
154   gh->user_data1=fptr;
155   HashAdd(gh,t);
156 }
157 
158 U0 ErectClass(U8 *clsn) {
159   U8 name[STR_LEN],*tmp;
160   CDirEntry *head,*cur;
161   CShlong *cls=ClsNew(clsn);
162   CMethod *meth;
163    CLexer *l;
164   if(!FileFind("Semen")) DirMk("Semen");
165   StrPrint(name,"Semen/%s",cls);
166   if(!FileFind(name)) {
167     DirMk(name);
168     return;
169   }
170 
171   StrPrint(name,"Semen/%s/Methods",cls);
172   if(!FileFind(name)) DirMk(name);
173   CatPrint(name,"/*");
174   head=FilesFind(name);  
175   for(cur=head;cur;cur=cur->next) {
176    l=LexerNew(tmp=FileRead(cur->full_name),cur->full_name);
177    try {
178      meth=ParseMethod(l);
179      AddMethod(meth,meth->name,cls->cls.members);
180    } catch
181      PutExcept(TRUE);
182    LexerDel(l);
183    Free(tmp);
184   } 
185   DirTreeDel(head);
186   StrPrint(name,"Semen/%s/ClsMethods",cls);
187   if(!FileFind(name)) DirMk(name);
188   CatPrint(name,"/*");
189   head=FilesFind(name);  
190   for(cur=head;cur;cur=cur->next) {
191    l=LexerNew(tmp=FileRead(cur->full_name),cur->full_name);
192    try {
193      meth=ParseMethod(l);
194      AddClsMethod(meth,meth->name,cls->cls.members);
195    } catch
196      PutExcept(TRUE);
197    LexerDel(l);
198    Free(tmp);
199   } 
200   DirTreeDel(head);
201 }
202 CShlongClass *GetShlongClass(U8 *s) {
203   I64 inst;
204   CHashGeneric *gh;
205   for(inst=1;gh=HashFind(s,universe,inst);inst++) {
206     if(gh->user_data0==SHLONG_TALKP_CLASS)
207       return gh->user_data1;
208   }
209   return NULL;
210 }
211 CShlongClass *GetShlongClassXXXX(U8 *s,CShlong *sh,I64 type) {
212   I64 inst;
213   CHashGeneric *gh;
214   if(sh->prim.type!=SHLONG_TALKP_CLASS)
215     sh=sh->prim.cls;
216   if(!sh||sh->prim.type!=SHLONG_TALKP_CLASS)
217     throw('Prim');
218   for(inst=1;gh=HashFind(s,sh->cls.members,HTT_FRAME_PTR,inst);inst++) {
219     if(gh->user_data0==type)
220       return gh->user_data1;
221   }
222   return NULL;
223 }
224 CMethod *GetShlongClassMethod(U8 *s,CShlong *sh) {
225   return GetShlongClassXXXX(s,sh,MEMT_CLASS_METHOD);
226 }
227 CMethod *GetShlongMethod(U8 *s,CShlong *sh) {
228   return GetShlongClassXXXX(s,sh,MEMT_METHOD);
229 }
230 CMethod *GetShlongNativeMethod(U8 *s,CShlong *sh) {
231   return GetShlongClassXXXX(s,sh,MEMT_NATIVE_METHOD);
232 }
233 CMethod *GetShlongSharedVar(U8 *s,CShlong *sh) {
234   return GetShlongClassXXXX(s,sh,MEMT_SHARED_VAR);
235 }
236 CMethod *GetShlongMember(U8 *s,CShlong *sh) {
237   return GetShlongClassXXXX(s,sh,MEMT_MEMBER);
238 }
239 
240 CShlongClass *num_cls=ClsNew("Number");
241 U0 FreeObject(CShlong *self) {
242   I64 idx;
243   if(self->string.type==SHLONG_TALKP_STR) {
244     if(--self->string.ref_cnt==0)
245         Free(self->string.str);
246   } else if(self->string.type==SHLONG_TALKP_ARRAY) {
247     if(--self->string.ref_cnt==0) {
248       idx=self->array.len;
249       while(--idx>=0) {
250         FreeObject(self->array.items[idx]);
251       }
252       Free(self->array.items);
253     }
254   }
255 }
256 U0 PrimAddNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
257   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
258   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
259   FreeObject(res);
260   res->type=SHLONG_TALKP_NUM;
261   res->cls=num_cls;
262   res->value=self->value+other->value;
263   res->ref_cnt=1;
264 }
265 AddNativeMethod(&PrimAddNum,"+",num_cls);
266 
267 U0 PrimSubNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
268   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
269   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
270   res->type=SHLONG_TALKP_NUM;
271   res->cls=num_cls;
272   res->value=self->value-other->value;
273   res->ref_cnt=1;
274 }
275 AddNativeMethod(&PrimSubNum,"-",num_cls);
276 
277 U0 PrimMulNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
278   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
279   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
280   FreeObject(res);
281   res->type=SHLONG_TALKP_NUM;
282   res->cls=num_cls;
283   res->value=self->value*other->value;
284   res->ref_cnt=1;
285 }
286 AddNativeMethod(&PrimMulNum,"*",num_cls);
287 
288 U0 PrimDivNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
289   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
290   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
291   if(other->value==0.) throw('Divide');
292   FreeObject(res);
293   res->type=SHLONG_TALKP_NUM;
294   res->cls=num_cls;
295   res->value=self->value/other->value;
296   res->ref_cnt=1;
297 }
298 AddNativeMethod(&PrimDivNum,"/",num_cls);
299 
300 U0 PrimRemNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
301   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
302   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
303   if(other->value==0.) throw('Divide');
304   FreeObject(res);
305   res->type=SHLONG_TALKP_NUM;
306   res->cls=num_cls;
307   res->value=self->value%other->value;
308   res->ref_cnt=1;
309 }
310 AddNativeMethod(&PrimRemNum,"%",num_cls);
311 
312 U0 PrimDivFloorNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
313   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
314   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
315   if(other->value==0.) throw('Divide');
316   FreeObject(res);
317   res->type=SHLONG_TALKP_NUM;
318   res->cls=num_cls;
319   res->value=ToI64(self->value/other->value);
320   res->ref_cnt=1;
321 }
322 AddNativeMethod(&PrimDivFloorNum,"//",num_cls);
323 
324 U0 PrimEqualsNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
325   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
326   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
327   FreeObject(res);
328   res->type=SHLONG_TALKP_NUM;
329   res->cls=num_cls;
330   res->value=self->value==other->value;
331   res->ref_cnt=1;
332 }
333 AddNativeMethod(&PrimEqualsNum,"=",num_cls);
334 
335 U0 PrimNotEqualsNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
336   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
337   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
338   FreeObject(res);
339   res->type=SHLONG_TALKP_NUM;
340   res->cls=num_cls;
341   res->value=self->value!=other->value;
342   res->ref_cnt=1;
343 }
344 AddNativeMethod(&PrimNotEqualsNum,"~=",num_cls);
345 
346 U0 PrimLtNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
347   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
348   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
349   FreeObject(res);
350   res->type=SHLONG_TALKP_NUM;
351   res->cls=num_cls;
352   res->value=self->value<other->value;
353   res->ref_cnt=1;
354 }
355 AddNativeMethod(&PrimLtNum,"<",num_cls);
356 
357 U0 PrimGtNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
358   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
359   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
360   FreeObject(res);
361   res->type=SHLONG_TALKP_NUM;
362   res->cls=num_cls;
363   res->value=self->value>other->value;
364   res->ref_cnt=1;
365 }
366 AddNativeMethod(&PrimGtNum,">",num_cls);
367 
368 U0 PrimLeNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
369   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
370   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
371   FreeObject(res);
372   res->type=SHLONG_TALKP_NUM;
373   res->cls=num_cls;
374   res->value=self->value<=other->value;
375   res->ref_cnt=1;
376 }
377 AddNativeMethod(&PrimLeNum,"<=",num_cls);
378 
379 
380 U0 PrimGeNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
381   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
382   if(other->type!=SHLONG_TALKP_NUM) throw('Prim');
383   FreeObject(res);
384   res->type=SHLONG_TALKP_NUM;
385   res->cls=num_cls;
386   res->ref_cnt=1;
387   res->value=self->value>=other->value;
388 }
389 AddNativeMethod(&PrimGeNum,">=",num_cls);
390 
391 U0 PrimFloorNum(CShlongNum *res,CShlongNum *self) {
392   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
393   FreeObject(res);
394   res->type=SHLONG_TALKP_NUM;
395   res->cls=num_cls;
396   res->ref_cnt=1;
397   res->value=Floor(self->value);
398 }
399 AddNativeMethod(&PrimFloorNum,"floor",num_cls);
400 
401 U0 PrimCeilNum(CShlongNum *res,CShlongNum *self) {
402   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
403   FreeObject(res);
404   res->type=SHLONG_TALKP_NUM;
405   res->cls=num_cls;
406   res->ref_cnt=1;
407   res->value=Ceil(self->value);
408 }
409 AddNativeMethod(&PrimCeilNum,"ceil",num_cls);
410 
411 U0 PrimLnNum(CShlongNum *res,CShlongNum *self) {
412   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
413   FreeObject(res);
414   res->type=SHLONG_TALKP_NUM;
415   res->cls=num_cls;
416   res->ref_cnt=1;
417   res->value=Ln(self->value);
418 }
419 AddNativeMethod(&PrimLnNum,"ln",num_cls);
420 
421 U0 PrimRaisedToNum(CShlongNum *res,CShlongNum *self,CShlongNum *other) {
422   if(self->type!=SHLONG_TALKP_NUM) throw('Prim');
423   FreeObject(res);
424   res->type=SHLONG_TALKP_NUM;
425   res->cls=num_cls;
426   res->ref_cnt=1;
427   res->value=self->value`other->value;
428 }
429 AddNativeMethod(&PrimRaisedToNum,"raisedTo:",num_cls);
430 CShlong *RunAST(CAST *ast) {
431   U8 *meth_name=NULL;
432   I64 argc=0;
433 //1st item of meth_args is return value
434   CShlong **meth_args=NULL,*ret=CAlloc(sizeof CShlong),*self;
435   CMethod *smethod;
436   U8 *nmethod;
437   switch(ast->type) {
438     case AST_UNOP:
439       meth_name=ast->name;
440       argc=2;
441       meth_args=CAlloc(2*8);
442       self=RunAST(ast->args.next);
443       break;
444     case AST_BINOP:
445       meth_name=ast->name;
446       meth_args=CAlloc(3*8);
447       argc=3;
448       self=RunAST(ast->args.next);
449       meth_args[2]=RunAST(ast->args.last);
450       break;
451     case AST_NUM:
452       ret->num.type=SHLONG_TALKP_NUM;
453       ret->num.cls=num_cls;
454       ret->num.ref_cnt=1;
455       ret->num.value=ast->num;
456       return ret;
457   }
458   meth_args[0]=ret;
459   meth_args[1]=self;
460  if(smethod=GetShlongMethod(meth_name,self)) {
461 //TODO
462   } else if(nmethod=GetShlongNativeMethod(meth_name,self)) {
463     Call(nmethod,argc,meth_args);
464   }
465   while(--argc>=1) {
466     FreeObject(meth_args[argc]);
467   }
468   Free(meth_args);
469   return ret;
470 }
471 CLexer *l=LexerNew("(123.4 + 3) / 2");`
472 Lex(l);
473 PrintShlong(RunAST(ParseAst(l)));