diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 20 | ||||
| -rw-r--r-- | src/boot/ast.boot | 26 | ||||
| -rw-r--r-- | src/boot/parser.boot | 36 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 181 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 61 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 3 | ||||
| -rw-r--r-- | src/boot/translator.boot | 2 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 2 |
8 files changed, 182 insertions, 149 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a1e43359..728cdea2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2012-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/parser.boot (bpSignatureTail): Split out of bpSignature. + (bpTyped): Use it. + (bpThrow): Lilkewise. + (bpRegularBVItemTail): Likewise. + (bpAssignLHS): Likewise. + (bpStoreName): Do not reference $typings. + * boot/ast.boot (%Ast): Remove %Pretend variant. + (bfSignature): Rename from bfLocal. Build %Signature variant. + (bfLET1): Handle assignment to typed variable. + (shoeCompTran): Do not reference $typings. + (shoeCompTran1): Do not translate assignment to typed variables. + (bindFluidVars): Handle them here. + (bfTagged): Remove. + (bfTry): Tidy. + * boot/translator.boot (shoeOutParse): Do not reference $typings + and $returns. + * interp/c-util.boot (isAlmostSimple): Initialize $assignmentList. + 2012-06-01 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/translator.boot: Remove DEFUSE, $booDefined, diff --git a/src/boot/ast.boot b/src/boot/ast.boot index ff360d3a..05a1d94d 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -82,7 +82,6 @@ structure %Ast == %BoundedSgement(%Ast,%Ast) -- 2..4 %Tuple(%List) -- a, b, c, d %ColonAppend(%Ast,%Ast) -- [:y] or [x, :y] - %Pretend(%Ast,%Ast) -- e : t -- hard coercion %Is(%Ast,%Ast) -- e is p -- patterns %Isnt(%Ast,%Ast) -- e isnt p -- patterns %Reduce(%Ast,%Ast) -- +/[...] @@ -567,9 +566,9 @@ bfForInBy(tu,variable,collection,step)== bfForin(tu,lhs,U)== bfFor(tu,lhs,U,1) -bfLocal(a,b)== +bfSignature(a,b)== b is "local" => compFluid a - a + ['%Signature,a,b] bfTake(n,x)== x = nil => x @@ -631,7 +630,7 @@ bfLetForm(lhs,rhs) == bfLET1(tu,lhs,rhs) == symbol? lhs => bfLetForm(lhs,rhs) - lhs is ['%Dynamic,.] => bfLetForm(lhs,rhs) + lhs is ['%Dynamic,.] or lhs is ['%Signature,:.] => bfLetForm(lhs,rhs) symbol? rhs and not bfCONTAINED(rhs,lhs) => rhs1 := bfLET2(tu,lhs,rhs) rhs1 is ["L%T",:.] => bfMKPROGN [rhs1,rhs] @@ -1034,8 +1033,6 @@ shoeCompTran x== deref(locVars) := setDifference(setDifference(deref locVars,deref fluidVars),shoeATOMs args) body := body' := body - if $typings then - body' := [["DECLARE",:$typings],:body'] if fvars := setDifference(deref dollarVars,deref fluidVars) then body' := [["DECLARE",["SPECIAL",:fvars]],:body'] vars := deref locVars => declareLocalVars(vars,body') @@ -1105,6 +1102,7 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) == -- Defer translation of operator for this form. second(x) := y x + l is ['%Signature,:.] => x -- local binding with explicit typing x.op := "SETQ" symbol? l => bfBeginsDollar l => @@ -1150,6 +1148,12 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) == bindFluidVars! x bindFluidVars! x == + x is [["L%T",['%Signature,v,t],expr],:stmts] => + x.first := + stmts = nil => ["LET",[[v,expr]],['DECLARE,['TYPE,t]],v] + ["LET",[[v,expr]],['DECLARE,['TYPE,t]],:bindFluidVars! stmts] + x.rest := nil + x if x is [["L%T",:init],:stmts] then x.first := groupFluidVars([init],[first init],stmts) x.rest := nil @@ -1166,14 +1170,6 @@ groupFluidVars(inits,vars,stmts) == ["LET",inits,["DECLARE",["SPECIAL",:vars]],bfMKPROGN stmts] ["LET*",inits,["DECLARE",["SPECIAL",:vars]],bfMKPROGN stmts] -bfTagged(tu,a,b)== - enclosingFunction tu = nil => %Signature(a,b) -- surely a toplevel decl - symbol? a => - b is "local" => bfLET(tu,compFluid a,nil) - $typings := [["TYPE",b,a],:$typings] - a - ["THE",b,a] - bfRestrict(x,t) == ["THE",t,x] @@ -1420,7 +1416,7 @@ bfTry(e,cs) == bfThrow e == t := nil x := nil - if e is ["%Pretend",:.] then + if e is ['%Signature,:.] then t := third e x := second e else diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 2ef81452..ce3f4954 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -553,8 +553,12 @@ bpTypeAliasDefition ps == ++ Signature: ++ Name COLON Mapping bpSignature ps == - bpName ps and bpEqKey(ps,"COLON") and bpRequire(ps,function bpTyping) - and bpPush(ps,%Signature(bpPop2 ps, bpPop1 ps)) + bpName ps and bpSignatureTail ps + +bpSignatureTail ps == + bpEqKey(ps,"COLON") and bpRequire(ps,function bpTyping) and + bpPush(ps,bfSignature(bpPop2 ps,bpPop1 ps)) + ++ SimpleMapping: ++ Application @@ -691,9 +695,7 @@ bpTyping ps == ++ Application @ Typing bpTyped ps == bpApplication ps and - bpEqKey(ps,"COLON") => - bpRequire(ps,function bpTyping) and - bpPush(ps,bfTagged(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) + bpSignatureTail ps => true bpEqKey(ps,"AT") => bpRequire(ps,function bpTyping) and bpPush(ps,bfRestrict(bpPop2 ps, bpPop1 ps)) @@ -792,9 +794,7 @@ bpAnd ps == bpThrow ps == bpEqKey(ps,"THROW") and bpApplication ps => -- Allow user-supplied matching type tag - if bpEqKey(ps,"COLON") then - bpRequire(ps,function bpApplication) - bpPush(ps,%Pretend(bpPop2 ps,bpPop1 ps)) + bpSignatureTail ps bpPush(ps,bfThrow bpPop1 ps) nil @@ -989,7 +989,6 @@ bpDefinition ps == bpStoreName ps == enclosingFunction(parserLoadUnit ps) := first parserTrees ps sideConditions(parserLoadUnit ps) := nil - $typings := nil true bpDef ps == @@ -1154,14 +1153,13 @@ bpPatternTail ps == ++ a form with a specific pattern structure, or whether it has ++ a default value. bpRegularBVItemTail ps == - bpEqKey(ps,"COLON") and bpRequire(ps,function bpApplication) and - bpPush(ps,bfTagged(parserLoadUnit ps,bpPop2 ps, bpPop1 ps)) - or bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern) and - bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) - or bpEqKey(ps,"IS") and bpRequire(ps,function bpPattern) and - bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) - or bpEqKey(ps,"DEF") and bpRequire(ps,function bpApplication) and - bpPush(ps,%DefaultValue(bpPop2 ps, bpPop1 ps)) + bpSignatureTail ps + or bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern) and + bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) + or bpEqKey(ps,"IS") and bpRequire(ps,function bpPattern) and + bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) + or bpEqKey(ps,"DEF") and bpRequire(ps,function bpApplication) and + bpPush(ps,%DefaultValue(bpPop2 ps, bpPop1 ps)) bpRegularBVItem ps == @@ -1204,9 +1202,7 @@ bpAssignVariable ps == bpAssignLHS ps == not bpName ps => false - bpEqKey(ps,"COLON") => -- variable declaration - bpRequire(ps,function bpApplication) - bpPush(ps,bfLocal(bpPop2 ps,bpPop1 ps)) + bpSignatureTail ps => true -- variable declaration bpArgumentList ps and (bpEqPeek(ps,"DOT") or (bpEqPeek(ps,"BEC") and bpPush(ps,bfPlace bpPop1 ps)) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index b977f958..73afad30 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -75,73 +75,71 @@ (DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|) (CONS '|%ColonAppend| (LIST . #1#))) -(DEFUN |%Pretend| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Pretend| (LIST . #1#))) +(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#))) -(DEFUN |%Is| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Is| (LIST . #1#))) +(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#))) -(DEFUN |%Isnt| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Isnt| (LIST . #1#))) +(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#))) -(DEFUN |%Reduce| #1=(|bfVar#48| |bfVar#49|) (CONS '|%Reduce| (LIST . #1#))) - -(DEFUN |%PrefixExpr| #1=(|bfVar#50| |bfVar#51|) +(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|) (CONS '|%PrefixExpr| (LIST . #1#))) -(DEFUN |%Call| #1=(|bfVar#52| |bfVar#53|) (CONS '|%Call| (LIST . #1#))) +(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#))) -(DEFUN |%InfixExpr| #1=(|bfVar#54| |bfVar#55| |bfVar#56|) +(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|) (CONS '|%InfixExpr| (LIST . #1#))) -(DEFUN |%ConstantDefinition| #1=(|bfVar#57| |bfVar#58|) +(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|) (CONS '|%ConstantDefinition| (LIST . #1#))) -(DEFUN |%Definition| #1=(|bfVar#59| |bfVar#60| |bfVar#61|) +(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|) (CONS '|%Definition| (LIST . #1#))) -(DEFUN |%Macro| #1=(|bfVar#62| |bfVar#63| |bfVar#64|) +(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|) (CONS '|%Macro| (LIST . #1#))) -(DEFUN |%Lambda| #1=(|bfVar#65| |bfVar#66|) (CONS '|%Lambda| (LIST . #1#))) +(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#))) -(DEFUN |%SuchThat| #1=(|bfVar#67|) (CONS '|%SuchThat| (LIST . #1#))) +(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#))) -(DEFUN |%Assignment| #1=(|bfVar#68| |bfVar#69|) +(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|) (CONS '|%Assignment| (LIST . #1#))) -(DEFUN |%While| #1=(|bfVar#70|) (CONS '|%While| (LIST . #1#))) +(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#))) -(DEFUN |%Until| #1=(|bfVar#71|) (CONS '|%Until| (LIST . #1#))) +(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#))) -(DEFUN |%For| #1=(|bfVar#72| |bfVar#73| |bfVar#74|) (CONS '|%For| (LIST . #1#))) +(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#))) -(DEFUN |%Implies| #1=(|bfVar#75| |bfVar#76|) (CONS '|%Implies| (LIST . #1#))) +(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#))) -(DEFUN |%Iterators| #1=(|bfVar#77|) (CONS '|%Iterators| (LIST . #1#))) +(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#))) -(DEFUN |%Cross| #1=(|bfVar#78|) (CONS '|%Cross| (LIST . #1#))) +(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#))) -(DEFUN |%Repeat| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Repeat| (LIST . #1#))) +(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#))) -(DEFUN |%Pile| #1=(|bfVar#81|) (CONS '|%Pile| (LIST . #1#))) +(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#))) -(DEFUN |%Append| #1=(|bfVar#82|) (CONS '|%Append| (LIST . #1#))) +(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#))) -(DEFUN |%Case| #1=(|bfVar#83| |bfVar#84|) (CONS '|%Case| (LIST . #1#))) +(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#))) -(DEFUN |%Return| #1=(|bfVar#85|) (CONS '|%Return| (LIST . #1#))) +(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#))) -(DEFUN |%Leave| #1=(|bfVar#86|) (CONS '|%Leave| (LIST . #1#))) +(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#))) -(DEFUN |%Throw| #1=(|bfVar#87|) (CONS '|%Throw| (LIST . #1#))) +(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#))) -(DEFUN |%Catch| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Catch| (LIST . #1#))) +(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#))) -(DEFUN |%Finally| #1=(|bfVar#90|) (CONS '|%Finally| (LIST . #1#))) +(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#))) -(DEFUN |%Try| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Try| (LIST . #1#))) +(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#))) -(DEFUN |%Where| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Where| (LIST . #1#))) +(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#))) -(DEFUN |%Structure| #1=(|bfVar#95| |bfVar#96|) +(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Structure| (LIST . #1#))) (DEFSTRUCT (|%LoadUnit| (:COPIER |copy%LoadUnit|)) @@ -818,7 +816,8 @@ (DEFUN |bfForin| (|tu| |lhs| U) (|bfFor| |tu| |lhs| U 1)) -(DEFUN |bfLocal| (|a| |b|) (COND ((EQ |b| '|local|) (|compFluid| |a|)) (T |a|))) +(DEFUN |bfSignature| (|a| |b|) + (COND ((EQ |b| '|local|) (|compFluid| |a|)) (T (LIST '|%Signature| |a| |b|)))) (DEFUN |bfTake| (|n| |x|) (COND ((NULL |x|) |x|) ((EQL |n| 0) NIL) @@ -885,10 +884,12 @@ (DEFUN |bfLET1| (|tu| |lhs| |rhs|) (LET* (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|) (COND ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|)) - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Dynamic|) - (PROGN - (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + ((OR + (AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Dynamic|) + (PROGN + (SETQ |ISTMP#1| (CDR |lhs|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + (AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|))) (|bfLetForm| |lhs| |rhs|)) ((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) (SETQ |rhs1| (|bfLET2| |tu| |lhs| |rhs|)) @@ -1727,7 +1728,6 @@ |body| |args| |lamtype|) - (DECLARE (SPECIAL |$typings|)) (PROGN (SETQ |lamtype| (CAR |x|)) (SETQ |args| (CADR . #1=(|x|))) @@ -1744,9 +1744,6 @@ (PROGN (SETQ |body'| |body|) (COND - (|$typings| - (SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|)))) - (COND ((SETQ |fvars| (|setDifference| (|deref| |dollarVars|) (|deref| |fluidVars|))) @@ -1880,6 +1877,7 @@ (SETF (|deref| |fluidVars|) (CONS |y| (|deref| |fluidVars|))))) (SETF (CADR |x|) |y|) |x|) + ((AND (CONSP |l|) (EQ (CAR |l|) '|%Signature|)) |x|) (T (RPLACA |x| 'SETQ) (COND ((SYMBOLP |l|) @@ -1977,26 +1975,76 @@ (|bindFluidVars!| |x|))))))) (DEFUN |bindFluidVars!| (|x|) - (LET* (|y| |stmts| |init| |ISTMP#1|) - (PROGN - (COND - ((AND (CONSP |x|) - (PROGN - (SETQ |ISTMP#1| (CAR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T) - (PROGN (SETQ |init| (CDR |ISTMP#1|)) T))) - (PROGN (SETQ |stmts| (CDR |x|)) T)) - (RPLACA |x| - (|groupFluidVars| (LIST |init|) (LIST (CAR |init|)) |stmts|)) - (RPLACD |x| NIL))) - (COND - ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |y| (CAR |ISTMP#1|)) T)))) - |y|) - (T |x|))))) + (LET* (|y| + |init| + |stmts| + |expr| + |ISTMP#6| + |t| + |ISTMP#5| + |v| + |ISTMP#4| + |ISTMP#3| + |ISTMP#2| + |ISTMP#1|) + (COND + ((AND (CONSP |x|) + (PROGN + (SETQ |ISTMP#1| (CAR |x|)) + (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T) + (PROGN + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SETQ |ISTMP#3| (CAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (CAR |ISTMP#3|) '|%Signature|) + (PROGN + (SETQ |ISTMP#4| (CDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (PROGN + (SETQ |v| (CAR |ISTMP#4|)) + (SETQ |ISTMP#5| (CDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (NULL (CDR |ISTMP#5|)) + (PROGN + (SETQ |t| (CAR |ISTMP#5|)) + T))))))) + (PROGN + (SETQ |ISTMP#6| (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#6|) (NULL (CDR |ISTMP#6|)) + (PROGN (SETQ |expr| (CAR |ISTMP#6|)) T)))))))) + (SETQ |stmts| (CDR |x|)) + (RPLACA |x| + (COND + ((NULL |stmts|) + (LIST 'LET (LIST (LIST |v| |expr|)) + (LIST 'DECLARE (LIST 'TYPE |t|)) |v|)) + (T + (CONS 'LET + (CONS (LIST (LIST |v| |expr|)) + (CONS (LIST 'DECLARE (LIST 'TYPE |t|)) + (|bindFluidVars!| |stmts|))))))) + (RPLACD |x| NIL) |x|) + (T + (COND + ((AND (CONSP |x|) + (PROGN + (SETQ |ISTMP#1| (CAR |x|)) + (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T) + (PROGN (SETQ |init| (CDR |ISTMP#1|)) T))) + (PROGN (SETQ |stmts| (CDR |x|)) T)) + (RPLACA |x| + (|groupFluidVars| (LIST |init|) (LIST (CAR |init|)) |stmts|)) + (RPLACD |x| NIL))) + (COND + ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |y| (CAR |ISTMP#1|)) T)))) + |y|) + (T |x|)))))) (DEFUN |groupFluidVars| (|inits| |vars| |stmts|) (LET* (|stmts'| @@ -2075,15 +2123,6 @@ (LIST 'LET* |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|)) (|bfMKPROGN| |stmts|)))))) -(DEFUN |bfTagged| (|tu| |a| |b|) - (DECLARE (SPECIAL |$typings|)) - (COND ((NULL (|enclosingFunction| |tu|)) (|%Signature| |a| |b|)) - ((SYMBOLP |a|) - (COND ((EQ |b| '|local|) (|bfLET| |tu| (|compFluid| |a|) NIL)) - (T (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|)) - |a|))) - (T (LIST 'THE |b| |a|)))) - (DEFUN |bfRestrict| (|x| |t|) (LIST 'THE |t| |x|)) (DEFUN |bfAssign| (|tu| |l| |r|) @@ -2719,7 +2758,7 @@ (SETQ |t| NIL) (SETQ |x| NIL) (COND - ((AND (CONSP |e|) (EQ (CAR |e|) '|%Pretend|)) (SETQ |t| (CADDR |e|)) + ((AND (CONSP |e|) (EQ (CAR |e|) '|%Signature|)) (SETQ |t| (CADDR |e|)) (SETQ |x| (CADR |e|))) (T (SETQ |t| '|SystemException|) (SETQ |x| |e|))) (SETQ |t| (COND ((SYMBOLP |t|) (|quote| (LIST |t|))) (T (|quote| |t|)))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 8bd130d9..d0d000c8 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -560,9 +560,11 @@ (|bpLogical| |ps|) (|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|))))) -(DEFUN |bpSignature| (|ps|) - (AND (|bpName| |ps|) (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpTyping|) - (|bpPush| |ps| (|%Signature| (|bpPop2| |ps|) (|bpPop1| |ps|))))) +(DEFUN |bpSignature| (|ps|) (AND (|bpName| |ps|) (|bpSignatureTail| |ps|))) + +(DEFUN |bpSignatureTail| (|ps|) + (AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpTyping|) + (|bpPush| |ps| (|bfSignature| (|bpPop2| |ps|) (|bpPop1| |ps|))))) (DEFUN |bpSimpleMapping| (|ps|) (COND @@ -698,16 +700,12 @@ (DEFUN |bpTyped| (|ps|) (AND (|bpApplication| |ps|) - (COND - ((|bpEqKey| |ps| 'COLON) - (AND (|bpRequire| |ps| #'|bpTyping|) - (|bpPush| |ps| - (|bfTagged| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) - (|bpPop1| |ps|))))) - ((|bpEqKey| |ps| 'AT) - (AND (|bpRequire| |ps| #'|bpTyping|) - (|bpPush| |ps| (|bfRestrict| (|bpPop2| |ps|) (|bpPop1| |ps|))))) - (T T)))) + (COND ((|bpSignatureTail| |ps|) T) + ((|bpEqKey| |ps| 'AT) + (AND (|bpRequire| |ps| #'|bpTyping|) + (|bpPush| |ps| + (|bfRestrict| (|bpPop2| |ps|) (|bpPop1| |ps|))))) + (T T)))) (DEFUN |bpExpt| (|ps|) (|bpRightAssoc| |ps| '(POWER) #'|bpTyped|)) @@ -835,10 +833,7 @@ (DEFUN |bpThrow| (|ps|) (COND ((AND (|bpEqKey| |ps| 'THROW) (|bpApplication| |ps|)) - (COND - ((|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|) - (|bpPush| |ps| (|%Pretend| (|bpPop2| |ps|) (|bpPop1| |ps|))))) - (|bpPush| |ps| (|bfThrow| (|bpPop1| |ps|)))) + (|bpSignatureTail| |ps|) (|bpPush| |ps| (|bfThrow| (|bpPop1| |ps|)))) (T NIL))) (DEFUN |bpTry| (|ps|) @@ -1033,12 +1028,10 @@ (T (|bpRestore| |ps| |a|) NIL)))))) (DEFUN |bpStoreName| (|ps|) - (DECLARE (SPECIAL |$typings|)) (PROGN (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) (CAR (|parserTrees| |ps|))) (SETF (|sideConditions| (|parserLoadUnit| |ps|)) NIL) - (SETQ |$typings| NIL) T)) (DEFUN |bpDef| (|ps|) @@ -1205,21 +1198,17 @@ T))) (DEFUN |bpRegularBVItemTail| (|ps|) - (OR - (AND (|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|) - (|bpPush| |ps| - (|bfTagged| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) - (|bpPop1| |ps|)))) - (AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|) - (|bpPush| |ps| - (|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) - (|bpPop1| |ps|)))) - (AND (|bpEqKey| |ps| 'IS) (|bpRequire| |ps| #'|bpPattern|) - (|bpPush| |ps| - (|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) - (|bpPop1| |ps|)))) - (AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpApplication|) - (|bpPush| |ps| (|%DefaultValue| (|bpPop2| |ps|) (|bpPop1| |ps|)))))) + (OR (|bpSignatureTail| |ps|) + (AND (|bpEqKey| |ps| 'BEC) (|bpRequire| |ps| #'|bpPattern|) + (|bpPush| |ps| + (|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) + (|bpPop1| |ps|)))) + (AND (|bpEqKey| |ps| 'IS) (|bpRequire| |ps| #'|bpPattern|) + (|bpPush| |ps| + (|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|) + (|bpPop1| |ps|)))) + (AND (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpApplication|) + (|bpPush| |ps| (|%DefaultValue| (|bpPop2| |ps|) (|bpPop1| |ps|)))))) (DEFUN |bpRegularBVItem| (|ps|) (OR (|bpBVString| |ps|) (|bpConstTok| |ps|) @@ -1272,9 +1261,7 @@ (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|))) (DEFUN |bpAssignLHS| (|ps|) - (COND ((NOT (|bpName| |ps|)) NIL) - ((|bpEqKey| |ps| 'COLON) (|bpRequire| |ps| #'|bpApplication|) - (|bpPush| |ps| (|bfLocal| (|bpPop2| |ps|) (|bpPop1| |ps|)))) + (COND ((NOT (|bpName| |ps|)) NIL) ((|bpSignatureTail| |ps|) T) (T (AND (|bpArgumentList| |ps|) (OR (|bpEqPeek| |ps| 'DOT) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index e14dc923..50553932 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -433,11 +433,8 @@ (DEFUN |shoeOutParse| (|toks|) (LET* (|found| |ps|) - (DECLARE (SPECIAL |$returns| |$typings|)) (PROGN (SETQ |ps| (|makeParserState| |toks|)) - (SETQ |$typings| NIL) - (SETQ |$returns| NIL) (|bpFirstTok| |ps|) (SETQ |found| (LET ((#1=#:G729 diff --git a/src/boot/translator.boot b/src/boot/translator.boot index b0288f08..5f296b6a 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -356,8 +356,6 @@ shoeAddComment l== shoeOutParse toks == ps := makeParserState toks - $typings := [] - $returns := [] bpFirstTok ps found := try bpOutItem ps diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 0638fd91..b1d09f25 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -865,7 +865,7 @@ isSideEffectFree op == isAlmostSimple x == --returns (<new predicate> . <list of assignments>) or nil - $assignmentList: local --$assigmentList is only used in this function + $assignmentList: local := nil --$assigmentList is only used in this function transform:= fn x where fn x == |