From f23893b83a0450f8729579f74758e212bf3543b7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 18 Mar 2008 20:40:17 +0000 Subject: * interp/sys-utility.boot: Define more type abbreviations. * interp/apply.boot: Adjust signature declarations. * interp/compiler.boot: Likewise. --- configure | 18 +++---- configure.ac | 2 +- configure.ac.pamphlet | 2 +- src/ChangeLog | 6 +++ src/interp/apply.boot | 25 ++++----- src/interp/compiler.boot | 128 ++++++++++++++++++++++---------------------- src/interp/sys-utility.boot | 10 ++++ 7 files changed, 104 insertions(+), 87 deletions(-) diff --git a/configure b/configure index 28666f58..b531561b 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-03-17. +# Generated by GNU Autoconf 2.60 for OpenAxiom 1.2.0-2008-03-18. # # Report bugs to . # @@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.2.0-2008-03-17' -PACKAGE_STRING='OpenAxiom 1.2.0-2008-03-17' +PACKAGE_VERSION='1.2.0-2008-03-18' +PACKAGE_STRING='OpenAxiom 1.2.0-2008-03-18' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' ac_unique_file="src/Makefile.pamphlet" @@ -1394,7 +1394,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OpenAxiom 1.2.0-2008-03-17 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.2.0-2008-03-18 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1464,7 +1464,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-03-17:";; + short | recursive ) echo "Configuration of OpenAxiom 1.2.0-2008-03-18:";; esac cat <<\_ACEOF @@ -1568,7 +1568,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.2.0-2008-03-17 +OpenAxiom configure 1.2.0-2008-03-18 generated by GNU Autoconf 2.60 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1582,7 +1582,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.2.0-2008-03-17, which was +It was created by OpenAxiom $as_me 1.2.0-2008-03-18, which was generated by GNU Autoconf 2.60. Invocation command line was $ $0 $@ @@ -25448,7 +25448,7 @@ exec 6>&1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OpenAxiom $as_me 1.2.0-2008-03-17, which was +This file was extended by OpenAxiom $as_me 1.2.0-2008-03-18, which was generated by GNU Autoconf 2.60. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -25497,7 +25497,7 @@ Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -OpenAxiom config.status 1.2.0-2008-03-17 +OpenAxiom config.status 1.2.0-2008-03-18 configured by $0, generated by GNU Autoconf 2.60, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.ac b/configure.ac index c4133a3e..29e51b24 100644 --- a/configure.ac +++ b/configure.ac @@ -1,6 +1,6 @@ sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-03-17], +AC_INIT([OpenAxiom], [1.2.0-2008-03-18], [open-axiom-bugs@lists.sf.net]) AC_CONFIG_AUX_DIR(config) diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet index bdc65f0a..03cc867c 100644 --- a/configure.ac.pamphlet +++ b/configure.ac.pamphlet @@ -1069,7 +1069,7 @@ information: <>= sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.2.0-2008-03-17], +AC_INIT([OpenAxiom], [1.2.0-2008-03-18], [open-axiom-bugs@lists.sf.net]) @ diff --git a/src/ChangeLog b/src/ChangeLog index 157dd632..e667b79d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2008-03-18 Gabriel Dos Reis + + * interp/sys-utility.boot: Define more type abbreviations. + * interp/apply.boot: Adjust signature declarations. + * interp/compiler.boot: Likewise. + 2008-03-17 Gabriel Dos Reis * interp/sys-driver.boot (restart): Rename from RESTART. diff --git a/src/interp/apply.boot b/src/interp/apply.boot index f1000b5b..03186e75 100644 --- a/src/interp/apply.boot +++ b/src/interp/apply.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -35,7 +35,7 @@ import '"compiler" )package "BOOT" -compAtomWithModemap: (%Thing,%Thing,%List,%Thing) -> %List +compAtomWithModemap: (%Form,%Mode,%Env,%Thing) -> %Triple compAtomWithModemap(x,m,e,v) == Tl := [[transImplementation(x,map,fn),target,e] @@ -46,13 +46,13 @@ compAtomWithModemap(x,m,e,v) == 0<#Tl and m=$NoValueMode => first Tl nil -transImplementation: (%Thing,%Thing,%Thing) -> %List +transImplementation: (%Form,%Modemap,%Thing) -> %Code transImplementation(op,map,fn) == fn := genDeltaEntry [op,:map] fn is ["XLAM",:.] => [fn] ["call",fn] -compApply: (%List,%List,%Thing,%List,%Thing,%List) -> %List +compApply: (%List,%List,%Thing,%List,%Mode,%Env) -> %Triple compApply(sig,varl,body,argl,m,e) == argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl] contour:= @@ -63,14 +63,14 @@ compApply(sig,varl,body,argl,m,e) == body':= (comp(body,m',addContour(contour,e))).expr [code,m',e] -compToApply: (%Thing,%List,%Thing,%List) -> %List +compToApply: (%Form,%List,%Mode,%Env) -> %Triple compToApply(op,argl,m,e) == T:= compNoStacking(op,$EmptyMode,e) or return nil m1:= T.mode T.expr is ["QUOTE", =m1] => nil compApplication(op,argl,m,T.env,T) -compApplication: (%Thing,%List,%Thing,%List,%List) -> %List +compApplication: (%Form,%List,%Mode,%Env,%Triple) -> %Triple compApplication(op,argl,m,e,T) == T.mode is ['Mapping, retm, :argml] => #argl ^= #argml => nil @@ -92,7 +92,7 @@ compApplication(op,argl,m,e,T) == eltForm := ['elt, op, :argl] comp(eltForm, m, e) -compFormWithModemap: (%List,%Thing,%List,%List) -> %List +compFormWithModemap: (%Form,%Mode,%Env,%Modemap) -> %Triple compFormWithModemap(form is [op,:argl],m,e,modemap) == [map:= [.,target,:.],[pred,impl]]:= modemap -- this fails if the subsuming modemap is conditional @@ -156,7 +156,7 @@ compFormWithModemap(form is [op,:argl],m,e,modemap) == -- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] -- convert([form,SUBLIS(pairlis,first ml),e],m) -applyMapping: (%List,%Thing,%List,%List) -> %List +applyMapping: (%Form,%Mode,%Env,%List) -> %Triple applyMapping([op,:argl],m,e,ml) == #argl^=#ml-1 => nil isCategoryForm(first ml,e) => @@ -186,7 +186,7 @@ applyMapping([op,:argl],m,e,ml) == --% APPLY MODEMAPS -compApplyModemap: (%List,%List,%List,%List) -> %List +compApplyModemap: (%Form,%Modemap,%Env,%List) -> %Triple compApplyModemap(form,modemap,$e,sl) == [op,:argl] := form --form to be compiled [[mc,mr,:margl],:fnsel] := modemap --modemap we are testing @@ -229,16 +229,16 @@ compApplyModemap(form,modemap,$e,sl) == [genDeltaEntry [op,:modemap],lt',$bindings] [f,lt',$bindings] -compMapCond: (%List,%Thing,%List,%List) -> %List +compMapCond: (%Symbol,%Mode,%Env,%List) -> %Code compMapCond(op,mc,$bindings,fnsel) == or/[compMapCond'(u,op,mc,$bindings) for u in fnsel] -compMapCond': (%List,%Thing,%Thing,%Thing) -> %List +compMapCond': (%List,%Symbol,%Mode,%Env) -> %Code compMapCond'([cexpr,fnexpr],op,dc,bindings) == compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings) stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] -compMapCond'': (%Thing,%Thing) -> %Boolean +compMapCond'': (%Thing,%Mode) -> %Boolean compMapCond''(cexpr,dc) == cexpr=true => true --cexpr = "true" => true @@ -256,6 +256,7 @@ compMapCond''(cexpr,dc) == stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] false +compMapCondFun: (%Thing,%Symbol,%Mode,%Env) -> %Code compMapCondFun(fnexpr,op,dc,bindings) == [fnexpr,bindings] diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 06f332da..bd9cf135 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -48,7 +48,7 @@ $coreDiagnosticFunctions == ++ list of functions to compile $compileOnlyCertainItems := [] -compTopLevel: (%Thing,%Thing,%List) -> %List +compTopLevel: (%Form,%Mode,%Env) -> %Triple compTopLevel(x,m,e) == --+ signals that target is derived from lhs-- see NRTmakeSlot1Info $NRTderivedTargetIfTrue: local := false @@ -62,15 +62,15 @@ compTopLevel(x,m,e) == --keep old environment after top level function defs compOrCroak(x,m,e) -compUniquely: (%Thing,%Thing,%List) -> %List +compUniquely: (%Form,%Mode,%Env) -> %Triple compUniquely(x,m,e) == $compUniquelyIfTrue: local:= true CATCH("compUniquely",comp(x,m,e)) -compOrCroak: (%Thing,%Thing,%List) -> %List +compOrCroak: (%Form,%Mode,%Env) -> %Triple compOrCroak(x,m,e) == compOrCroak1(x,m,e,'comp) -compOrCroak1: (%Thing,%Thing,%List,%Thing) -> %List +compOrCroak1: (%Form,%Mode,%Env,%Thing) -> %Triple compOrCroak1(x,m,e,compFn) == fn(x,m,e,nil,nil,compFn) where fn(x,m,e,$compStack,$compErrorMessageStack,compFn) == @@ -100,13 +100,13 @@ tc() == comp($x,$m,$f) -comp: (%Thing,%Thing,%List) -> %List +comp: (%Form,%Mode,%Env) -> %Triple comp(x,m,e) == T:= compNoStacking(x,m,e) => ($compStack:= nil; T) $compStack:= [[x,m,e,$exitModeStack],:$compStack] nil -compNoStacking: (%Thing,%Thing,%List) -> %List +compNoStacking: (%Form,%Mode,%Env) -> %Triple compNoStacking(x,m,e) == T:= comp2(x,m,e) => $useRepresentationHack and m=$EmptyMode and T.mode=$Representation => @@ -119,13 +119,13 @@ compNoStacking(x,m,e) == --hack only when `Rep' is defined the old way. -- gdr 2008/01/26 compNoStacking1(x,m,e,$compStack) -compNoStacking1: (%Thing,%Thing,%List,%List) -> %List +compNoStacking1: (%Form,%Mode,%Env,%List) -> %Triple compNoStacking1(x,m,e,$compStack) == u:= get(RepIfRepHack m,"value",e) => (T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil) nil -comp2: (%Thing,%Thing,%List) -> %List +comp2: (%Form,%Mode,%Env) -> %Triple comp2(x,m,e) == [y,m',e]:= comp3(x,m,e) or return nil if $LISPLIB and isDomainForm(x,e) then @@ -138,7 +138,7 @@ comp2(x,m,e) == --$bootStrapMode-test necessary for compiling Ring in $bootStrapMode [y,m',e] -comp3: (%Thing,%Thing,%List) -> %List +comp3: (%Form,%Mode,%Env) -> %Triple comp3(x,m,$e) == --returns a Triple or %else nil to signalcan't do' $e:= addDomain(m,$e) @@ -163,7 +163,7 @@ comp3(x,m,$e) == [x',m',addDomain(m',e')] t -compTypeOf: (%List,%Thing,%List) -> %List +compTypeOf: (%Form,%Mode,%Env) -> %Triple compTypeOf(x:=[op,:argl],m,e) == $insideCompTypeOf: local := true newModemap:= EQSUBSTLIST(argl,$FormalMapVariableList,get(op,'modemap,e)) @@ -176,7 +176,7 @@ hasFormalMapVariable(x, vl) == ScanOrPairVec(function hasone?,x) where hasone? x == MEMQ(x,$formalMapVariables) -compWithMappingMode: (%Thing,%List,%List) -> %List +compWithMappingMode: (%Form,%Mode,%List) -> %List compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == $killOptimizeIfTrue: local:= true e:= oldE @@ -280,14 +280,14 @@ extractCodeAndConstructTriple(u, m, oldE) == [op,:.,env] := u [["CONS",["function",op],env],m,oldE] -compExpression: (%Thing,%Thing,%List) -> %List +compExpression: (%Form,%Mode,%Env) -> %Triple compExpression(x,m,e) == $insideExpressionIfTrue: local:= true atom first x and (fn:= GETL(first x,"SPECIAL")) => FUNCALL(fn,x,m,e) compForm(x,m,e) -compAtom: (%Thing,%Thing,%List) -> %List +compAtom: (%Form,%Mode,%Env) -> %Triple compAtom(x,m,e) == T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T x="nil" => @@ -303,7 +303,7 @@ compAtom(x,m,e) == [x,primitiveType x or return nil,e] convert(t,m) -primitiveType: %Thing -> %List +primitiveType: %Thing -> %Mode primitiveType x == x is nil => $EmptyMode STRINGP x => $String @@ -314,7 +314,7 @@ primitiveType x == FLOATP x => $DoubleFloat nil -compSymbol: (%Thing,%Thing,%List) -> %List +compSymbol: (%Form,%Mode,%Env) -> %Triple compSymbol(s,m,e) == s="$NoValue" => ["$NoValue",$NoValueMode,e] isFluid s => [s,getmode(s,e) or return nil,e] @@ -338,7 +338,7 @@ compSymbol(s,m,e) == ++ Return true if `m' is the most recent unique type case assumption ++ on `x' that predates its declaration in environment `e'. -hasUniqueCaseView: (%Thing,%Thing,%List) -> %Boolean +hasUniqueCaseView: (%Form,%Mode,%Env) -> %Boolean hasUniqueCaseView(x,m,e) == props := getProplist(x,e) for [p,:v] in props repeat @@ -346,13 +346,13 @@ hasUniqueCaseView(x,m,e) == p = "value" => return false -convertOrCroak: (%List,%Thing) -> %List +convertOrCroak: (%Triple,%Mode) -> %Triple convertOrCroak(T,m) == u:= convert(T,m) => u userError ["CANNOT CONVERT: ",T.expr,"%l"," OF MODE: ",T.mode,"%l", " TO MODE: ",m,"%l"] -convert: (%List,%Thing) -> %List +convert: (%Triple,%Mode) -> %Triple convert(T,m) == coerce(T,resolve(T.mode,m) or return nil) @@ -377,12 +377,12 @@ hasType(x,e) == --% General Forms -compForm: (%List,%Thing,%List) -> %List -compForm1: (%List,%Thing,%List) -> %List -compForm2: (%List,%Thing,%List,%List) -> %List -compForm3: (%Thing,%Thing,%List,%List) -> %List -compArgumentsAndTryAgain: (%List,%Thing,%List) -> %List -compExpressionList: (%List,%Thing,%List) -> %List +compForm: (%Form,%Mode,%Env) -> %Triple +compForm1: (%Form,%Mode,%Env) -> %Triple +compForm2: (%Form,%Mode,%Env,%List) -> %Triple +compForm3: (%Form,%Mode,%Env,%List) -> %Triple +compArgumentsAndTryAgain: (%Form,%Mode,%Env) -> %Triple +compExpressionList: (%List,%Mode,%Env) -> %Triple compForm(form,m,e) == T:= @@ -499,7 +499,7 @@ compForm3(form is [op,:argl],m,e,modemapList) == T T -getFormModemaps: (%List,%List) -> %List +getFormModemaps: (%Form,%Env) -> %List getFormModemaps(form is [op,:argl],e) == op is ["elt",domain,op1] => [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]] @@ -591,12 +591,12 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) == compConstructorCategory(x,m,e) == [x,resolve($Category,m),e] -compString: (%String,%Thing,%List) -> %List +compString: (%Form,%Mode,%Env) -> %Triple compString(x,m,e) == [x,resolve($StringCategory,m),e] --% SUBSET CATEGORY -compSubsetCategory: (%List,%Thing,%List) -> %List +compSubsetCategory: (%Form,%Mode,%Env) -> %Triple compSubsetCategory(["SubsetCategory",cat,R],m,e) == --1. put "Subsets" property on R to allow directly coercion to subset; -- allow automatic coercion from subset to R but not vice versa @@ -611,8 +611,8 @@ compSubsetCategory(["SubsetCategory",cat,R],m,e) == --% CONS -compCons: (%List,%Thing,%List) -> %List -compCons1: (%List,%Thing,%List) -> %List +compCons: (%Form,%Mode,%Env) -> %Triple +compCons1: (%Form,%Mode,%Env) -> %Triple compCons(form,m,e) == compCons1(form,m,e) or compForm(form,m,e) @@ -647,7 +647,7 @@ compSetq1(form,val,m,E) == op="Tuple" => setqMultiple(l,val,m,E) setqSetelt(form,val,m,E) -compMakeDeclaration: (%Thing,%Thing,%List) -> %List +compMakeDeclaration: (%Form,%Mode,%Env) -> %Triple compMakeDeclaration(x,m,e) == $insideExpressionIfTrue: local compColon(x,m,e) @@ -771,7 +771,7 @@ compileQuasiquote(["[||]",:form],m,e) == --% WHERE -compWhere: (%List,%Thing,%List) -> %List +compWhere: (%Form,%Mode,%Env) -> %Triple compWhere([.,form,:exprList],m,eInit) == $insideExpressionIfTrue: local:= false $insideWhereIfTrue: local:= true @@ -787,7 +787,7 @@ compWhere([.,form,:exprList],m,eInit) == eInit [x,m,eFinal] -compConstruct: (%List,%Thing,%List) -> %List +compConstruct: (%Form,%Mode,%Env) -> %Triple compConstruct(form is ["construct",:l],m,e) == y:= modeIsAggregateOf("List",m,e) => T:= compList(l,["List",CADR y],e) => convert(T,m) @@ -806,14 +806,14 @@ compConstruct(form is ["construct",:l],m,e) == compQuote(expr,m,e) == [expr,m,e] -compList: (%Thing,%List,%List) -> %List +compList: (%Form,%Mode,%Env) -> %Triple compList(l,m is ["List",mUnder],e) == null l => [NIL,m,e] Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] Tl="failed" => nil T:= [["LIST",:[T.expr for T in Tl]],["List",mUnder],e] -compVector: (%Thing,%List,%List) -> %List +compVector: (%Form,%Mode,%Env) -> %Triple compVector(l,m is ["Vector",mUnder],e) == null l => [$EmptyVector,m,e] Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] @@ -837,8 +837,8 @@ compMacro(form,m,e) == --% SEQ -compSeq: (%List,%Thing,%List) -> %List -compSeq1: (%List,%List,%List) -> %List +compSeq: (%Form,%Mode,%Env) -> %Triple +compSeq1: (%Form,%List,%Env) -> %Triple compSeqItem: (%Thing,%Thing,%List) -> %List compSeq(["SEQ",:l],m,e) == compSeq1(l,[m,:$exitModeStack],e) @@ -884,7 +884,7 @@ replaceExitEtc(x,tag,opFlag,opMode) == replaceExitEtc(rest x,tag,opFlag,opMode) --% SUCHTHAT -compSuchthat: (%List,%Thing,%List) -> %List +compSuchthat: (%Form,%Mode,%Env) -> %Triple compSuchthat([.,x,p],m,e) == [x',m',e]:= comp(x,m,e) or return nil [p',.,e]:= comp(p,$Boolean,e) or return nil @@ -893,7 +893,7 @@ compSuchthat([.,x,p],m,e) == --% exit -compExit: (%List,%Thing,%List) -> %List +compExit: (%Form,%Mode,%Env) -> %Triple compExit(["exit",level,x],m,e) == index:= level-1 $exitModeStack = [] => comp(x,m,e) @@ -911,7 +911,7 @@ modifyModeStack(m,index) == ($exitModeStack.index:= resolve(m,$exitModeStack.index); $exitModeStack)) $exitModeStack.index:= resolve(m,$exitModeStack.index) -compLeave: (%List,%Thing,%List) -> %List +compLeave: (%Form,%Mode,%Env) -> %Triple compLeave(["leave",level,x],m,e) == index:= #$exitModeStack-1-$leaveLevelStack.(level-1) [x',m',e']:= u:= comp(x,$exitModeStack.index,e) or return nil @@ -920,7 +920,7 @@ compLeave(["leave",level,x],m,e) == --% return -compReturn: (%List,%Thing,%List) -> %List +compReturn: (%Form,%Mode,%Env) -> %Triple compReturn(["return",level,x],m,e) == null $exitModeStack => stackSemanticError(["the return before","%b",x,"%d","is unneccessary"],nil) @@ -936,7 +936,7 @@ compReturn(["return",level,x],m,e) == --% ELT -compElt: (%List,%Thing,%List) -> %List +compElt: (%Form,%Mode,%Env) -> %Triple compElt(form,m,E) == form isnt ["elt",aDomain,anOp] => compForm(form,m,E) aDomain="Lisp" => @@ -964,7 +964,7 @@ compElt(form,m,E) == --% HAS -compHas: (%List,%Thing,%List) -> %List +compHas: (%Form,%Mode,%Env) -> %Triple compHas(pred is ["has",a,b],m,$e) == --b is (":",:.) => (.,.,E):= comp(b,$EmptyMode,E) $e:= chaseInferences(pred,$e) @@ -989,9 +989,9 @@ compHasFormat (pred is ["has",olda,b]) == --% IF -compIf: (%List,%Thing,%List) -> %List -compBoolean: (%List,%Thing,%List) -> %List -compFromIf: (%List,%Thing,%List) -> %List +compIf: (%Form,%Mode,%Env) -> %Triple +compBoolean: (%Form,%Mode,%Env) -> %List +compFromIf: (%Form,%Mode,%Env) -> %Triple compIf(["IF",a,b,c],m,E) == [xa,ma,Ea,Einv]:= compBoolean(a,$Boolean,E) or return nil @@ -1108,7 +1108,7 @@ compFromIf(a,m,E) == quotify x == x -compImport: (%List,%Thing,%List) -> %List +compImport: (%Form,%Mode,%Env) -> %Triple compImport(["import",:doms],m,e) == for dom in doms repeat e:=addDomain(dom,e) ["/throwAway",$NoValueMode,e] @@ -1118,7 +1118,7 @@ compImport(["import",:doms],m,e) == --% etc. ++ compile a logical negation form `(not ...)'. -compileNot: (%List,%Thing,%List) -> %List +compileNot: (%Form,%Mode,%Env) -> %Triple compileNot(x,m,e) == x isnt ["not", y] => nil -- If there is a modemap available that can make this work, just use it. @@ -1133,8 +1133,8 @@ compileNot(x,m,e) == --% Case -compCase: (%List,%Thing,%List) -> %List -compCase1: (%List,%Thing,%List) -> %List +compCase: (%Form,%Mode,%Env) -> %Triple +compCase1: (%Form,%Mode,%Env) -> %Triple --Will the jerk who commented out these two functions please NOT do so --again. These functions ARE needed, and case can NOT be done by @@ -1169,12 +1169,12 @@ compCase1(x,m,e) == ++ (target type) is taken unevaluated. The corresponding parameter ++ type in the modemap was specified as quasiquotation. We ++ want to look at the actual type when comparing with modeEqual. -maybeSpliceMode: %Thing -> %Thing +maybeSpliceMode: %Mode -> %Mode maybeSpliceMode m == (m' := isQuasiquote m) => m' m -compColon: (%List,%Thing,%List) -> %List +compColon: (%Form,%Mode,%Env) -> %Triple compColon([":",f,t],m,e) == $insideExpressionIfTrue=true => compColonInside(f,m,e,t) --if inside an expression, ":" means to convert to m "on faith" @@ -1212,7 +1212,7 @@ unknownTypeError name == name stackSemanticError(["%b",name,"%d","is not a known type"],nil) -compPretend: (%List,%Thing,%List) -> %List +compPretend: (%Form,%Mode,%Env) -> %Triple compPretend(["pretend",x,t],m,e) == e:= addDomain(t,e) T:= comp(x,t,e) or comp(x,$EmptyMode,e) or return nil @@ -1232,7 +1232,7 @@ compColonInside(x,m,e,m') == stackWarning [":",m'," -- should replace by pretend"] T' -compIs: (%List,%Thing,%List) -> %List +compIs: (%Form,%Mode,%Env) -> %Triple compIs(["is",a,b],m,e) == [aval,am,e] := comp(a,$EmptyMode,e) or return nil [bval,bm,e] := comp(b,$EmptyMode,e) or return nil @@ -1246,7 +1246,7 @@ compIs(["is",a,b],m,e) == -- One should always call the correct function, since the represent- -- ation of basic objects may not be the same. -coerce: (%List,%Thing) -> %List +coerce: (%Triple,%Mode) -> %Triple coerce(T,m) == $InteractiveMode => keyedSystemError("S2GE0016",['"coerce", @@ -1265,7 +1265,7 @@ coerce(T,m) == " to mode","%b",m2,"%d"] -coerceEasy: (%List,%Thing) -> %List +coerceEasy: (%Triple,%Mode) -> %Triple coerceEasy(T,m) == m=$EmptyMode => T m=$NoValueMode or m=$Void => [T.expr,m,T.env] @@ -1278,7 +1278,7 @@ coerceEasy(T,m) == [T.expr,m,T.env] -coerceSubset: (%List,%Thing) -> %List +coerceSubset: (%Triple,%Mode) -> %Triple coerceSubset([x,m,e],m') == isSubset(m,m',e) => [x,m',e] m is ['SubDomain,=m',:.] => [x,m',e] @@ -1290,7 +1290,7 @@ coerceSubset([x,m,e],m') == [x,m',e] nil -coerceHard: (%List,%Thing) -> %List +coerceHard: (%Triple,%Mode) -> %Triple coerceHard(T,m) == $e: local:= T.env m':= T.mode @@ -1307,7 +1307,7 @@ coerceHard(T,m) == coerceExtraHard(T,m) coerceExtraHard(T,m) -coerceExtraHard: (%List,%Thing) -> %List +coerceExtraHard: (%Triple,%Mode) -> %Triple coerceExtraHard(T is [x,m',e],m) == T':= autoCoerceByModemap(T,m) => T' isUnionMode(m',e) is ["Union",:l] and (t:= hasType(x,e)) and @@ -1335,22 +1335,22 @@ coerceable(m,m',e) == coerce(["$fromCoerceable$",m,e],m') => m' nil -coerceExit: (%List,%Thing) -> %List +coerceExit: (%Triple,%Mode) -> %Triple coerceExit([x,m,e],m') == m':= resolve(m,m') x':= replaceExitEtc(x,catchTag:= MKQ GENSYM(),"TAGGEDexit",$exitMode) coerce([["CATCH",catchTag,x'],m,e],m') -compAtSign: (%List,%Thing,%List) -> %List +compAtSign: (%Form,%Mode,%Env) -> %Triple compAtSign(["@",x,m'],m,e) == e:= addDomain(m',e) T:= comp(x,m',e) or return nil coerce(T,m) -compCoerce: (%List,%Thing,%List) -> %List -compCoerce1: (%List,%Thing,%List) -> %List -coerceByModemap: (%List,%Thing) -> %List -autoCoerceByModemap: (%List,%Thing) -> %List +compCoerce: (%Form,%Mode,%Env) -> %Triple +compCoerce1: (%Form,%Mode,%Env) -> %Triple +coerceByModemap: (%Triple,%Mode) -> %Triple +autoCoerceByModemap: (%Triple,%Mode) -> %Triple compCoerce(["::",x,m'],m,e) == e:= addDomain(m',e) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 07dba9f5..3b119a65 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -46,6 +46,16 @@ import '"vmlisp" %List <=> LIST %Vector <=> VECTOR %Thing <=> true +%Sequence <=> SEQUENCE + +--% Data structures for the compiler +%Form <=> NUMBER or %Symbol or %String or CONS -- input syntax form +%Env <=> %List -- compiling env +%Mode <=> %Symbol or %String or %List -- type of forms +%Code <=> %Form -- generated code +%Triple <=> %List -- form + type + env + +%Modemap <=> %List -- modemap ++ returns true if `f' is bound to a macro. macrop: %Thing -> %Boolean -- cgit v1.2.3