home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 01 / levelki / lispfram.inc < prev    next >
Encoding:
Text File  |  1988-10-27  |  3.6 KB  |  116 lines
  1. (*******************************************************)
  2. (*                  LISPFRAM.INC                       *)
  3. (*         Include-Modul des LittleLisp-Systems        *)
  4. (*          (C) 1988 Reinhard Häring & TOOLBOX         *)
  5. (*******************************************************)
  6.  
  7. {-- Frames & Environments ---------------------}
  8.  
  9. FUNCTION build_in(x:objp):BOOLEAN;
  10.  
  11.   VAR t:INTEGER;
  12.       n:string20;
  13.  
  14. BEGIN
  15.   t:=x^.typ;
  16.   IF t<>2 THEN
  17.     build_in:=FALSE
  18.   ELSE BEGIN
  19.     n:=x^.s^;
  20.     build_in:=    (n='access') OR (n='set') OR (n='def')
  21.                OR (n='extend-env') OR (n='proc-env')
  22.                OR (n='the-env') OR (n='eval')
  23.                OR (n='apply') OR (n='dynamic')
  24.                OR (n='lexical') OR (n='dynamic?')
  25.                OR (n='newline') OR (n='null?')
  26.                OR (n='atom?') OR (n='integer?')
  27.                OR (n='pair?') OR (n='inlist')
  28.                OR (n='outlist') OR (n='map')
  29.                OR (n='number?') OR (n='string?')
  30.                OR (n='car') OR (n='cdr') OR (n='caar')
  31.                OR (n='cddr') OR (n='cdar') OR (n='cadr')
  32.                OR (n='list') OR (n='cons') OR (n='equal')
  33.                OR (n='equal?') OR (n='eq') OR (n='not')
  34.                OR (n='eq?') OR (n='assoc')
  35.                OR (n='delayed?') OR (n='bound?')
  36.                OR (n='symbol?') OR (n='+') OR (n='-')
  37.                OR (n='*') OR (n='/') OR (n='=') OR (n='>')
  38.                OR (n='<') OR (n='>=') OR (n='<=')
  39.                OR (n='<>') OR (n='bound-in-frame?')
  40.                OR (n='read') OR (n='print')
  41.                OR (n='read-file') OR (n='append')
  42.                OR (n='member') OR (n='length')
  43.                OR (n='proplist') OR (n='begin')
  44.                OR (n='setcar!') OR (n='setcdr!')
  45.                OR (n='property') OR (n='put')
  46.                OR (n='get') OR (n='rem') OR (n='strlen')
  47.                OR (n='strcopy') OR (n='concat')
  48.                OR (n='proc-def')
  49.   END;
  50. END;
  51.  
  52. FUNCTION make_frame(vars,values:objp):objp;
  53. BEGIN
  54.   IF 2=vars^.typ THEN
  55.     make_frame:=cons(cons(vars,values),null)
  56.   ELSE IF nullp(vars) AND nullp(values) THEN
  57.     make_frame:=null
  58.   ELSE IF nullp(vars) OR nullp(values) THEN
  59.     error('make_frame error - '+outlist(vars)
  60.           +' - '+outlist(values))
  61.   ELSE
  62.     make_frame:=cons(cons(car(vars),car(values)),
  63.                      make_frame(cdr(vars),cdr(values)));
  64. END;
  65.  
  66.  
  67. FUNCTION binding_in_env(va,env:objp):objp;
  68. VAR b:objp;
  69. BEGIN
  70.   binding_in_env:=null;
  71.   IF nullp(env) THEN
  72.     IF build_in(va) THEN
  73.       binding_in_env:=cons(va,va)
  74.     ELSE
  75.   ELSE BEGIN
  76.     b:=assoc(va,car(env));
  77.     IF NOT nullp(b) THEN binding_in_env:=b
  78.     ELSE binding_in_env:=binding_in_env(va,cdr(env));
  79.   END;
  80. END;
  81.  
  82.  
  83. FUNCTION lookup_variable_value(va,env:objp):objp;
  84. VAR b:objp;
  85. BEGIN
  86.   b:=binding_in_env(va,env);
  87.   IF NOT nullp(b) THEN lookup_variable_value:=cdr(b)
  88.   ELSE error('Unbound Var: '+outlist(va));
  89. END;
  90.  
  91.  
  92. FUNCTION extend_environment(vars,values,base:objp):objp;
  93. BEGIN
  94.   extend_environment:=cons(make_frame(vars,values),base);
  95. END;
  96.  
  97.  
  98. FUNCTION set_variable_value(va,Val,env:objp):objp;
  99. VAR b:objp;
  100. BEGIN
  101.   set_variable_value:=null;
  102.   b:=binding_in_env(va,env);
  103.   IF NOT nullp(b) THEN set_variable_value:=setcdr(b,Val)
  104.   ELSE error('Unbound-Variable in set: '+outlist(va));
  105. END;
  106.  
  107.  
  108. FUNCTION define_variable(va,Val,env:objp):objp;
  109. VAR b:objp;
  110. BEGIN
  111.   b:=assoc(va,car(env));
  112.   IF NOT nullp(b) THEN define_variable:=setcdr(b,Val)
  113.   ELSE define_variable:=setcar(env,cons(cons(va,Val),
  114.                                             car(env)));
  115. END;
  116.