From 5f24b5d3416d723eed6052b491311c7549a2526e Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 29 Aug 2009 17:28:32 +0000 Subject: * boot/ast.boot (%Definition): Lose one argument. (bfDefinition): Remove. (bfSimpleDefinition): Likewise. (bfCompDef): Likewise. (bfDefSequence): Likewise. (defSheepAndGoats): Tidy. * boot/parser.boot (bpSimpleDefinitionTail): Likewise. (bpCompoundDefinitionTail): Likewise. (bpDefinitionPileItems): Likewise. (bpSemiColonDefinition): Likewise. * boot/translator.boot (translateToplevel): Likewise. --- src/boot/ast.boot | 57 ++++------- src/boot/parser.boot | 8 +- src/boot/strap/ast.clisp | 208 +++++++++++++++------------------------- src/boot/strap/parser.clisp | 8 +- src/boot/strap/translator.clisp | 11 ++- src/boot/translator.boot | 3 +- 6 files changed, 114 insertions(+), 181 deletions(-) (limited to 'src/boot') diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 3a0703cc..52c161fc 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -110,7 +110,7 @@ structure %Ast == %Call(%Ast,%Sequence) -- f(x, y , z) %InfixExpr(%Name,%Ast,%Ast) -- x + y %ConstantDefinition(%Name,%Ast) -- x == y - %Definition(%Name,%List,%Ast,%Ast) -- f x == y + %Definition(%Name,%Ast,%Ast) -- f x == y %Macro(%Name,%List,%Ast) -- m x ==> y %SuchThat(%Ast) -- | p %Assignment(%Ast,%Ast) -- x := y @@ -196,26 +196,9 @@ bfColonAppend(x,y) == else ["&REST",y] else cons(first x,bfColonAppend(rest x,y)) -bfDefinition: (%Thing,%Thing,%Thing) -> %List -bfDefinition(bflhsitems, bfrhs,body) == - ['DEF,bflhsitems,bfrhs,body] - -bfSimpleDefinition: (%Thing,%Thing) -> %Thing -bfSimpleDefinition(lhs,rhs) == - if atom lhs then - $constantIdentifiers := [lhs,:$constantIdentifiers] - else if lhs is ["%Signature",id,.] then - $constantIdentifiers := [id,:$constantIdentifiers] - %ConstantDefinition(lhs,rhs) - -bfCompDef: %Thing -> %List -bfCompDef x == - x is [def, op, args, body] => bfDef(op,args,body) - coreError '"invalid AST" - bfBeginsDollar: %Thing -> %Boolean bfBeginsDollar x == - EQL('"$".0,(PNAME x).0) + (PNAME x).0 = char "$" compFluid id == ["FLUID",id] @@ -477,9 +460,6 @@ bfDrop(n,x)== null x or n=0 =>x bfDrop(n-1,rest x) -bfDefSequence l == - ['SEQ,: l] - bfReturnNoName a == ["RETURN",a] @@ -500,22 +480,22 @@ bfSUBLIS1(p,e)== bfSUBLIS1(cdr p,e) defSheepAndGoats(x)== - EQCAR (x,"DEF") => - [def,op,args,body]:=x - argl:=if bfTupleP args - then rest args - else [args] - if null argl - then - opassoc:=[[op,:body]] - [opassoc,[],[]] - else - op1:=INTERN CONCAT(PNAME $op,'",",PNAME op) - opassoc:=[[op,:op1]] - defstack:=[[op1,args,body]] - [opassoc,defstack,[]] - EQCAR (x,"SEQ") => defSheepAndGoatsList(rest x) - [[],[],[x]] + case x of + %Definition(op,args,body) => + argl:=if bfTupleP args + then rest args + else [args] + if null argl + then + opassoc:=[[op,:body]] + [opassoc,[],[]] + else + op1:=INTERN CONCAT(PNAME $op,'",",PNAME op) + opassoc:=[[op,:op1]] + defstack:=[[op1,args,body]] + [opassoc,defstack,[]] + %Pile defs => defSheepAndGoatsList defs + otherwise => [[],[],[x]] defSheepAndGoatsList(x)== if null x @@ -525,6 +505,7 @@ defSheepAndGoatsList(x)== [opassoc1,defs1,nondefs1] := defSheepAndGoatsList rest x [append(opassoc,opassoc1),append(defs,defs1), append(nondefs,nondefs1)] + --% LET bfLetForm(lhs,rhs) == diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 8d906c00..52169219 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -889,13 +889,13 @@ bpDDef() == bpName() and bpDefTail() bpSimpleDefinitionTail() == bpEqKey "DEF" and (bpWhere() or bpTrap()) - and bpPush bfSimpleDefinition(bpPop2(), bpPop1()) + and bpPush %ConstantDefinition(bpPop2(), bpPop1()) ++ Parse the remaining of a compound definition. bpCompoundDefinitionTail() == bpVariable() and bpReturnType() and bpEqKey "DEF" and (bpWhere() or bpTrap()) - and bpPush bfDefinition(bpPop3(),bpPop2(),bpPop1()) + and bpPush %Definition(bpPop3(),bpPop2(),bpPop1()) ++ Parse the remainding of a definition. When we reach this point @@ -940,12 +940,12 @@ bpDefinitionItem()== bpDefinitionPileItems()== bpListAndRecover function bpDefinitionItem - and bpPush bfDefSequence bpPop1() + and bpPush %Pile bpPop1() bpBDefinitionPileItems()== bpPileBracketed function bpDefinitionPileItems bpSemiColonDefinition()==bpSemiListing - (function bpDefinitionItem,function bfDefSequence) + (function bpDefinitionItem,function %Pile) bpPDefinitionItems()==bpParenthesized function bpSemiColonDefinition diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 8a355ff2..5f5e63eb 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -99,53 +99,53 @@ (DEFUN |%ConstantDefinition| #0=(|bfVar#44| |bfVar#45|) (CONS '|%ConstantDefinition| (LIST . #0#))) -(DEFUN |%Definition| #0=(|bfVar#46| |bfVar#47| |bfVar#48| |bfVar#49|) +(DEFUN |%Definition| #0=(|bfVar#46| |bfVar#47| |bfVar#48|) (CONS '|%Definition| (LIST . #0#))) -(DEFUN |%Macro| #0=(|bfVar#50| |bfVar#51| |bfVar#52|) +(DEFUN |%Macro| #0=(|bfVar#49| |bfVar#50| |bfVar#51|) (CONS '|%Macro| (LIST . #0#))) -(DEFUN |%SuchThat| #0=(|bfVar#53|) (CONS '|%SuchThat| (LIST . #0#))) +(DEFUN |%SuchThat| #0=(|bfVar#52|) (CONS '|%SuchThat| (LIST . #0#))) -(DEFUN |%Assignment| #0=(|bfVar#54| |bfVar#55|) +(DEFUN |%Assignment| #0=(|bfVar#53| |bfVar#54|) (CONS '|%Assignment| (LIST . #0#))) -(DEFUN |%While| #0=(|bfVar#56|) (CONS '|%While| (LIST . #0#))) +(DEFUN |%While| #0=(|bfVar#55|) (CONS '|%While| (LIST . #0#))) -(DEFUN |%Until| #0=(|bfVar#57|) (CONS '|%Until| (LIST . #0#))) +(DEFUN |%Until| #0=(|bfVar#56|) (CONS '|%Until| (LIST . #0#))) -(DEFUN |%For| #0=(|bfVar#58| |bfVar#59| |bfVar#60|) +(DEFUN |%For| #0=(|bfVar#57| |bfVar#58| |bfVar#59|) (CONS '|%For| (LIST . #0#))) -(DEFUN |%Implies| #0=(|bfVar#61| |bfVar#62|) +(DEFUN |%Implies| #0=(|bfVar#60| |bfVar#61|) (CONS '|%Implies| (LIST . #0#))) -(DEFUN |%Iterators| #0=(|bfVar#63|) (CONS '|%Iterators| (LIST . #0#))) +(DEFUN |%Iterators| #0=(|bfVar#62|) (CONS '|%Iterators| (LIST . #0#))) -(DEFUN |%Cross| #0=(|bfVar#64|) (CONS '|%Cross| (LIST . #0#))) +(DEFUN |%Cross| #0=(|bfVar#63|) (CONS '|%Cross| (LIST . #0#))) -(DEFUN |%Repeat| #0=(|bfVar#65| |bfVar#66|) +(DEFUN |%Repeat| #0=(|bfVar#64| |bfVar#65|) (CONS '|%Repeat| (LIST . #0#))) -(DEFUN |%Pile| #0=(|bfVar#67|) (CONS '|%Pile| (LIST . #0#))) +(DEFUN |%Pile| #0=(|bfVar#66|) (CONS '|%Pile| (LIST . #0#))) -(DEFUN |%Append| #0=(|bfVar#68|) (CONS '|%Append| (LIST . #0#))) +(DEFUN |%Append| #0=(|bfVar#67|) (CONS '|%Append| (LIST . #0#))) -(DEFUN |%Case| #0=(|bfVar#69| |bfVar#70|) +(DEFUN |%Case| #0=(|bfVar#68| |bfVar#69|) (CONS '|%Case| (LIST . #0#))) -(DEFUN |%Return| #0=(|bfVar#71|) (CONS '|%Return| (LIST . #0#))) +(DEFUN |%Return| #0=(|bfVar#70|) (CONS '|%Return| (LIST . #0#))) -(DEFUN |%Throw| #0=(|bfVar#72|) (CONS '|%Throw| (LIST . #0#))) +(DEFUN |%Throw| #0=(|bfVar#71|) (CONS '|%Throw| (LIST . #0#))) -(DEFUN |%Catch| #0=(|bfVar#73|) (CONS '|%Catch| (LIST . #0#))) +(DEFUN |%Catch| #0=(|bfVar#72|) (CONS '|%Catch| (LIST . #0#))) -(DEFUN |%Try| #0=(|bfVar#74| |bfVar#75|) (CONS '|%Try| (LIST . #0#))) +(DEFUN |%Try| #0=(|bfVar#73| |bfVar#74|) (CONS '|%Try| (LIST . #0#))) -(DEFUN |%Where| #0=(|bfVar#76| |bfVar#77|) +(DEFUN |%Where| #0=(|bfVar#75| |bfVar#76|) (CONS '|%Where| (LIST . #0#))) -(DEFUN |%Structure| #0=(|bfVar#78| |bfVar#79|) +(DEFUN |%Structure| #0=(|bfVar#77| |bfVar#78|) (CONS '|%Structure| (LIST . #0#))) (DEFPARAMETER |$inDefIS| NIL) @@ -216,66 +216,9 @@ (#0='T (LIST '&REST |y|)))) (#0# (CONS (CAR |x|) (|bfColonAppend| (CDR |x|) |y|))))))) -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) - |bfDefinition|)) - -(DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|) - (LIST 'DEF |bflhsitems| |bfrhs| |body|)) - -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Thing|) - |bfSimpleDefinition|)) - -(DEFUN |bfSimpleDefinition| (|lhs| |rhs|) - (PROG (|ISTMP#2| |id| |ISTMP#1|) - (DECLARE (SPECIAL |$constantIdentifiers|)) - (RETURN - (PROGN - (COND - ((ATOM |lhs|) - (SETQ |$constantIdentifiers| - (CONS |lhs| |$constantIdentifiers|))) - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|) - (PROGN - (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |id| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL)))))) - (SETQ |$constantIdentifiers| - (CONS |id| |$constantIdentifiers|)))) - (|%ConstantDefinition| |lhs| |rhs|))))) - -(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCompDef|)) - -(DEFUN |bfCompDef| (|x|) - (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|) - (RETURN - (COND - ((AND (CONSP |x|) - (PROGN - (SETQ |def| (CAR |x|)) - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |op| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |args| (CAR |ISTMP#2|)) - (SETQ |ISTMP#3| (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CDR |ISTMP#3|) NIL) - (PROGN - (SETQ |body| (CAR |ISTMP#3|)) - 'T)))))))) - (|bfDef| |op| |args| |body|)) - ('T (|coreError| "invalid AST")))))) - (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) -(DEFUN |bfBeginsDollar| (|x|) (EQL (ELT "$" 0) (ELT (PNAME |x|) 0))) +(DEFUN |bfBeginsDollar| (|x|) (EQL (ELT (PNAME |x|) 0) (|char| '$))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) @@ -302,22 +245,22 @@ (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|)))) (COND - ((LET ((|bfVar#81| NIL) (|bfVar#80| |a|) (|x| NIL)) + ((LET ((|bfVar#80| NIL) (|bfVar#79| |a|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#80|) - (PROGN (SETQ |x| (CAR |bfVar#80|)) NIL)) - (RETURN |bfVar#81|)) + ((OR (ATOM |bfVar#79|) + (PROGN (SETQ |x| (CAR |bfVar#79|)) NIL)) + (RETURN |bfVar#80|)) ('T (PROGN - (SETQ |bfVar#81| + (SETQ |bfVar#80| (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))) - (COND (|bfVar#81| (RETURN |bfVar#81|)))))) - (SETQ |bfVar#80| (CDR |bfVar#80|)))) + (COND (|bfVar#80| (RETURN |bfVar#80|)))))) + (SETQ |bfVar#79| (CDR |bfVar#79|)))) (|bfMakeCons| |a|)) ('T (CONS 'LIST |a|))))))) @@ -477,19 +420,19 @@ (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) ('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) - (LET ((|bfVar#84| NIL) (|bfVar#82| |f|) (|i| NIL) - (|bfVar#83| |r|) (|j| NIL)) + (LET ((|bfVar#83| NIL) (|bfVar#81| |f|) (|i| NIL) + (|bfVar#82| |r|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#82|) - (PROGN (SETQ |i| (CAR |bfVar#82|)) NIL) - (ATOM |bfVar#83|) - (PROGN (SETQ |j| (CAR |bfVar#83|)) NIL)) - (RETURN (NREVERSE |bfVar#84|))) + ((OR (ATOM |bfVar#81|) + (PROGN (SETQ |i| (CAR |bfVar#81|)) NIL) + (ATOM |bfVar#82|) + (PROGN (SETQ |j| (CAR |bfVar#82|)) NIL)) + (RETURN (NREVERSE |bfVar#83|))) ('T - (SETQ |bfVar#84| (CONS (APPEND |i| |j|) |bfVar#84|)))) - (SETQ |bfVar#82| (CDR |bfVar#82|)) - (SETQ |bfVar#83| (CDR |bfVar#83|))))))))) + (SETQ |bfVar#83| (CONS (APPEND |i| |j|) |bfVar#83|)))) + (SETQ |bfVar#81| (CDR |bfVar#81|)) + (SETQ |bfVar#82| (CDR |bfVar#82|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) @@ -604,25 +547,25 @@ (COND (|vars| (SETQ |loop| (LIST 'LET - (LET ((|bfVar#87| NIL) - (|bfVar#85| |vars|) (|v| NIL) - (|bfVar#86| |inits|) (|i| NIL)) + (LET ((|bfVar#86| NIL) + (|bfVar#84| |vars|) (|v| NIL) + (|bfVar#85| |inits|) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#85|) + ((OR (ATOM |bfVar#84|) (PROGN - (SETQ |v| (CAR |bfVar#85|)) + (SETQ |v| (CAR |bfVar#84|)) NIL) - (ATOM |bfVar#86|) + (ATOM |bfVar#85|) (PROGN - (SETQ |i| (CAR |bfVar#86|)) + (SETQ |i| (CAR |bfVar#85|)) NIL)) - (RETURN (NREVERSE |bfVar#87|))) + (RETURN (NREVERSE |bfVar#86|))) ('T - (SETQ |bfVar#87| - (CONS (LIST |v| |i|) |bfVar#87|)))) - (SETQ |bfVar#85| (CDR |bfVar#85|)) - (SETQ |bfVar#86| (CDR |bfVar#86|)))) + (SETQ |bfVar#86| + (CONS (LIST |v| |i|) |bfVar#86|)))) + (SETQ |bfVar#84| (CDR |bfVar#84|)) + (SETQ |bfVar#85| (CDR |bfVar#85|)))) |loop|)))) |loop|)))) @@ -702,8 +645,6 @@ ((OR (NULL |x|) (EQL |n| 0)) |x|) ('T (|bfDrop| (- |n| 1) (CDR |x|))))) -(DEFUN |bfDefSequence| (|l|) (CONS 'SEQ |l|)) - (DEFUN |bfReturnNoName| (|a|) (LIST 'RETURN |a|)) (DEFUN |bfSUBLIS| (|p| |e|) @@ -725,31 +666,34 @@ (#0# (|bfSUBLIS1| (CDR |p|) |e|))))))))) (DEFUN |defSheepAndGoats| (|x|) - (PROG (|defstack| |op1| |opassoc| |argl| |body| |args| |op| |def|) + (PROG (|defstack| |op1| |opassoc| |argl|) (DECLARE (SPECIAL |$op|)) (RETURN - (COND - ((EQCAR |x| 'DEF) - (PROGN - (SETQ |def| (CAR |x|)) - (SETQ |op| (CADR . #0=(|x|))) - (SETQ |args| (CADDR . #0#)) - (SETQ |body| (CADDDR . #0#)) - (SETQ |argl| - (COND - ((|bfTupleP| |args|) (CDR |args|)) - (#1='T (LIST |args|)))) - (COND - ((NULL |argl|) (SETQ |opassoc| (LIST (CONS |op| |body|))) - (LIST |opassoc| NIL NIL)) - (#1# - (SETQ |op1| - (INTERN (CONCAT (PNAME |$op|) "," (PNAME |op|)))) - (SETQ |opassoc| (LIST (CONS |op| |op1|))) - (SETQ |defstack| (LIST (LIST |op1| |args| |body|))) - (LIST |opassoc| |defstack| NIL))))) - ((EQCAR |x| 'SEQ) (|defSheepAndGoatsList| (CDR |x|))) - ('T (LIST NIL NIL (LIST |x|))))))) + (LET ((|bfVar#87| (CDR |x|))) + (CASE (CAR |x|) + (|%Definition| + (LET ((|op| (CAR |bfVar#87|)) (|args| (CADR |bfVar#87|)) + (|body| (CADDR |bfVar#87|))) + (PROGN + (SETQ |argl| + (COND + ((|bfTupleP| |args|) (CDR |args|)) + (#0='T (LIST |args|)))) + (COND + ((NULL |argl|) + (SETQ |opassoc| (LIST (CONS |op| |body|))) + (LIST |opassoc| NIL NIL)) + (#0# + (SETQ |op1| + (INTERN (CONCAT (PNAME |$op|) "," + (PNAME |op|)))) + (SETQ |opassoc| (LIST (CONS |op| |op1|))) + (SETQ |defstack| + (LIST (LIST |op1| |args| |body|))) + (LIST |opassoc| |defstack| NIL)))))) + (|%Pile| (LET ((|defs| (CAR |bfVar#87|))) + (|defSheepAndGoatsList| |defs|))) + (T (LIST NIL NIL (LIST |x|)))))))) (DEFUN |defSheepAndGoatsList| (|x|) (PROG (|nondefs1| |defs1| |opassoc1| |nondefs| |defs| |opassoc| diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index fc811e17..fd1472d2 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -919,12 +919,12 @@ (DEFUN |bpSimpleDefinitionTail| () (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|)) - (|bpPush| (|bfSimpleDefinition| (|bpPop2|) (|bpPop1|))))) + (|bpPush| (|%ConstantDefinition| (|bpPop2|) (|bpPop1|))))) (DEFUN |bpCompoundDefinitionTail| () (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|)) - (|bpPush| (|bfDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|))))) + (|bpPush| (|%Definition| (|bpPop3|) (|bpPop2|) (|bpPop1|))))) (DEFUN |bpDefTail| () (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|))) @@ -959,13 +959,13 @@ (DEFUN |bpDefinitionPileItems| () (AND (|bpListAndRecover| #'|bpDefinitionItem|) - (|bpPush| (|bfDefSequence| (|bpPop1|))))) + (|bpPush| (|%Pile| (|bpPop1|))))) (DEFUN |bpBDefinitionPileItems| () (|bpPileBracketed| #'|bpDefinitionPileItems|)) (DEFUN |bpSemiColonDefinition| () - (|bpSemiListing| #'|bpDefinitionItem| #'|bfDefSequence|)) + (|bpSemiListing| #'|bpDefinitionItem| #'|%Pile|)) (DEFUN |bpPDefinitionItems| () (|bpParenthesized| #'|bpSemiColonDefinition|)) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 94a7f969..f73aafe9 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -594,11 +594,11 @@ (DEFUN |translateToplevel| (|b| |export?|) (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |xs|) (DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode| - |$foreignsDefsForCLisp| |$currentModuleName|)) + |$constantIdentifiers| |$foreignsDefsForCLisp| + |$currentModuleName|)) (RETURN (COND ((ATOM |b|) (LIST |b|)) - ((AND (CONSP |b|) (EQ (CAR |b|) 'DEF)) (CDR (|bfCompDef| |b|))) ((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE) (PROGN (SETQ |xs| (CDR |b|)) #0='T)) (|coreError| "invalid AST")) @@ -608,6 +608,11 @@ (|%Signature| (LET ((|op| (CAR |bfVar#15|)) (|t| (CADR |bfVar#15|))) (LIST (|genDeclaration| |op| |t|)))) + (|%Definition| + (LET ((|op| (CAR |bfVar#15|)) + (|args| (CADR |bfVar#15|)) + (|body| (CADDR |bfVar#15|))) + (CDR (|bfDef| |op| |args| |body|)))) (|%Module| (LET ((|m| (CAR |bfVar#15|)) (|ds| (CADR |bfVar#15|))) (PROGN @@ -667,6 +672,8 @@ #0#)))))) (SETQ |sig| (|genDeclaration| |n| |t|)) (SETQ |lhs| |n|))) + (SETQ |$constantIdentifiers| + (CONS |lhs| |$constantIdentifiers|)) (LIST (LIST 'DEFCONSTANT |lhs| |rhs|))))) (|%Assignment| (LET ((|lhs| (CAR |bfVar#15|)) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index d172b0ed..ff7f2840 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -406,10 +406,10 @@ translateToplevelExpression expr == translateToplevel(b,export?) == atom b => [b] -- generally happens in interactive mode. - b is ["DEF",:.] => rest bfCompDef b b is ["TUPLE",:xs] => coreError '"invalid AST" case b of %Signature(op,t) => [genDeclaration(op,t)] + %Definition(op,args,body) => rest bfDef(op,args,body) %Module(m,ds) => $currentModuleName := m @@ -432,6 +432,7 @@ translateToplevel(b,export?) == if lhs is ["%Signature",n,t] then sig := genDeclaration(n,t) lhs := n + $constantIdentifiers := [lhs,:$constantIdentifiers] [["DEFCONSTANT",lhs,rhs]] %Assignment(lhs,rhs) => -- cgit v1.2.3