diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 27 | ||||
| -rw-r--r-- | src/interp/define.boot | 19 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 10 | ||||
| -rw-r--r-- | src/interp/metalex.lisp | 2 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 1 | ||||
| -rw-r--r-- | src/interp/sys-constants.boot | 2 |
7 files changed, 61 insertions, 11 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0a6ffee6..f7804a76 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2009-03-01 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/compiler.boot (compTopLevel): Initialize list of + optimizable domain constructors. + (processInlineRequest): New. + * interp/define.boot (spadCompileOrSetq): Tidy. + (mutateToNothing): New. + (doIt): Use it. Add support for inline directives. + * interp/fnewmeta.lisp (PARSE-Inline): New. + * interp/metalex.lisp (KEYWORDS): Include 'inline'. + 2009-02-28 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/nruncomp.boot (genDeltaEntry): Return optimized diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index ae68d089..7f903248 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -93,10 +93,12 @@ $compileOnlyCertainItems := [] compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple compTopLevel(x,m,e) == ---+ signals that target is derived from lhs-- see NRTmakeSlot1Info + -- signals that target is derived from lhs-- see NRTmakeSlot1Info $NRTderivedTargetIfTrue: local := false $killOptimizeIfTrue: local:= false $forceAdd: local:= false + -- start with a base list of domains we may inline. + $optimizableConstructorNames: local := $SystemInlinableConstructorNames x is ["DEF",:.] or x is ["where",["DEF",:.],:.] => ([val,mode,.]:= compOrCroak(x,m,e); [val,mode,e]) --keep old environment after top level function defs @@ -829,7 +831,7 @@ setqSingle(id,val,m,E) == addBinding(id,newProplist,e') if isDomainForm(val,e') then if isDomainInScope(id,e') then - stackWarning("domain valued variable %1b has been reassigned within its scope",[id]) + stackWarning('"domain valued variable %1b has been reassigned within its scope",[id]) e':= augModemapsFromDomain1(id,val,e') --all we do now is to allocate a slot number for lhs --e.g. the %LET form below will be changed by putInLocalDomainReferences @@ -1911,6 +1913,27 @@ compMatch(["%Match",subject,altBlock],m,e) == --% +--% Inline Requests +--% + +++ We are processing a capsule and `t is nominated in an inline +++ directive. This means that the compiler can `bypass' the usual +++ indirect call through domain interface and attempt to resolve +++ modemap references. +++ Concretely, this means that `t is evaluated. +processInlineRequest(t,e) == + T := compOrCroak(t,$EmptyMode,e) + not isCategoryForm(T.mode,e) => + stackAndThrow('"%1b does not designate a domain",[t]) + atom T.expr => + stackWarning('"inline request for type variable %1bp is meaningless",[t]) + T.expr is [ctor] => + $optimizableConstructorNames := [ctor,:$optimizableConstructorNames] + -- Don't try too hard; the current domain evaluation is insane. + stackWarning('"Ignoring inline arequest for non-niladic type %1bp",[t]) + + +--% --% ITERATORS --% diff --git a/src/interp/define.boot b/src/interp/define.boot index c3173e82..6a2aecbb 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1287,10 +1287,9 @@ spadCompileOrSetq (form is [nam,[lam,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]] + form := + GET(nam,"SPADreplace") => [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]] + [nam,[lam,vl,body]] $insideCapsuleFunctionIfTrue => $optExportedFunctionReference => @@ -1439,6 +1438,12 @@ compSingleCapsuleItem(item,$predl,$e) == doIt(macroExpandInPlace(item,$e),$predl) $e + +++ subroutine of doIt. Called to generate runtime noop insn. +mutateToNothing item == + RPLACA(item,'PROGN) + RPLACD(item,NIL) + doIt(item,$predl) == $GENNO: local:= 0 item is ['SEQ,:l,['exit,1,x]] => @@ -1483,8 +1488,10 @@ doIt(item,$predl) == for dom in doms repeat sayBrightly ['" importing ",:formatUnabbreviated dom] [.,.,$e] := compOrCroak(item,$EmptyMode,$e) - RPLACA(item,'PROGN) - RPLACD(item,NIL) -- creates a no-op + mutateToNothing item + item is ["%Inline",type] => + processInlineRequest(type,$e) + mutateToNothing item item is ["IF",:.] => doItIf(item,$predl,$e) item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e) item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e) diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index fd15745d..9867963c 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.lisp @@ -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-2009, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -454,6 +454,14 @@ (CONS '|import| (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))))) +;; domain inlining. Same syntax as import directive; except +;; deliberate restriction on naming one type at a time. +;; -- gdr, 2009-02-28. +(DEFUN |PARSE-Inline| () + (AND (MATCH-ADVANCE-STRING "inline") + (MUST (|PARSE-Expr| 1000)) + (PUSH-REDUCTION '|PARSE-Inline| + (CONS '|%Inline| (CONS (POP-STACK-1) NIL))))) (DEFUN |PARSE-Infix| () (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL)) diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp index 5a4d718d..aebd2aaa 100644 --- a/src/interp/metalex.lisp +++ b/src/interp/metalex.lisp @@ -575,7 +575,7 @@ empty (if File-Closed (return nil)) |has| |with| |add| |case| |in| |by| |pretend| |mod| |exquo| |div| |quo| |else| |rem| |then| |suchthat| |if| |yield| |iterate| |from| |exit| |leave| |return| - |not| |unless| |repeat| |until| |while| |for| |import|) + |not| |unless| |repeat| |until| |while| |for| |import| |inline|) "Alphabetic literal strings occurring in the New Meta code constitute keywords. These are recognized specifically by the AnyId production, diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp index c0027b68..3d328de7 100644 --- a/src/interp/newaux.lisp +++ b/src/interp/newaux.lisp @@ -134,6 +134,7 @@ (|until| 130 190 (|PARSE-Loop|)) (|repeat| 130 190 (|PARSE-Loop|)) (|import| 120 0 (|PARSE-Import|) ) + (|inline| 120 0 (|PARSE-Inline|) ) (|unless|) (|add| 900 120) (|with| 1000 300 (|PARSE-With|)) diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index e3372db5..32105963 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -553,7 +553,7 @@ $SpecialDomainNames == SubDomain) -$optimizableConstructorNames == +$SystemInlinableConstructorNames == '(List _ Integer _ PositiveInteger _ |