From a619487f9feb4a530244171b94decfccce57af8b Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 13 Oct 2008 04:44:48 +0000 Subject: Add support for Lisp declarations in generated Lisp code. * interp/i-map.boot (compileCoerceMap): Tell backend that minivector is global. * interp/i-spec1.boot (compileADEFBody): Likewise. * interp/slam.boot (reportFunctionCompilation): Likewise. * interp/define.boot (spadCompileOrSetq): Tell backend to ignore last argument for simple functions. * interp/c-util.boot (skipDeclarations): New. (lastDeclarationNode): Likewise. (declareGlobalVariables): Likewise. (transformToBackendCode): Use them to allow for Lisp declarations in middle-end forms. * interp/sys-driver.boot (AxiomCore::%sysInit): Reading Lisp level Floating point numbers default to double precision. * algebra/strap: Update. --- src/interp/c-util.boot | 57 +++++++++++++++++++++++++++++++++------------- src/interp/define.boot | 7 +++++- src/interp/i-map.boot | 3 ++- src/interp/i-spec1.boot | 3 ++- src/interp/slam.boot | 3 ++- src/interp/sys-driver.boot | 1 + 6 files changed, 54 insertions(+), 20 deletions(-) (limited to 'src/interp') diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index c18d6b52..3af79992 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1215,11 +1215,31 @@ mutateToBackendCode x == $LocalVars := REMOVE_-IF(function LAMBDA(y(), y in newBindings), $LocalVars) [u,second x,:res] + u = "DECLARE" => nil -- there is nothing to do convert there mutateToBackendCode u mutateToBackendCode rest x -++ Generate Lisp code by lowering middle end form `x'. +skipDeclarations: %List -> %List +skipDeclarations form == + while first form is ["DECLARE",:.] repeat + form := rest form + form + +++ return the last node containing a declaration in form, otherwise nil. +lastDeclarationNode: %List -> %List +lastDeclarationNode form == + while second form is ["DECLARE",:.] repeat + form := rest form + first form is ["DECLARE",:.] => form + nil + +declareGlobalVariables: %List -> %List +declareGlobalVariables vars == + ["DECLARE",["SPECIAL",:vars]] + +++ Generate Lisp code by lowering middle end defining form `x'. +++ x has the strucrure: transformToBackendCode: %Form -> %Code transformToBackendCode x == $FluidVars: fluid := nil @@ -1227,27 +1247,32 @@ transformToBackendCode x == $SpecialVars: fluid := nil x := middleEndExpand x mutateToBackendCode CDDR x + body := skipDeclarations CDDR x + -- Make it explicitly a sequence of statements if it is not a one liner. body := - null CDDDR x and - (atom third x or first third x = "SEQ" - or not CONTAINED("EXIT",third x)) => - third x - ["SEQ",:CDDR x] - x := [first x, second x, body] + stmt := first body + null rest body and + (atom stmt or first stmt = "SEQ" or not CONTAINED("EXIT",stmt)) => + body + [["SEQ",:body]] $FluidVars := REMDUP nreverse $FluidVars $LocalVars := S_-(S_-(REMDUP nreverse $LocalVars,$FluidVars), LISTOFATOMS second x) lvars := [:$FluidVars,:$LocalVars] fluids := S_+($FluidVars,$SpecialVars) - x := + body := fluids ^= nil => - [first x, second x, ["PROG",lvars,["DECLARE","SPECIAL",:fluids], - ["RETURN",third x]]] - [first x, second x, - (lvars ^= nil or CONTAINED("RETURN",third x) => - ["PROG",lvars,["RETURN",third x]]; third x)] + [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]] + lvars ^= nil or CONTAINED("RETURN",body) => + [["PROG",lvars,["RETURN",:body]]] + body -- add reference parameters to the list of special variables. fluids := S_+(backendFluidize second x, $SpecialVars) - null fluids => x - [first x, second x, ["DECLARE","SPECIAL",:fluids],:CDDR x] - + lastdecl := lastDeclarationNode rest x + if lastdecl = nil then + RPLACD(rest x, body) + else + null fluids => + RPLACD(lastdecl, body) + RPLACD(lastdecl, [declareGlobalVariables fluids,:body]) + x diff --git a/src/interp/define.boot b/src/interp/define.boot index ae460b75..3104d044 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1246,7 +1246,6 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == clearReplacement nam -- Make sure we have fresh info if $optReplaceSimpleFunctions then body := replaceSimpleFunctions body - form := [nam,[lam,vl,body]] if vl is [:vl',E] and body is [nam',: =vl'] then LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam'] @@ -1256,6 +1255,12 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == macform := ['XLAM,vl',body] LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform] sayBrightly ['" ",:bright nam,'"is replaced by",:bright body] + + if GET(nam,"SPADreplace") then + form := [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]] + else + form := [nam,[lam,vl,body]] + $insideCapsuleFunctionIfTrue => $optExportedFunctionReference => $capsuleFunctionStack := [form,:$capsuleFunctionStack] diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 56eae07a..6ae29170 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -760,7 +760,8 @@ compileCoerceMap(op,argTypes,mm) == minivectorName := makeInternalMapMinivectorName(name) body := substitute(minivectorName,"$$$",body) setDynamicBinding(minivectorName,LIST2REFVEC $minivector) - compileInteractive [name,['LAMBDA,parms,body]] + compileInteractive + [name,['LAMBDA,parms,declareGlobalVariables [minivectorName],body]] CAR sig depthOfRecursion(opName,body) == diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index c3690278..93c383f7 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -177,7 +177,8 @@ compileADEFBody(t,vars,types,body,computedResultType) == -- -- MCD 13/3/96 if not $definingMap and ($genValue or $compilingMap) then - fun := [$mapName,["LAMBDA",[:vars,'envArg],body]] + fun := [$mapName,["LAMBDA",[:vars,'envArg], + declareGlobalVariables [minivectorName],body]] code := wrap compileInteractive fun else $freeVariables := [] diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 672acb96..8adf4882 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -54,7 +54,8 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) == cacheCount:= getCacheCount op cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body) cacheCount = 0 or null argl => - fun:= [nam,["LAMBDA",[:argl,'envArg],body]] + fun:= [nam,["LAMBDA",[:argl,'envArg], + declareGlobalVariables [minivectorName],body]] compileInteractive fun nam num := diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index da622f96..4d21a797 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -59,6 +59,7 @@ $options := [] +++ to the interpreter or compiler. +++ ??? This part is still in flux. AxiomCore::%sysInit() == + SETQ(_*READ_-DEFAULT_-FLOAT_-FORMAT_*, "DOUBLE-FLOAT") SETQ(_*PACKAGE_*, FIND_-PACKAGE '"BOOT") SETQ(_*LOAD_-VERBOSE_*,false) initMemoryConfig() -- cgit v1.2.3