diff options
Diffstat (limited to 'src/boot/translator.boot')
| -rw-r--r-- | src/boot/translator.boot | 44 |
1 files changed, 32 insertions, 12 deletions
diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 1f906a2f..1ddbb2b8 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -42,6 +42,25 @@ import ast )package "BOOTTRAN" +++ If non nil, holds the name of the current module being translated. +$currentModuleName := nil + +++ Stack of foreign definitions to cope with CLisp's odd FFI interface. +$foreignsDefsForCLisp := [] + +genModuleFinalization(stream) == + %hasFeature KEYWORD::CLISP => + null $foreignsDefsForCLisp => nil + $currentModuleName = nil => + coreError '"current module has no name" + init := + ["DEFUN", INTERN strconc($currentModuleName,"InitCLispFFI"), nil, + ["MAPC",["FUNCTION", "FMAKUNBOUND"], + ["QUOTE",[second d for d in $foreignsDefsForCLisp]]], + :[["EVAL",["QUOTE",d]] for d in $foreignsDefsForCLisp]] + REALLYPRETTYPRINT(init,stream) + nil + +++ True if we are translating code written in Old Boot. $translatingOldBoot := false @@ -88,9 +107,10 @@ BOOTTOCLLINES(lines, fn, outfn)== shoeClLines(a,fn,lines,outfn)== a=nil => shoeNotFound fn $GenVarCounter := 0 - shoeOpenOutputFile(stream,outfn, - (for line in lines repeat shoeFileLine (line,stream); - shoeFileTrees(shoeTransformStream a,stream))) + shoeOpenOutputFile(stream,outfn,_ + ((for line in lines repeat shoeFileLine(line,stream); + shoeFileTrees(shoeTransformStream a,stream)); + genModuleFinalization(stream))) outfn ++ (boottoclc "filename") translates the file "filename.boot" to @@ -115,7 +135,8 @@ shoeClCLines(a,fn,lines,outfn)== shoeOpenOutputFile(stream,outfn, (for line in lines repeat shoeFileLine (line,stream); shoeFileTrees(shoeTransformToFile(stream, - shoeInclude bAddLineNumber(bRgen a,bIgen 0)),stream))) + shoeInclude bAddLineNumber(bRgen a,bIgen 0)),stream); + genModuleFinalization(stream))) outfn ++ (boottomc "filename") translates the file "filename.boot" @@ -389,9 +410,10 @@ genImportDeclaration(op, sig) == [KEYWORD::RETURN_-TYPE,bfColonColon("FFI",nativeType t)], [KEYWORD::LANGUAGE,KEYWORD::STDC]] forwardingFun := - ["DEFUN",op,args, - [n,:[coerceToNativeType(a,t) for a in args for x in s]] - [foreignDecl,forwardingFun] + ["DEFUN",op,args, + [n,:[coerceToNativeType(a,t) for a in args for x in s]]] + $foreignsDefsForCLisp := [foreignDecl,:$foreignsDefsForCLisp] + [forwardingFun] fatalError '"import declaration not implemented for this Lisp" shoeOutParse stream == @@ -451,7 +473,9 @@ bpOutItem()== Signature(op,t) => bpPush [genDeclaration(op,t)] - %Module(m) => + %Module(m) => + $currentModuleName := m + $foreignsDefsForCLisp := nil bpPush [shoeCompileTimeEvaluation ["PROVIDE", STRING m]] Import(m) => @@ -798,10 +822,6 @@ loadNativeModule m == EVAL [bfColonColon("FFI","DEFAULT-FOREIGN-LIBRARY"), m] systemError '"don't know how to load a dynamically linked module" -$OpenAxiomCoreModuleLoaded := false - loadSystemRuntimeCore() == - $OpenAxiomCoreModuleLoaded => nil loadNativeModule strconc(systemLibraryDirectory(), '"libopen-axiom-core",$NativeModuleExt) - $OpenAxiomCoreModuleLoaded := true |