diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/boot/ast.boot | 38 | ||||
| -rw-r--r-- | src/boot/parser.boot | 31 |
3 files changed, 57 insertions, 22 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 8863e00b..70baa3c2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,15 @@ 2008-04-18 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (%DefaultValue): New %Ast node. + (bfParameterList): New. + (bfInsertLet): Use it. + (bfInsertLet1): Handle parameter with default values. + * boot/parser.boot (bpRegularBVItemTail): Split from bpRegularBVItem. + (bpRegularBVItem): Tidy. + +2008-04-18 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/ast.boot: * interp/define.boot ($mutableDomain): Define. (compDefineFunctor): Initialize it before compiling a functor. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 5fe33191..ab37de68 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -82,6 +82,7 @@ structure Ast == EqualName(Name) -- =x -- patterns Colon(Name) -- :x QualifiedName(Name, Name) -- m::x + %DefaultValue(%Name,%Ast) -- opt. value for function param. Bracket(Ast) -- [x, y] UnboundedSegment(Ast) -- 3.. BoundedSgement(Ast, Ast) -- 2..4 @@ -838,6 +839,22 @@ shoeComp x== if EQCAR(a,"LAMBDA") then ["DEFUN",CAR x,CADR a,:CDDR a] else ["DEFMACRO",CAR x,CADR a,:CDDR a] + + +++ Translate function parameter list to Lisp. +++ We are processing a function definition. `p2' is the list of +++ parameters we have seen so far, and we are about to add a +++ parameter `p1'. Check that the new specification is coherent +++ with the previous one. In particular, check that restrictions +++ on parameters with default values are satisfied. Return the +++ new augmented parameter list. +bfParameterList(p1,p2) == + p2=nil and not atom p1 => p1 + p1 is ["&OPTIONAL",:.] => + p2 isnt ["&OPTIONAL",:.] => bpSpecificErrorHere '"default value required" + [first p1,:rest p1,:rest p2] + p2 is ["&OPTIONAL",:.] => [p1,first p2,:rest p2] + [p1,:p2] bfInsertLet(x,body)== if null x @@ -850,20 +867,17 @@ bfInsertLet(x,body)== else [b,norq,name1,body1]:= bfInsertLet1 (car x,body) [b1,norq1,name2,body2]:= bfInsertLet (cdr x,body1) - [b or b1,cons(norq,norq1),cons(name1,name2),body2] + [b or b1,cons(norq,norq1),bfParameterList(name1,name2),body2] bfInsertLet1(y,body)== - if y is ["L%T",l,r] - then [false,nil,l,bfMKPROGN [bfLET(r,l),body]] - else if IDENTP y - then [false,nil,y,body] - else - if y is ["BVQUOTE",b] - then [true,"QUOTE",b,body] - else - g:=bfGenSymbol() - ATOM y => [false,nil,g,body] - [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]] + y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]] + IDENTP y => [false,nil,y,body] + y is ["BVQUOTE",b] => [true,"QUOTE",b,body] + g:=bfGenSymbol() + ATOM y => [false,nil,g,body] + case y of + %DefaultValue(p,v) => [false,nil,["&OPTIONAL",[p,v]],body] + otherwise => [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]] shoeCompTran x== lamtype:=CAR x diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 6eeaa392..af8098b2 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -981,17 +981,28 @@ bpPatternTail()== and bpPush append (bpPop2(),bpPop1()) or true) -- BOUND VARIABLE + +++ We are parsing parameters in a function definition. We have +++ just seen a parameter name; we are attempting to see whether +++ it might be followed by a type annotation, or whether it actually +++ a form with a specific pattern structure, or whether it has +++ a default value. +bpRegularBVItemTail() == + bpEqKey "COLON" and (bpApplication() or bpTrap()) and + bpPush bfTagged(bpPop2(), bpPop1()) + or bpEqKey "BEC" and (bpPattern() or bpTrap()) and + bpPush bfAssign(bpPop2(),bpPop1()) + or bpEqKey "IS" and (bpPattern() or bpTrap()) and + bpPush bfAssign(bpPop2(),bpPop1()) + or bpEqKey "DEF" and (bpApplication() or bpTrap()) and + bpPush %DefaultValue(bpPop2(), bpPop1()) + + bpRegularBVItem() == - bpBVString() or - bpConstTok() or - (bpName() and - (bpEqKey "COLON" and (bpApplication() or bpTrap()) - and bpPush bfTagged(bpPop2(), bpPop1()) or - bpEqKey "BEC" and (bpPattern() or bpTrap()) - and bpPush bfAssign(bpPop2(),bpPop1()) or - (bpEqKey "IS" and (bpPattern() or bpTrap()) - and bpPush bfAssign(bpPop2(),bpPop1())) or true)) - or bpBracketConstruct function bpPatternL + bpBVString() + or bpConstTok() + or (bpName() and (bpRegularBVItemTail() or true)) + or bpBracketConstruct function bpPatternL bpBVString()== EQ(shoeTokType $stok,"STRING") and |