aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog10
-rw-r--r--src/boot/ast.boot38
-rw-r--r--src/boot/parser.boot31
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